关于制作透明窗体的问题!!(100分)

W

wingkk

Unregistered / Unconfirmed
GUEST, unregistred user!
想开发一个类似桌面宠物的小程序,现在碰到几个问题,第一个是关于透明FORM的,原来是在
FORMCREAT里设定BRUSH.STYLE:=CSCLEAR,这样FORM会透出下面的背景,但当整个FORM移动时
后边同FORM一样大的一块背景也一块跟着移动,就像是在FORM建立时抓取了后边的背景当做
FORM的原有背景一样!这样,我有一个思路,即在FORM移动的时候抓取移动后位置的背景,然后
贴到FORM上,再在FORM上加上想放置的内容!!!但是不知道要具体怎么实现,高手指教!!
另一个问题是,如果在IMAGE控件内放一张处理过的图片,图片上除想要的内容外,其他区域被
单色填充,如果想把这个颜色去掉,做成透明的,只保留图片上想要的内容,又应该怎么做????
[:)]
 
其实最简单的方法是:
在FormCreate中,添加代码:
Brush.Style:=bsClear;
即可,注意,不是Canvas.Brush.Style!
procedure TForm1.FormCreate(Sender: TObject);
var p:longint;
begin
p:=GetWindowLong(handle,GWL_STYLE);//获取窗体属性
SetWindowLong(handle,GWL_EXSTYLE,p+WS_EX_TRANSPARENT);//设置新属性

form1.Refresh;
end;
***************************
To make a form transparent you should put these 2 lines in form's creation procedure:

procedure TForm1.FormCreate(Sender: TObject);
begin
Form1.Brush.Style:=bsClear;
Form1.BorderStyle:=bsNone;
end;

If you use only that you will notice that the form is transparent but if you put something
over it, it will not clear its own background and traces of that object will be left on the
form. To solve that you need to make sure that the transparent form's Paint procedure (WM_PAINT)
will be called last. To do that you need to override the TWinControl (TForm's ancestor)
CreateParams procedure and set the Form's extended style (ExStyle) to WS_EX_TRANSPARENT.

Here's the full code for making a form transparent:

type
TForm1 = class(TForm)
procedure CreateParams(var Params:TCreateParams); override;
procedure FormCreate(Sender: TObject);
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:=WS_EX_TRANSPARENT;
End;

procedure TForm1.FormCreate(Sender: TObject);
begin
Form1.Brush.Style:=bsClear;
Form1.BorderStyle:=bsNone;
end;
 
在来一个
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.
其实论坛里有很多,可以找一下就有了[^][^]
 
接受答案了.
 
顶部