在Delphi中实现任意形状的窗体

form的text：

object form1: tform1
left = 192
top = 107
borderstyle = bsnone
caption = form1
clientheight = 348
clientwidth = 536
color = clbtnface
font.charset = default_charset
font.color = clwindowtext
font.height = -11
font.name = ms sans serif
font.style = []
oldcreateorder = false
oncreate = button1click
pixelsperinch = 96
textheight = 13
object button1: tbutton
    left = 392
    top = 152
    width = 75
    height = 25
    caption = button1
    taborder = 0
    onclick = button1click
end
object button2: tbutton
    left = 432
    top = 24
    width = 17
    height = 17
    caption = button2
    taborder = 1
    onclick = button2click
end
object button3: tbutton
    left = 448
    top = 40
    width = 17
    height = 17
    caption = button2
    taborder = 2
    onclick = button3click
end
object button4: tbutton
    left = 464
    top = 56
    width = 17
    height = 17
    caption = button2
    taborder = 3
    onclick = button4click
end
end

各种不同的事件声名：

tform1 = class(tform)
    button1: tbutton;
    button2: tbutton;
    button3: tbutton;
    button4: tbutton;
    procedure button1click(sender: tobject);
    procedure button2click(sender: tobject);
    procedure button3click(sender: tobject);
    procedure button4click(sender: tobject);
private
    procedure wmmove(var message: twmnchittest); message wm_nchittest;
    { private declarations }
public
    { public declarations }
end;

var
form1: tform1;

implementation

{$r *.dfm}

procedure tform1.wmmove(var message: twmnchittest);
begin
message.result := htcaption;
end;

procedure tform1.button1click(sender: tobject);
var
r1,r2,r3,r4,r5: hrgn;
begin
r1 := createellipticrgn(0,0,round(clientwidth / 2),clientheight);
r2 := createellipticrgn(round(clientwidth / 2),0,clientwidth,clientheight);
r3 := createellipticrgn(round(clientwidth / 4 ),round(clientheight / 4 *3),round(clientwidth / 4 *3),clientheight);
r4 := createrectrgn(0,0,0,0);
r5 := createrectrgn(0,0,0,0);
combinergn(r4,r2,r1,rgn_or);
combinergn(r5,r4,r3,rgn_or);

setwindowrgn(handle,r5,true);
deleteobject(r1);
deleteobject(r2);
deleteobject(r3);
deleteobject(r4);
deleteobject(r5);
end;

procedure tform1.button2click(sender: tobject);
begin
sendmessage(handle,wm_syscommand,sc_minimize,0);
end;

procedure tform1.button3click(sender: tobject);
begin
sendmessage(handle,wm_syscommand,sc_default,0);
end;

procedure tform1.button4click(sender: tobject);
begin
application.terminate;
end;

end.

下一篇：sql server 2005中的DDL触发器

↓相关文章：