如何做一个透明的panel?(50分)

  • 主题发起人 主题发起人 base1
  • 开始时间 开始时间
没做过,看看去
http://www.gislab.ecnu.edu.cn/delphibbs/DispQ.asp?LID=140472
 
用他人编写的控件
 
问题是,控件在哪?
 
用CoolControls。
http://www.net-wing.net/kangwei/
 
这个问题我也想知道,在VCL库中,只要是从TWinControl类继承下来的部件
似乎都不能作成透明的,不知高手有什么看法?
 
很简单, 到已答问题里找. 主要截取WM_ERASEBKGND, WM_PAINT, 重载
CreateParams, CreateWnd, SetParent这几个方法以保证它的window ExStyle里包
含WS_EX_TRANSPARENT位, 并且Parent的Style中不包含WS_CLIPCHILDREN位.
当然, 想要刷新流畅还得有点技巧, 比如事先保存背景, 然后设置ControlStyle里包含
csOpaque以防止每次刷新都重画整个背景, 等到移动或者改变大小时再去掉csOpaque
并再次保存背景.
 
也可以这样:

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.
 
多人接受答案了。
 
后退
顶部