Можно ли изменить цвет шрифта заголовка вкладки TTabSheet? - PullRequest
Новая
       52

Можно ли изменить цвет шрифта заголовка вкладки TTabSheet?

3 голосов
/ 24 марта 2012

Просто ответьте на этот вопрос здесь => ссылка Можно ли изменить цвет текста заголовка TabSheet на другой цвет (например, белый) и изменить стиль шрифта на «жирный»

1 Ответ

3 голосов
/ 26 марта 2012

Может быть, это может дать вам такое вдохновение. Опять же, обратите внимание , это будет работать только в Windows и с темами, отключенными в вашем приложении. 

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;

Вот как это выглядит:

enter image description here

...