Проблемы с CheckListBox

[yuray]

Хотелось поставить точку в этой теме, но есть несколько замечаний. Некоторые из них незначительны, но все же осмелюсь их озвучить.

Правда изменение размера шрифта в runtime не проверял.

1. В runtime это не работает.
2. Скроллинг появляется преждевременно. Например, если CheckListBox имеет 2 колонки, то горизонтальная прокрутка появляется после заполнения 1 колонки, при этом наблюдается, на первый взгляд, непонятный визуальный эффект (незначительное замечания).

В чеклистбоксе высота строки меняется независимо от размера шрифта параметром ItemHeight.

3. Спасибо за подсказку. Если я не ошибаюсь, Павел взял формулу ItemHeight:=MulDiv(MulDiv(font.Size,25,10),72,font.PixelsPerInch) за основу при решении этой проблемы. Лично у меня нет возражений для такого решения, если не учитывать то, что свойство ItemHeight утратило свое назначение. В r15373 его значения изменить нельзя. Теперь оно напрямую зависит от размера шрифта (незначительное замечания, возможно, я ошибаюсь).

Павел, еще одна просьба. Так как Lazarus полностью перешел на utf8, возникли проблемы с LazReport – пропала кириллица. Здесь viewtopic.php?f=5&t=3453 прозвучало, что ты можешь помочь. Помоги, так как придется выбирать: или исправленный CheckListBox или LazReport с кириллицей.

Спасибо

[Павел Ишенин]

Не брал я за основу эту формулу. Вместо ItemHeight я использовал Canvas.TextHeigh() при вызове MeasureItem. Да и вообще если интересно, можно изменения в svn посмотреть.

По поводу lazreport - я им не занимался никогда и не планировал. Те, кто им занимаются получили информацию о проблеме и возможном решении. Вам лучше обращаться напрямую к Jesus Rayes по этому поводу.

[yuray]

Не брал я за основу эту формулу.

Я не имел ввиду использования этой формулы в буквальном смысле. Просто хотел сказать, что в чеклистбоксе высота строки уже не меняется независимо от размера шрифта параметром ItemHeight.

Павел, а можно добавить событие OnContextPopup и исправить изменение размера шрифта в runtime?

Спасибо

[Troublemaker]

Почему-то исчезло сообщение, которое я набирал, или модератор его удалил.

Идея такая: сделать ItemHeight и FontSize зависимыми друг от друга, но чтобы это можно было контролировать. Например, добавить, если возможно методы типа TCheckListBox.AdjustItemHeight и TCheckListBox.AdjustFontSize, подгоняющие одно под другое.

[Павел Ишенин]

Исправил изменение высоты в runtime в r15433, добавил OnContextPopup еще раньше.

[yuray]

Исправил изменение высоты в runtime в r15433, добавил OnContextPopup еще раньше.

Большое спасибо, уже пользуюсь.
Еще одна проблема. Когда CheckListBox первый раз получает фокус, то получаем такую картинку

CheckListBox_4.JPG

При перерисовке формы вид нормализуется.

[yuray]

Плохо работает метод ItemAtPos. Этот метод всегда возвращает значения индекса чекбокса, который размещен в первой колонке.

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

function TCustomListBox.ItemAtPos(const Pos: TPoint; Existing: Boolean
  ): Integer;
begin
  Result:=GetIndexAtY(Pos.Y);
  if Existing then begin
    if Result>=Items.Count then Result:=-1;
  end else begin
    if (Result<0) and (Result>Items.Count) and PtInRect(ClientRect,Pos) then
      Result:=Items.Count;
  end;
end;

Result:=GetIndexAtY(Pos.Y);
Здесь нужно как-то не так...
Смотрел реализацию этого метода в Delphi, но портировать в Lazarus ума не хватает.

[Павел Ишенин]

Не надо портировать в Lazarus код из Delphi.

[yuray]

Не надо портировать в Lazarus код из Delphi.

Портировать не стал
Сделал так:
1.
unit StdCtrls;
В клас TCustomListBox добавил

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

...
public
...   
    procedure ClearSelection;
    function GetIndexAtY(Y: integer): integer;
    function GetIndexAtXY(X, Y: integer): integer; // <--------------------------
    function GetSelectedText: string;   
...   


Реализация этого метода в customlistbox.inc

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

function TCustomListBox.GetIndexAtXY(X, Y: integer): integer;
begin
  Result:=-1;
  if (not HandleAllocated) then exit;
  Result := TWSCustomListBoxClass(WidgetSetClass).GetIndexAtXY(Self, X, Y);
end;


2.
unit WSStdCtrls;

Все делал по аналогии с GetIndexAtY

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

...
TWSCustomListBox = class(TWSWinControl)
    class function GetIndexAtY(const ACustomListBox: TCustomListBox; y: integer): integer; virtual;
    class function GetIndexAtXY(const ACustomListBox: TCustomListBox; x,y: integer): integer; virtual;// <----------------
    class function GetItemIndex(const ACustomListBox: TCustomListBox): integer; virtual; 
...

//Реализация GetIndexAtXY

class function TWSCustomListBox.GetIndexAtXY(
  const ACustomListBox: TCustomListBox; x, y: integer): integer;
begin
  Result := -1;
end;


3.
unit Win32WSStdCtrls;

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

TWin32WSCustomListBox = class(TWSCustomListBox)
  private
  protected
  public
    class procedure AdaptBounds(const AWinControl: TWinControl;
          var Left, Top, Width, Height: integer; var SuppressMove: boolean); override;
    class function  CreateHandle(const AWinControl: TWinControl;
          const AParams: TCreateParams): HWND; override;
    class function GetIndexAtY(const ACustomListBox: TCustomListBox; y: integer): integer; override;
    class function GetIndexAtXY(const ACustomListBox: TCustomListBox; x, y: integer): integer; override; // <----------------
    class function GetItemIndex(const ACustomListBox: TCustomListBox): integer; override;
...
//Реализация GetIndexAtXY

class function TWin32WSCustomListBox.GetIndexAtXY(
  const ACustomListBox: TCustomListBox; x, y: integer): integer;
begin
  Result := Windows.SendMessage(ACustomListBox.Handle, LB_ITEMFROMPOINT, 0, MakeLParam(x,y));
  if hi(Result)=0 then
    Result := lo(Result)
  else
    Result := -1;
end;


4. И наконец в customlistbox.inc в ItemAtPos заменил GetIndexAtY на GetIndexAtXY.

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

function TCustomListBox.ItemAtPos(const Pos: TPoint; Existing: Boolean
  ): Integer;
begin
  Result:=GetIndexAtXY(Pos.X, Pos.Y);// <--------------------------------------
  if Existing then begin
    if Result>=Items.Count then Result:=-1;
  end else begin
    if (Result<0) and (Result>Items.Count) and PtInRect(ClientRect,Pos) then
      Result:=Items.Count;
  end;
end;

Все. После пересборки метод ItemAtPos работает нормально

Павел, а можно исправить баг о котором я писал здесь 19.06.2008 11:59:49 ?