请问在Win2000下如何制作透明的不规则窗体,很急,请帮忙解答(200分)

L

lndlgzg

Unregistered / Unconfirmed
GUEST, unregistred user!
我用SetLayeredWindowAttributes使窗体透明后,再用SetWindowRgn就不起作用了,不知为何
 
不会吧? 在我这里没有问题, 你试试:
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs;
type
TForm1 = class(TForm)
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;
function SetLayeredWindowAttributes(Handle: THandle;
crey, bAlpha: Byte;
dwFlags: Integer): LongInt;
stdcall;
implementation
{$R *.dfm}
{$EXTERNALSYM SetLayeredWindowAttributes}
function SetLayeredWindowAttributes;
external user32 name 'SetLayeredWindowAttributes';
procedure TForm1.FormCreate(Sender: TObject);
var
Rgn: HRgn;
bTrans: Byte;
OldStyle: Integer;
begin
Rgn := CreateEllipticRgn(0, 0, Width, ClientHeight);
SetWindowRgn(Handle, Rgn, True);
bTrans := 192;
OldStyle := GetWindowLong(Handle, GWL_EXSTYLE);
SetWindowLong(Handle, GWL_EXSTYLE, OldStyle or WS_EX_LAYERED);
SetLayeredWindowAttributes(Handle, 0, bTrans, LWA_ALPHA);
end;

end.
 
其实在Delphi6中也不用SetLayeredWindowAttributes这么麻烦
直接设置属性AlphaBlend及AlphaBlendValue就行了。
 
to xianjun:
我试了你的代码,还是不行。情况是中间椭圆形的窗体正常透明,而其他本应该看不见的那部分
(也就是椭圆以外的窗体)就变成了暗黑色透明的了,不知为何。我的代码如下:
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs;
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)
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;
function SetLayeredWindowAttributes(Handle: THandle;
crey, bAlpha: Byte;
dwFlags: Integer): LongInt;
stdcall;
implementation
{$R *.DFM}
function SetLayeredWindowAttributes;
external user32 name 'SetLayeredWindowAttributes';
procedure TForm1.FormCreate(Sender: TObject);
var
Rgn: HRgn;
bTrans: Byte;
OldStyle: Integer;
begin
Rgn := CreateEllipticRgn(0, 0, Width, ClientHeight);
SetWindowRgn(Handle, Rgn, True);
bTrans := 192;
OldStyle := GetWindowLong(Handle, GWL_EXSTYLE);
SetWindowLong(Handle, GWL_EXSTYLE, OldStyle or WS_EX_LAYERED);
SetLayeredWindowAttributes(Handle, 0, bTrans, LWA_ALPHA);
end;

end.
 
如果你用的是D6,就用它的属性设置-来得简单方便
 
制作异形窗口可以用这种方法:
000年看到一篇文章做的演示代码,可以根据位图做出漂亮的不规则FORM,大家可以下载演示程序研究一下,包含DELPHI版和VC版。


unit Unit1;

interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ExtCtrls, StdCtrls, Buttons;

