关于制作透明窗体(100分)

yuboo · 2000-10-16

在网上和杂志上经常看到关于制作透明窗体的文章，大多是加载窗体前复制好窗体下面的 图像，移动窗体时计算好相对位置后向窗体上拷贝。但当图像改变后就露馅了，而且代码 也很长。有没有一种简单的方法实现呢？我看到过一篇VB的文章是用的这三个API函数: SetWindowRgn,CombineRgn和CreateRectRgn来实现的。不知Delphi是如何用API函数实现的? 能否写的具体一些?或写信告诉我:fox21th@sina.com多谢!

hhzh426 · 2000-10-16

制作透明窗体只要将form.cavas.brush.style设置成bsclear就可以了。 而制作不规则窗体就需要用你所说的三个函数，setwindowrgn(handle, CreateEllipticRgn(0,0,400,300),true)将建立一个椭圆窗体。其余的你可以看相应帮助。

zengr · 2000-10-16

实现窗体透明，主要是拦截CMEraseBkgnd消息，并将窗体画刷的Style属性设为bsClear。 下为简单的例子： Procedure CMEraseBkgnd(var Message:TWMEraseBkgnd);Message WM_ERASEBKGND; begin   brush.style := bsClear;   Inherited; end;

Croco · 2000-10-16

SetWindowRgn,CombineRgn和CreateRectRgn是用于创建任意形状的窗口， 不是用于使窗口透明的。

pino · 2000-10-16

概念问题！ 真正的透明或者是半透明窗体应该是可以透过窗体本身的可见部分看到后面的背景， 也就是其他窗体或是桌面。这个必然要通过alpha混合来实现，目前只有在win2000 下可以真正实现，因为有api支持，win9x下只能模拟，效果不太好，就象金山词霸 的取词窗口，背景改变而窗体上还是不变，就象你说的那种技术。

www · 2000-10-16

pino说的对。

devuser · 2000-10-17

