unit Unit1;interfaceuses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,ExtCtrls,
  StdCtrls;type
  TForm1 = class(TForm)
    Memo1: TMemo;
    Label1: TLabel;
    Edit1: TEdit;
    procedure FormResize(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    procedure setformtransparent;  end;var
  Form1: TForm1;implementation{$R *.DFM}{ TForm1 }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[I].Left; 
    Y := MarginY + Controls[I].Top; 
    W:=Controls[I].Width;
    H:=Controls[I].Height; 
{} 
    if controls[i] is timage then begin
      with controls[i] 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[i] is tShape then begin 
      if W < H then S := W else S := H; 
      if (Controls[i] 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[i] 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;end.

解决方案 »

  1.   

    WIN200下也可以这样:unit Unit1;interfaceuses
      Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
      StdCtrls;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;
    //新增加的常量定义
    type
      TForm1 = class(TForm)
        Button1: TButton;
        Label1: TLabel;
        Memo1: TMemo;
        procedure FormCreate(Sender: TObject);
      private
        { Private declarations }
      public
        { Public declarations }
      end;function SetLayeredWindowAttributes(hwnd:HWND; crKey:Longint; bAlpha:byte; dwFlags:longint ):longint; stdcall; external user32;var
      Form1: TForm1;implementation{$R *.DFM}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, 0, 180, LWA_ALPHA);
        SetLayeredWindowAttributes (handle, 0, 180, LWA_ALPHA);
    //第二个参数是指定透明颜色
    //第二个参数为0则使用第四个参数设置alpha值,从0到255end;end.
      

  2.   

    WIN2000下也可以这样:unit Unit1;interfaceuses
      Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
      StdCtrls;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;
    //新增加的常量定义
    type
      TForm1 = class(TForm)
        Button1: TButton;
        Label1: TLabel;
        Memo1: TMemo;
        procedure FormCreate(Sender: TObject);
      private
        { Private declarations }
      public
        { Public declarations }
      end;function SetLayeredWindowAttributes(hwnd:HWND; crKey:Longint; bAlpha:byte; dwFlags:longint ):longint; stdcall; external user32;var
      Form1: TForm1;implementation{$R *.DFM}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, 0, 180, LWA_ALPHA);
        SetLayeredWindowAttributes (handle, 0, 180, LWA_ALPHA);
    //第二个参数是指定透明颜色
    //第二个参数为0则使用第四个参数设置alpha值,从0到255end;end.
      

  3.   

    function SetLayeredWindowAttributes(hwnd:HWND; crKey:Longint; bAlpha:byte; dwFlags:longint ):longint; stdcall; external user32;不明白  :?