Решение проблемы перемещения виджетов в `TListBox` с `OwnerDraw`

Delphi , Компоненты и Классы , Списки

Решение проблемы перемещения виджетов в TListBox с OwnerDraw

Вопрос, описанный в контексте, заключается в проблеме перерисовки элементов в TListBox с использованием стиля lbOwnerDrawFixed. Проблема проявляется при использовании полосы прокрутки или отправке сообщения WM_VSCROLL в TListBox. Это приводит к тому, что виджеты, размещенные в TListBox, не перемещаются вместе с элементами списка при прокрутке. В частности, рассматривается ситуация с кнопкой TButton, созданной внутри TListBox, которая не перемещается вместе с перерисовкой элементов списка.

Описание проблемы

При использовании события TListBox1DrawItem для отрисовки элементов списка и размещении на них виджетов (в данном случае кнопки), при прокрутке списка с помощью полосы прокрутки или отправке сообщения WM_VSCROLL, виджеты не перемещаются вместе с элементами списка. Это связано с тем, что свойства виджетов устанавливаются в событии TListBox1DrawItem, которое вызывается для отрисовки, а не для управления позиционированием.

Пример кода, вызывающего проблему

procedure TForm1.ListBox1DrawItem(Control: TWinControl; Index: Integer;
  Rect: TRect; State: TOwnerDrawState);
begin
  inherited;
  TListBox(Control).Canvas.FillRect(Rect);
  TListBox(Control).Canvas.TextOut(Rect.Left+5, Rect.Top+8, TListBox(Control).Items[Index]);
  if odSelected in State then
  begin
    Button.Left:=Rect.Right-80;
    Button.Top:=Rect.Top+4;
    Button.Visible:=true;
    Button.Invalidate;
  end;
end;

Подтвержденное решение проблемы

Проблема заключается в том, что в событии OnDrawItem происходит изменение состояния пользовательского интерфейса (в данном случае, позиционирование кнопки). Это недопустимо, так как событие предназначено исключительно для отрисовки.

Существует два возможных решения:

1. Субклассирование TListBox для обработки сообщения WM_VSCROLL и перепозиционирования виджетов по мере необходимости. Пример кода для субклассирования:

var
  PrevListBoxWndProc: TWndMethod;

procedure TForm1.FormCreate(Sender: TObject);
begin
  PrevListBoxWndProc := ListBox1.WindowProc;
  ListBox1.WindowProc := ListBoxWndProc;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  ListBox1.WindowProc := PrevListBoxWndProc;
end;

procedure TForm1.PositionButton(Index: Integer);
var
  R: TRect;
begin
  if Index <= -1 then
    Button.Visible := False
  else
  begin
    R := ListBox1.ItemRect(Index);
    Button.Left := R.Right - 80;
    Button.Top := R.Top + 4;
    Button.Visible := True;
  end;
end;

var
  LastIndex: Integer = -1;

procedure TForm1.ListBox1Click(Sender: TObject);
var
  Index: Integer;
begin
  Index := ListBox1.ItemIndex;
  if Index <> LastIndex then
  begin
    LastIndex := Index;
    PositionButton(Index);
  end;
end;

procedure TForm1.ListBoxWndProc(var Message: TMessage);
begin
  PrevListBoxWndProc(Message);
  if Message.Msg = WM_VSCROLL then
    PositionButton(ListBox1.ItemIndex);
end;

1. Удаление TButton и использование события OnDrawItem для отрисовки изображения кнопки непосредственно на TListBox, а затем использование событий OnMouseDown/Up или OnClick для проверки, находится ли курсор над "кнопкой", и соответствующего действия.

var
  MouseX: Integer = -1;
  MouseY: Integer = -1;

procedure TForm1.ListBox1DrawItem(Control: TWinControl; Index: Integer;
  Rect: TRect; State: TOwnerDrawState);
var
  R: TRect;
  P: TPoint;
  BtnState: UINT;
begin
  TListBox(Control).Canvas.FillRect(Rect);
  TListBox(Control).Canvas.TextOut(Rect.Left+5, Rect.Top+8, TListBox(Control).Items[Index]);
  if not (odSelected in State) then Exit;
  R := Rect(Rect.Right-80, Rect.Top+4, Rect.Right-30, Rect.Top+24);
  P := Point(MouseX, MouseY);
  BtnState := DFCS_BUTTONPUSH;
  if PtInRect(R, P) then BtnState := BtnState or DFCS_PUSHED;
  DrawFrameControl(TListBox(Control).Canvas.Handle, R, DFC_BUTTON, BtnState);
  InflateRect(R, -4, -4);
  DrawText(TListBox(Control).Canvas.Handle, 'BTN', 3, R, DT_CENTER or DT_VCENTER or DT_SINGLELINE);
end;

// Дополнительные процедуры для обработки событий мыши...

Альтернативные действия пользователя

• Прежде чем приступать к одному из предложенных решений, убедитесь, что вы понимаете, как они работают, и что они соответствуют вашим требованиям к функциональности и производительности приложения.
• Если виджеты в TListBox не являются критически важными, рассмотрите возможность их исключения для упрощения логики приложения.

Следуя предложенным решениям, вы сможете устранить проблему неправильного перемещения виджетов в TListBox при прокрутке.

Создано по материалам из источника по ссылке.

Проблема связана с некорректным перемещением виджетов внутри `TListBox` при использовании стиля `lbOwnerDrawFixed` и прокрутке списка, что требует перепозиционирования виджетов или их отрисовки напрямую.

Комментарии и вопросы

Получайте свежие новости и обновления по Object Pascal, Delphi и Lazarus прямо в свой смартфон. Подпишитесь на наш Telegram-канал delphi_kansoftware и будьте в курсе последних тенденций в разработке под Linux, Windows, Android и iOS

:: Главная :: Списки ::