Delphi代码
- unit Unit1;
- interface
- uses
- SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
- Forms, Dialogs, Buttons, DdeMan, StdCtrls;
- type
- TTitleBtnForm = class(TForm)
- Button1: TButton;
- procedure FormResize(Sender: TObject);
- private
- TitleButton : TRect;
- procedure DrawTitleButton;
- {Paint-related messages}
- procedure WMSetText(var Msg : TWMSetText); message WM_SETTEXT;
- procedure WMNCPaint(var Msg : TWMNCPaint); message WM_NCPAINT;
- procedure WMNCActivate(var Msg : TWMNCActivate); message WM_NCACTIVATE;
- {Mouse down-related messages}
- procedure WMNCHitTest(var Msg : TWMNCHitTest); message WM_NCHITTEST;
- procedure WMNCLButtonDown(var Msg : TWMNCLButtonDown); message WM_NCLBUTTONDOWN;
- function GetVerInfo : DWORD;
- end;
- var
- TitleBtnForm: TTitleBtnForm;
- const
- htTitleBtn = htSizeLast + 1;
- implementation
- {$R *.DFM}
- procedure TTitleBtnForm.DrawTitleButton;
- var
- bmap : TBitmap; {Bitmap to be drawn - 16 X 16 : 16 Colors}
- XFrame, {X and Y size of Sizeable area of Frame}
- YFrame,
- XTtlBit, {X and Y size of Bitmaps in caption}
- YTtlBit : Integer;
- begin
- {Get size of form frame and bitmaps in title bar}
- XFrame := GetSystemMetrics(SM_CXFRAME);
- YFrame := GetSystemMetrics(SM_CYFRAME);
- XTtlBit := GetSystemMetrics(SM_CXSIZE);
- YTtlBit := GetSystemMetrics(SM_CYSIZE);
- {$IFNDEF WIN32}
- TitleButton := Bounds(Width - (3 * XTtlBit) - ((XTtlBit div 2) - 2),
- YFrame - 1,
- XTtlBit + 2,
- YTtlBit + 2);
- {$ELSE} {Delphi 2.0 positioning}
- if (GetVerInfo = VER_PLATFORM_WIN32_NT) then
- TitleButton := Bounds(Width - (3 * XTtlBit) - ((XTtlBit div 2) - 2),
- YFrame - 1,
- XTtlBit + 2,
- YTtlBit + 2)
- else
- TitleButton := Bounds(Width - XFrame - 4*XTtlBit + 2,
- XFrame + 2,
- XTtlBit + 2,
- YTtlBit + 2);
- {$ENDIF}
- Canvas.Handle := GetWindowDC(Self.Handle); {Get Device context for drawing}
- try
- {Draw a button face on the TRect}
- DrawButtonFace(Canvas, TitleButton, 1, bsAutoDetect, False, False, False);
- bmap := TBitmap.Create;
- bmap.LoadFromFile(‘c:\windows\desktop\aaa.bmp‘);
- with TitleButton do
- {$IFNDEF WIN32}
- Canvas.Draw(Left + 2, Top + 2, bmap);
- {$ELSE}
- if (GetVerInfo = VER_PLATFORM_WIN32_NT) then
- Canvas.Draw(Left + 2, Top + 2, bmap)
- else
- Canvas.StretchDraw(TitleButton, bmap);
- {$ENDIF}
- finally
- ReleaseDC(Self.Handle, Canvas.Handle);
- bmap.Free;
- Canvas.Handle := 0;
- end;
- end;
- {Paint triggering events}
- procedure TTitleBtnForm.WMNCActivate(var Msg : TWMNCActivate);
- begin
- Inherited;
- DrawTitleButton;
- end;
- procedure TTitleBtnForm.FormResize(Sender: TObject);
- begin
- Perform(WM_NCACTIVATE, Word(Active), 0);
- end;
- {Painting events}
- procedure TTitleBtnForm.WMNCPaint(var Msg : TWMNCPaint);
- begin
- Inherited;
- DrawTitleButton;
- end;
- procedure TTitleBtnForm.WMSetText(var Msg : TWMSetText);
- begin
- Inherited;
- DrawTitleButton;
- end;
- {Mouse-related procedures}
- procedure TTitleBtnForm.WMNCHitTest(var Msg : TWMNCHitTest);
- begin
- Inherited;
- {Check to see if the mouse was clicked in the area of the button}
- with Msg do
- if PtInRect(TitleButton, Point(XPos - Left, YPos - Top)) then
- Result := htTitleBtn;
- end;
- procedure TTitleBtnForm.WMNCLButtonDown(var Msg : TWMNCLButtonDown);
- begin
- inherited;
- if (Msg.HitTest = htTitleBtn) then
- ShowMessage(‘You pressed the new button‘);
- end;
- function TTitleBtnForm.GetVerInfo : DWORD;
- var
- verInfo : TOSVERSIONINFO;
- begin
- result:=0;
- verInfo.dwOSVersionInfoSize := SizeOf(TOSVersionInfo);
- if GetVersionEx(verInfo) then
- Result := verInfo.dwPlatformID;
- {Returns:
- VER_PLATFORM_WIN32s Win32s on Windows 3.1
- VER_PLATFORM_WIN32_WINDOWS Win32 on Windows 95
- VER_PLATFORM_WIN32_NT Windows NT }
- end;
- end.