Adding a Custom Button to the Caption Bar with System Menu and Hint (Views: 28)
Problem/Question/Abstract: How to add a custom button to the caption bar with a System Menu and HINT!!!! Answer: That code can create a button to the caption bar, create a MenuItem in System menu and create a Hint to the button! Just put the code above in your Unit and change the "FrmMainForm" to your Form name, and other small things like Text of Hint private { Private declarations } procedure WMNCPAINT(var msg: Tmessage); message WM_NCPAINT; procedure WMNCACTIVATE(var msg: Tmessage); message WM_NCACTIVATE; procedure WMNCMOUSEDOWN(var msg: Tmessage); message WM_NCLBUTTONDOWN; procedure WMNCMOUSEMOVE(var Msg: TMessage); message WM_NCMOUSEMOVE; procedure WMMOUSEMOVE(var Msg: TMessage); message WM_MOUSEMOVE; procedure WMLBUTTONUP(var msg: Tmessage); message WM_LBUTTONUP; procedure WNCLBUTTONDBLCLICK(var msg: Tmessage); message WM_NCLBUTTONDBLCLK; procedure WMNCRBUTTONDOWN(var msg: Tmessage); message WM_NCRBUTTONDOWN; procedure WMNCHITTEST(var msg: Tmessage); message WM_NCHITTEST; procedure WMSYSCOMMAND(var msg: Tmessage); message WM_SYSCOMMAND; {...} var {...} Pressed: Boolean; FocusLost: Boolean; Rec: TRect; NovoMenuHandle: THandle; PT1: TPoint; FHintshow: Boolean; FHint: THintWindow; FHintText: string; FHintWidth: Integer; {...} //------------------------------------------------------------------------------ procedure TFrmMainForm.WMSYSCOMMAND(var Msg: TMessage); begin if Msg.WParam = LongInt(NovoMenuHandle) then //********************************************* //The button was clicked! Put you function here //********************************************* inherited; end; //------------------------------------------------------------------------------ procedure TFrmMainForm.WMNCHITTEST(var Msg: TMessage); var Tmp: Boolean; begin if Pressed then begin Tmp := FocusLost; PT1.X := Msg.LParamLo - FrmMainForm.Left; PT1.Y := Msg.LParamHi - FrmMainForm.Top; if PTInRect(Rec, PT1) then FocusLost := False else FocusLost := True; if FocusLost <> Tmp then InvalidateRect(FrmMainForm.Handle, @Rec, True); end; inherited; end; //------------------------------------------------------------------------------ procedure TFrmMainForm.WMLBUTTONUP(var Msg: TMessage); var Tmp: Boolean; begin ReleaseCapture; Tmp := Pressed; Pressed := False; if Tmp and PTInRect(Rec, PT1) then begin InvalidateRect(FrmMainForm.Handle, @Rec, True); FHintShow := False; FHint.ReleaseHandle; //********************************************* //The button was clicked! Put you function here //********************************************* end else inherited; end; //------------------------------------------------------------------------------ procedure TFrmMainForm.WNCLBUTTONDBLCLICK(var Msg: TMessage); begin PT1.X := Msg.LParamLo - FrmMainForm.Left; PT1.Y := Msg.LParamHi - FrmMainForm.Top; if not PTInRect(Rec, PT1) then inherited; end; //------------------------------------------------------------------------------ procedure TFrmMainForm.WMNCRBUTTONDOWN(var Msg: TMessage); begin PT1.X := Msg.LParamLo - FrmMainForm.Left; PT1.Y := Msg.LParamHi - FrmMainForm.Top; if not PTInRect(Rec, PT1) then inherited; end; //------------------------------------------------------------------------------ procedure TFrmMainForm.WMNCMOUSEDOWN(var Msg: TMessage); begin PT1.X := Msg.LParamLo - FrmMainForm.Left; PT1.Y := Msg.LParamHi - FrmMainForm.Top; FHintShow := False; if PTInRect(Rec, PT1) then begin Pressed := True; FocusLost := False; InvalidateRect(FrmMainForm.Handle, @Rec, True); SetCapture(TWinControl(FrmMainForm).Handle); end else begin FrmMainForm.Paint; inherited; end; end; //------------------------------------------------------------------------------ //That function Create a Hint procedure TFrmMainForm.WMNCMOUSEMOVE(var Msg: TMessage); begin PT1.X := Msg.LParamLo - FrmMainForm.Left; PT1.Y := Msg.LParamHi - FrmMainForm.Top; if PTInRect(Rec, PT1) then begin FHintWidth := FHint.Canvas.TextWidth(FHintText); if (FHintShow = False) and (Length(Trim(FHintText)) <> 0) then FHint.ActivateHint( Rect( Mouse.CursorPos.X, Mouse.CursorPos.Y + 20, Mouse.CursorPos.X + FHintWidth + 10, Mouse.CursorPos.Y + 35 ), FHintText ); FHintShow := True; end else begin FHintShow := False; FHint.ReleaseHandle; end; end; //------------------------------------------------------------------------------ procedure TFrmMainForm.WMMOUSEMOVE(var Msg: TMessage); begin FHintShow := False; FHint.ReleaseHandle; end; //------------------------------------------------------------------------------ procedure TFrmMainForm.WMNCACTIVATE(var Msg: TMessage); begin InvalidateRect(FrmMainForm.Handle, @Rec, True); inherited; end; //------------------------------------------------------------------------------ procedure TFrmMainForm.WMNCPAINT(var Msg: TMessage); begin InvalidateRect(FrmMainForm.Handle, @Rec, True); inherited; end; //------------------------------------------------------------------------------ procedure TFrmMainForm.FormPaint(Sender: TObject); var Border3D_Y, Border_Thickness, Btn_Width, Button_Width, Button_Height: Integer; MyCanvas: TCanvas; begin MyCanvas := TCanvas.Create; MyCanvas.Handle := GetWindowDC(FrmMainForm.Handle); Border3D_Y := GetSystemMetrics(SM_CYEDGE); Border_Thickness := GetSystemMetrics(SM_CYSIZEFRAME); Button_Width := GetSystemMetrics(SM_CXSIZE); Button_Height := GetSystemMetrics(SM_CYSIZE); //It make a square button, but if you want a different button //just change that var to your width. Btn_Width := Border3D_Y + Border_Thickness + Button_Height - (2 * Border3D_Y) - 1; Rec.Left := FrmMainForm.Width - (3 * Button_Width + Btn_Width); Rec.Right := FrmMainForm.Width - (3 * Button_Width + 03); Rec.Top := Border3D_Y + Border_Thickness - 1; Rec.Bottom := Rec.Top + Button_Height - (2 * Border3D_Y); FillRect(MyCanvas.Handle, Rec, HBRUSH(COLOR_BTNFACE + 1)); if not Pressed or Focuslost then DrawEdge(MyCanvas.Handle, Rec, EDGE_RAISED, BF_SOFT or BF_RECT) else if Pressed and not Focuslost then DrawEdge(MyCanvas.Handle, Rec, EDGE_SUNKEN, BF_SOFT or BF_RECT); //It draw a the application icon to the button. Easy to change. DrawIconEX(MyCanvas.Handle, Rec.Left + 4, Rec.Top + 3, Application.Icon.Handle, 8, 8, 0, 0, DI_NORMAL); MyCanvas.Free; end; {... } procedure TFrmMainForm.FormCreate(Sender: TObject); {... } InsertMenu(GetSystemMenu(Handle, False), 4, MF_BYPOSITION + MF_STRING, NovoMenuHandle, pchar('TEXT OF THE MENU')); Rec := Rect(0, 0, 0, 0); FHintText := 'Put the text of your Hint HERE'; FHint := THintWindow.Create(Self); FHint.Color := clInfoBk; //You can change the background color of the Hint |