制作一个透明的TPanel(50分)

  • 主题发起人 主题发起人 kenan_2001
  • 开始时间 开始时间
K

kenan_2001

Unregistered / Unconfirmed
GUEST, unregistred user!
加一个transparent属性,把现有的TPanel加入透明属性,成为新的控件.
 
1.override CreateParams方法,ExStyle里加上WS_EX_TRANSPARENT.
2.修改Parent的 WindowStyle,去掉WS_CLIPCHILDREN.
3.截获WM_ERASEBKGND,什么都不做直接返回1,就是说不要加inherited
4.重载Paint,自己画.

 
unit MyPanel;

interface

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

type
TMyPanel = class(TPanel)
private
{ Private declarations }
protected
{ Protected declarations }
procedure Paint; override;
public
{ Public declarations }
published
{ Published declarations }
end;

procedure Register;

implementation
procedure DrawParentImage(Control: TControl; Dest: TCanvas);
var
SaveIndex: Integer;
DC: HDC;
Position: TPoint;
begin
with Control do
begin
if Parent = nil then
Exit;
DC := Dest.Handle;
SaveIndex := SaveDC(DC);
{$IFDEF DFS_COMPILER_2}
GetViewportOrgEx(DC, @Position);
{$ELSE}
GetViewportOrgEx(DC, Position);
{$ENDIF}
SetViewportOrgEx(DC, Position.X - Left, Position.Y - Top, nil);
IntersectClipRect(DC, 0, 0, Parent.ClientWidth, Parent.ClientHeight);
Parent.Perform(WM_ERASEBKGND, DC, 0);
Parent.Perform(WM_PAINT, DC, 0);
RestoreDC(DC, SaveIndex);
end;
end;

procedure Register;
begin
RegisterComponents('Samples', [TMyPanel]);
end;

procedure TMyPanel.Paint;
var
Bitmap: TBitmap;
begin

if not (csDesigning in ComponentState) then
exit;
Bitmap := TBitmap.Create;
try
Bitmap.Height := ClientRect.Bottom;
Bitmap.Width := ClientRect.Right;

DrawParentImage(Self, Bitmap.Canvas);


canvas.CopyRect(ClientRect, Bitmap.canvas, ClientRect);
finally
Bitmap.free;
end;
end;

end.

 
楼上的能不能把那段改坐标的用处说一下,我有看过这段代码,不懂改坐标原点有什么用
处? 是减少刷新区域?
 
谢谢,好用!
 
我想,对于直接添加透明属性很好,可是具体怎么操作了
 
后退
顶部