//透明Panel控件

unit TranPanel;

interface

uses

Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ExtCtrls;

type

TGlassStyle = (
gsBlackness, gsDstInvert, gsMergeCopy, gsMergePaint, gsNotSrcCopy,
gsNotSrcErase, gsPatCopy, gsPatInvert, gsPatPaint, gsSrcAnd,
gsSrcCopy, gsSrcErase, gsSrcInvert, gsSrcPaint, gsWhiteness);

TGlass = class(TCustomControl)

private

FColor: TColor;
FStyle: TGlassStyle;
FOnPaint: TNotifyEvent;
procedure SetColor(Value: TColor);
procedure SetStyle(Value: TGlassStyle);
procedure CMCtl3DChanged(var Message: TMessage); message CM_CTL3DCHANGED;
procedure WMEraseBkgnd(var Message: TMessage); message WM_ERASEBKGND;
procedure WMWindowPosChanging(var Message: TWMWindowPosChanging); message WM_WINDOWPOSCHANGING;

protected

Buffer: TBitmap;
procedure CreateParams(var Params: TCreateParams); override;
procedure Paint; override;
procedure Resize; override;

public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
property Canvas;

published

property Align;
property Anchors;
property AutoSize;
property BiDiMode;
property BorderWidth;
property Color: TColor read FColor write SetColor;
property Ctl3D;
property Enabled;
property Style: TGlassStyle read FStyle write SetStyle default gsSrcAnd;
property Visible;
property OnClick;
property OnDblClick;
property OnEnter;
property OnExit;
property OnMouseDown;
property OnMouseMove;
property OnMouseUp;
property OnResize;
property OnPaint: TNotifyEvent read FOnPaint write FOnPaint;
end;

procedure Register;

implementation

procedure Register;
begin
RegisterComponents(‘Croco‘, [TGlass]);
end;

function GlassStyleToInt(gs: TGlassStyle): LongInt;
begin
case gs of
gsBlackness : Result := cmBlackness;
gsDstInvert : Result := cmDstInvert;
gsMergeCopy : Result := cmMergeCopy;
gsMergePaint : Result := cmMergePaint;
gsNotSrcCopy : Result := cmNotSrcCopy;
gsNotSrcErase: Result := cmNotSrcErase;
gsPatCopy : Result := cmPatCopy;
gsPatInvert : Result := cmPatInvert;
gsPatPaint : Result := cmPatPaint;
gsSrcAnd : Result := cmSrcAnd;
gsSrcCopy : Result := cmSrcCopy;
gsSrcErase : Result := cmSrcErase;
gsSrcInvert : Result := cmSrcInvert;
gsSrcPaint : Result := cmSrcPaint;
gsWhiteness : Result := cmWhiteness;
else Assert(True, ‘Error parameter in function GlassStyleToInt‘);
end;
end;

constructor TGlass.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
Buffer := TBitmap.Create;
ControlStyle := [csAcceptsControls, csCaptureMouse, csClickEvents,
csDoubleClicks, csReplicatable];
Width := 100;
Height := 100;
FStyle := gsSrcAnd;
ParentCtl3d := False;
Ctl3D := False;
ParentColor := False;
FColor := clWhite;
end;

destructor TGlass.Destroy;
begin
Buffer.Free;
inherited Destroy;
end;

procedure TGlass.Paint;
var
R: TRect;
rop: LongInt;
begin
R := Rect(0, 0, Width, Height);
Buffer.Width := Width;
Buffer.Height := Height;
Buffer.Canvas.Brush.Style := bsSolid;
Buffer.Canvas.Brush.Color := FColor;
Buffer.Canvas.FillRect(Rect(0, 0, Width, Height));
rop := GlassStyleToInt(FStyle);
StretchBlt(Buffer.Canvas.Handle, 0, 0, Width, Height,
Canvas.Handle, 0, 0, Width, Height, rop);
if Ctl3D then DrawEdge(Buffer.Canvas.Handle, R, BDR_RAISEDINNER, BF_RECT);
Buffer.Canvas.Pen.Mode := pmCopy;
Buffer.Canvas.Pen.Style := psSolid;
Canvas.Draw(0, 0, Buffer);
if Assigned(FOnPaint) then FOnPaint(Self);
end;　

procedure TGlass.SetColor(Value: TColor);
begin
if Value <> FColor then
begin
FColor := Value;
RecreateWnd;
end;
end;

procedure TGlass.CreateParams(var Params: TCreateParams);
begin
inherited CreateParams(Params);
Params.ExStyle := Params.ExStyle + WS_EX_TRANSPARENT;
end;

