我想做一个半透明的窗口效果

Question

D6的Form的alphablendvalue可以设置透明度

Answer 1

看一个Vcl的源码，也许对你有帮助:
procedure TCustomForm.SetAlphaBlendValue(const Value: Byte);
begin
  if FAlphaBlendValue <> Value then
  begin
    FAlphaBlendValue := Value;
    SetLayeredAttribs;
  end;
end;
procedure TCustomForm.SetLayeredAttribs;
const
  cUseAlpha: array [Boolean] of Integer = (0, LWA_ALPHA);
  cUseColorKey: array [Boolean] of Integer = (0, LWA_COLORKEY);
var
  AStyle: Integer;
begin
  if not (csDesigning in ComponentState) and
    (Assigned(SetLayeredWindowAttributes)) and HandleAllocated then
  begin
    AStyle := GetWindowLong(Handle, GWL_EXSTYLE);
    if FAlphaBlend or FTransparentColor then
    begin
      if (AStyle and WS_EX_LAYERED) = 0 then
        SetWindowLong(Handle, GWL_EXSTYLE, AStyle or WS_EX_LAYERED);
      SetLayeredWindowAttributes(Handle, FTransparentColorValue, FAlphaBlendValue,
        cUseAlpha[FAlphaBlend] or cUseColorKey[FTransparentColor]);
    end
    else
    begin
      SetWindowLong(Handle, GWL_EXSTYLE, AStyle and not WS_EX_LAYERED);
      RedrawWindow(Handle, nil, 0, RDW_ERASE or RDW_INVALIDATE or RDW_FRAME or RDW_ALLCHILDREN);
    end;
  end;
end;

Answer 2

unit Unit1;interfaceuses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, Buttons, ExtCtrls;type
  TForm1 = class(TForm)
    Image1: TImage;
    StaticText1: TStaticText;
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
    BackgroundBmp:TBitmap;
    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;
  tmp:TBitmap;
begin
  Scn:=TCanvas.Create; //建立整个屏幕的画布
  tmp:=TBitmap.Create;
  h:=ClientHeight;//窗口的高
  w:=ClientWidth; //窗口的宽
  try
    tmp.Height:=h;    //设返回位图的高就是窗口的高
    tmp.Width:=w;//设返回位图的宽就是窗口的宽
    try
      Scn.Handle:=GetDC(0);//取得整个屏幕的DC
      //以下一行将窗口的背景部分复制到指定的画布中，也就是本函数的返回值
      tmp.Canvas.CopyRect(Rect(0,0,w,h),Scn,
      Rect(Left,Top,Left+w,Top+h));
      ReleaseDC(0, Scn.handle);
      result:=tmp;
    finally
      Scn.Free;
    end;
  finally
     tmp.FreeImage;
  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;end.

Answer 3

上面的代码应该是你想要的效果（象foxmail,netants都是这样实现的）

Answer 4

SetLayeredWindowAttributes只对Win2000适用！

Answer 5

to  phide(不爱喝酒)
我试了，效果不行，我的程序窗口出来后form背景是拷贝原位置的桌面内容，
我想要的半透明窗口是不要背景的，透过form是桌面的真实内容。

Answer 6

var l:longint;
begin
  l:=getWindowLong(Handle, GWL_EXSTYLE);
  l := l Or WS_EX_LAYERED;
  SetWindowLong (handle, GWL_EXSTYLE, l);
  SetLayeredWindowAttributes (handle, 0, 180, LWA_ALPHA);
end;最后一行第二个参数越小越透明，反之。

Answer 7

SetLayeredWindowAttributes 函数是哪里来的？

Answer 8

就是上面的代码可以通用。Win98不支持SetLayeredWindowAttributes API和alphablendvalue属性。