Search code examples
lazarusttabsheet

Is It Possible To Change The Font Colour of a TTabSheet Tab Caption


Just a follow up question to this one here => link Is it possible to change the text colour of a TabSheet caption to another colour (eg. White) and change the font style to 'bold'?


Solution

  • Maybe this might give you such inspiration. Again, please note this will work only on Windows and with themes disabled in your application.

    uses
      ComCtrls, Windows, LCLType;
    
    type
      TPageControl = class(ComCtrls.TPageControl)
      private
        procedure CNDrawItem(var Message: TWMDrawItem); message WM_DRAWITEM;
      protected
        procedure CreateParams(var Params: TCreateParams); override;
      end; 
    
    implementation
    
    procedure TPageControl.CreateParams(var Params: TCreateParams);
    begin
      inherited CreateParams(Params);
      with Params do
      begin
        if not (csDesigning in ComponentState) then
          Style := Style or TCS_OWNERDRAWFIXED;
      end;
    end;
    
    procedure TPageControl.CNDrawItem(var Message: TWMDrawItem);
    var
      FontHandle: HFONT;
      FontColor: COLORREF;
      FontObject: TLogFont;
      BrushColor: COLORREF;
      BrushHandle: HBRUSH;
    begin
      with Message.DrawItemStruct^ do
      begin
        GetObject(Font.Handle, SizeOf(FontObject), @FontObject);
        case itemID of
          0:
          begin
            BrushColor := RGB(235, 24, 33);
            FontColor := clWhite;
            FontObject.lfWeight := FW_NORMAL;
            FontObject.lfItalic := 0;
          end;
          1:
          begin
            BrushColor := RGB(247, 200, 34);
            FontColor := clGreen;
            FontObject.lfWeight := FW_NORMAL;
            FontObject.lfItalic := 1;
          end;
          2:
          begin
            BrushColor := RGB(178, 229, 26);
            FontColor := clGreen;
            FontObject.lfWeight := FW_BOLD;
            FontObject.lfItalic := 1;
          end
          else
            BrushColor := ColorToRGB(clBtnFace);
        end;
    
        BrushHandle := CreateSolidBrush(BrushColor);
        FillRect(hDC, rcItem, BrushHandle);
    
        FontHandle := CreateFontIndirect(FontObject);
        try
          SelectObject(hDC, FontHandle);
          SetTextColor(hDC, FontColor);
          SetBkMode(hDC, TRANSPARENT);
          DrawTextEx(hDC, PChar(Page[itemID].Caption), -1, rcItem, DT_CENTER or
            DT_VCENTER or DT_SINGLELINE, nil);
        finally
          DeleteObject(FontHandle);
        end;
      end;
      Message.Result := 1;
    end;
    

    Here is how it looks like:

    enter image description here