procedure TGlass.WMWindowPosChanging(var Message: TWMWindowPosChanging);
begin
Invalidate;
inherited;
end;

procedure TGlass.WMEraseBkgnd(var Message: TMessage);
begin
Message.Result := 0;
end;

procedure TGlass.Resize;
begin
Invalidate;
inherited;
end;

procedure TGlass.CMCtl3DChanged(var Message: TMessage);
begin
inherited;
RecreateWnd;
end;

procedure TGlass.SetStyle(Value: TGlassStyle);
begin
if Value <> FStyle then
begin
FStyle := Value;
RecreateWnd;
end;
end;

end.
我也遇到同样的问题,能解决的话,另外我也开贴给分.
目前网上有不少代码.目前我使用的方法是
1.重写TPanel的Create方法,增加
ControlStyle := ControlStyle - [csOpaque];
  Brush.Style := bsClear;
2.CreateParams方法,增加
with Params  do
  begin
    ExStyle := ExStyle or WS_EX_TRANSPARENT;
  end;
3.重写Paint方法,直接将置空(我现在用的Panel只是做为一个容器用)
4.获取WM_ERASEBKGND消息,Result为1

但是现在出现两个问题
1.放置Panel的窗口发生变化时,Panel不显示
2.Panel刷新后,背景没有刷新.(我在Panel上放了两个控件:控件1,控件2,这两个控件是交替显示的,发生交替的时候发现前面一个隐藏掉的控件还是画在了Panel上面,导致背景看起来很乱).

由于这个Panel是放在Form上使用的,我在Form上又放置了TImage控件,我希望Panel透明以后不要影响其他控件的显示效果,而现在网上的基本是靠获取Panel的父控件的背景来重画Panel背景实现,这种方式会影响其他控件的使用.
我结合网上搜到的资料,做了一个,基本能够达到我的应用了,但是还存在一个问题"放置Panel的窗口发生变化时,Panel不显示",
先把代码贴出来,大家帮忙看看哪边有问题.
//透明Panel
  TTransparentPanel=class(TPanel)
  protected
    procedure Paint; override;
    procedure WMEraseBkgnd(var Message: TMessage); message WM_ERASEBKGND;
    procedure WMMove(var Message: TWMMove); Message WM_Move;
    procedure AlignControls(AControl: TControl; var Rect: TRect); override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure CreateParams(var Params: TCreateParams); override;
    procedure Invalidate;override;
  end;

{ TTransparentPanel }

procedure TTransparentPanel.AlignControls(AControl: TControl; var Rect: TRect);
begin
  inherited;
  Invalidate;
end;

constructor TTransparentPanel.Create(AOwner: TComponent);
begin
  inherited;
  ControlStyle := ControlStyle - [csSetCaption];
  ControlStyle := ControlStyle - [csOpaque];
end;

procedure TTransparentPanel.CreateParams(var Params: TCreateParams);
begin
  inherited;
  with Params  do
  begin
    ExStyle := ExStyle or WS_EX_TRANSPARENT;
  end;
end;

destructor TTransparentPanel.Destroy;
begin

  inherited Destroy;
end;

procedure TTransparentPanel.Invalidate;
var
  Rect: TRect;
  iLoop: Integer;
begin
  if (Parent<>nil) and(Parent.HandleAllocated) then
  begin
    Rect := BoundsRect;
    InvalidateRect(Parent.Handle,@Rect,False);
    for iLoop := 0 to ControlCount- 1 do
       Controls[iLoop].Invalidate;
  end;
end;

procedure TTransparentPanel.Paint;
var
  ARect: TRect;
  TopColor, BottomColor: TColor;

  procedure AdjustColors(Bevel: TPanelBevel);
  begin
    TopColor := clBtnHighlight;
    if Bevel = bvLowered then TopColor := clBtnShadow;
    BottomColor := clBtnShadow;
    if Bevel = bvLowered then BottomColor := clBtnHighlight;
  end;
begin
  ARect := GetClientRect;
  if BevelOuter <> bvNone then
  begin
    AdjustColors(BevelOuter);
    Frame3D(Canvas, ARect, TopColor, BottomColor, BevelWidth);
  end;
  Frame3D(Canvas, ARect, Color, Color, BorderWidth);
  if BevelInner <> bvNone then
  begin
    AdjustColors(BevelInner);
    Frame3D(Canvas, ARect, TopColor, BottomColor, BevelWidth);
  end;
  Update;
end;

procedure TTransparentPanel.WMEraseBkgnd(var Message: TMessage);
begin
  Message.Result := 1;
end;


procedure TTransparentPanel.WMMove(var Message: TWMMove);
begin
  inherited;
  Invalidate;
end;

delphi透明panel组件或者制作方法