用Win2000 新的API函数制作透明窗口 -------------------------------------------------------------------------------- ---- Windows2000增加了很多功能，起码修改TCP/IP设置后无需重新启动电脑就可以使用的特性就会使很多以前饱受WIN95/98重新启动并扫描文件之苦的用户觉得Windows2000 确实有了改进。除此之外，Windows2000的API也有很多新的东西。下面一个例子是利用 Windows2000新的API函数制作透明窗口。这里主要介绍用Delphi调用Windows2000新的 API函数实现这一功能的过程。 ----使用SetLayeredWindowAttributes API函数可以设置窗口的风格，该函数介绍如下： 函数功能：设置窗口透明颜色 格式：BOOL SetLayeredWindowAttributes(              HWND hwnd,         //窗口手柄              COLORREF crKey,    //指定颜色值              BYTE bAlpha,        //混合函数值              DWORD dwFlags     //动作             &nbsp

; ----参数解释： ----hwnd ---- 窗口手柄。当使用CreateWindowEx函数创建窗口时，窗口由WS_EX_LAYERED指定的值创建；或者窗口已经创建后，由SetWindowLong根据 WS_EX_LAYERED指定的值改变。 ----crKey ----指向一个COLORREF值，该值指定一个透明颜色值，当创建窗口时，窗口将使用该值。窗口绘制的所有颜色将为透明。要想产生COLORREF值，请使用RGB宏。 ----bAlpha ----混合函数值。该值用于描述窗口的不透明度。当bAlpha 值为0时，窗口完全透明，当bAlpha值为255时，窗口完全不透明。 ---- dwFlags ----指定动作。这个参数可以取一个或多个值：   ----返回值： ----如果函数成功，返回非零值。如果函数失败，返回零值。进一步取得错误信息，请调用GetLastError.函数。 ----注意：一旦SetLayeredWindowAttributes调用该函数，随后的UpdateLayeredWindow调用将会无效，直到层风格的点被清除并重新设置。 ---- 各个参数详细意义和它们的取值以及每个值的意义请参看http//msdn.microsoft.com/ library/psdk/winui/windows_1p6b.htm，这里不加赘述。这里要强调的是，该函数只适用于Windows2000，要调试本程序，请选Windows2000操作系统。 ---- 在表单中放置一个ScrollBar控件，使用FormCreate， FormDestroy，ScrollBar1Change三个事件。当移动ScrollBar的按钮时，表单的透明度将产生变化。程序代码如下： {API声明} type   TSetLayeredWindowAttributes     = function(wnd: HWND; crKey: DWORD;       bAlpha: BYTE; dwFlag: DWORD): Boolean; stdcall; const   WS_EX_LAYERED = ＄80000;   LWA_ALPHA = 2; var   hLibUser32: THandle;   MySetLayeredWindowAttributes:       TSetLayeredWindowAttributes; implementation {＄R ＊.DFM} procedure TForm1.FormCreate(Sender: TObject); var   p: Pointer; begin   hLibUser32 := LoadLibraryA(‘user32.dll');   MySetLayeredWindowAttributes := nil;   if hLibUser32 <> 0 then begin  p:=GetProcAddress(hLibUser32,     ‘SetLayeredWindowAttributes');     if p = nil then begin       FreeLibrary(hLibUser32);       hLibUser32 := 0;     end else begin       MySetLayeredWindowAttributes :=      TSetLayeredWindowAttributes(p);     end;   end;   if hLibUser32 <> 0 then begin     SetWindowLong(Handle, GWL_EXSTYLE,       GetWindowLong(Handle, GWL_EXSTYLE)        or WS_EX_LAYERED);     ScrollBar1.Position := ScrollBar1.Max;     ScrollBar1Change(Self);   end else begin     ShowMessage(‘该操作系统不支持！');     Application.Terminate;   end; end; procedure TForm1.FormDestroy(Sender: TObject); begin   if hLibUser32 <> 0 then begin      FreeLibrary(hLibUser32);      hLibUser32 := 0;   end; end; procedure TForm1.ScrollBar1Change(Sender: TObject); var   alpha: Integer; begin   if hLibUser32 <> 0 then begin     alpha := ScrollBar1.Position; alpha := alpha ＊ 255 div  (ScrollBar1.Max － ScrollBar1.Min);     if alpha < 8 then alpha := 8;     if alpha > 255 then alpha := 255; MySetLayeredWindowAttributes (Handle, 0, Byte(alpha), LWA_ALPHA);   end; end; ----程序在Delphi5.0、Wndows2000操作系统下调试成功。

devuser · 2000-10-17

如何制作半透明窗口 ---- 用过金山词霸的朋友，一定会为其半透明的翻译提示窗口而称奇。究竟这种窗口是如何做出来的呢？下面我们将来探讨这种半透明的窗口的制作方法。 一、原理 ---- 首先，我们先从透明窗口说起，其实透明窗口就是可以透过窗口看到它背景。所以，我们可以将窗口后面的背景图象，显示在窗口前面，就可实现透明窗口的效果了。至于半透明的效果，是在透明的基础上，加上一层滤镜，使看到的背景模糊一点而已。所以，在拿到背景图象后，先在该图象加上一层滤镜（把图象弄模糊），然后再显示在窗口上，就能达到半透明的效果。 ---- 我们可归纳出实现半透明窗口的步骤：在窗口显示前其获取背景图 → 对背景图象进行滤镜效果处理 → 将处理过的背景图象显示在窗口前面。 ---- （1）获取背景图象 ---- 要获取背景图，先用GetDC(0)函数获取整个屏幕设备场景（DC），再用CopyRect函数拷贝窗口的背景到指定的Tbitmap，该Tbitmap就是我们所要的图象了。其中函数GetDC(0)取得的DC可用TCanvas.Handle保存；而CopyRect是TCancas类的成员函数，作用是从一Canvas中拷贝一指定区域（Rect）到另一Canvas的指定区域。 ---- (2）对背景图进行滤镜效果处理 ---- 用循环的方法遍历图象的每一点，将各点的某些频段的光波滤除。其实，滤镜种类繁多，所以的算法亦很多，读者们可参考相关资料，选择您满意的方法。本文的滤镜是灰色的，实现方法见TranslucentBmp(Bmp:TBitmap;AColor:TColor;ATransparent:Longint)。其中，参数Bmp是要处理的图象，AColor是滤镜的颜色，ATransparent是透明度。 二、写程序 ---- 将以上原理用Delphi编写成程序，在Delphi中新建一Project，Form1的Height和Width分别设成150和300（不要做的太大，不然显示速度很慢），再设置BorderStyle的值为bsNone；在Form1中添加一Timage控件Image1，将其Align属性设成alClient。再添加一标签Label1和按钮TSpeedButton，在Label1的Caption属性中输入"这是一半透明窗口！"，按钮的Caption属性设成"x"，在其OnClick事件中输入一行"Close;"。并将它们Bring to Front。另外，可添加四个TShape，贴在Image1的四边上，以构造Form1的3D效果，如图（一）。各控件的属性如下表： 组件名称属性设置值 Form1 BorderStyle BsNone  Height 150  Width 300  TFont 宋体9号 Image1 Align AlClient Label1 Caption 这是一半透明窗口！  TFont 宋体9号，黄色 SpeedButton1 Caption X  Left 279  Top -1  Height 14  Width 13  Transparent True   图（一） ---- 完整的源代码如下： unit Unit1; interface uses   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,   StdCtrls, ExtCtrls, Buttons; type   TForm1 = class(TForm)     Label1: TLabel;     Shape1: TShape;     Shape2: TShape;     Shape3: TShape;     Shape4: TShape;     Image1: TImage;     SpeedButton1: TSpeedButton;     procedure FormCreate(Sender: TObject);     procedure SpeedButton1Click(Sender: TObject);   private     { Private declarations }     //截获背景图象     function  GetBackgroundBmp:TBitmap;     //对背景图象进行滤镜处理 procedure TranslucentBmp(Bmp:TBitmap; AColor:TColor;ATransparent:Longint);   public     { Public declarations }   end; var   Form1: TForm1; implementation {$R *.DFM} //以下截获背景图象 function TForm1.GetBackgroundBmp:TBitmap; var Scn:TCanvas;     h,w:Integer; begin Scn:=TCanvas.Create; //建立整个屏幕的画布 h:=ClientHeight;//窗口的高 w:=ClientWidth; //窗口的宽 Result.Height:=h;    //设返回位图的高就是窗口的高 Result.Width:=w;//设返回位图的宽就是窗口的宽 try Scn.Handle:=GetDC(0);//取得整个屏幕的DC //以下一行将窗口的背景部分复制到指定的画布中， 也就是本函数的返回值 Result.Canvas.CopyRect(Rect(0,0,w,h),Scn, Rect(Left,Top,Left+w,Top+h)); ReleaseDC(0, Scn.handle); finally Scn.Free; end; end; //以下函数对背景图象进行滤镜处理， Bmp是要处理的位图；ATransparent是透明度 procedure TForm1.TranslucentBmp(Bmp: TBitmap;AColor:TColor;ATransparent:Longint); var BkColor:COLORREF;     ForeColor:Longint;     R,G,B:Int64;     i,j:Integer; begin ForeColor:=ColorToRGB(AColor); with Bmp.Canvas do for i:=ClientHeight-1 downto 0 do    for j:=ClientWidth-1 downto 0 do    begin  BkColor:=GetPixel(Handle,j,i); //取得每一象素  R:=Byte(ForeColor)+ (Byte(BkColor)-Byte(ForeColor))*ATransparent;  G:=Byte(ForeColor shr 8)+ (Byte(BkColor shr 8)-Byte(ForeColor shr 8))*ATransparent;  B:=Byte(ForeColor shr 16)+ (Byte(BkColor shr 16)-Byte(ForeColor shr 16))*ATransparent;  SetPixelV(Handle,j,i,RGB(R,G,B));//合成象素    end; end; procedure TForm1.FormCreate(Sender: TObject); var BackgroundBmp:TBitmap; begin try BackgroundBmp:=Tbitmap.Create;   //建立窗口背景图 BackgroundBmp.PixelFormat:=pf24bit;   //指定该图是24位真彩色 BackgroundBmp:=GetBackgroundBmp; //取得窗口背景图 TranslucentBmp(BackgroundBmp,clBlack,50); //对该图象进行滤镜处理 Image1.Picture.Bitmap:=BackgroundBmp; //将处理过的图象显示出来 finally BackgroundBmp.Free; end; end; procedure TForm1.SpeedButton1Click (Sender: TObject); begin Close; end; end. ---- 程序的运行效果如图（一）所示。 三、结束语 ---- 需要说明的是：由于受到以上滤镜算法的速度影响，所以窗口显示时有所延迟，在窗口频繁显示和关闭时不是很流畅。但不知读者朋友们有没有发现，金山词霸的半透明窗口效果只能在带MMX指令集的处理器中才起作用，所以笔者大胆推测，金山词霸的半透明窗口是经过MMX的多媒体指令集进行优化的，这样它才可以达到理想的效果。有兴趣的朋友可以试一下，说不定您做得比金山词霸还好呢。 ---- 以上程序在中文Windows 98、Delphi 4 C/S环境下编译通过。

yuboo · 2000-10-23

那我所问的那三个函数又如何用呢？

gcq · 2000-10-24

拦截CMEraseBkgnd消息，并将窗体画刷的Style属性设为bsClear 》不能刷新！W2000的那个函数也只是看过！应该可以的！ SetWindowRgn   设置窗体的显示区域 CombineRgn     获取两个区域的并集 CreateRectRgn  创建矩形区域 具体的参数、用法可看帮助！

wjiachun · 2000-11-30

多人接受答案了。

关于制作透明窗体(100分)

yuboo

Unregistered / Unconfirmed

hhzh426

Unregistered / Unconfirmed

zengr

Unregistered / Unconfirmed

Croco

Unregistered / Unconfirmed

pino

Unregistered / Unconfirmed

www

Unregistered / Unconfirmed

devuser

Unregistered / Unconfirmed

devuser

Unregistered / Unconfirmed

yuboo

Unregistered / Unconfirmed

gcq

Unregistered / Unconfirmed

wjiachun

Unregistered / Unconfirmed

Similar threads