DELPHI在标题栏上增加按钮

标签：

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

DELPHI在标题栏上增加按钮

标签：

原文地址：http://www.cnblogs.com/honeynm/p/4174867.html