手机站
网通分站
电信主站
密 码:
用户名:
当前位置 : 主页>程序设计>delphi>列表

全透明窗体(效果比较好)

来源:互联网 作者:西部数码 时间:2008-04-09
西部数码-全国虚拟主机10强!40余项虚拟主机管理功能,全国领先!双线多线虚拟主机南北访问畅通无阻!免费赠送企业邮局,.CN域名,自助建站480元起,免费试用7天,满意再付款! P4主机租用799元/月.月付免压金!


全透明窗体(效果比较好)
uses里加上ExtCtrls
procedure tform1.setformtransparent;
var
I: Integer;
FullRgn,
ClientRgn,
ControlRgn: THandle;
Margin,
MarginX,
MarginY,
X,
Y: Integer;
W,H,S :Integer;
bX,bY :Integer;
c :TColor;
begin
Margin := (Width - ClientWidth) div 2;
FullRgn := CreateRectRgn(0, 0, Width, Height);
MarginX := Margin;
MarginY := Height - ClientHeight - Margin;
ClientRgn := CreateRectRgn(MarginX, MarginY, MarginX ClientWidth, MarginY ClientHeight);
CombineRgn(FullRgn, FullRgn, ClientRgn, RGN_DIFF);
DeleteObject(ClientRgn);
for I:=0 to ControlCount-1 do
begin
X := MarginX Controls[I].Left;
Y := MarginY Controls[I].Top;
W:=Controls[I].Width;
H:=Controls[I].Height;
{}
if controls[i] is timage then begin
with controls[i] as tImage do begin
c:=Picture.Bitmap.Canvas.Pixels[0,0];
for bX:=0 to Picture.Bitmap.Width-1 do begin
for bY:=0 to Picture.Bitmap.Height-1 do begin
if Picture.Bitmap.Canvas.Pixels[bX,bY]<>c then begin
ControlRgn := CreateRectRgn(X bX, Y bY, X bX 1, Y bY 1);
CombineRgn(FullRgn, FullRgn, ControlRgn, RGN_OR);
DeleteObject(ControlRgn);
end;
end;
end;
end;
end else
{}
if controls[i] is tShape then begin
if W < H then S := W else S := H;
if (Controls[i] as tshape).Shape in [stSquare, stRoundSquare, stCircle] then
begin
Inc(X, (W - S) div 2);
Inc(Y, (H - S) div 2);
W := S;
H := S;
end;
Inc(W); Inc(H); Inc(S);
case (controls[i] as tshape).Shape of
stRectangle, stSquare:
ControlRgn := CreateRectRgn(X, Y, X W, Y H);
stRoundRect, stRoundSquare:
ControlRgn := CreateRoundRectRgn(X, Y, X W, Y H, S div 4, S div 4);
stCircle, stEllipse:
ControlRgn:=CreateEllipticRgn(X, Y, X W, Y H);
else
ControlRgn := CreateRectRgn(X, Y, X W, Y H);
end;
CombineRgn(FullRgn, FullRgn, ControlRgn, RGN_OR);
DeleteObject(ControlRgn);
end else
{}
begin
ControlRgn := CreateRectRgn(X, Y, X W, Y H);
CombineRgn(FullRgn, FullRgn, ControlRgn, RGN_OR);
DeleteObject(ControlRgn);
end;
end;
SetWindowRgn(Handle, FullRgn, True);
DeleteObject(FullRgn);
end;

procedure TForm1.FormResize(Sender: TObject);
begin
setformtransparent;
end;

//rock
//转载请保留此信息

文章整理:西部数码--专业提供域名注册虚拟主机服务
http://www.west263.com
以上信息与文章正文是不可分割的一部分,如果您要转载本文章,请保留以上信息,谢谢!