TPanel transparent ?

[Shamora]

Hallo!
Hoffe, es hilft Euch. Funktioniert einwandfrei.

Delphi-Quellcode:

unit TransparentPanel;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, ExtCtrls;

type
  TTransparentPanel = class(TCustomPanel)
  private
    { Private declarations }
    procedure WMEraseBkgnd(var Message: TWmEraseBkgnd); message WM_ERASEBKGND;    
  protected
    { Protected declarations }
    Procedure Paint; override;
    Procedure CreateParams(var Params : TCreateParams); override;
  public
    { Public declarations }
    constructor Create(AComponent: TComponent);override;
  published
    { Published declarations }
    Property BevelInner;
    Property BevelOuter;
    Property Align;
    Property Caption;
    property OnClick;
  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('Shamora', [TTransparentPanel]);
end;

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

Procedure TTransparentPanel.Paint;
var
  Rect: TRect;
  TopColor, BottomColor: TColor;
const
  Alignments: array[TAlignment] of Word = (DT_LEFT, DT_RIGHT, DT_CENTER);

  procedure AdjustColors(Bevel: TPanelBevel);
  begin
    TopColor := clBtnHighlight;
    if Bevel = bvLowered then TopColor := clBtnShadow;
    BottomColor := clBtnShadow;
    if Bevel = bvLowered then BottomColor := clBtnHighlight;
  end;

begin
  Rect := GetClientRect;
  if BevelOuter < bvNone then
  begin
    AdjustColors(BevelOuter);
    Frame3D(Canvas, Rect, TopColor, BottomColor, BevelWidth);
  end;
  Frame3D(Canvas, Rect, Color, Color, BorderWidth);
  if BevelInner < bvNone then
  begin
    AdjustColors(BevelInner);
    Frame3D(Canvas, Rect, TopColor, BottomColor, BevelWidth);
  end;
end;

Procedure TTransparentPanel.CreateParams(var Params : TCreateParams);
Begin
  inherited CreateParams(Params);
  With Params do
  begin
    ExStyle := ExStyle or WS_EX_TRANSPARENT;
    Style := Style and not WS_CLIPCHILDREN;
    Style := Style and not WS_CLIPSIBLINGS;
  end;
End;

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

end.

Gruß,
Shamora.