Form - Colocando botao no caption |
Top Previous Next |
|
// Fonte completo de botãozinho no caption
unit Unit1;
interface
uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, buttons;
type TForm1 = class(TForm) procedure FormResize(Sender: TObject); private TitleButton : TRect; procedure DrawTitleButton; 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; end;
var Form1: TForm1;
const htTitleBtn = htSizeLast + 1;
implementation
{$R *.DFM}
procedure TForm1.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 TForm1.WMNCLButtonDown(var Msg : TWMNCLButtonDown); begin inherited; if (Msg.HitTest = htTitleBtn) then ShowMessage('You pressed the new button'); end;
procedure TForm1.WMNCActivate(var Msg : TWMNCActivate); begin Inherited; DrawTitleButton; end;
//Painting events procedure TForm1.WMNCPaint(var Msg : TWMNCPaint); begin Inherited; DrawTitleButton; end;
procedure TForm1.WMSetText(var Msg : TWMSetText); begin Inherited; DrawTitleButton; end;
procedure TForm1.DrawTitleButton; var bmap : TBitmap; // Bitmap to be drawn - 16 X 16 : 16 Colors XFrame , YFrame, // X and Y size of Sizeable area of Frame} XTtlBit, YTtlBit: Integer; // X and Y size of Bitmaps in caption 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);
TitleButton := Bounds(Width - (3 * XTtlBit) - ((XTtlBit div 2) + 20), YFrame + 2, XTtlBit - 2, YTtlBit - 4);
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:\CHAVE.BMP'); with TitleButton do Canvas.Draw(Left + 2, Top + 2, bmap); finally ReleaseDC(Self.Handle, Canvas.Handle); bmap.Free; Canvas.Handle := 0; end; end;
procedure TForm1.FormResize(Sender: TObject); begin Perform(WM_NCACTIVATE, Word(Active), 0); end;
end. |