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 或向我的 ListBox 发送 WM_VSCROLL 消息时存在。当我使用键盘箭头或鼠标单击更改选择时，通常会绘制所有内容。 Problem also not exists when selected item are visible by scrolling and not leave visible area.

我认为 Button.Top 属性在 DrawItem 调用之前仍然有一个旧值，稍后更改（例如为 -30px）。

Answer 1

问题是您正在使用 OnDrawItem 事件对 UI 进行更改（在本例中，定位按钮）。不要那样做，活动仅供绘图。

我建议您：

将 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;

完全摆脱 TButton。使用 OnDrawItem 将按钮的 image 直接绘制到 ListBox 上（您可以为此使用 DrawFrameControl() or DrawThemeBackground()），然后使用 OnMouseDown/Up 或OnClick 事件以检查鼠标是否在 "button" 上，如果是，则根据需要采取相应行动。

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;

Ownerdraw TListBox子控件不被滚动移动

Ownerdraw TListBox child controls are not moved by scrolling

delphi

tlistbox