如何使Form保持透明？

Question

一般可以通过设置Form的一个属性使其在显示的位置暂时透明。可是它没有做到真正的透明？就是窗体像块玻璃一样随着移动而后面的界面能真正反在窗体上，
比如FlashGet的浮动小窗体就是这种效果？

Answer 1

转贴
------------
半透明窗体
半透明窗体并不是win2000的新特效，凡是用过金山词霸的同志都会发现在屏幕取词设置中有一个半透明背景的选项，这说明在win98下是可以实现半透明窗口的。但我还是要首先谈谈在win2000实现半透明窗体的新函数setlayeredwindowattributes。利用这个函数就可以轻松创建一个半透明窗体，但是利用这个函数的程序编译后在win98下是无法运行的。setlayeredwindowattributes api函数介绍如下： 函数功能：设置窗口透明颜色 参数：setlayeredwindowattributes( hwnd hwnd, //窗口手柄 colorref crkey, //指定颜色值 byte balpha, //混合函数值 dword dwflags //动作 参数解释： hwnd:窗口句柄。当使用createwindowex函数创建窗口时，窗口由ws_ex_layered指定的值创建；或者窗口已经创建后，由setwindowlong根据ws_ex_layered指定的值改变。 crkey:指向一个color值，该值指定一个透明颜色值，当创建窗口时，窗口将使用该值。 balpha:混合函数值。该值用于描述窗口的不透明度。当balpha 值为0时，窗口完全透明，当balpha值为255时，窗口完全不透明。 dwflags:指定动作。这个参数可以取一个或多个值。用它我们可以创建一个不规则的窗体。

Answer 2

setlayeredwindowattributes函数的api声明: setlayeredwindowattributes(hwnd: hwnd; crkey: dword;balpha: byte; dwflag: dword): boolean; stdcall; ---------程序代码1： const ws_ex_layered = $80000; lwa_colorkey = $1; lwa_alpha = $2; procedure tform1.formcreate(sender: tobject); var l:longint; begin l :=getwindowlong(handle, gwl_exstyle); l := l or ws_ex_layered; setwindowlong (handle, gwl_exstyle, l); setlayeredwindowattributes(handle, 180, 120, lwa_alpha); end; 还有一些其它的常量定义如: ac_src_alpha = $1; ac_dst_no_premult_alpha = $10; ulw_colorkey = $1; ulw_alpha = $2; ulw_opaque = $400; 等还要参看msdn。有些我还没有搞明白，如果哪位同志知道的话，请告诉我。 那么在win98下又是如何实现半透明窗体的呢?其基本原理是:在窗口显示前其获取背景图然后对背景图象进行滤镜效果处理再将处理过的背景图象显示在窗口前面。 有一种方法是:首先，做出一个透明窗体，然后在窗体上添加一个shape，将其扩展至全屏幕，将shape的pen的mode属性设为pmmask,pen的style属性设为psclear,最后改变brush的color属性即可。 因为没有api支持，win9x下只能模拟，效果不太好，就象金山词霸的取词窗口，背景改变而窗体上还是不变。但我们可以利用timer控件来解决窗体的刷新率和时时更新的问题。 不过听说“金山词霸的半透明窗口效果只能在带mmx指令集的处理器中才起作用”不知是真是假，由于手头没有这样的电脑，还请同志们自己验证吧。

Answer 3

--------------------------------------------------------------------------------
在windows2000下增加了一些API,可以轻易的实现半透明的窗体，源程序如下，必要的地方我加上了注释unit Unit1;interfaceuses  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs;const  WS_EX_LAYERED = $80000;  AC_SRC_OVER = $0;  AC_SRC_ALPHA = $1;  AC_SRC_NO_PREMULT_ALPHA = $1;  AC_SRC_NO_ALPHA = $2;  AC_DST_NO_PREMULT_ALPHA = $10;  AC_DST_NO_ALPHA = $20;  LWA_COLORKEY = $1;  LWA_ALPHA = $2;  ULW_COLORKEY = $1  ULW_ALPHA = $2  ULW_OPAQUE = $4

Answer 4

设置FORM的三个属性就可以了：TransparentColorValue，TransparentColor，Color

Answer 5

unit homepage_coolform;interfaceuses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ExtCtrls, StdCtrls, Buttons;type TForm1 = class(TForm)
procedure FormPaint(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private { Private declarations }
public { Public declarations }
hbmp:integer;
end;var Form1: TForm1;implementation
{$R *.DFM}
function CopyScreenToBitmap(Rect:TREct):integer;
var
  hScrDC, hMemDC, hBitmap, hOldBitmap:integer;     
  nX, nY, nX2, nY2: integer;
  nWidth, nHeight:integer;      
  xScrn, yScrn:integer;
begin
if (IsRectEmpty(Rect)) then
begin
result:= 0;
exit;
end; // 获得屏幕缓冲区的句柄.
// a memory DC compatible to screen DC
hScrDC:= CreateDC('DISPLAY', pchar(0), pchar(0), PDeviceModeA(0));
hMemDC:= CreateCompatibleDC(hScrDC);
// get points of rectangle to grab
nX := rect.left;
nY := rect.top;
nX2 := rect.right;
nY2 := rect.bottom;
// get screen resolution
xScrn:= GetDeviceCaps(hScrDC, HORZRES);
yScrn := GetDeviceCaps(hScrDC, VERTRES);
//make sure bitmap rectangle is visible
if (nX <0) then
            nX :="0;"
      if (nY < 0) then
            nY :="0;" 
      if (nX2> xScrn) then
nX2 := xScrn;
if (nY2 > yScrn) then
nY2 := yScrn;
nWidth := nX2 - nX;
nHeight := nY2 - nY;
// create a bitmap compatible with the screen DC
hBitmap := CreateCompatibleBitmap(hScrDC, nWidth, nHeight);
// select new bitmap into memory DC
hOldBitmap := SelectObject(hMemDC, hBitmap);
// bitblt screen DC to memory DC
BitBlt(hMemDC, 0, 0, nWidth, nHeight, hScrDC, nX, nY, SRCCOPY);
// select old bitmap back into memory DC and get handle to
// bitmap of the screen
hBitmap := SelectObject(hMemDC, hOldBitmap);
// clean up
DeleteDC(hScrDC);
DeleteDC(hMemDC);
result:= hBitmap;
end;procedure TForm1.FormShow(Sender: TObject);
Var
rect:TRect;
p:TPoint;
begin
rect:=ClientRect;
p:=ClientOrigin;
rect.left:=p.x;
rect.top:=p.y;
rect.bottom:=rect.bottom+p.y;
rect.right:=rect.right+p.x;
hbmp:=copyScreenToBitmap(rect);
inherited;
end;procedure TForm1.FormPaint(Sender: TObject);
var
bitmap:TBitmap;
rect:TRect;
begin
bitmap:=TBitmap.create;
bitmap.handle:=hbmp;
rect:=ClientRect;
canvas.draw(rect.left,rect.top,bitmap);
bitmap.handle:=0;
bitmap.free;
end;procedure TForm1.FormDestroy(Sender: TObject);
begin
DeleteObject(hbmp);
end;end.

Answer 6

这是全透明窗体了
uses里加上ExtCtrls
procedure tform1.setformtransparent;
var
I: Integer;
FullRgn,
ClientRgn,
ControlRgn: THandle;
Margin, 
MarginX, 
MarginY, 
X, 
Y: Integer;
W,H,S :Integer; 
bX,bY :Integer; 
c :TColor; 
begin
Margin := (Width - ClientWidth) div 2; 
FullRgn := CreateRectRgn(0, 0, Width, Height); 
MarginX := Margin; 
MarginY := Height - ClientHeight - Margin;
ClientRgn := CreateRectRgn(MarginX, MarginY, MarginX + ClientWidth, MarginY + ClientHeight); 
CombineRgn(FullRgn, FullRgn, ClientRgn, RGN_DIFF); 
DeleteObject(ClientRgn); 
for I:=0 to ControlCount-1 do
begin 
X := MarginX + Controls.Left; 
Y := MarginY + Controls.Top; 
W:=Controls.Width;
H:=Controls.Height; 
{} 
if controls is timage then begin
with controls as tImage do begin
c:=Picture.Bitmap.Canvas.Pixels[0,0];
for bX:=0 to Picture.Bitmap.Width-1 do begin 
for bY:=0 to Picture.Bitmap.Height-1 do begin 
if Picture.Bitmap.Canvas.Pixels[bX,bY]<>c then begin
ControlRgn := CreateRectRgn(X+bX, Y+bY, X + bX+1, Y + bY+1); 
CombineRgn(FullRgn, FullRgn, ControlRgn, RGN_OR); 
DeleteObject(ControlRgn); 
end;
end; 
end; 
end; 
end else
{} 
if controls is tShape then begin 
if W < H then S := W else S := H; 
if (Controls as tshape).Shape in [stSquare, stRoundSquare, stCircle] then
begin 
Inc(X, (W - S) div 2); 
Inc(Y, (H - S) div 2); 
W := S;
H := S; 
end; 
Inc(W); Inc(H); Inc(S); 
case (controls as tshape).Shape of
stRectangle, stSquare: 
ControlRgn := CreateRectRgn(X, Y, X + W, Y + H); 
stRoundRect, stRoundSquare: 
ControlRgn := CreateRoundRectRgn(X, Y, X + W, Y + H, S div 4, S div 4);
stCircle, stEllipse: 
ControlRgn:=CreateEllipticRgn(X, Y, X + W, Y + H); 
else 
ControlRgn := CreateRectRgn(X, Y, X + W, Y + H);
end; 
CombineRgn(FullRgn, FullRgn, ControlRgn, RGN_OR); 
DeleteObject(ControlRgn); 
end else
{} 
begin 
ControlRgn := CreateRectRgn(X, Y, X + W, Y + H); 
CombineRgn(FullRgn, FullRgn, ControlRgn, RGN_OR);
DeleteObject(ControlRgn); 
end; 
end; 
SetWindowRgn(Handle, FullRgn, True);
DeleteObject(FullRgn);
end; procedure TForm1.FormResize(Sender: TObject);
begin
setformtransparent;
end; 

Answer 7

http://expert.csdn.net/Expert/FAQ/FAQ_Index.asp?id=160183

Answer 8

AlphaBlend 和AlphaBlendValue是可以实现半透明的啊，你说的不能保持是什么 意思？我的程序就是利用了这两个属性，不过他们也有缺陷，1、必须在Win2000系统以上才支持，（这个就不好说了）2、必须要PII级别以上的CPU才支持（这个比较好作到，现在几乎都是这样的机子）  

Answer 9

AlphaBlendt和AlphaBlendValue确实是可以实现的啊

Answer 10

AlphaBlendt和AlphaBlendValue的方法只能在Win2k中有效
我试过了grail_(grail_)的方法在Win2k中有效但不知道在win98/me是否有效
谢谢各位仁兄啦!!