怎么实现透明窗体

Question

DevExpressForum系列组件里面有个组件可以实现。

Answer 1

加入下列代码试试看：  Brush.Style :=bsClear;

Answer 2

DELPHI6?
窗体本身就有透明的属性
AlphaBlend
AlphaBlendValue

Answer 3

DELPHI6不用控件也可以实现透明窗体啊，ALPHABLEND:=True
Alphablendvalue:=180 (255以下是透明效果)

Answer 4

unit Unit1; {The transparent form effect is done with Regions. 
First create a region that encompasses the entire form. 
Then, find the client area of the form (Client vs. non-Client) and 
combine with the full region with RGN_DIFF to make the borders 
and title bar visible.  Then create a region for each of the 
controls and combine them with the original (FullRgn) region.} {From various posts in the newsgroups - based on some famous 
author I'm sure, but I first saw the post by Kerstin Thaler...} interface uses 
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, 
  ExtCtrls, StdCtrls; type 
  TForm1 = class(TForm) 
    Button1: TButton; 
    Panel1: TPanel; 
    Button2: TButton; 
    procedure FormDestroy(Sender: TObject); 
    procedure FormCreate(Sender: TObject); 
    procedure Button1Click(Sender: TObject); 
    procedure Button2Click(Sender: TObject); 
    procedure FormResize(Sender: TObject); 
  private 
    { Private declarations } 
    procedure DoVisible; 
    procedure DoInvisible; 
  public 
    { Public declarations } 
  end; var 
  Form1: TForm1; 
  FullRgn, ClientRgn, CtlRgn : THandle; implementation {$R *.DFM} procedure TForm1.DoInvisible; 
var 
  AControl : TControl; 
  A, Margin, X, Y, CtlX, CtlY : Integer; 
begin 
  Margin := ( Width - ClientWidth ) div 2; 
  //First, get form region 
  FullRgn := CreateRectRgn(0, 0, Width, Height); 
  //Find client area region 
  X := Margin; 
  Y := Height - ClientHeight - Margin; 
  ClientRgn := CreateRectRgn( X, Y, X + ClientWidth, Y + ClientHeight ); 
  //'Mask' out all but non-client areas 
  CombineRgn( FullRgn, FullRgn, ClientRgn, RGN_DIFF );   //Now, walk through all the controls on the form and 'OR' them 
  // into the existing Full region. 
  for A := 0 to ControlCount - 1 do begin 
    AControl := Controls[A]; 
    if ( AControl is TWinControl ) or ( AControl is TGraphicControl ) 
        then with AControl do begin 
      if Visible then begin 
        CtlX := X + Left; 
        CtlY := Y + Top; 
        CtlRgn := CreateRectRgn( CtlX, CtlY, CtlX + Width, CtlY + Height ); 
        CombineRgn( FullRgn, FullRgn, CtlRgn, RGN_OR ); 
      end; 
    end; 
  end; 
  //When the region is all ready, put it into effect: 
  SetWindowRgn(Handle, FullRgn, TRUE); 
end; procedure TForm1.FormDestroy(Sender: TObject); 
begin 
  //Clean up the regions we created 
  DeleteObject(ClientRgn); 
  DeleteObject(FullRgn); 
  DeleteObject(CtlRgn); 
end; procedure TForm1.DoVisible; 
begin 
  //To restore complete visibility: 
  FullRgn := CreateRectRgn(0, 0, Width, Height); 
  CombineRgn(FullRgn, FullRgn, FullRgn, RGN_COPY); 
  SetWindowRgn(Handle, FullRgn, TRUE); 
end; procedure TForm1.FormCreate(Sender: TObject); 
begin 
  //We start out as a transparent form.... 
  DoInvisible; 
end; procedure TForm1.Button1Click(Sender: TObject); 
begin 
  //This button just toggles between transparent and not trans.. 
  if Button1.Caption = 'Show Form' then begin 
    DoVisible; 
    Button1.Caption := 'Hide Form'; 
  end 
  else begin 
    DoInvisible; 
    Button1.Caption := 'Show Form'; 
  end; 
end; procedure TForm1.Button2Click(Sender: TObject); 
begin 
  Application.Terminate; 
end; procedure TForm1.FormResize(Sender: TObject); 
begin 
  //Need to address the transparency if the form gets re-sized. 
  //Also, note that Form1 scroll bars are set to VISIBLE/FALSE. 
  //I did that to save a little coding here.... 
  if Button1.Caption = 'Show Form' then 
    DoInvisible 
  else 
    DoVisible; 
end; end. 

Answer 5

Snakeguo(枫) 
所说的在Win98不行的,Win98不支持层窗口

Answer 6

to larruping(总要把热情渗入^_^) & Snakeguo(枫):
ALPHABLEND:=
Alphablendvalue:=
在98下是不能用的

Answer 7

那就试试这个：
怎样制作全透明的窗口1．先把Form1的BorderStyle属性置为bsNoneunit 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 8

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, 100, LWA_ALPHA);//100的数值越大，透明度越低。反之。
end;

Answer 9

我在98下试验过larruping(总要把热情渗入^_^)的代码，效果非常的。烂的，只要一有窗口覆盖过这个窗口，这个所谓的透明的窗口就会非常的，难看，不知道应该如何改进

Answer 10

到www.netgocn.com去下载NetGoCN运行看看，那个拖放框的透明效果如何？
一点都不难看，它还可以改变大小呢！

Answer 11

可惜我是用XP系统的无法测试。查找：DELPHI案例教程 中科多媒体电子出版社 第一章 界面设计篇 案例14原理：重载窗体创建时调用的createParams过程。在TFORM1的Protected部分声明：
procedure FormCreate(sender:Tobject);定义：
procedure FormCreate(sender:Tobject);
begin
  inherited createparams(params);
  params.exstyle:=params.exstyle or WS_EX_TRANSPARENT;
end;procedure Tform1create(sender:Tobject);
begin
  inherited;
  canvas.brush.style:=bsClear;
end;
Xp下测试：
unit Unit1;interfaceuses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;type
  TForm1 = class(TForm)
    procedure FormCreate(Sender: TObject);
    procedure createparams(var params:TcreateParams); override;
  private
    { Private declarations }
  public
    { Public declarations }
  end;var
  Form1: TForm1;implementation{$R *.dfm}procedure Tform1.createparams(var params:TcreateParams);
begin
  inherited createparams(params);
  params.exstyle:=params.exstyle or WS_EX_TRANSPARENT;
end;
procedure TForm1.formcreate(sender:Tobject);
begin
  inherited;
  canvas.Brush.Style:=bsclear;
end;end.