转贴阿~~用DELPHI实现窗体标题栏上的按钮 摘要:要在标题栏放置按钮(非系统按钮),用普通的方法是无法实现的,因为我们无法将DELPHI提供的按钮控件放置到标题栏上。DELPHI提供了一个很好用的函数DrawButtonFace,它允许用户在任何画布(canvas)上画出一个按钮,而标题栏也是画布,因此在标题栏上画出一个按钮也就不是很困难的事了,本文给出一个
示例,供感兴趣的朋友参考。 曾见到过一个软件在标题栏放置了按钮(非系统按钮),那么这种技术如何实现的呢?用普通的方法是无法实现的,因为我们无法将DELPHI提供的按钮控件放置到标题栏上。DELPHI提供了一个很好用的函数DrawButtonFace,它允许用户在任何画布(canvas)上画出一个按钮,而标题栏也是画布,因此在标题栏上画出一个按钮也就不是很困难的事了,本文给出一个示例,供感兴趣的朋友参考。 要在标题栏上画按钮,还有一些事情需要考虑,我们必须考虑各种消息事件,比如窗体从后台激活到前台时、窗体的Paint消息等,遇到这些消息就必须重画按钮,否则按钮将会消失,但这些不会对系统造成过多的负担。为方便大家使用,给出完整的源程序并给出注释。unit Unit1;interfaceuses
Windows, Buttons, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs;type
TForm1 = class(TForm)
procedure FormResize(Sender: TObject);
private
CaptionBtn : TRect;
procedure DrawCaptButton;
procedure WMNCPaint(var Msg : TWMNCPaint); message WM_NCPaint;
procedure WMNCActivate(var Msg : TWMNCActivate); message WM_NCACTIVATE;
procedure WMSetText(var Msg : TWMSetText); message WM_SETTEXT;
procedure WMNCHitTest(var Msg : TWMNCHitTest); message WM_NCHITTEST;
procedure WMNCLButtonDown(var Msg : TWMNCLButtonDown); message WM_NCLBUTTONDOWN;
public
{ Public declarations }
end;var
Form1: TForm1;implementationconst
htCaptionBtn = htSizeLast + 1;
{$R *.DFM}procedure TForm1.DrawCaptButton;
var
xFrame,
yFrame,
xSize,
ySize : Integer;
R : TRect;
begin
//获取窗体的边框尺寸
xFrame := GetSystemMetrics(SM_CXFRAME);
yFrame := GetSystemMetrics(SM_CYFRAME);//获取标题按钮的尺寸
xSize := GetSystemMetrics(SM_CXSIZE);
ySize := GetSystemMetrics(SM_CYSIZE);//定义一个新的标题按钮(非系统按钮)
CaptionBtn := Bounds(Width - xFrame - 5*xSize + 2,
yFrame + 2, xSize + 2, ySize - 4);
//获取窗体画布的句柄
Canvas.Handle := GetWindowDC(Self.Handle); //定义画布的属性
Canvas.Font.Name := '宋体';
Canvas.Font.Color := clBlue;
Canvas.Pen.Color := clYellow;
Canvas.Brush.Color := clBtnFace;try
//画按钮
DrawButtonFace(Canvas, CaptionBtn, 1, bsAutoDetect, False, False, False);
//在按钮中定义一个范围用来输出按钮标题信息
R := Bounds(Width - xFrame - 5 * xSize + 2,
yFrame + 3, xSize +10, ySize - 7);
with CaptionBtn do
Canvas.TextRect(R, R.Left + 2, R.Top , '你好');
finally
ReleaseDC(Self.Handle, Canvas.Handle);
Canvas.Handle := 0;
end;
end;
//接收到Paint消息时重画按钮
procedure TForm1.WMNCPaint(var Msg : TWMNCPaint);
begin
inherited;
DrawCaptButton;
end;
//激活时重画
procedure TForm1.WMNCActivate(var Msg : TWMNCActivate);
begin
inherited;
DrawCaptButton;
end;
//接收到WM_SETTEXT消息时重画按钮
procedure TForm1.WMSetText(var Msg : TWMSetText);
begin
inherited;
DrawCaptButton;
end;
//捕获鼠标消息,检查是否按了按钮
procedure TForm1.WMNCHitTest(var Msg : TWMNCHitTest);
begin
inherited;
with Msg do
if PtInRect(CaptionBtn, Point(XPos - Left, YPos - Top)) then
Result := htCaptionBtn;
end;
//鼠标按下的相应操作,用户可添加各种代码,这里只显示一个对话框作例子
procedure TForm1.WMNCLButtonDown(var Msg : TWMNCLButtonDown);
begin
inherited;
if (Msg.HitTest = htCaptionBtn) then
ShowMessage('你好,你按的是标题栏上的按钮!');
end;//窗体改变大小时强制重画标题栏
procedure TForm1.FormResize(Sender: TObject);
begin
//Force a redraw of caption bar if form is resized
Perform(WM_NCACTIVATE, Word(Active), 0);
end;end.
示例,供感兴趣的朋友参考。 曾见到过一个软件在标题栏放置了按钮(非系统按钮),那么这种技术如何实现的呢?用普通的方法是无法实现的,因为我们无法将DELPHI提供的按钮控件放置到标题栏上。DELPHI提供了一个很好用的函数DrawButtonFace,它允许用户在任何画布(canvas)上画出一个按钮,而标题栏也是画布,因此在标题栏上画出一个按钮也就不是很困难的事了,本文给出一个示例,供感兴趣的朋友参考。 要在标题栏上画按钮,还有一些事情需要考虑,我们必须考虑各种消息事件,比如窗体从后台激活到前台时、窗体的Paint消息等,遇到这些消息就必须重画按钮,否则按钮将会消失,但这些不会对系统造成过多的负担。为方便大家使用,给出完整的源程序并给出注释。unit Unit1;interfaceuses
Windows, Buttons, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs;type
TForm1 = class(TForm)
procedure FormResize(Sender: TObject);
private
CaptionBtn : TRect;
procedure DrawCaptButton;
procedure WMNCPaint(var Msg : TWMNCPaint); message WM_NCPaint;
procedure WMNCActivate(var Msg : TWMNCActivate); message WM_NCACTIVATE;
procedure WMSetText(var Msg : TWMSetText); message WM_SETTEXT;
procedure WMNCHitTest(var Msg : TWMNCHitTest); message WM_NCHITTEST;
procedure WMNCLButtonDown(var Msg : TWMNCLButtonDown); message WM_NCLBUTTONDOWN;
public
{ Public declarations }
end;var
Form1: TForm1;implementationconst
htCaptionBtn = htSizeLast + 1;
{$R *.DFM}procedure TForm1.DrawCaptButton;
var
xFrame,
yFrame,
xSize,
ySize : Integer;
R : TRect;
begin
//获取窗体的边框尺寸
xFrame := GetSystemMetrics(SM_CXFRAME);
yFrame := GetSystemMetrics(SM_CYFRAME);//获取标题按钮的尺寸
xSize := GetSystemMetrics(SM_CXSIZE);
ySize := GetSystemMetrics(SM_CYSIZE);//定义一个新的标题按钮(非系统按钮)
CaptionBtn := Bounds(Width - xFrame - 5*xSize + 2,
yFrame + 2, xSize + 2, ySize - 4);
//获取窗体画布的句柄
Canvas.Handle := GetWindowDC(Self.Handle); //定义画布的属性
Canvas.Font.Name := '宋体';
Canvas.Font.Color := clBlue;
Canvas.Pen.Color := clYellow;
Canvas.Brush.Color := clBtnFace;try
//画按钮
DrawButtonFace(Canvas, CaptionBtn, 1, bsAutoDetect, False, False, False);
//在按钮中定义一个范围用来输出按钮标题信息
R := Bounds(Width - xFrame - 5 * xSize + 2,
yFrame + 3, xSize +10, ySize - 7);
with CaptionBtn do
Canvas.TextRect(R, R.Left + 2, R.Top , '你好');
finally
ReleaseDC(Self.Handle, Canvas.Handle);
Canvas.Handle := 0;
end;
end;
//接收到Paint消息时重画按钮
procedure TForm1.WMNCPaint(var Msg : TWMNCPaint);
begin
inherited;
DrawCaptButton;
end;
//激活时重画
procedure TForm1.WMNCActivate(var Msg : TWMNCActivate);
begin
inherited;
DrawCaptButton;
end;
//接收到WM_SETTEXT消息时重画按钮
procedure TForm1.WMSetText(var Msg : TWMSetText);
begin
inherited;
DrawCaptButton;
end;
//捕获鼠标消息,检查是否按了按钮
procedure TForm1.WMNCHitTest(var Msg : TWMNCHitTest);
begin
inherited;
with Msg do
if PtInRect(CaptionBtn, Point(XPos - Left, YPos - Top)) then
Result := htCaptionBtn;
end;
//鼠标按下的相应操作,用户可添加各种代码,这里只显示一个对话框作例子
procedure TForm1.WMNCLButtonDown(var Msg : TWMNCLButtonDown);
begin
inherited;
if (Msg.HitTest = htCaptionBtn) then
ShowMessage('你好,你按的是标题栏上的按钮!');
end;//窗体改变大小时强制重画标题栏
procedure TForm1.FormResize(Sender: TObject);
begin
//Force a redraw of caption bar if form is resized
Perform(WM_NCACTIVATE, Word(Active), 0);
end;end.
我的同事实现了一个词霸的界面,实际把窗体的borderstyle设置成bsnone,然后自己用image控件建立一个界面,包括标题栏,栏上的图表等。
我将会把分给你看有谁还有更好的方法!
var tt :boolean;
point,ll:Tpoint ;
begin
ll.x := msg.XPos;
ll.y := msg.YPos;
point := screentoclient(ll) ;
if ((point.y< 25) and ( point.x < image2.Left )) or( ( point.y > image2.Top+image2.Height) and (point.y < 25))
then
msg.Result := htcaption
else if (point.x < 3 ) then
msg.result := htleft
else if (point.x > form1.Width -3 ) and ( point.y >3 ) and (point.y < form1.Height -3)
then
msg.Result := htright
else if (point.y > form1.Height -3 ) and (point.x > 3) and (point.x <form1.Width -3 )
then
msg.Result := htbottom
else if (point.x < 3 ) and ( point.y <3) then
msg.Result := httopleft
else if ( point.x > form1.Width -3 ) and (point.y <3) then
msg.Result := httopright
else if (point.x< 3 ) and (point.y > form1.Height-3) then
msg.Result := htbottomleft
else if (point.x>form1.Width -3 ) and (point.y>form1.Height-3) then
msg.Result := htbottomright
else
inherited;end;procedure TForm1.Image2Click(Sender: TObject);
begin
application.Minimize ;
end;function Tform1.poit_in(var
x:integer;y:integer;topx:integer;topy:integer;
botx:integer;boty:integer ):boolean;
begin
if ((x > topx) and (x < botx) and (y > topy ) and (y < boty)) then
result := true
else result := false;
end;
procedure TForm1.Image4Click(Sender: TObject);
begin
form1.Close;
end;procedure TForm1.FormCreate(Sender: TObject);
begin
setpos;
end;procedure Tform1.setpos;
begin
image4.Left := form1.Width -image4.Width -5;
image3.left := image4.left-image3.Width -3;
image2.Left := image3.left - image2.Width - 3;
end;procedure TForm1.FormResize(Sender: TObject);
begin
setpos;
end;其中,image1是底图,image2,3,4分别对应最小、最大和关闭窗口
现在还在调试中
Shift: TShiftState; X, Y: Integer);
const
SC_DragMove = $F012; { a magic number }
begin
ReleaseCapture;
Panel4.perform(WM_SysCommand, SC_DragMove, 0);
end;在你的伪造的那个标题栏的MouseDow事件里面~向系统发送移动窗体的命令~~
呵呵~~试一下你就知道了~~
至少也值两个钱//小小改动
procedure TForm1.Panel1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
ReleaseCapture;
Panel1.perform(WM_SysCommand, SC_MOVE + 1, 0);
//^^^^^^^^^^^
end;
//再小小改动
procedure TForm1.WinControlMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
ReleaseCapture;
TWinControl(Sender).Perform(WM_SysCommand, SC_MOVE + 1, 0);
//^^^^^^^^^^^^^^^^^^
end;
//赋给谁(TWinControl)都行
请进:
http://www.csdn.net/expert/topic/152/152956.shtm
里面还有很多好东东啊!
你学DELPHI不可不去这个网站啊
DELPHI盒子:
http://mantousoft.51.net/indexs.php
也谢罗!