Ownerdraw TListBox child controls are not moved by scrolling

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;

The repaint problem only exists when using ScrollBar or sending WM_VSCROLL message to my ListBox. All normally drawn when I change selection by using keyboard arrows or mouse clicks. Problem also not exists when selected item are visible by scrolling and not leave visible area.

I think that Button.Top property still have an old value before DrawItem calls, and change (to -30px for example) later.

Answer 1

The problem is that you are using the OnDrawItem event to make changes to the UI (in this case, positioning the button). Do not do that, the event is for DRAWING ONLY.

I would suggest that you either:

1. subclass the ListBox to handle the WM_VSCROLL message and have your message handler reposition the button as needed.

   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. get rid of the TButton altogether. Use OnDrawItem to draw an image of a button (you can use DrawFrameControl() or DrawThemeBackground() for that) directly onto the ListBox, and then use the OnMouseDown/Up or OnClick event to check if the mouse is over the "button" and if so act accordingly as needed.

   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;