Search code examples
delphidelphi-xe2vcl-stylestpagecontrol

close button of a tabsheet not supporting vcl styles


I have used the code provided in this example How to implement a close button for a TTabsheet of a TPageControl to draw a close button to each tabsheet of a pagecontrol and I have replaced ThemeServices with Style Services inside the code and when applying styles the close button doesn`t show and react in no way. Could anyone point me to a different path o solving this issue. thank you! this is the code of the OnDrawTab event:

  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;

Solution

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

    If you have problems implementing the style hook let me know to post a full solution here.

    UPDATE

    I just wrote this simple style hook to add suport for a close button in the tabsheets.

    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 in this way

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

    And this is a demo

    enter image description here