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.