Ownerdraw TListBox дочерние элементы управления не перемещаются при прокрутке

Question

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;

procedure TForm1.FormCreate(Sender: TObject);
begin
  ListBox1.DoubleBuffered:=true;
  ListBox1.ItemHeight:=30;
  ListBox1.Style:=lbOwnerDrawFixed;
  Button:=TButton.Create(ListBox1);
  Button.Parent:=ListBox1;
  Button.DoubleBuffered:=true;
  Button.Visible:=false;
  Button.Width:=50;
  Button.Height:=20;
  Button.Caption:='BTN';
end;

Проблема перерисовки существует только при использовании ScrollBar или при отправке сообщения WM_VSCROLL в мой ListBox. Все обычно рисуется, когда я меняю выделение, используя стрелки клавиатуры или щелчки мышью. Проблема также не существует, когда выбранный элемент виден при прокрутке и не покидает видимую область.

Я думаю, что свойство Button.Top по-прежнему имеет старое значение до вызова DrawItem и изменяется (например, на -30px) позже.

Answer 1

Проблема в том, что вы используете OnDrawItem событие для внесения изменений в пользовательский интерфейс (в этом случае позиционирование кнопки). Не делайте этого, мероприятие предназначено ТОЛЬКО для НАНЕСЕНИЯ.

Я бы посоветовал вам либо:

1. подкласс ListBox для обработки 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;
   

2. избавиться от TButton в целом. использование OnDrawItem нарисовать изображение кнопки (вы можете использовать DrawFrameControl() или же DrawThemeBackground() для этого) непосредственно на ListBox, а затем используйте 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;
   
   procedure TForm1.ListBox1MouseDown(Sender: TObject; Button: TMouseButton;
     Shift: TShiftState; X, Y: Integer);
   begin
     if Button <> mbLeft then Exit;
     MouseX := X;
     MouseY := Y;
     ListBox1.Invalidate;
   end;
   
   procedure TForm1.ListBox1MouseUp(Sender: TObject; Button: TMouseButton;
     Shift: TShiftState; X, Y: Integer);
   begin
     if Button <> mbLeft then Exit;
     MouseX := -1;
     MouseY := -1;
     ListBox1.Invalidate;
   end;
   
   procedure TForm1.ListBox1Click(Sender: TObject);
   var
     P: TPoint;
     R: TRect;
     Index: Integer;
   begin
     P := Point(MouseX, MouseY);
     Index := ListBox1.ItemAtPos(P, True);
     if (Index = -1) or (Index <> ListBox1.ItemIndex) then Exit;
     R := ListBox1.ItemRect(Index);
     R := Rect(R.Right-80, R.Top+4, R.Right-30, R.Top+24);
     if not PtInRect(R, P) then Exit;
     // click is on selected item's "button", do something...
   end;