DELPHI在标题栏上增加按钮

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:windowsdesktopaaa.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.   
【推广】 免费学中医，健康全家人
原文地址：https://www.cnblogs.com/honeynm/p/4174867.html