Не получается отрисовать элемент TCheckListBox :(

Вопросы программирования и использования среды Lazarus.

Модератор: Модераторы

Не получается отрисовать элемент TCheckListBox :(

Сообщение xterro » 26.03.2014 08:44:54

Приветствую, решил сделать свой компонент(аля TCheckLixtBox, только чекрыжики рисую самостоятельно). накидал набросок класса, но отрисовку решил попробовать в существующем TCheckListBox. Кинул на форму список и пару кнопок. При нажатии а кнопку добавить, создаю элемент(класс элемента самодельный) и добавляю его в список. Далее пытаюсь самостоятельно отрисовывать элементы в списке TCheckListBox, но почему-то не получается. Вот код обработчика:

Код: Выделить всё
procedure TForm1.OnDrawItem(Control: TWinControl; Index: Integer; ARect: TRect;
State: TOwnerDrawState);
var
    CBText : String;
    CBItem : TColorCheckListItem;
    TextSize : TSize;
    TextPosY : Integer;
    PPoints : array[1..3] of TPoint;
    FCheckRectSize : Integer = 20; { by default }
    HRectIndent : Integer = 5;
    VRectIndent : Integer = 2;
begin
    with (Control as TCheckListBox).Canvas do begin
        //Pen.Color := clBlack;
        //FCheckRectSize := Round((ARect.Bottom - ARect.Top) - 2*VRectIndent);
        if (Index <= CheckListBox.Items.Count-1) then begin
            CBText := CheckListBox.Items.Strings[Index];
            CBItem := TColorCheckListItem(CheckListBox.Items.Objects[Index]);

            if Assigned(CBItem) then begin
                Rectangle(ARect.Left + HRectIndent, ARect.Top + VRectIndent,
                         ARect.Left + FCheckRectSize + HRectIndent, ARect.Top + FCheckRectSize + VRectIndent);
                Brush.Color := CBItem.Color;

                if(CBItem.IsChecked) then begin
                    { draw empty rectangle with small clip at left top corner }
                    PPoints[0].x := Round(ARect.Left + HRectIndent + 1);
                    PPoints[0].y := Round(ARect.Top + VRectIndent + FCheckRectSize/2);

                    PPoints[1].x := Round(ARect.Left + HRectIndent + 1);
                    PPoints[1].y := Round(ARect.Top + VRectIndent + 1);

                    PPoints[2].x := Round(ARect.Left + HRectIndent + FCheckRectSize/2);
                    PPoints[2].y := Round(ARect.Top + VRectIndent + 1);

                    Polygon(PPoints);
                    end
                else
                    { fill rect }
                    FillRect(ARect.Left + HRectIndent + 1, ARect.Top + VRectIndent + 1,
                            ARect.Left + FCheckRectSize + HRectIndent - 1, ARect.Top + FCheckRectSize + VRectIndent - 1);
            end;

            TextSize := Canvas.TextExtent(CBText);
            TextPosY := ARect.Top + Round(((ARect.Bottom - ARect.Top)/2 - TextSize.cy/2));

            if(CBItem.BoldText = True) then
                Font.Bold := True;

            Brush.Style := bsClear;
            TextOut(ARect.Left + (HRectIndent * 2) + FCheckRectSize, TextPosY, CBText);

            if (odSelected in State) then begin
                Brush.Color := clSkyBlue;
                Font.Color := clHighlightText;
                FillRect(ARect);
                DrawFocusRect(aRect);
            end
            else begin
                Brush.Color := clWindow;
                Font.Color := clWindowText;
            end;
        end;
    end;
end;                                                           


Имеется несколько вопросов:
1. Почему-то, когда срабатывается условие "if(CBItem.IsChecked)" то переменная FCheckRectSize меняется своё значение на 6 (О_о), хотя должна быть 20.
2. Почему-то, когда добавляешь элементы в список, текст на первых элементах списка начинает отрисовываться жирным (О_о), выглядит это так:
1.png

3. Когда добавишь много записей в список, появляется скроллбар, начинаешь его двигать, список заливается черным:
2.png


Во вложение добавил архив с проектом, можете проверить, у вас такая же беда или это у меня косяки? Что я делаю не правильно? Да и как вообще правильно отрисовывать элементы?
У вас нет необходимых прав для просмотра вложений в этом сообщении.
xterro
постоялец
 
Сообщения: 148
Зарегистрирован: 23.02.2014 13:49:33

Re: Не получается отрисовать элемент TCheckListBox :(

Сообщение zub » 26.03.2014 11:48:46

CustomDraw в LCL довольно забагованый(( у меня невыходит добится одинакового поведения listbox`а на win, gtk, qt. Строчите багрепорты))
Для избавления от "фона" и "жирности" затирайте фон и выставляйте соответствующие проперти канваса самомтоятельно

>> только чекрыжики рисую самостоятельно
для отрисовки интерфейсных "чекрыжиков" лучше использовать ThemeServices.Draw, если они стандартные - кнопки, чек\радио боксы и т.д. Но к сожалению ThemeServices тоже может в разных виджесетах\темах вести себя не вполне адекватно((
zub
долгожитель
 
Сообщения: 2887
Зарегистрирован: 14.11.2005 23:51:26

Re: Не получается отрисовать элемент TCheckListBox :(

Сообщение xterro » 26.03.2014 12:36:53

Хм, и так вроде ставлю...
Код: Выделить всё
\
if(CBItem.BoldText = True) then
    Font.Bold := True;

Brush.Style := bsClear;
TextOut(ARect.Left + (HRectIndent * 2) + FCheckRectSize, TextPosY, CBText);


Да уж, баги такие баги. Вот думаю, может на самом компоненте такого не будет, мол это ошибка только при замещении отрисовки у существующего компонента )
xterro
постоялец
 
Сообщения: 148
Зарегистрирован: 23.02.2014 13:49:33

Re: Не получается отрисовать элемент TCheckListBox :(

Сообщение zub » 26.03.2014 13:07:30

Как я понял на входе в кустомдрав канвас может прийти не настроенный или с "оставшимися" настройками после прошлой отрисовки (покрайней мере в некоторых виджесетах), лучше так:
Код: Выделить всё
if(CBItem.BoldText = True) then
    Font.Bold := True
else
   Font.Bold := False;

ИМХО тут правило такое - либо устанавливай все нужные параметры не надеясь на дефолтное значение, либо перед отрисовкой запоминай как всё было, а после отрисовки меняй всё что настраивал обратно в исходное состояние

[offtopic]Насколько я помню ты на лоре "терзался" выбором языка? Выбор пал на Lazarus?[/offtopic]
zub
долгожитель
 
Сообщения: 2887
Зарегистрирован: 14.11.2005 23:51:26

Re: Не получается отрисовать элемент TCheckListBox :(

Сообщение xterro » 26.03.2014 13:53:34

Я до этого пробовал сохранять кисть, а после рисования её восстанавливал, не помогало, попробую ваше предложение, спасибо. Да, сейчас с ним играюсь, к паскалю привыкаю. Долгое время лепил = вместо := но вроде прошло ))
xterro
постоялец
 
Сообщения: 148
Зарегистрирован: 23.02.2014 13:49:33

Re: Не получается отрисовать элемент TCheckListBox :(

Сообщение zub » 26.03.2014 14:05:34

кисть - только цвет фона
zub
долгожитель
 
Сообщения: 2887
Зарегистрирован: 14.11.2005 23:51:26

Re: Не получается отрисовать элемент TCheckListBox :(

Сообщение xterro » 26.03.2014 14:26:30

zub писал(а):кисть - только цвет фона

Да, так я пытался "черноту" при скроллинге победить.
xterro
постоялец
 
Сообщения: 148
Зарегистрирован: 23.02.2014 13:49:33

Re: Не получается отрисовать элемент TCheckListBox :(

Сообщение zub » 26.03.2014 14:45:03

Код: Выделить всё
                else
                    { fill rect }
                    FillRect(ARect.Left + HRectIndent + 1, ARect.Top + VRectIndent + 1,
                            ARect.Left + FCheckRectSize + HRectIndent - 1, ARect.Top + FCheckRectSize + VRectIndent - 1);

ARect это весь рисуемый прямоугольник итема, вот его весь и надо заполнить цветом фона и не в else, а вообще перед отрисовкой. По уму это должна делать LCL перед вызовом TForm1.OnDrawItem (ЕМНИП в винде вроде делает)
Имхо пока особо не заморачивайся с кустомдравом, пиши багрепорт(ы) - поправят или укажут твои ошибки.

Нормальные рабочие примеры можно найти только для delphi, в лазаре покрайней мере у меня всегда получалось не совсем то что задумано - сыро((
zub
долгожитель
 
Сообщения: 2887
Зарегистрирован: 14.11.2005 23:51:26

Re: Не получается отрисовать элемент TCheckListBox :(

Сообщение xterro » 26.03.2014 15:14:37

Не, в "else" рисуется непосредственно сам "чекрыжик", а не весь айтем. Но идею понял, поробую так. Сегодня ещё попробую дома собрать этот пример, посмотреть, как оно под Линуксами будет.

Добавлено спустя 6 часов 39 минут 2 секунды:
Прикол, похоже в Линуксе, событие OnDrawItem вообще игнорируется О_о Поставил Style в lbOwnerDrawFixed(хотя оно и так при инициализации устанавливалось
) но бесполезно, обработчик не вызывается. Разве такое может быть?
xterro
постоялец
 
Сообщения: 148
Зарегистрирован: 23.02.2014 13:49:33

Re: Не получается отрисовать элемент TCheckListBox :(

Сообщение zub » 27.03.2014 10:01:04

>>но бесполезно, обработчик не вызывается. Разве такое может быть?
Еще и не такое бывало)) сам "интерфейс" овнердрав в VCL сильно винапи ориентирован, LCL вынуждена его повторять, соответственно пока этим серъезно никто из разрабов не занимается - глюки

В каком компоненте? в TListView вроде всё более-менее работает.
проверять в транке@писать багрепорт. правят очень оперативно
zub
долгожитель
 
Сообщения: 2887
Зарегистрирован: 14.11.2005 23:51:26

Re: Не получается отрисовать элемент TCheckListBox :(

Сообщение xterro » 27.03.2014 11:47:01

Запостил им багрепорт, интересно, что ответят. Наверняка свалят на кривые руки ))
xterro
постоялец
 
Сообщения: 148
Зарегистрирован: 23.02.2014 13:49:33

Re: Не получается отрисовать элемент TCheckListBox :(

Сообщение xterro » 30.03.2014 16:15:53

Так оно и произошло, отправили на форум, благо хоть на форуме помогли. Поправили код, стало работать правильнее. На версии 1.2 OnDrawItem в Linux-е вызывается, но появилась другая проблема - теперь рядом с моим рисованием всё равно рисуется родной "чекрыжик". Хрен победишь )))
Снимок-Form1.png
У вас нет необходимых прав для просмотра вложений в этом сообщении.
xterro
постоялец
 
Сообщения: 148
Зарегистрирован: 23.02.2014 13:49:33

Re: Не получается отрисовать элемент TCheckListBox :(

Сообщение zub » 31.03.2014 18:34:55

Я не знаю должен ли "родной чекрыжик" отрисовываться при овнердраве в чеклистбоксе, но подобных багов в гтк видел достаточно - я использую кустомдравные комбо и листбоксы, в обоих случаях ЛЦЛ "помогал" мне рисовать)) до фикшенья багов
http://bugs.freepascal.org/view.php?id=19356
http://bugs.freepascal.org/view.php?id=23093

>>Хрен победишь )))
Проверяйте как ЛЦЛ ведет себя на других виджесетах (в идеале лучше проверять на delphi). Если он не должен рисоваться - велком в багтрекер
zub
долгожитель
 
Сообщения: 2887
Зарегистрирован: 14.11.2005 23:51:26

Re: Не получается отрисовать элемент TCheckListBox :(

Сообщение xterro » 31.03.2014 19:14:50

Я повешал им багу http://bugs.freepascal.org/view.php?id=25952 Уже вторая по счёту, посмотрю что отпишут )
xterro
постоялец
 
Сообщения: 148
Зарегистрирован: 23.02.2014 13:49:33


Вернуться в Lazarus

Кто сейчас на конференции

Сейчас этот форум просматривают: Google [Bot] и гости: 248

Рейтинг@Mail.ru