//透明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;