unit Unit1;interfaceuses
Windows, Messages, SysUtils, Classes,
Graphics, Controls, Forms, Dialogs,
StdCtrls, Menus;type
TForm1 = class(TForm)
Button1: TButton;
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure FormCanResize(Sender: TObject; var NewWidth,
NewHeight: Integer; var Resize: Boolean); private
{ Private declarations }
IsGraphTicket: Boolean;
CBBtnRect: TRect; // Caption Bar Button Rectangle
CBBtnFont: TFont; // Caption Bar Button Font
procedure SetRect();
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
uses StrUtils;{$R *.DFM}procedure TForm1.SetRect();
var
Width: Integer;
begin
with CBBtnRect do
begin
if IsGraphTicket then
Width := 100
else
Width := 110;
left := Self.Width - Width - 57; top := 6;
right := left + Width;
bottom := 20;
end;
end;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
if IsGraphTicket then
DrawText(hCaptionDC, '到了按钮', 8, CBBtnRect, DT_CENTER)
else
DrawText(hCaptionDC, '到了按钮', 8, CBBtnRect, DT_CENTER)
else
begin
r := CBBtnRect;
OffsetRect(r, 1, 1);
if IsGraphTicket then
DrawText(hCaptionDC, '到了按钮', 8, CBBtnRect, DT_CENTER)
else
DrawText(hCaptionDC, '到了按钮', 8, CBBtnRect, 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 // 如果不在按钮区域
begin
DrawCaptionBtn(EDGE_RAISED);
//Application.ShowHint := False;
end
else
begin
inherited; // 执行默认的操作
end;
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
IsGraphTicket := not IsGraphTicket;
DrawCaptionBtn(EDGE_RAISED);
//自己的OnClick事件写在这里
ShowMessage('Here');
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函数来进行更精确的计算。这里
// 只是用来示例
SetRect();
// 标题栏按钮字体。
CBBtnFont := self.Font;
{CBBtnFont := TFont.Create;
with CBBtnFont do
begin
Name := '宋体';
Size := 9;
Color := clRed;
end;//}
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
//CBBtnFont.Free;
end;procedure TForm1.FormCanResize(Sender: TObject; var NewWidth,
NewHeight: Integer; var Resize: Boolean);
var
t: TMessage;
Form: TForm;
begin
SetRect();
Form := TForm.Create(nil);
Form.Show;
Form.Free;
end;end.
Windows, Messages, SysUtils, Classes,
Graphics, Controls, Forms, Dialogs,
StdCtrls, Menus;type
TForm1 = class(TForm)
Button1: TButton;
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure FormCanResize(Sender: TObject; var NewWidth,
NewHeight: Integer; var Resize: Boolean); private
{ Private declarations }
IsGraphTicket: Boolean;
CBBtnRect: TRect; // Caption Bar Button Rectangle
CBBtnFont: TFont; // Caption Bar Button Font
procedure SetRect();
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
uses StrUtils;{$R *.DFM}procedure TForm1.SetRect();
var
Width: Integer;
begin
with CBBtnRect do
begin
if IsGraphTicket then
Width := 100
else
Width := 110;
left := Self.Width - Width - 57; top := 6;
right := left + Width;
bottom := 20;
end;
end;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
if IsGraphTicket then
DrawText(hCaptionDC, '到了按钮', 8, CBBtnRect, DT_CENTER)
else
DrawText(hCaptionDC, '到了按钮', 8, CBBtnRect, DT_CENTER)
else
begin
r := CBBtnRect;
OffsetRect(r, 1, 1);
if IsGraphTicket then
DrawText(hCaptionDC, '到了按钮', 8, CBBtnRect, DT_CENTER)
else
DrawText(hCaptionDC, '到了按钮', 8, CBBtnRect, 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 // 如果不在按钮区域
begin
DrawCaptionBtn(EDGE_RAISED);
//Application.ShowHint := False;
end
else
begin
inherited; // 执行默认的操作
end;
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
IsGraphTicket := not IsGraphTicket;
DrawCaptionBtn(EDGE_RAISED);
//自己的OnClick事件写在这里
ShowMessage('Here');
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函数来进行更精确的计算。这里
// 只是用来示例
SetRect();
// 标题栏按钮字体。
CBBtnFont := self.Font;
{CBBtnFont := TFont.Create;
with CBBtnFont do
begin
Name := '宋体';
Size := 9;
Color := clRed;
end;//}
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
//CBBtnFont.Free;
end;procedure TForm1.FormCanResize(Sender: TObject; var NewWidth,
NewHeight: Integer; var Resize: Boolean);
var
t: TMessage;
Form: TForm;
begin
SetRect();
Form := TForm.Create(nil);
Form.Show;
Form.Free;
end;end.
解决方案 »
免费领取超大流量手机卡,每月29元包185G流量+100分钟通话, 中国电信官方发货