Table close button that does not support vcl styles

Question

I used the code in this example How to implement a close button for TTabsheet TPageControl to draw a close button on each pagecontrol tab and I replaced ThemeServices with style services inside the code, and when applying styles, the close button does not show and does not react in any way. Can someone point me to another way to solve this problem. Thanks! This is the OnDrawTab event code:

procedure TFormMain.PageControlCloseButtonDrawTab(Control: TCustomTabControl; TabIndex: Integer; const Rect: TRect; Active: Boolean); var CloseBtnSize: Integer; PageControl: TPageControl; TabCaption: TPoint; CloseBtnRect: TRect; CloseBtnDrawState: Cardinal; CloseBtnDrawDetails: TThemedElementDetails; begin PageControl := Control as TPageControl; if InRange(TabIndex, 0, Length(FCloseButtonsRect) - 1) then begin CloseBtnSize := 14; TabCaption.Y := Rect.Top + 3; if Active then begin CloseBtnRect.Top := Rect.Top + 4; CloseBtnRect.Right := Rect.Right - 5; TabCaption.X := Rect.Left + 6; end else begin CloseBtnRect.Top := Rect.Top + 3; CloseBtnRect.Right := Rect.Right - 5; TabCaption.X := Rect.Left + 3; end; CloseBtnRect.Bottom := CloseBtnRect.Top + CloseBtnSize; CloseBtnRect.Left := CloseBtnRect.Right - CloseBtnSize; FCloseButtonsRect[TabIndex] := CloseBtnRect; PageControl.Canvas.FillRect(Rect); PageControl.Canvas.TextOut(TabCaption.X, TabCaption.Y, PageControl.Pages[TabIndex].Caption); if not UseThemes then begin if (FCloseButtonMouseDownIndex = TabIndex) and FCloseButtonShowPushed then CloseBtnDrawState := DFCS_CAPTIONCLOSE + DFCS_PUSHED else CloseBtnDrawState := DFCS_CAPTIONCLOSE; Winapi.Windows.DrawFrameControl(PageControl.Canvas.Handle, FCloseButtonsRect[TabIndex], DFC_CAPTION, CloseBtnDrawState); end else begin Dec(FCloseButtonsRect[TabIndex].Left); if (FCloseButtonMouseDownIndex = TabIndex) and FCloseButtonShowPushed then CloseBtnDrawDetails := StyleServices.GetElementDetails(twCloseButtonPushed) else CloseBtnDrawDetails := StyleServices.GetElementDetails(twCloseButtonNormal); StyleServices.DrawElement(PageControl.Canvas.Handle, CloseBtnDrawDetails, FCloseButtonsRect[TabIndex]); end; end; end; 

Answer 1

If you are using vcl styles, you must write a vcl style hook to draw a close button in the tab controls, take a look at Vcl.Styles.ColorTabs (introduced in these articles Creating colorful tables with VCL styles , Added border for TTabColorControlStyleHook ) to have an idea of ​​what you need to write in a style like this. In addition to the code, to draw a button on the tabs, you must process the WM_MOUSEMOVE and WM_LBUTTONUP messages (in the hook style) to change the state of the button (normal, hot) and detect a click on the close button.

If you are having trouble implementing the hook method, let me know to post the full solution here.

UPDATE

