异形窗体制作过程中的问题???请大侠看看代码,帮小弟一下!(28分)

  • 主题发起人 主题发起人 laohe
  • 开始时间 开始时间
L

laohe

Unregistered / Unconfirmed
GUEST, unregistred user!
下面这篇文件,我试用了一下,不错,可以制作很多异形窗体,
可惜的是当窗体最大化,窗体还是最初的异形;
我不知道如何取消,并恢复初始化,请高手指点,也让我学习一下;

//----------------------------------------------------



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);
BeginPath(dc);
for x:=0 to wMask.Width-1 do
begin
line := false;
for y:=0 to wMask.Height-1 do
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;
end.

 
大侠怎么没有了,这么多人流量
 
老大,急
 
我也替你急~
踢!~
 
procedure TForm1.Image1DblClick(Sender: TObject);
var
rgn:Thandle;
begin
rgn := CreateRectRgn(0, 0, Width, Height);
SetWindowRgn(handle,rgn,true);
end;
 
bubble:大侠您终于出来了;

我试了您给我的代码,但只是变成方形;但大小不能改变,

我想让它的大小与窗体一样,不知改呢

rgn := CreateRectRgn(0, 0, Form1.Width, Form1.Height);没有作用

 
bubble大侠,不好意思,我把FORM设为AutoSize,改过来就可以了,谢谢您

form1.AutoSize:=false;

 
后退
顶部