如何制作一个透明FORM!(50分)

  • 主题发起人 主题发起人 yzhang
  • 开始时间 开始时间
Y

yzhang

Unregistered / Unconfirmed
GUEST, unregistred user!
我想制作一个透明的FORM,不知各位大侠有何高见!
 
一些据称能制作透明FORM的代码试了试都不行,
下面这个网站提供构件,不仅仅是透明Form,还有很多功能:

http://www.lawrenz.com/coolform/index.htm
 
这是我从别人主页上摘的(忘了是谁的主页了)。你看看吧

这个例子演示如何显示透明的窗口.同时也介绍了如何捕获屏幕.必须把Form1的BorderStyle属性置为bsNone

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.

如果当程序运行时,你什么也没有看见(当然你可以加入一个按钮),那就成功了.
透明窗口有什么用呢?我正在打算编制一些奇形怪状的菜单,能够加入任何控制
的菜单.思考了好久,觉得只有这么一条出路.:-(

这个例子参考了一个C++程序(我已经忘了是哪个C++程序)
 
将form的property
borderStyle:=bsNone;
borderIcons:=[];

在form消息TWMEraseBKgnd的处理进行覆盖
procedure Tfrom1.CMEraseBkgnd(var message:TWMEraseBKgnd);message WM_ERASEBKGND
begin
Brush.style:=bsClear;
inherited;
emd;
即可。
 
我要求:form的property
borderStyle不能为bsNone!
不知各位是否有高招!
 
procedure TForm1.FormCreate(Sender: TObject);
var
FullRgn, ClientRgn, ButtonRgn: THandle;
Margin, X, Y: Integer;
begin
Margin := (Width - ClientWidth) div 2;
FullRgn := CreateRectRgn(0, 0, Width, Height);
X := Margin;
Y := Height - ClientHeight - Margin;
ClientRgn := CreateRectRgn(X, Y, X + ClientWidth, Y + ClientHeight);
CombineRgn(FullRgn, FullRgn, ClientRgn, RGN_DIFF);
X := X + Button1.Left;
Y := Y + Button1.Top;
ButtonRgn := CreateRectRgn(X, Y, X + Button1.Width, Y + Button1.Height);
CombineRgn(FullRgn, FullRgn, ButtonRgn, RGN_OR);
SetWindowRgn(Handle, FullRgn, True);
end;

Try this.
 
我指出的那个构件试过了吗?
斑竹不是说很"酷"吗?
 
在Form的OnCreate事件中加入如下代码:

Brush.Style := bsClear;
borderstyle := bsnone;

应当能实现FORM透明。
 
乖乖!我下载了那个CoolForm,简直是骗人的(但愿是我不会用)

还是Henry Chan的代码起到透明作用,只是太透明了,
把事件都“漏下去”了(yysun语),恐怕得AlwaysOnTop
才好用。
我把它改造了一把,可以通用了,仅供大家参考:


procedure TForm1.FormCreate(Sender: TObject);
var
FullRgn, ClientRgn, ButtonRgn: THandle;
LeftMargin,TopMargin:Integer;
Margin, X, Y: Integer;
i:integer;
begin
Margin := (Width - ClientWidth) div 2;
FullRgn := CreateRectRgn(0, 0, Width, Height);
LeftMargin := Margin;
TopMargin := Height - ClientHeight - Margin;
ClientRgn := CreateRectRgn(LeftMargin, TopMargin, LeftMargin + ClientWidth, TopMargin + ClientHeight);
CombineRgn(FullRgn, FullRgn, ClientRgn, RGN_DIFF);

for i:= 0 to ComponentCount-1 do
begin
if not (Components is TWinControl) then continue;
if (Components as TWinControl).Parent<>self then continue;
X := LeftMargin + (Components as TWinControl).Left;
Y := TopMargin + (Components as TWinControl).Top;
ButtonRgn := CreateRectRgn(X, Y, X + (Components as TWinControl).Width, Y + (Components as TWinControl).Height);
CombineRgn(FullRgn, FullRgn, ButtonRgn, RGN_OR);
end;

SetWindowRgn(Handle, FullRgn, True);
end;
 
刚刚要给dwwang大侠加分, 失望地发现自己并不是这儿的摊主,
我愿意再出任此版版主, 各位意下如何?
 
我同意!现在摊主太少了,身兼多职也是没办法,
再加上pega也很在行。当然,最主要的是... *_^
 
接受答案了.
 
yzhang: 不好意思, 我看到dwwang大侠的答案不错, 就急忙给加
了分, 以后我会注意尽量由提问者自行决定, 除非提问者保持沉
默超过两个星期.

下不为例!
 
补充说明,CoolForm时可以用的,我刚刚发现了用法,
需要一个BMP之类的图形,然后设置Mask.
被Mask的部分就变得透明了,因此适合于做Norton CrashGuard
那种特殊形状的Form.
 
CoolForm和dwwang的算法各有千秋,
CoolForm显示BMP很不错,试试它的例子,看到那个女同志照片吗?
请在她右臂与身体之间的透明洞处按鼠标,这个事件会漏下去把下面的窗口激活(调
到前面),而在其他不透明之处,事件是漏不下去的,因此您可以任意拖动她的位置.
所以这是个很Cool的不规则边界的透明Form.
问题是放上去的控件都不见了,这点dwwang的算法就解决了,最好两者结合一下.
 
后退
顶部