I just wrote this simple style to add suport for the close button in tables.

 uses Vcl.Styles, Vcl.Themes; type TTabControlStyleHookBtnClose = class(TTabControlStyleHook) private FHotIndex : Integer; FWidthModified : Boolean; procedure WMMouseMove(var Message: TMessage); message WM_MOUSEMOVE; procedure WMLButtonUp(var Message: TWMMouse); message WM_LBUTTONUP; function GetButtonCloseRect(Index: Integer):TRect; strict protected procedure DrawTab(Canvas: TCanvas; Index: Integer); override; procedure MouseEnter; override; procedure MouseLeave; override; public constructor Create(AControl: TWinControl); override; end; constructor TTabControlStyleHookBtnClose.Create(AControl: TWinControl); begin inherited; FHotIndex:=-1; FWidthModified:=False; end; procedure TTabControlStyleHookBtnClose.DrawTab(Canvas: TCanvas; Index: Integer); var Details : TThemedElementDetails; ButtonR : TRect; FButtonState: TThemedWindow; begin inherited; if (FHotIndex>=0) and (Index=FHotIndex) then FButtonState := twSmallCloseButtonHot else if Index = TabIndex then FButtonState := twSmallCloseButtonNormal else FButtonState := twSmallCloseButtonDisabled; Details := StyleServices.GetElementDetails(FButtonState); ButtonR:= GetButtonCloseRect(Index); if ButtonR.Bottom - ButtonR.Top > 0 then StyleServices.DrawElement(Canvas.Handle, Details, ButtonR); end; procedure TTabControlStyleHookBtnClose.WMLButtonUp(var Message: TWMMouse); Var LPoint : TPoint; LIndex : Integer; begin LPoint:=Message.Pos; for LIndex := 0 to TabCount-1 do if PtInRect(GetButtonCloseRect(LIndex), LPoint) then begin if Control is TPageControl then begin TPageControl(Control).Pages[LIndex].Parent:=nil; TPageControl(Control).Pages[LIndex].Free; end; break; end; end; procedure TTabControlStyleHookBtnClose.WMMouseMove(var Message: TMessage); Var LPoint : TPoint; LIndex : Integer; LHotIndex : Integer; begin inherited; LHotIndex:=-1; LPoint:=TWMMouseMove(Message).Pos; for LIndex := 0 to TabCount-1 do if PtInRect(GetButtonCloseRect(LIndex), LPoint) then begin LHotIndex:=LIndex; break; end; if (FHotIndex<>LHotIndex) then begin FHotIndex:=LHotIndex; Invalidate; end; end; function TTabControlStyleHookBtnClose.GetButtonCloseRect(Index: Integer): TRect; var FButtonState: TThemedWindow; Details : TThemedElementDetails; R, ButtonR : TRect; begin R := TabRect[Index]; if R.Left < 0 then Exit; if TabPosition in [tpTop, tpBottom] then begin if Index = TabIndex then InflateRect(R, 0, 2); end else if Index = TabIndex then Dec(R.Left, 2) else Dec(R.Right, 2); Result := R; FButtonState := twSmallCloseButtonNormal; Details := StyleServices.GetElementDetails(FButtonState); if not StyleServices.GetElementContentRect(0, Details, Result, ButtonR) then ButtonR := Rect(0, 0, 0, 0); Result.Left :=Result.Right - (ButtonR.Width) - 5; Result.Width:=ButtonR.Width; end; procedure TTabControlStyleHookBtnClose.MouseEnter; begin inherited; FHotIndex := -1; end; procedure TTabControlStyleHookBtnClose.MouseLeave; begin inherited; if FHotIndex >= 0 then begin FHotIndex := -1; Invalidate; end; end; 

Register this way

  TStyleManager.Engine.RegisterStyleHook(TCustomTabControl, TTabControlStyleHookBtnClose); TStyleManager.Engine.RegisterStyleHook(TTabControl, TTabControlStyleHookBtnClose); 

And this is a demonstration

Answer 2

I worked on this example, and I started working on the Metro UI on delphi XE6.

My workaround for getting the correct distance between the tab name and the button was to change this line

 Result.Left := Result.Right - (ButtonR.Width); //it was Result.Left := Result.Right - (ButtonR.Width) -5; 

And setting a larger TabWith ​​value in the PageController properties.

Also, recall that the “Register” strings go through the initialization class right to the end of the device.

  //...all the code of the unit Initialization TStyleManager.Engine.RegisterStyleHook(TCustomTabControl, TTabControlStyleHookBtnClose); TStyleManager.Engine.RegisterStyleHook(TTabControl, TTabControlStyleHookBtnClose); end.//final unit "end" =D