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

来点实用的,自己画带标题栏窗体,可当模态窗体样继承 bob008原创在CSDN 发表于2005-0

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

end;
end
else if msg.HitTest = htclose then
begin
Bitblt(cvs.handle, (width - 38), 1, 26, 30, imgclose.canvas.handle, 26, 0, SRCcopy);
end
else
inherited;
end;
finally
releasedc(handle, cvs.handle);
cvs.free;
end;
end;
//标题栏鼠标左键松开
procedure TForm1.wmnclbuttonup(var msg: twmnclbuttonup);
begin
if msg.HitTest = htminbutton then
begin
application.Minimize;
end
else if msg.HitTest = htmaxbutton then
begin
if windowstate = wsNormal then
begin
windowstate := wsMaximized;
left := left 6;
top := top 3;
end
else if windowstate = wsMaximized then
begin
windowstate := wsNormal;
end;
end
else if msg.HitTest = htclose then
begin
application.Terminate;
end
else
inherited;
end;
procedure TForm1.wndproc(var message: Tmessage);
begin
inherited wndproc(message);
if message.msg = wm_activate then
begin
case message.WParamLo of
wa_active, wa_clickactive:
begin
DrawActivate;
shuai := true;
end;
wa_inactive:
begin
DrawDeActivate;
shuai := false;
end;
end;
end;
if message.msg = wm_ncactivate then
begin
message.Result := 1;//返回个固定值吧,免得老闪来闪去多画N次
end;

end;
//用这个来告诉消息最好不过了,好好利用先
procedure TForm1.wmnchittest(var msg: TWMNCHITTEST);
var
cprect : TRect; //定义标题栏的RECT(也就是一个正方形的区域)
minrect : TRect; //最小化按纽的RECT
maxrect : TRect; //最大化按纽的RECT
closerect : TRect; //关闭 按纽的RECT
pt : TPoint; //鼠标指针
begin
cprect := rect(36, -getsystemmetrics(SM_CYMIN) 6, width - 98, 31); //设置RECT
minrect := rect((width - 90), -getsystemmetrics(SM_CYMIN) 1, (width - 65), -getsystemmetrics(SM_CYMIN) 29);
maxrect := rect((width - 64), -getsystemmetrics(SM_CYMIN) 1, (width - 39), -getsystemmetrics(SM_CYMIN) 29);
closerect := rect((width - 38), -getsystemmetrics(SM_CYMIN) 1, (width - 13), -getsystemmetrics(SM_CYMIN) 29);
pt.X := Screentoclient(mouse.CursorPos).X; //鼠标X
pt.Y := Screentoclient(mouse.CursorPos).Y; // Y值
//准备欺骗系统了 ,因为BSNONE样式的窗体是没有这些返回消息的
if PtInRect(minrect, pt)
then
msg.Result := htminbutton //告诉它在最小化按纽这里
else if PtInRect(maxrect, pt)
then
msg.Result := htmaxbutton //告诉它在最大化按纽这里
else if PtInRect(closerect, pt)
then
msg.Result := htclose //告诉它在关闭 按纽这里
else if PtInRect(cprect, pt)
then
msg.Result := htCaption //告诉它在标题栏这里
else if (pt.X < 5) and (pt.Y < -getsystemmetrics(SM_CYMIN) 8) then
msg.Result := httopleft //告诉它在左上角
else if (pt.X > width - 13) and (pt.Y < -getsystemmetrics(SM_CYMIN) 5) then
msg.Result := httopright //告诉它在右上角
else if (pt.X > width - 13) and (pt.Y > height - 5 - getsystemmetrics(SM_CYMIN)) then
msg.Result := htbottomright //告诉它在右下角
else if (pt.X < 5) and (pt.Y > height - 5 - getsystemmetrics(SM_CYMIN)) then
msg.Result := htbottomleft //告诉它在左下角
else if (pt.X < 5) then
msg.Result := htleft //偶是左派
else if (pt.Y < -getsystemmetrics(SM_CYMIN) 5) then
msg.Result := httop //我在上面,低头不见抬头见
else if (pt.X > width - 9) then
msg.Result := htright //偶是右派
else if (pt.Y > height - 5 - getsystemmetrics(SM_CYMIN)) then
msg.Result := htbottom //偶是贫下中农
else
inherited; { http://www.csdn.net bob008 原创 2005-03-14,严禁未经许可的转载,出版}
end;
//标题栏双击消息,偶们来模拟一下
procedure TForm1.wmnclbuttondblclk(var msg: TWMNCLButtonDblClk);
begin
if msg.HitTest = htCaption then
if windowstate = wsMaximized then
windowstate := wsNormal
else if windowstate = wsNormal then
begin
windowstate := wsMaximized;
left := left 6;
top := top 3;
end;
end;
//标题栏上鼠标移动的消息
procedure TForm1.wmncmousemove(var msg: TWMNcMousemove);
var
dc : HDC;
cv : TCanvas;
begin
dc := getwindowDc(handle);
cv := TCanvas.Create;
try
cv.handle := dc;
with cv do
begin
if shuai = true then
begin
if msg.HitTest = htminbutton then

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