CODEWITHSUNDEEP
delphitlistbox
Leo Stdin
Leo Stdin

Reputation: 23

Ownerdraw TListBox child controls are not moved by scrolling

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;

screenshot 1

screenshot 2

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.

Upvotes: 1

Views: 893

Answers (1)

Remy Lebeau
Remy Lebeau

Reputation: 598154

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;

Upvotes: 5

Related Questions