I
import
Unregistered / Unconfirmed
GUEST, unregistred user!
话题091104的标题是： 如何制作一个透明FORM！ (50分) 分类：图形图象 yzhang (1998-11-3 10:50:48)
我想制作一个透明的FORM，不知各位大侠有何高见！
dwwang (1998-11-3 10:54:33)
一些据称能制作透明FORM的代码试了试都不行,
下面这个网站提供构件,不仅仅是透明Form,还有很多功能:
http://www.lawrenz.com/coolform/index.htm
Kiven (1998-11-3 15:59:22)
这是我从别人主页上摘的（忘了是谁的主页了）。你看看吧
这个例子演示如何显示透明的窗口.同时也介绍了如何捕获屏幕.必须把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++程序)
hqy (1998-11-6 11:29:39)
将form的property
borderStyle:=bsNone;
borderIcons:=[];
在form消息TWMEraseBKgnd的处理进行覆盖
procedure Tfrom1.CMEraseBkgnd(var message:TWMEraseBKgnd);message WM_ERASEBKGND
begin
Brush.style:=bsClear;
inherited;
emd;
即可。
yzhang (1998-11-9 15:41:54)
我要求：form的property
borderStyle不能为bsNone！
不知各位是否有高招！
Henry Chan (1998-11-9 15:58:39)
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.
dwwang (1998-11-9 16:50:38)
我指出的那个构件试过了吗?
斑竹不是说很"酷"吗?
nudtzy (1998-11-11 21:57:09)
在Form的OnCreate事件中加入如下代码:
Brush.Style := bsClear;
borderstyle := bsnone;
应当能实现FORM透明。
dwwang (1998-11-11 23:32:55)
乖乖！我下载了那个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;
pegasus (1998-11-13 0:01:37)
刚刚要给dwwang大侠加分, 失望地发现自己并不是这儿的摊主,
我愿意再出任此版版主, 各位意下如何?
dwwang (1998-11-13 1:40:34)
我同意！现在摊主太少了，身兼多职也是没办法，
再加上pega也很在行。当然，最主要的是... *_^
pegasus (1998-11-13 14:31:44)
接受答案了.
pegasus (1998-11-13 16:06:42)
yzhang: 不好意思, 我看到dwwang大侠的答案不错, 就急忙给加
了分, 以后我会注意尽量由提问者自行决定, 除非提问者保持沉
默超过两个星期.
下不为例!
dwwang (1998-11-13 18:02:06)
补充说明,CoolForm时可以用的,我刚刚发现了用法,
需要一个BMP之类的图形,然后设置Mask.
被Mask的部分就变得透明了,因此适合于做Norton CrashGuard
那种特殊形状的Form.
yysun (1998-11-13 23:49:27)
CoolForm和dwwang的算法各有千秋,
CoolForm显示BMP很不错,试试它的例子,看到那个女同志照片吗?
请在她右臂与身体之间的透明洞处按鼠标,这个事件会漏下去把下面的窗口激活(调
到前面),而在其他不透明之处,事件是漏不下去的,因此您可以任意拖动她的位置.
所以这是个很Cool的不规则边界的透明Form.
问题是放上去的控件都不见了,这点dwwang的算法就解决了,最好两者结合一下.
dwwang的回答最终被接受。
我想制作一个透明的FORM，不知各位大侠有何高见！
dwwang (1998-11-3 10:54:33)
一些据称能制作透明FORM的代码试了试都不行,
下面这个网站提供构件,不仅仅是透明Form,还有很多功能:
http://www.lawrenz.com/coolform/index.htm
Kiven (1998-11-3 15:59:22)
这是我从别人主页上摘的（忘了是谁的主页了）。你看看吧
这个例子演示如何显示透明的窗口.同时也介绍了如何捕获屏幕.必须把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++程序)
hqy (1998-11-6 11:29:39)
将form的property
borderStyle:=bsNone;
borderIcons:=[];
在form消息TWMEraseBKgnd的处理进行覆盖
procedure Tfrom1.CMEraseBkgnd(var message:TWMEraseBKgnd);message WM_ERASEBKGND
begin
Brush.style:=bsClear;
inherited;
emd;
即可。
yzhang (1998-11-9 15:41:54)
我要求：form的property
borderStyle不能为bsNone！
不知各位是否有高招！
Henry Chan (1998-11-9 15:58:39)
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.
dwwang (1998-11-9 16:50:38)
我指出的那个构件试过了吗?
斑竹不是说很"酷"吗?
nudtzy (1998-11-11 21:57:09)
在Form的OnCreate事件中加入如下代码:
Brush.Style := bsClear;
borderstyle := bsnone;
应当能实现FORM透明。
dwwang (1998-11-11 23:32:55)
乖乖！我下载了那个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;
pegasus (1998-11-13 0:01:37)
刚刚要给dwwang大侠加分, 失望地发现自己并不是这儿的摊主,
我愿意再出任此版版主, 各位意下如何?
dwwang (1998-11-13 1:40:34)
我同意！现在摊主太少了，身兼多职也是没办法，
再加上pega也很在行。当然，最主要的是... *_^
pegasus (1998-11-13 14:31:44)
接受答案了.
pegasus (1998-11-13 16:06:42)
yzhang: 不好意思, 我看到dwwang大侠的答案不错, 就急忙给加
了分, 以后我会注意尽量由提问者自行决定, 除非提问者保持沉
默超过两个星期.
下不为例!
dwwang (1998-11-13 18:02:06)
补充说明,CoolForm时可以用的,我刚刚发现了用法,
需要一个BMP之类的图形,然后设置Mask.
被Mask的部分就变得透明了,因此适合于做Norton CrashGuard
那种特殊形状的Form.
yysun (1998-11-13 23:49:27)
CoolForm和dwwang的算法各有千秋,
CoolForm显示BMP很不错,试试它的例子,看到那个女同志照片吗?
请在她右臂与身体之间的透明洞处按鼠标,这个事件会漏下去把下面的窗口激活(调
到前面),而在其他不透明之处,事件是漏不下去的,因此您可以任意拖动她的位置.
所以这是个很Cool的不规则边界的透明Form.
问题是放上去的控件都不见了,这点dwwang的算法就解决了,最好两者结合一下.
dwwang的回答最终被接受。