在标题栏中加入按钮的delphi源码
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs;
type
TForm1 = class(TForm)
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
ButtonRect: TRect;
//工具栏上按钮的区域
procedure DrawCaptionBtn(BtnStyle: 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(BtnStyle: UINT);
var
hCaptionDC: HDC;
//标题条的设备上下文
r: TRect;
begin
hCaptionDC := GetWindowDC(Self.Handle);
//注意不能用GetDC,那样的话，将得不到标题栏的设备上下文
DrawEdge(hCaptionDC, ButtonRect, BtnStyle,BF_RECT or BF_MIDDLE or BF_SOFT);
//画按钮的样子，如果BtnStyle=EDGE_RAISED，则画出的样子为凸起；
//如果BtnStyle=EDGE_SUNKEN，则画出的样子为凹下
SetBkMode(hCaptionDC, TRANSPARENT);
//设置标题栏的设备上下文为透明状态
if BtnStyle = EDGE_RAISED then
DrawText(hCaptionDC, '按钮',4, ButtonRect, DT_CENTER)
else
begin
r := ButtonRect;
OffsetRect(r, 1, 1);
DrawText(hCaptionDC, '按下',4, r, DT_CENTER);
end;
//画按钮
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(ButtonRect, 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(ButtonRect, 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(ButtonRect, p) then
// 如果按在了按钮区域
begin
Self.BringToFront;
DrawCaptionBtn(EDGE_SUNKEN);
ShowMessage('按下了按钮');
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(ButtonRect, 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(ButtonRect, p) then
inherited;
//如果不在标题栏按钮区域,执行默认的操作
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
with ButtonRect do
begin
left := 100;
top := 4;
right := 150;
bottom := 22;
end;
end;
end.
下一篇:图片翻转的delphi源码