发信人: powerjeep@GZ()
整理人: kingron(2001-01-11 17:48:57), 站内信件
|
标 题: Re: 不规则的窗体怎么制作？并且没有蓝色的标题栏？
发信站: 网易虚拟社区 (Thu Apr 27 12:23:15 2000), 站内信件
【 在 ygcan (乖东东) 的大作中提到: 】
: 不规则的窗体怎么制作？并且没有蓝色的标题栏？
unit AnyShape;
interface
uses Windows, Messages, SysUtils, Classes, Graphics,
Controls, Forms, Dialogs, ExtCtrls;
type
TAnyShape = class(TComponent)
private
fimagefilename : string ;
fimage : Timage ;
protected { Protected declarations }
function BitmapToRegion(bmp: TBitmap) : dword; //返回值为 region
helper variable
public
procedure ShowImage;
published
{ Published declarations }
property ImageFileName : string read fimagefilename write fimagefi
lename ;
property Image : Timage read fimage write fimage ;
end;
procedure Register;
implementation
procedure Register;
begin
RegisterComponents('Musicwind', [TAnyShape]);
end;
{ TSkinImage }
function TAnyShape.BitmapToRegion(bmp: TBitmap) : dword;
var
ix,iy : integer; // loop variables
tc : TColor; // transparentColor
b1 : boolean; // am looking through "real" pixels (no tran
sparent pixels)
c1 : cardinal; // region helper variable
i1 : integer; // first position of real pixel
begin
Result := 0;
i1 := 0; // memory transparent color
tc := bmp.transparentColor and $FFFFFF;
with bmp.canvas do // scan through all lines
for iy := 0 to bmp.height - 1 do begin
b1 := False;
// scan through all pixels in this line
for ix:=0 to bmp.Width - 1 do
// did we find the first/last real pixel in a row
if (pixels[ix, iy] and $FFFFFF <> tc) <> b1 then
begin
// yes, and it was the last pixel,
//so we can add a line style region...
if b1 then begin
c1:=CreateRectRgn(i1,iy,ix,iy+1);
if result<>0 then
begin
// it's not the first region
CombineRgn(Result, Result, c1, RGN_OR);
DeleteObject(c1);
// it's the first region
end
else
Result := c1;
end else i1 := ix;
// change mode, looking for the first or last real pixel?
b1:=not b1;
end;
// was the last pixel in this row a real pixel?
if b1 then begin
c1:=CreateRectRgn(i1, iy, bmp.width-1, iy+1);
if (Result <> 0) then
begin
CombineRgn(Result, Result, c1, RGN_OR);
DeleteObject(c1);
end
else
Result := c1;
end;
end;
end;
procedure TAnyShape.ShowImage;
var
Region : HRGN;
bmp_temp : Tbitmap ;
img_temp : Timage ;
begin
bmp_temp := Tbitmap.Create ;
img_temp := Timage.Create(Self) ;
if (fimagefilename <> '') or ( fimage <> nil) then
begin
TForm(Owner).borderstyle := bsnone ;
if fimage.Picture.Graphic <> nil then
bmp_temp.Assign (fimage.picture.graphic)
else
if FileExists(fimagefilename) then
begin
img_temp.picture.LoadFromFile(Fimagefilename) ;
bmp_temp.Assign (img_temp.picture.graphic) ;
end;
Region := BitmapToRegion(bmp_temp);
SetWindowRgn(TForm(Owner).Handle, Region, True);
DeleteObject(Region);
end;
bmp_temp.free ;
img_temp.free ;
end;
initialization
//
end.
安装此控件，然后给他指定一个BMP图，然后执行该控件的SHOWIMAGE方法即可得
到
任意形状的FORM
--
…… 世界因你而美丽
世界有我更精彩 ……
※ 来源:．月光软件站 http://www.moon-soft.com．[FROM: 61.130.6.8]
|
|