2012-02-18 3 views
4

Я бегу Lazarus 0.9.30.2. У меня есть TForm, на котором есть TPageControl. Внутри TPageControl существует серия TTabSheets (около 30 из них). То, что я хочу сделать, - это цветовой код вкладки, поэтому первые 10 - Красный, следующие 10 - Синие, а последние 10 - Зеленые. Я видел фрагменты кода в интрасети, которые меняют цвет закладки вкладки (включая вкладку), когда вы нажимаете на них, и переходите к ним (чтобы выделить активную вкладку), но я хочу, чтобы они окрашивали их, как описано выше, когда сначала загружаются вкладки.Можно ли изменить цвет вкладок TTabSheet

Есть ли способ сделать это?

enter image description here

+2

Привет там, я не уверен, что я получаю свой вопрос. Вы пытались использовать 'TTabControl' вместо этого? Он содержит необходимые события OnDrawTab. Lazarus имеет от Delphi другого предка 'TPageControl'. – TLama

+0

Я хочу сделать что-то вроде этого [Пример] http://imgur.com/cNMko – user1174918

+0

Это действительно замечательно @TLama ..... это нормально для того, что я хочу делать. Очень признателен. – user1174918

ответ

4

Если это достаточно для вас, чтобы получить каверзный решение мало-мальски работает только на Windows, с тем отключенным попробуйте следующее:

Un-проверить Use manifest file to enable themes (Windows only) вариант из Project/Project Options ... проекта и вставьте следующий код в свой блок с помощью элемента управления страницей. Он использует вставленный класс, поэтому он будет работать только в тех частях, где вы вставляете этот код.

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 
    BrushHandle: HBRUSH; 
    BrushColor: COLORREF; 
begin 
    with Message.DrawItemStruct^ do 
    begin 
    case itemID of 
     0: BrushColor := RGB(235, 24, 33); 
     1: BrushColor := RGB(247, 200, 34); 
     2: BrushColor := RGB(178, 229, 26); 
    else 
     BrushColor := ColorToRGB(clBtnFace); 
    end; 
    BrushHandle := CreateSolidBrush(BrushColor); 
    FillRect(hDC, rcItem, BrushHandle); 
    SetBkMode(hDC, TRANSPARENT); 
    DrawTextEx(hDC, PChar(Page[itemID].Caption), -1, rcItem, DT_CENTER or 
     DT_VCENTER or DT_SINGLELINE, nil); 
    end; 
    Message.Result := 1; 
end; 

Вот как это выглядит (уродливое :)

enter image description here