【Delphi】创建透明的Panel

转自:http://delphi-kb.blogspot.nl/2011/06/how-to-create-transparent-tpanel_1516.html

Problem/Question/Abstract:

How to create a transparent TPanel

Answer:

Solve 1:

Particularly note the SetParent bit. It works even with movement. It should even work in Delphi 1, as it doesn't use the Win32 non-rectangular-window method for creating transparency. The code is simple so can be easily retro-fitted to any control that you wished were transparent. I put this together in ten minutes, so it needs proper testing to make sure it doesn't cause any problems, but here it is. Create one on a form, and drag it about over some edits, combo boxes etc. (and TImages and you'll get major flicker).

type
  TTransparentPanel = class(TPanel)
  private
    procedure SetParent(AParent: TWinControl); override;
    procedure WMEraseBkGnd(var Message: TWMEraseBkGnd); message WM_EraseBkGnd;
  protected
    procedure CreateParams(var Params: TCreateParams); override;
    procedure Paint; override;
  public
    constructor Create(AOwner: TComponent); override;
    procedure Invalidate; override;
  end;

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

procedure TTransparentPanel.CreateParams(var Params: TCreateParams);
begin
  inherited CreateParams(Params);
  Params.ExStyle := Params.ExStyle or WS_EX_TRANSPARENT;
end;

procedure TTransparentPanel.Paint;
begin
  Canvas.Brush.Style := bsClear;
  Canvas.Rectangle(0, 0, Width, Height);
  Canvas.TextOut(Width div 2, Height div 2, 'Transparent');
end;

procedure TTransparentPanel.WMEraseBkGnd(var Message: TWMEraseBkGnd);
begin
  {Do Nothing}
  Message.Result := 1;
end;

procedure TTransparentPanel.SetParent(AParent: TWinControl);
begin
  inherited SetParent(AParent);
  {The trick needed to make it all work! I don't know if changing the parent's 
        style is a good idea, but it only removes the WS_CLIPCHILDREN style which shouldn't    cause any problems.}
  if Parent <> nil then
    SetWindowLong(Parent.Handle, GWL_STYLE, GetWindowLong
      (Parent.Handle, GWL_STYLE) and not WS_ClipChildren);
end;

procedure TTransparentPanel.Invalidate;
var
  Rect: TRect;
begin
  Rect := BoundsRect;
  if (Parent <> nil) and Parent.HandleAllocated then
    InvalidateRect(Parent.Handle, @Rect, True)
  else
    inherited Invalidate;
end;


Solve 2:

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;

procedure TTransparentPanel.CaptureBackground;
var
  canvas: TCanvas;
  dc: HDC;
  sourcerect: TRect;
begin
  FBackground := TBitmap.Create;
  with Fbackground do
  begin
    width := clientwidth;
    height := clientheight;
  end;
  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
    DeleteDC(dc);
  end;
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);

相关推荐

  • Delphi中如何实现透明按钮 各位亲爱的读者,在delphi编程实战中我们可以使用按钮控件来制作程序中的按钮键。但是在使用其它软件时,我们常常可以看到透明按钮的效果。那么如何在delphi中实现透明按钮的效果?笔者在互联网搜索了不少时间也没有找到这方面的控件,于是决定自
  • 从头开始教你创建一个自定义可视化的Winows Form控件(Divider Panel)--For Begnners DividerPanel-从头开始教你创建一个自定义可视化的WinowsForm控件-ForBeginners原文(英文)http://www.codeproject.com/cs/miscctrl/DividerPanel.asp系统:W
  • Delphi 10 up1 透明窗体的bug. 当将Form.Transparency=True时,即设置Form为透明的。运行程序,显示这个窗口,是正常的,但这时候如果按Home键返回android桌面,再切换回来,问题就来了,你看不到这个透明窗口上的控件,也就相当于没有显示这个透明窗
  • Delphi 创建建具有“反射调用”功能的类 Delphi创建建具有“反射调用”功能的类有的时候你会希望自己定义的一个Class在运行期能增加一个property、function,或者一个方法能完全改变他的行为,又或者你希望通过方法名来调用方法(类似JAVA)。这样的效果可以利用Au
  • 小技巧:用Delphi创建服务程序 小技巧:用Delphi创建服务程序来源:中国IT实验室整理  Windows2000/XP和2003等支持一种叫做"服务程序"的东西.程序作为服务启动有以下几个好处:    (1)不用登陆进系统即可运行.  (2)具有SYSTEM特权.所以
  • delphi组件继承与dll创建 dll创建:
  • delphi创建文件和读取.ini文件 filecreate('路径加文件名');//创建一个文件。读写ini文件:先在uses定义Inifiles,在var定义myinifile:Tinifile;实现部分写代码:myinifile:=Tinifile.create('d:\1
  • Delphi下用WindowsAPI创建窗体 //Delphi下调用WindowsAPI创建窗体.////模板-------BYHottey2004-4-13-0:18////作者网站:http://asp.itdrp.com/hottey//programdelphi;useswin
  • Delphi调用基于CXF创建的Web Service问题 Delphi调用基于CXF创建的WebService问题分类:WebService技术2009-08-1919:18791人阅读评论(5)收藏举报1.Encoding编码问题2009-8-1919:19:49org.apache.cxf.i
  • Delphi编程创建和删除文件夹 本实例介绍如何在程序中创建文件夹,并且可以将新创建的文件夹删除到回收站中。  向窗体上添加两个TButton组件,一个用于创建新的文件夹,另一个用于删除新创建的文件夹,设计完成的窗体如图1所示。  图1主界面  首先在程序的uses段中添加
  • [二级Delphi必备资料]delphi动态创建窗体   落拓犁花刊播击溃出奔普陀陈设!小考乱采残币初访拱抱盲人扭打签证,飘泊鲁王全能每篇奥马。来到猸子吵扰遣责祈使埃门舒张毛团,电影不韪德寇来世立苗劳驾,事功黄米麋集足踝铺摊离站。吗啡名驰拉纤旁证小狐轻待,湟源马场路祭民丰登仕明堂。  成性痂病
  • 用Delphi创建服务程序(delphi7) 引用:http://www.mycoolapp.net/post/51.htmlWindows2000/XP和2003等支持一种叫做"服务程序"的东西.程序作为服务启动有以下几个好处:(1)不用登陆进系统即可运行.(2)具有SYSTEM特权

你的评论

就没有什么想说的吗?

©2017传客网    琼ICP备15003173号-2    

本站部分文章来源于互联网,版权归属于原作者。
本站所有转载文章言论不代表本站观点,如是侵犯了原作者的权利请发邮件联系站长(weishubao@126.com),我们收到后立即删除。
站内所有资源仅供学习与参考,请勿用于商业用途,否则产生的一切后果将由您自己承担!

X