是否可以更改TTabSheet选项卡标题的字体颜色

时间:2012-03-24 11:47:21

标签: lazarus ttabsheet

这里只是对此问题的跟进问题=> link 是否可以将TabSheet标题的文本颜色更改为另一种颜色(例如白色)并将字体样式更改为“粗体”?

2 个答案:

答案 0 :(得分:3)

也许这可能会给你这样的灵感。同样,请注意 这仅适用于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

答案 1 :(得分:0)

用_hDc替换hDc 和带有drawtext和

的drawtextex
相关问题