DELPHI在标题栏上增加按钮

Delphi代码

1. unit Unit1;
2. interface
3. uses
4. SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
5. Forms, Dialogs, Buttons, DdeMan, StdCtrls;
6. type
7. TTitleBtnForm = class(TForm)
8. Button1: TButton;
9. procedure FormResize(Sender: TObject);
10. private
11. TitleButton : TRect;
12. procedure DrawTitleButton;
13. {Paint-related messages}
14. procedure WMSetText(var Msg : TWMSetText); message WM_SETTEXT;
15. procedure WMNCPaint(var Msg : TWMNCPaint); message WM_NCPAINT;
16. procedure WMNCActivate(var Msg : TWMNCActivate); message WM_NCACTIVATE;
17. {Mouse down-related messages}
18. procedure WMNCHitTest(var Msg : TWMNCHitTest); message WM_NCHITTEST;
19. procedure WMNCLButtonDown(var Msg : TWMNCLButtonDown); message WM_NCLBUTTONDOWN;
20. function GetVerInfo : DWORD;
21. end;
22. var
23. TitleBtnForm: TTitleBtnForm;
24. const
25. htTitleBtn = htSizeLast + 1;
26. implementation
27. {$R *.DFM}
28. procedure TTitleBtnForm.DrawTitleButton;
29. var
30. bmap : TBitmap; {Bitmap to be drawn - 16 X 16 : 16 Colors}
31. XFrame, {X and Y size of Sizeable area of Frame}
32. YFrame,
33. XTtlBit, {X and Y size of Bitmaps in caption}
34. YTtlBit : Integer;
35. begin
36. {Get size of form frame and bitmaps in title bar}
37. XFrame := GetSystemMetrics(SM_CXFRAME);
38. YFrame := GetSystemMetrics(SM_CYFRAME);
39. XTtlBit := GetSystemMetrics(SM_CXSIZE);
40. YTtlBit := GetSystemMetrics(SM_CYSIZE);
41. {$IFNDEF WIN32}
42. TitleButton := Bounds(Width - (3 * XTtlBit) - ((XTtlBit div 2) - 2),
43. YFrame - 1,
44. XTtlBit + 2,
45. YTtlBit + 2);
46. {$ELSE} {Delphi 2.0 positioning}
47. if (GetVerInfo = VER_PLATFORM_WIN32_NT) then
48. TitleButton := Bounds(Width - (3 * XTtlBit) - ((XTtlBit div 2) - 2),
49. YFrame - 1,
50. XTtlBit + 2,
51. YTtlBit + 2)
52. else
53. TitleButton := Bounds(Width - XFrame - 4*XTtlBit + 2,
54. XFrame + 2,
55. XTtlBit + 2,
56. YTtlBit + 2);
57. {$ENDIF}
58. Canvas.Handle := GetWindowDC(Self.Handle); {Get Device context for drawing}
59. try
60. {Draw a button face on the TRect}
61. DrawButtonFace(Canvas, TitleButton, 1, bsAutoDetect, False, False, False);
62. bmap := TBitmap.Create;
63. bmap.LoadFromFile('c:\windows\desktop\aaa.bmp');
64. with TitleButton do
65. {$IFNDEF WIN32}
66. Canvas.Draw(Left + 2, Top + 2, bmap);
67. {$ELSE}
68. if (GetVerInfo = VER_PLATFORM_WIN32_NT) then
69. Canvas.Draw(Left + 2, Top + 2, bmap)
70. else
71. Canvas.StretchDraw(TitleButton, bmap);
72. {$ENDIF}
73. finally
74. ReleaseDC(Self.Handle, Canvas.Handle);
75. bmap.Free;
76. Canvas.Handle := 0;
77. end;
78. end;
79. {Paint triggering events}
80. procedure TTitleBtnForm.WMNCActivate(var Msg : TWMNCActivate);
81. begin
82. Inherited;
83. DrawTitleButton;
84. end;
85. procedure TTitleBtnForm.FormResize(Sender: TObject);
86. begin
87. Perform(WM_NCACTIVATE, Word(Active), 0);
88. end;
89. {Painting events}
90. procedure TTitleBtnForm.WMNCPaint(var Msg : TWMNCPaint);
91. begin
92. Inherited;
93. DrawTitleButton;
94. end;
95. procedure TTitleBtnForm.WMSetText(var Msg : TWMSetText);
96. begin
97. Inherited;
98. DrawTitleButton;
99. end;
100. {Mouse-related procedures}
101. procedure TTitleBtnForm.WMNCHitTest(var Msg : TWMNCHitTest);
102. begin
103. Inherited;
104. {Check to see if the mouse was clicked in the area of the button}
105. with Msg do
106. if PtInRect(TitleButton, Point(XPos - Left, YPos - Top)) then
107. Result := htTitleBtn;
108. end;
109. procedure TTitleBtnForm.WMNCLButtonDown(var Msg : TWMNCLButtonDown);
110. begin
111. inherited;
112. if (Msg.HitTest = htTitleBtn) then
113. ShowMessage('You pressed the new button');
114. end;
115. function TTitleBtnForm.GetVerInfo : DWORD;
116. var
117. verInfo : TOSVERSIONINFO;
118. begin
119. result:=0;
120. verInfo.dwOSVersionInfoSize := SizeOf(TOSVersionInfo);
121. if GetVersionEx(verInfo) then
122. Result := verInfo.dwPlatformID;
123. {Returns:
124. VER_PLATFORM_WIN32s Win32s on Windows 3.1
125. VER_PLATFORM_WIN32_WINDOWS Win32 on Windows 95
126. VER_PLATFORM_WIN32_NT Windows NT }
127. end;
128. end.