PDA

View Full Version : panel بی رنگ



Delphi-Man
دوشنبه 30 شهریور 1388, 00:46 صبح
با سلام
چطوری می تونم یه پنل بی رنگ درست کنم که چیزای پشتش پیدا باشه؟

Mahyaa
دوشنبه 30 شهریور 1388, 02:46 صبح
با یک سرچ در گوگل به یک تاپیک در Expert-Exchange برخوردم. سه راه متفاوت رو معرفی کرده :

http://www.experts-exchange.com/Programming/Languages/Pascal/Delphi/Q_20950505.html





TSkinPanel = Class (TCustomPanel)
Private
Procedure WMEraseBkGnd (Var Msg : TWMEraseBkGnd); Message WM_ERASEBKGND;

Protected
Procedure Paint; Override;

Public
Constructor Create ( AOwner : TComponent); Override;
Destructor Destroy; Override;
End;
{------------------------------------------------------------------------------}
Constructor TSkinPanel.Create ( AOwner : TComponent);
Begin
Inherited Create (AOwner);

Width := 100;
Height := 100;
End;
{------------------------------------------------------------------------------}
Destructor TSkinPanel.Destroy;
Begin
Inherited Destroy;
End;
{------------------------------------------------------------------------------}
Procedure TSkinPanel.Paint;
Var
TheClientRect : TRect;
SaveIndex : Integer;
Begin
{ This code will re-paint the parent panel }
{ This way, you may have 1 trans panel on another }
SaveIndex := SaveDC (Canvas.Handle);
MoveWindowOrg (Canvas.Handle, -Left, -Top);
Parent.Perform (WM_PAINT, Canvas.Handle, 0);
RestoreDC (Canvas.Handle, SaveIndex);
TheClientRect := ClientRect;
{ Do your drawing here }
End;
{------------------------------------------------------------------------------}
Procedure TSkinPanel.WMEraseBkGnd (Var Msg : TWMEraseBkGnd);
Begin
Msg.Result := 0;
End;
{------------------------------------------------------------------------------}





TMyTransparentPanel = class(TPanel)
protected
procedure CreateParams(var Params: TCreateParams); override;
procedure Paint; override;
end;
{...}

procedure TMyTransparentPanel.CreateParams(var Params: TCreateParams);
begin
inherited CreateParams(Params);
if not (csDesigning in ComponentState)
then Params.ExStyle:=Params.ExStyle or WS_EX_TRANSPARENT;
end;

procedure TMyTransparentPanel.Paint;
var
XBitMap: TBitMap;
XOldDC: HDC;
XRect: TRect;
begin
{This panel will be transparent only in Run Time}
if (csDesigning in ComponentState)
then inherited Paint
else begin
XRect:=ClientRect;
XOldDC:=Canvas.Handle;
XBitMap:=TBitMap.Create;
try
XBitMap.Height:=Height; XBitMap.Width:=Width;
Canvas.Handle:=XBitMap.Canvas.Handle;
inherited Paint;
RedrawWindow(Parent.Handle, @XRect, 0,
RDW_ERASE or RDW_INVALIDATE or
RDW_NOCHILDREN or RDW_UPDATENOW);
finally
Canvas.Handle:=XOldDC;
Canvas.BrushCopy(XRect, XBitMap, XRect, Color);
XBitMap.Free;
end;
end;
end;




unit TransparentPanel;

interface

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

type
TTransparentPanel = class(TPanel)
private
{ Private declarations }
FBackground: TBitmap;

Procedure WMEraseBkGnd( Var msg: TWMEraseBkGnd );
message WM_ERASEBKGND;
protected
{ Protected declarations }
Procedure CaptureBackground;
Procedure Paint; override;
public
{ Public declarations }
Procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer); override;
property Canvas;
Constructor Create( aOwner: TComponent ); override;
Destructor Destroy; override;
published
{ Published declarations }
end;

procedure Register;

implementation

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

{ TTransparentPanel }

procedure TTransparentPanel.CaptureBackground;
var
canvas: TCanvas;
dc: HDC;
sourcerect: TRect;
begin
FBackground := TBitmap.Create;
with Fbackground do begin
width := clientwidth;
height := clientheight;
end; { with }
sourcerect.TopLeft := ClientToScreen(clientrect.TopLeft);
sourcerect.BottomRight := ClientToScreen( clientrect.BottomRight );
dc:= CreateDC( 'DISPLAY', nil, nil, nil );
try
canvas:= TCanvas.Create;
try
canvas.handle:= dc;
Fbackground.Canvas.CopyRect( clientrect, canvas, sourcerect );
finally
canvas.handle := 0;
canvas.free;
end; { finally }
finally
DeleteDC( dc );
end; { finally }
end;

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

destructor TTransparentPanel.Destroy;
begin
FBackground.free;
inherited;
end;

procedure TTransparentPanel.Paint;
begin
if csDesigning In ComponentState Then
inherited
// would need to draw frame and optional caption here
// do NOT call inherited, the control fills its client area if you do!
end;

procedure TTransparentPanel.SetBounds(ALeft, ATop, AWidth,
AHeight: Integer);
begin
if Visible and HandleAllocated and not (csDesigning In
ComponentState) then begin
Fbackground.Free;
Fbackground := Nil;
Hide;
inherited;
Parent.Update;
Show;
end
else
inherited;
end;

procedure TTransparentPanel.WMEraseBkGnd(var msg: TWMEraseBkGnd);
var
canvas: TCanvas;
begin
if csDesigning In ComponentState Then
inherited
else begin
if not Assigned( FBackground ) then
Capturebackground;
canvas := TCanvas.create;
try
canvas.handle := msg.DC;
canvas.draw( 0, 0, FBackground );
finally
canvas.handle := 0;
canvas.free;
end; { finally }
msg.result := 1;
end;
end;