type
TForm1 = class(TForm)
Image1: TImage;
Button1: TButton;
procedure FormCreate(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure Image1MouseDown(Sender: TObject;
Button: TMouseButton;
Shift: TShiftState;
X, Y: Integer);
private
function CreateRegion(wMask: TBitmap;
wColor: TColor;
hControl: THandle): HRGN;
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation
{$R *.DFM}
function Tform1.CreateRegion(wMask:TBitmap;wColor:TColor;hControl:THandle): HRGN;
var
dc, dc_c: HDC;
rgn: HRGN;
x, y: integer;
coord: TPoint;
line: boolean;
color: TColor;
begin

dc := GetWindowDC(hControl);
dc_c := CreateCompatibleDC(dc);
SelectObject(dc_c, wMask.Handle);
begin
Path(dc);
for x:=0 to wMask.Width-1do

begin

line := false;
for y:=0 to wMask.Height-1do

begin

color := GetPixel(dc_c, x, y);
if not (color = wColor) then

begin

if not line then

begin

line := true;
coord.x := x;
coord.y := y;
end;

end;

if (color = wColor) or (y=wMask.Height-1) then

begin

if line then

begin

line := false;
MoveToEx(dc, coord.x, coord.y, nil);
LineTo(dc, coord.x, y);
LineTo(dc, coord.x + 1, y);
LineTo(dc, coord.x + 1, coord.y);
CloseFigure(dc);
end;

end;

end;

end;

EndPath(dc);
rgn := PathToRegion(dc);
ReleaseDC(hControl, dc);
Result := rgn;
end;

procedure TForm1.FormCreate(Sender: TObject);
var
w1:TBitmap;
w2:TColor;
rgn: HRGN;
begin

w1:=TBitmap.Create;
w1.Assign(image1.Picture.Bitmap);
w2:=w1.Canvas.Pixels[0,0];
rgn := CreateRegion(w1,w2,Handle);
if rgn<>0 then

begin

SetWindowRgn(Handle, rgn, true);
end;

w1.Free;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin

Close;
end;

procedure TForm1.Image1MouseDown(Sender: TObject;
Button: TMouseButton;
Shift: TShiftState;
X, Y: Integer);
begin

ReleaseCapture;
SendMessage(Handle, WM_SYSCOMMAND, $F012, 0);
end;

end.

 
透明的可以在DELPHI 6.0的窗体属性中设置;
很简单,也可以采用前面朋友的方法;
 
>(也就是椭圆以外的窗体)就变成了暗黑色透明的了
我这里没有这种现象啊
真是奇怪
我的系统是EWin2KAS + SP2 Delphi6 + Update2
 
可将窗体的alphaBlend 属性设为真,再将alphablendvalue值设为0(0为不显示!
255为显示)好好用吧!可要给我加分哟,不然下次嘿你一下!
 
我说明一下,我用的是Delphi5+win2000,实现不了透明的不规则窗体,请大家出出注意,是
不是哪儿没有设置
 
www.2ccc.com 有演示代码下载
 
俺给你贴一段代码,保证ok,如果你要源程序的话,给我email:
cqwty@sina.com发信:
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Forms,
Buttons, StdCtrls, ExtCtrls, Controls;
type
TForm1 = class(TForm)
Image1: TImage;
BitBtn1: TBitBtn;
procedure FormCreate(Sender: TObject);
procedure Image1MouseDown(Sender: TObject;
Button: TMouseButton;
Shift: TShiftState;
X, Y: Integer);
procedure BitBtn1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.FormCreate(Sender: TObject);
var
tot_reg, tmp_reg : HRGN;
colu_img, fila_img,
x_a, x_b : Integer;
color_transparente : TColor;
linea : PByteArray;
Virtual_Image : TBitmap;
begin
tot_reg := CreateRectRgn(0, 0, Image1.Width, Image1.Height);
Virtual_Image := Image1.Picture.BitMap;
linea := Virtual_Image.ScanLine[0];
// definimos el color transparente, como el primer pixel de la imagen (izquierda, superior)
color_transparente := linea[0];
// procesamos scanline x scanline
for fila_img := 0 to (Virtual_Image.Height-1)do
begin
linea := Virtual_Image.ScanLine[fila_img];
colu_img := 0;
x_a := colu_img;
while (colu_img <= (Virtual_Image.Width-1))do
begin
x_b := TColor(linea[colu_img]);
if (x_b <> color_transparente)
then
begin
tmp_reg := CreateRectRgn(x_a, fila_img, colu_img, fila_img+1);
CombineRgn(tot_reg, tot_reg, tmp_reg, RGN_XOR);
DeleteObject(tmp_reg);
// avanzamos, hasta encontrar un color transparente
repeat
inc(colu_img);
until ((TColor(linea[colu_img])=color_transparente) or (colu_img=Virtual_Image.Width-1));
x_a := colu_img;
end;
// if (x_b <> color_transparente)
inc(colu_img);
end;
// while (colu_img <> (Virtual_Image.Width-1))do

// procesamos tambien, si el ultimo pixel de la imagen es de "color transparente"
if TColor(linea[colu_img-1])=color_transparente
then
begin
tmp_reg := CreateRectRgn(x_a, fila_img, colu_img+1, fila_img+1);
CombineRgn(tot_reg, tot_reg, tmp_reg, RGN_XOR);
DeleteObject(tmp_reg);
end;
// if TColor(linea[colu_img-1])=color_transparente
end;
// for fila_img := 0 to Virtual_Image.Height-1do

SetWindowRgn(form1.Handle, tot_reg, true);
deleteobject(tot_reg);
end;

procedure TForm1.Image1MouseDown(Sender: TObject;
Button: TMouseButton;
Shift: TShiftState;
x, y: Integer);
begin
ReleaseCapture;
TForm(form1).perform(WM_SYSCOMMAND, $F012, 0);
end;

procedure TForm1.BitBtn1Click(Sender: TObject);
begin
Close;
end;

end.
很舒服的,自己看看罢!
 
我写的一篇没有被发表的文章,也许对你有用。其中的makeregion函数可以根据一幅位图的轮廓形成一个不规则窗口
采用优化算法,速度很快。我想win2000也一样适用
===============================================================================
用delphi做一个会在桌面上跳舞的小猪
————兼谈不规则窗口的制作
do
do505
也许大家对office助手都有印象:一个小孙悟空或一个小狗不时地在桌面上耍来耍去,玩弄出各种姿态和花样,用鼠标单击它时还会弹出菜单选项与用户交互。那么它是怎么作出来的呢?本文便向大家介绍如何制作一个象office助手那样的会在桌面上跳舞的小猪。
编程思路:要做一个在桌面上跳舞的小猪,我们可以用位图拷贝函数BitBlt通过各种不同的掩膜组合向桌面上连续绘制不同的透明图片(图片如下图1)这样就会形成小猪在桌面上跳舞的动画。
图1(图片见附件)
但这样做有一个极大的缺点,那就是这样作成的小猪只顾自己跳舞无法与用户交互,也就是说无论我们用鼠标单击或双击小猪,它都没有任何反应,更不会弹出什么菜单选项了。那又该怎么办呢?最直接的解决办法就是使用不规则窗口,即先按照第一张小猪跳舞图片中小猪的轮廓形成一个不规则窗口(如图2),
图2
这时再把该图片放到该不规则窗口中时,则此窗口只显示出小猪来,其余部分自然是透明的(如图3)。
图3
依此类推再处理第二张,形成又一个不规则窗口,然后显示出来,再处理第三张......。如此不停地显示便形成了小猪在桌面上跳舞的动画。由于该动画本身就是一个窗口,所以可以响应各种窗口消息事件如双击、单击等等。
那么现在的关键问题就是如何根据一幅位图的轮廓形成一个不规则窗口,这就要用到几个windows的api函数:CreateRectRgn,CreateEllipticRgn,CombineRgn,SetWindowRgn。其中CreateRectRgn函数用来创建一个矩形区域,CreateEllipticRgn函数用来创建一个圆或椭圆形区域。SetWindowRgn函数用来设置窗口的形状,SetWindowRgn函数的定义如下:
int SetWindowRgn( HWND hWnd, HRGN hRgn, BOOL bRedrawflag);
窗口的形状由参数 hRgn 所标志的区域 (region) 决定。通过创建不同的区域就可以创建不同形状窗口。例如下面的代码,可以产生一个圆形的窗口。(如图4)
图4
var
R : HRgn;
begin
R := CreateEllipticRgn(0,0,300,300);
SetWindowRgn( handle,R , TRUE ) ;
end;


CombineRgn函数可以混合两个区域成为一个区域。其函数原形为
int CombineRgn(
HRGN hrgnDest, // 目标区域的句柄
HRGN hrgnSrc1, // 源区域1的句柄
HRGN hrgnSrc2, // 源区域2的句柄
int fnCombineMode // 两个区域混合的方式
);

比如下面代码混合三个圆形区域形成一个米老鼠形的区域。(如图5)
图5
var
R1,R2,R3 : HRgn;
begin
//分别创建三个圆形区域R1,R2,R3
R1 := CreateEllipticRgn(0,0,60,60);
R2 := CreateEllipticRgn(150,0,210,60);
R3 := CreateEllipticRgn(30,30,180,180);
//混合这三个圆形区域则形成一个米老鼠形区域
combinergn(R1,R1,R2,rgn_or);
combinergn(R1,R1,R3,rgn_or);
//将这个米老鼠形区域赋给本窗口,则形成一个米老鼠形窗口
SetWindowRgn( handle,R1 , TRUE ) ;
end;
由于窗口是米老鼠形状的所以在米老鼠形窗口里放置一个图片框,则图片框里的图片只会显示成米老鼠的形状。(如图6)
图6
有了上面的介绍我们就可以用CreateRectRgn函数和CombineRgn函数通过一种算法来根据一幅位图的轮廓形成一个不规则窗口了。具体方法如下:在窗口中放入一Image图片框,在图片框中加载一幅图片,我们采用一个两重循环,逐行扫描图片中不透明的区域,用CreateRectRgn函数得到一个个连续的不透明的小矩形区域,然后将这些小矩形区域用CombineRgn函数组成一个整个的区域便得到了这个图片轮廓的区域,即按照该图片的轮廓形成了一个不规则区域。再用SetWindowRgn函数将该区域赋给窗口便按照该图片的轮廓形成了一个不规则窗口。
知道了如何根据一幅图片的轮廓形成一个不规则窗口,那么利用不规则窗口连续显示不同的图片以形成动画,就可以制作出我们的在桌面上跳舞的小猪了。(制作出的画面如图7)。
图7
用这种方法制作出来的小猪可以响应我们的鼠标事件,比如本程序中我们用鼠标单击小猪则可以弹出一个弹出菜单,选其中的“退出”选项则可关闭该程序。由于本程序中采用的算法是一行一行地扫描而不是一个点一个点地扫描所以速度很快。
程序源代码如下:
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls,
Forms, Dialogs,StdCtrls, ExtCtrls, Menus;
type
TForm1 = class(TForm)
Image1: TImage;
Timer1: TTimer;
PopupMenu1: TPopupMenu;
N1: TMenuItem;
N2: TMenuItem;
N3: TMenuItem;
procedure creat(Sender: TObject);
procedure clicked(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
procedure N1Click(Sender: TObject);
private
{ Private declarations }
a:integer;
mousepos:Tpoint;//存放鼠标指针位置
function makeregion(imagebox:Timage):hrgn;
//上面函数的作用是按照imagebox中的位图形状形成一个不规则区域
public
{ Public declarations }
end;

var
Form1: TForm1;
implementation
{$R *.DFM}
function Tform1.makeregion(imagebox:Timage):hrgn;
//该函数的作用是按照imagebox中的位图形状形成一个不规则区域
var
lineregion,fullregion:hrgn;//定义区域
x,y,startlinex:integer;//存放位置坐标
transparentcolor:longword;//存放所指定的透明色
infirstregion,inlinea:boolean;
picwidth,picheight:integer;
//图象的宽和高
hdc:hwnd;//图象框的句柄
begin
hdc:=imagebox.canvas.handle;//得到图象框的句柄
picwidth:=imagebox.width;//得到图象框的宽和高
picheight:=imagebox.height;
infirstregion:=true;
inlinea:=false;
startlinex:=0;
fullregion:=0;
transparentcolor:=getpixel(hdc,0,0);//指定透明色
//下面的两重循环逐行地扫描不透明色,将连续的不透明色形成一个个小的区域
//然后将这些小区域混合成一个大的不规则区域即位图中不透明区域的形状
//由于是一行行地扫描而不是一个点一个点地扫描所以速度快多了。
for y:=0 to picheight-1do
begin
for x:=0 to picwidth-1do
begin
if ((getpixel(hdc,x,y)=transparentcolor) or (x=picwidth)) then
begin
if (inlinea=true) then
begin
inlinea:=false;
//将连续的不透明色组成一个小的矩形区域
lineregion:=createrectrgn(startlinex,y,x,y+1);
if (infirstregion=true)then
begin
fullregion:=lineregion;
infirstregion:=false;
end
else
begin
//混合小的矩形区域到一个大区域,循环结束后,此大区域就是整个不规则窗口
combinergn(fullregion,fullregion,lineregion,rgn_or);
deleteobject(lineregion);
end;
end;
end
else
begin
if (inlinea=false)then
begin
inlinea:=true;
startlinex:=x;
end;
end;
end;
end;
result:= fullregion;
//返回所形成的不规则区域
end;

procedure TForm1.creat(Sender: TObject);
begin
//窗体式样为无边框
form1.BorderStyle:=bsNone;
//初始化a
a:=0;
end;
procedure TForm1.clicked(Sender: TObject);
begin
//得到当前鼠标位置
getcursorpos(mousepos);
//弹出菜单
popupmenu1.Popup(mousepos.x,mousepos.y);
end;
procedure TForm1.Timer1Timer(Sender: TObject);
var
aa:hrgn;//用于存储得到的区域
picture:string;//存储要显示的位图文件的文件名
begin
image1.AutoSize:=true;//按位图尺寸自动调整大小
a:=a+1;//每经过一个计时器事件,就换一幅位图
if a<8 then
begin
picture:='pig'+inttostr(a)+'.bmp' ;
image1.Picture.LoadFromFile(picture) ;
end
else
a:=0;
//按照image1中的位图形状形成一个不规则区域
aa:=makeregion(image1);
//将形成的不规则区域赋给本窗体以形成一个不规则窗体
setwindowrgn(handle,aa,true);
end;
procedure TForm1.N1Click(Sender: TObject);
begin
//单击窗体,在弹出的菜单中选“退出”时关闭本程序
application.Terminate;
end;

end.
以上程序在Delphi6,WindowsMe下调试通过。
==================================================================
 
请使用SkinPack,轻松开发皮肤软件
http://www.skin-studio.com
 
鎴戠敤浜唜ianjun鐨勪唬鐮侊紝OK! 璋㈣阿
閰嶇疆锛歸in2000serverSp4+del6
 

Similar threads

I
回复
0
查看
712
import
I
S
回复
0
查看
3K
SUNSTONE的Delphi笔记
S
S
回复
0
查看
2K
SUNSTONE的Delphi笔记
S
I
回复
0
查看
552
import
I
顶部