如何在窗口界面标题栏上添别一个标签或按钮???(100分)

W

wl2001

Unregistered / Unconfirmed
GUEST, unregistred user!
[:(]拜托各位,在这里先谢谢大家,祝大家春节愉快,万事如意
 
查查旧贴子吧 已经有答案了!
 
有句柄(handle)的控件不能放在标题栏上了。用Spy++跟踪一下的话,就会发现其中的秘密
。它并不是一个按钮,只不过是处理成按钮的样子罢了。
注意注解。
具体实例之前,我们应该知道几个关于标题栏的重要的消息:
WM_NCPAINT:重画标题栏消息。我们必须截住它,可以在这里重画按钮;
WM_NCLBUTTONDOWN:在标题栏上按下鼠标左键消息。我们可以截住它,在标题栏上画出
按钮按下的样子,并且可以在其中进行自已的单击事件的处理,使得它像一个按钮;
WM_NCLBUTTONUP:在标题栏上释放鼠标左键消息。我们可以截住它,在标题栏上画出按
钮弹起的样子;
WM_NCLBUTTONDBLCLK:在标题栏上双击鼠标左键消息。我们可以截住它,当在按钮区域
双击时,我们就该使其无效,从而避免窗体执行最大化和还原操作。
WM_NCRBUTTONDOWN:在标题栏上按下鼠标右键消息。我们可以截住它,当在按钮区域
双击时,我们就该使其无效,从而避免弹出窗体按制菜单。
WM_NCMOUSEMOVE:在标题栏上移动鼠标消息。我们可以截住它,当鼠标移出按钮区域时,
我们就必须画出按钮没有被按下,即凸起时的样子。
WM_NCACTIVATE:当标题栏在激活与非激活之间切换时收到该消息。我们可以截住它,
当该窗口处理激活状态时,我们可以做一些事情,比如说将我们的标题栏按钮上的字体
变灰或变黑来指示该窗口的当前状态。下面我没有加入该项功能,如果大家感兴趣的话,
可以自己完成。
(大家从这里可以发现,标题栏的消息都是WM_NC开头的)
例子:
unit main;
interface
uses
Windows, Messages, SysUtils, Classes,
Graphics, Controls, Forms, Dialogs,
StdCtrls, Menus;
type
TForm1 = class(TForm)
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
{ Private declarations }
CBBtnRect: TRect;
// Caption Bar Button Rectangle
CBBtnFont: TFont;
// Caption Bar Button Font
procedure DrawCaptionBtn(uEdge: UINT);
// 当在标题栏上按下鼠标左按钮时进入该过程
procedure WMNcLButtonDown(var m: TMessage);
message WM_NCLBUTTONDOWN;
// 当在标题栏上放开鼠标左按钮时进入该过程
procedure WMNcLButtonUp(var m: TMessage);
message WM_NCLBUTTONUP;
// 当在标题栏上移动鼠标时进入该过程
procedure WMNcMouseMove(var m: TMessage);
message WM_NCMOUSEMOVE;
// 当在标题栏上双击鼠标左铵钮时进入该过程
procedure WMNcLButtonDBLClk
(var m: TMessage);
message WM_NCLBUTTONDBLCLK;
// 当在标题栏上按下鼠标右按钮时进入该过程
procedure WMNcRButtonDown(var m: TMessage);
message WM_NCRBUTTONDOWN;
// 当画标题栏时进入该过程
procedure WMNcPaint(var m: TMessage);
message WM_NCPAINT;
// 当标题栏在激活与非激活之间切换时进入该过程
procedure WMNcActivate(var m: TMessage);
message WM_NCACTIVATE;
public
{ Public declarations }
end;

var
Form1: TForm1;
implementation
{$R *.DFM}
procedure TForm1.DrawCaptionBtn(uEdge: UINT);
var
hCaptionDC: HDC;
// 标题条Device Context
hOldFont: HFONT;
// 原来的字体
r: TRect;
begin
hCaptionDC := GetWindowDC(Self.Handle);
// 注意不能用GetDC,那样的话,将得不到标题栏
// 的设备上下文
//画按钮的样子,如果uEdge=EDGE_RAIS,
则画出的样子为凸起;如果
//uEdge=EDGE_SUNKEN,则画出的样子为凹下。
DrawEdge(hCaptionDC, CBBtnRect, uEdge,
BF_RECT or BF_MIDDLE or
BF_SOFT);

//设置标题栏的设备上下文为透明状态
SetBkMode(hCaptionDC, TRANSPARENT);
//设置标题栏设备上下文的字体
hOldFont:= SelectObject(hCaptionDC, CBBtnFont.Handle);
//画按钮
if uEdge = EDGE_RAISED then
DrawText(hCaptionDC, 'Caption Bar Button',
18, CBBtnRect, DT_CENTER)
else
begin
r := CBBtnRect;
OffsetRect(r, 1, 1);
DrawText(hCaptionDC, 'Caption Bar Button', 18, r, DT_CENTER);
end;

//还原为原来的字体
SelectObject(hCaptionDC, hOldFont);
end;

procedure TForm1.WMNcActivate(var m: TMessage);
begin
inherited;
DrawCaptionBtn(EDGE_RAISED);
end;

procedure TForm1.WMNcPaint(var m: TMessage);
begin
inherited;
DrawCaptionBtn(EDGE_RAISED);
end;

procedure TForm1.WMNcLButtonDBLClk(var m: TMessage);
var
p: TPoint;
begin
p.x := LOWORD(m.lParam) - Self.Left;
p.y := HIWORD(m.lParam) - Self.Top;
if not PtInRect(CBBtnRect, p) then
// 如果不在按钮区域内
inherited;
// 执行默认的操作
end;

procedure TForm1.WMNcMouseMove(var m: TMessage);
var
p: TPoint;
begin
p.x := LOWORD(m.lParam) - Self.Left;
p.y := HIWORD(m.lParam) - Self.Top;
if not PtInRect(CBBtnRect, p) then
// 如果不在按钮区域
DrawCaptionBtn(EDGE_RAISED)
else
inherited;
// 执行默认的操作
end;

procedure TForm1.WMNcLButtonDown(var m: TMessage);
var
p: TPoint;
begin
p.x := LOWORD(m.lParam) - Self.Left;
p.y := HIWORD(m.lParam) - Self.Top;
if PtInRect(CBBtnRect, p) then
// 如果按在了按钮区域
begin
Self.BringToFront;
DrawCaptionBtn(EDGE_SUNKEN);
end
else
inherited;
// 执行默认的操作
end;
procedure TForm1.WMNcLButtonUp(var m: TMessage);
var
p: TPoint;
begin
p.x := LOWORD(m.lParam) - Self.Left;
p.y := HIWORD(m.lParam) - Self.Top;
if PtInRect(CBBtnRect, p) then
//如果在标题栏按钮区域释放鼠标
begin
DrawCaptionBtn(EDGE_RAISED);
end
else
inherited;
// 执行默认的操作
end;
procedure TForm1.WMNcRButtonDown(var m: TMessage);
var
p: TPoint;
begin
p.x := LOWORD(m.lParam) - Self.Left;
p.y := HIWORD(m.lParam) - Self.Top;
if not PtInRect(CBBtnRect, p) then
// 如果不在标题栏按钮区域
inherited;
// 执行默认的操作
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
// 这个大小大家可以得用GetSystemMetrics函数来进行更精确的计算。这里
// 只是用来示例
with CBBtnRectdo
begin
left := 100;
top := 6;
right := 450;
bottom := 20;
end;
// 标题栏按钮字体。
CBBtnFont:= TFont.Create;
with CBBtnFontdo
begin
Name := '宋体';
Size := 9;
Color := clRed;
end;
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
CBBtnFont.Free;
end;
end.
 

Similar threads

S
回复
0
查看
3K
SUNSTONE的Delphi笔记
S
S
回复
0
查看
2K
SUNSTONE的Delphi笔记
S
D
回复
0
查看
902
DelphiTeacher的专栏
D
D
回复
0
查看
2K
DelphiTeacher的专栏
D
顶部