раскраска CheckListBox.

[sermaxim]

Здравствуйте, товарищи гуру!)

Есть необходимость раскрасить строки в CheckListBox. нашел такой пример кода для ListBox

Код: Выделить всё

procedure TForm1.ListBox1DrawItem(Control: TWinControl; Index: Integer; ARect: TRect; State: TOwnerDrawState);
var
txt: string;
begin
with ListBox1 do
  begin
   // "Забираем" текст текущего пункта в переменную
   // (это даёт возможность его изменения)
   txt:=Items[Index];

   // Присваиваем нужный цвет фона чётным/нечётным строкам
   if (Index mod 2)=0
    then Canvas.Brush.Color:=clWindow
    else Canvas.Brush.Color:=clGray;

   // Выделенная строка
   if (odSelected in State) then
    begin
     Canvas.Brush.Color:=clGreen;
     Canvas.Font.Color:=clWhite;
    end;

   // Выделение пунктов, начинающихся с заданного символа
   if txt[1]='!' then
    begin
     Canvas.Font.Style:=Canvas.Font.Style+[fsBold];
     // "отрезаем" символ-флаг
     txt:=Copy(txt, 2, Length(txt));
    end
    else Canvas.Font.Style:=Canvas.Font.Style-[fsBold];

   // Готовим канву к отрисовке
   Canvas.FillRect(ARect);
   // Отрисовываем текст с заданными параметрами
   Canvas.TextOut(ARect.Left, ARect.Top, txt)

  end;
end;     

приспособить получается, но пропадают сами "чеки" в поле остаются только строки..
Подскажите. пожалуйста, в какую сторону смотреть)

[alexs]

Скорее всего - тебе надо их самому рисовать в этом случае.

[Nik]

Код: Выделить всё

Canvas.TextOut(ARect.Left, ARect.Top, txt)

Можно попробовать делать небольшой отступ, чтобы CheckBox'ы не затирались при отрисовке текста:

Код: Выделить всё

Canvas.TextOut(ARect.Left+15, ARect.Top, txt)

[sermaxim]

Nik, попробовал сделать отступ, не помогло

alexs, а не подскажите как их в данном случае рисовать... пытался найти как устроен Style lbStandard , но безуспешно

Добавлено спустя 37 минут 47 секунд:
нашел такое странное поведение:
сделал отступ ARect.Left+30 и если кликать в то пустое место где должен быть чекбокс то он какбы нажимается т.е. его нет, но он как бы есть
... при чем включается чекбокс и отключается он в разных местах этого пустого места...

[alexs]

сделал отступ ARect.Left+30 и если кликать в то пустое место где должен быть чекбокс то он какбы нажимается

Данное поведение однозначно указывает на необходимость отрисовки чека вручную.
Как вариант - посмотри как сделаны чек-боксы в DBGrid-е.
Сразу подскажу - там две ветки - есть рисование чекбокса с помощью функций темы, а также рисование чекбокса с помощью готового битамапа.
Какой именно вызов будет - определяется общим стилем отрисовки грида.

[sermaxim]

да уж.. для меня это пока еще дебри))
но разобраться очень хочется)
подскажите как/где найти устройство TCheckListBox. поиск с помощью Ctrl по исходникам ничего не дает. мне кажется что можно посмотреть как устроен стиль lbStandard и скопировать от туда часть кода для прорисовки чекбоксов

[alexs]

Упрощаем
Ищем в модуле Grids:

Код: Выделить всё

procedure TCustomGrid.DrawGridCheckboxBitmaps(const aCol,aRow: Integer;
  const aRect: TRect; const aState: TCheckboxState);


Видим в этой процедуре большой if:

Код: Выделить всё

  if (TitleStyle=tsNative) and not assigned(OnUserCheckboxBitmap) then begin


А тут уже смотри то, что тебе нужно.
Если рисование темами - то смотри код, который в основной ветке.
Если рисование твоими красивыми чеками - то в той ветке, что в else.

[sermaxim]

Ура! все получилось, огромное спасибо за напутствие!
Вот пример кода для раскраски CheckListBox разными цветами с помощью стандартных тем:
- у CheckListBox-а свойство Style выбираем lbOwnerDrawFixed
- затем событию CheckListBox-а OnDrawItem назначаем процедуру CheckListBox1DrawItem
- дописываем uses

Код: Выделить всё

uses ...,
// Помимо прочего надо
   types, LCLType, Themes;

и собственно сама процедура

Код: Выделить всё

procedure TForm1.CheckListBox1DrawItem(Control: TWinControl; Index: Integer;
  ARect: TRect; AState: TOwnerDrawState);
var
   txt: string;
   CSize: TSize;
   details: TThemedElementDetails;
   CheckBoxState: TThemedButton;
begin
  with CheckListBox1 do
  begin
   // "Забираем" текст текущего пункта в переменную
   // (это даёт возможность его изменения)
   txt:=Items[Index];

   // Присваиваем нужный цвет фона чётным/нечётным строкам
   if (Index mod 2)=0
    then Canvas.Brush.Color:=clWindow
    else Canvas.Brush.Color:=clGradientInactiveCaption;

   // Выделенная строка
   if (odSelected in AState) then
    begin
     Canvas.Brush.Color:=clRed;
     Canvas.Font.Color:=clWhite;
    end;

   // Выделение пунктов, начинающихся с заданного символа
   if txt[1]='!' then
    begin
     Canvas.Font.Style:=Canvas.Font.Style+[fsBold];
     // "отрезаем" символ-флаг
     txt:=Copy(txt, 2, Length(txt));
    end
    else Canvas.Font.Style:=Canvas.Font.Style-[fsBold];

   // Готовим канву к отрисовке
   Canvas.FillRect(ARect);

   // Отрисовываем текст с заданными параметрами
   Canvas.TextOut(ARect.Left+23, ARect.Top, txt);

   // Проверка состояния CheckBox-а
   if Checked[Index] then CheckBoxState := tbCheckBoxCheckedNormal
   else CheckBoxState := tbCheckBoxUncheckedNormal;
   
   // Настраиваем детали CheckBox-а
   Details := ThemeServices.GetElementDetails(CheckBoxState);
   CSize := ThemeServices.GetDetailSize(Details);
   with ARect do
   begin
      Left := 3;
      Top  := Trunc((aRect.Top + aRect.Bottom - CSize.cy)/2);
      ARect := Bounds(Left, Top, CSize.cx, CSize.cy);
   end;

   // Вставляем CheckBox
   ThemeServices.DrawElement(Canvas.Handle, Details, ARect, nil);
  end;

end;

Если нужно вставить свои картинки CheckBox-ов, то смотрите 3910 строку модуля Grids как советовал alexs.

[alexs]

Вывод - читайте исходные тексты чужих библиотек и самого Lazarus-а. Очень способствует
Поздравляю с успешным решением проблемы!