标题栏上放控件(如:按钮)

Question

转贴阿～～用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.

Answer 1

我想那不是你所想的。
我的同事实现了一个词霸的界面，实际把窗体的borderstyle设置成bsnone，然后自己用image控件建立一个界面，包括标题栏，栏上的图表等。

Answer 2

tikkypeng(一两狂死郎之天衣有缝)用的是canvas画出标题栏，也是一种解决的思路。

Answer 3

to tikkypeng(一两狂死郎之天衣有缝):
  我将会把分给你看有谁还有更好的方法!

Answer 4

procedure Tform1.formcontrol(var msg:Twmnchittest);
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分别对应最小、最大和关闭窗口
现在还在调试中

Answer 5

窗体无边～随心所欲的放控件模拟标题栏～～然后～～procedure TForm1.Panel4MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
const
  SC_DragMove = $F012;  { a magic number }
begin
  ReleaseCapture;
  Panel4.perform(WM_SysCommand, SC_DragMove, 0);
end;在你的伪造的那个标题栏的ＭｏｕｓｅＤｏｗ事件里面～向系统发送移动窗体的命令～～
呵呵～～试一下你就知道了～～

Answer 6

tikkypeng(一两狂死郎之天衣有缝)的方法是很不错！但是要实现一些美观的界面时，用canvas画应该得不出效果吧，不过能领略到这样的代码，应当谢谢你！

Answer 7

to tikkypeng(一两狂死郎之天衣有缝)　
  至少也值两个钱//小小改动
procedure TForm1.Panel1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  ReleaseCapture;
  Panel1.perform(WM_SysCommand, SC_MOVE + 1, 0);
                              //^^^^^^^^^^^
end;

Answer 8

//在小小改动
//再小小改动
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)都行

Answer 9

给个mail，我发个程序给你，是我自己做的平面程序，模仿标题栏，比标准的好看多了，而且在失去焦点的时候标题栏和文字都会变色

Answer 10

to tikkypeng(一两狂死郎之天衣有缝)
  请进:
  http://www.csdn.net/expert/topic/152/152956.shtm

Answer 11

在这个网站上第一行就能看到一个例子！
里面还有很多好东东啊！
你学DELPHI不可不去这个网站啊
DELPHI盒子:
http://mantousoft.51.net/indexs.php

Answer 12

to liang_z:
  也谢罗!