delphi - Delphi TListView - 调用“免费”时添加的按钮不会消失

Question

（使用：德尔福 XE）

我正在向 ListView 的每一行添加一个 TButton。在按钮 OnClick 处理程序中是一个 Sender.Free。但是（虽然列表行消失了，因为填充列表视图的数据集已更新），但当按钮应该消失时，它仍保留在列表视图上。我究竟做错了什么？

这是我的代码，显示了按钮的创建，以及要释放它的 OnClick：

（另一方面，我知道在其事件处理程序中销毁组件不是一个好习惯。这有什么问题吗？您能建议另一种删除按钮的方法吗？）

procedure TfMain.actWaitListExecute(Sender: TObject);
var
  li: TListItem;
  s:  string;
  btRect: TRect;
  p:  PInteger;
begin
  lstWaitList.Items.Clear;
  lstWaitList.Clear;

  with uqWaitList do
  begin
    if State = dsInactive then
      Open
    else
      Refresh;

    First;
    while not EOF do
    begin
      li := lstWaitList.Items.Add;
      s  := MyDateFormat(FieldByName('VisitDate').AsString);
      li.Caption := s;

      New(p);
      p^ := FieldByName('ROWID').AsInteger;
      li.Data := p;
      s  := MyTimeFormat(FieldByName('InTime').AsString);
      li.SubItems.Add(s);
      li.SubItems.Add(FieldByName('FirstName').AsString + ' ' +
        FieldByName('LastName').AsString);
      //  li.SubItems.Add(FieldByName('LastName').AsString);

      with TButton.Create(lstWaitList) do
      begin
        Parent  := lstWaitList;
        btRect  := li.DisplayRect(drBounds);
        btRect.Left := btRect.Left + lstWaitList.Column[0].Width +
          lstWaitList.Column[1].Width + lstWaitList.Column[2].Width;
        btRect.Right := btRect.Left + lstWaitList.Column[3].Width;
        BoundsRect := btRect;
        Caption := 'Check Out';
        OnClick := WaitingListCheckOutBtnClick;
      end;

      Next;
    end;
  end;


end;


procedure TfMain.lstWaitListDeletion(Sender: TObject; Item: TListItem);
begin
  Dispose(Item.Data);
end;

procedure TfMain.WaitingListCheckOutBtnClick(Sender: TObject);
var
  SelROWID, outtime: integer;
  x: longword;
  y: TPoint;

  h, mm, s, ms: word;

begin
  y := lstWaitList.ScreenToClient(Mouse.CursorPos);
  //  Label23.Caption := Format('%d %d', [y.X, y.y]);
  x := (y.y shl 16) + y.X;
  PostMessage(lstWaitList.Handle, WM_LBUTTONDOWN, 0, x);
  PostMessage(lstWaitList.Handle, WM_LBUTTONUP, 0, x);
  Application.ProcessMessages;

  SelROWID := integer(lstWaitList.Selected.Data^);
  //  ShowMessage(IntToStr(SelROWID));

  with TfCheckOut.Create(Application) do
  begin
    try
      if ShowModal = mrOk then
      begin
        decodetime(teTimeOut.Time, h, mm, s, ms);
        outtime := h * 100 + mm;

        uqSetOutTime.ParamByName('ROWID').Value := SelROWID;
        uqSetOutTime.ParamByName('OT').Value := outtime;
        uqSetOutTime.Prepare;
        uqSetOutTime.ExecSQL;

        (TButton(Sender)).Visible := False;
        (TButton(Sender)).Free;

        actWaitListExecute(Self);
      end;
    finally
      Free;
    end;
  end;

end;

图片：

Answer 1

好吧，我看到了两个潜在的问题。首先，您正在使用一个with块，这可能会使编译器解析某些标识符的方式与您认为它们应该解析的不同。例如，如果 TfCheckOut 有一个名为 Sender 的成员，您最终将释放它而不是本地 Sender。

其次，该调用在条件内，并且仅在调用 ShowModal mrOK`TButton(Sender).Free时才会激活。is returning您是否进入调试器并确保该代码分支正在执行？

关于您关于不在其自己的事件处理程序中释放按钮的问题，这样做是完全合法的，代码明智的。这不是一个好主意，释放它可能会导致在事件处理程序完成后引发异常，但它不应该什么都不做，这就是您在此处看到的。这几乎肯定表明Free根本没有被调用。如果您想要一种安全释放它的方法，请查看消息传递。您需要在表单上创建一个消息 ID 和一个处理程序，然后PostMessage（不是SendMessage）将该消息发送到您的表单，并将控件作为参数，并且消息处理程序应该释放按钮。这样您就可以确保事件处理程序不再运行。

编辑：好的，因此，如果您确定Free正在调用它，则Free正在调用它，并且如果Free在没有引发异常的情况下完成，则该按钮将被销毁。真的就是这么简单。（在此代码运行后再次尝试单击该按钮。除非发生了非常非常奇怪的事情，否则什么都不会发生。）如果之后您仍然看到该按钮，那是另一个问题。这意味着父级（TListView）没有重新绘制自己。尝试调用它的Invalidate方法，这将使 Windows 正确地重新绘制它。

Answer 2

首先，我不知道为什么您的解决方案不起作用。单独采取的所有部分都可以正常工作，但组合解决方案不起作用。也许这种方法过于复杂并且掩盖了一些问题，也许这是你在查看自己的代码时有时看不到的那些愚蠢的“我写 i 而不是 j”之一......

无论如何，这是一个有效的快速实现。它不从数据库中获取原始数据，我使用 aTObjectList<>来存储数据，但概念是相同的。为了清楚起见，我不支持将按钮放在 ListView 上的想法，因为 ListView 不是为容纳其他控件而设计的。只是为了好玩，在列表中添加足够的原始数据，以便显示垂直滚动条。向下移动滚动条，您的按钮不会移动。当然，你可以破解一些东西来解决这个问题，但这并不能改变根本事实，它是一种破解。我要做的是切换到TVirtualTree，将其设置为看起来像列表并自己绘制按钮列。由于该TVirtualTree控件将被编译到我的可执行文件中，因此 Windows 升级不可能阻止我的自定义绘图。

PAS代码：

unit Unit14;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ComCtrls, Generics.Collections, StdCtrls;

type

  TItemInfo = class
  public
    DateAndTime: TDateTime;
    CustomerName: string;
  end;

  // Subclass the Button so we can add a bit more info to it, in order
  // to make updating the list-view easier.
  TMyButton = class(TButton)
  public
    ItemInfo: TItemInfo;
    ListItem: TListItem;
  end;

  TForm14 = class(TForm)
    ListView1: TListView;
    procedure FormCreate(Sender: TObject);
  private
    // Items list
    List: TObjectList<TitemInfo>;
    procedure FillListWithDummyData;
    procedure FillListView;
    procedure ClickOnCheckOut(Sender: TObject);
  public
    destructor Destroy;override;
  end;

var
  Form14: TForm14;

implementation

{$R *.dfm}

{ TForm14 }

procedure TForm14.ClickOnCheckOut(Sender: TObject);
var B: TMyButton;
    i: Integer;
    R: TRect;
begin
  B := Sender as TMyButton;
  // My button has a reference to the ListItem it sits on, use that
  // to remove the list item from the list view.
  ListView1.Items.Delete(B.ListItem.Index);
  // Not pretty but it works. Should be replaced with better code
  B.Free;
  // All buttons get there coordinates "fixed"
  for i:=0 to ListView1.ControlCount-1 do
    if ListView1.Controls[i] is TMyButton then
    begin
      B := TMyButton(ListView1.Controls[i]);
      if B.Visible then
      begin
        R := B.ListItem.DisplayRect(drBounds);
        R.Left := R.Right - ListView1.Columns[3].Width;
        B.BoundsRect := R;
      end;
    end;
end;

destructor TForm14.Destroy;
begin
  List.Free;
  inherited;
end;

procedure TForm14.FillListView;
var i:Integer;
    B:TMyButton;
    X:TItemInfo;
    ListItem: TListItem;
    R: TRect;
begin
  ListView1.Items.BeginUpdate;
  try
    // Make sure no Buttons are visible on ListView surface
    i := 0;
    while i < ListView1.ControlCount do
      if ListView1.Controls[i] is TMyButton then
        begin
          B := TMyButton(ListView1.Controls[i]);
          if B.Visible then
            begin
              // Make the button dissapear in two stages: On the first list refresh make it
              // invisible, on the second list refresh actually free it. This way we now for
              // sure we're not freeing the button from it's own OnClick handler.
              B.Visible := False;
              Inc(i);
            end
          else
            B.Free;
        end
      else
        Inc(i);
    // Clear the list-view
    ListView1.Items.Clear;
    // ReFill the list-view
    for X in List do
    begin
      ListItem := ListView1.Items.Add;
      ListItem.Caption := DateToStr(X.DateAndTime);
      Listitem.SubItems.Add(TimeToStr(X.DateAndTime));
      Listitem.SubItems.Add(X.CustomerName);

      B := TMyButton.Create(Self);
      R := ListItem.DisplayRect(drBounds);
      R.Left := R.Right - ListView1.Columns[3].Width;
      B.BoundsRect := R;
      B.Caption := 'CHECK OUT (' + IntToStr(R.Top) + ')';
      B.ItemInfo := x;
      B.ListItem := ListItem;
      B.OnClick := ClickOnCheckOut;
      B.Parent := ListView1;
    end;
  finally ListView1.Items.EndUpdate;
  end;
end;

procedure TForm14.FillListWithDummyData;
var X: TItemInfo;
begin
  X := TItemInfo.Create;
  X.DateAndTime := EncodeDate(2011, 7, 7) + EncodeTime(18, 6, 0, 0);
  X.CustomerName := 'Holmes Sherlok';
  List.Add(X);

  X := TItemInfo.Create;
  X.DateAndTime := EncodeDate(2011, 7, 7) + EncodeTime(18, 55, 0, 0);
  X.CustomerName := 'Glover Dan';
  List.Add(X);

  X := TItemInfo.Create;
  X.DateAndTime := EncodeDate(2011, 7, 8) + EncodeTime(23, 9, 0, 0);
  X.CustomerName := 'Cappas Shirley';
  List.Add(X);

  X := TItemInfo.Create;
  X.DateAndTime := EncodeDate(2011, 7, 8) + EncodeTime(23, 9, 0, 0);
  X.CustomerName := 'Jones Indiana';
  List.Add(X);
end;

procedure TForm14.FormCreate(Sender: TObject);
begin
  List := TObjectList<TitemInfo>.Create;
  FillListWithDummyData;
  FillListView;
end;

end.

表格的 DFM；那些它只是一个带有 aListView和 an的形式OnFormcreate，没什么特别的：

object Form14: TForm14
  Left = 0
  Top = 0
  Caption = 'Form14'
  ClientHeight = 337
  ClientWidth = 635
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'Tahoma'
  Font.Style = []
  OldCreateOrder = False
  OnCreate = FormCreate
  DesignSize = (
    635
    337)
  PixelsPerInch = 96
  TextHeight = 13
  object ListView1: TListView
    Left = 8
    Top = 8
    Width = 465
    Height = 321
    Anchors = [akLeft, akTop, akRight, akBottom]
    Columns = <
      item
        Caption = 'DATE'
        Width = 75
      end
      item
        Caption = 'IN TIME'
        Width = 75
      end
      item
        Caption = 'CUSTOMER NAME'
        Width = 150
      end
      item
        Caption = 'CHECK OUT'
        MaxWidth = 90
        MinWidth = 90
        Width = 90
      end>
    TabOrder = 0
    ViewStyle = vsReport
  end
end

Answer 3

在 TListview 中动态实例化 TButton 是错误的方法。

首先，您需要了解 TListview 是 Microsoft 公共控件 (ComCtl32) 的包装器，并且在运行时动态地将 TButton 放在那里是一个糟糕的 hack。例如，如果用户调整表单的大小以便恰好出现 3.5 个按钮，你会怎么做？您将如何剪裁按钮以使其一半可见？或者你会让部分行没有可见的按钮？你真的确定你可以处理当用户使用鼠标滚轮滚动并且你必须动态地重新生成控件时可能发生的所有奇怪情况吗？您不应该在绘制例程或鼠标向下或向上消息中生成控件并释放它们。

如果你真的想要一个按钮，你需要两个图像状态，一个未按下和按下的图像，当正确的单元格聚焦时，你在正确的位置绘制它。在鼠标按下时，在该区域中，您会检测到点击。

但是，如果您坚持，那么我会这样做：

1. 在程序开始时动态创建一个或多个按钮，并根据需要使每个按钮可见或不可见。
2. 当您有太多按钮时，显示或隐藏您的按钮或按钮控件数组元素，而不是分配它们，隐藏而不是释放它们。

您的图像每行显示一个按钮，因此假设您需要一个包含大约 30 个按钮的数组，在运行时创建并存储在控件数组（TList 或 TButton 数组）中

一个典型的网格示例，每行都有所有者绘制的按钮，这些按钮被绘制在单元格内，并且鼠标按下处理会导致按钮根据需要以向下状态或向上状态绘制：

但是要绘制每个项目，一次一行，我会得到一些所有者绘制按钮代码并在每个单元格中绘制一个按钮。

楼主绘制代码：

// ExGridView1:TExGridView from https://sites.google.com/site/warrenpostma/
procedure TForm1.ExGridView1DrawCell(Sender: TObject; Cell: TExGridCell;
  var Rect: TRect; var DefaultDrawing: Boolean);
var
   btnRect:TRect;
   ofs:Integer;
   caption:String;
   tx,ty:Integer;
   Flags,Pressed: Integer;
   DC:HDC;
begin
 if Cell.Col = 1 then begin
    DC := GetWindowDC(ExGridView1.Handle);
    with ExGridView1.Canvas do
    begin
      Brush.Color := clWindow;
      Rectangle(Rect);
      caption := 'Button '+IntToStr(cell.Row);
      Pen.Width := 1;
      btnRect.Top := Rect.Top +4;
      btnRect.Bottom := Rect.Bottom -4;
      btnRect.Left := Rect.left+4;
      btnRect.Right := Rect.Right-4;
      Pen.Color := clDkGray;
      if FMouseDown=Cell.Row then
      begin
         Flags := BF_FLAT;
         Pressed := 1;
      end else begin
         Flags := 0;
         Pressed := 0;
      end;
      Brush.Color := clBtnFace;
      DrawEdge(DC, btnRect, EDGE_RAISED, BF_RECT or BF_MIDDLE or Flags);
      Flags := (btnRect.Right - btnRect.Left) div 2 - 1 + Pressed;
      PatBlt(DC, btnRect.Left + Flags, btnRect.Top + Flags, 2, 2, BLACKNESS);
      PatBlt(DC, btnRect.Left + Flags - 3, btnRect.Top + Flags, 2, 2, BLACKNESS);
      PatBlt(DC, btnRect.Left + Flags + 3, btnRect.Top + Flags, 2, 2, BLACKNESS);
      Font.Color := clBtnText;
      Font.Style := [fsBold];
      tx := btnRect.left + ((btnRect.Right-btnRect.Left) div 2) - (TextWidth(Caption) div 2);
      ty := btnRect.Top + 2;
      TextOut(tx,ty,caption);
    end;
    DefaultDrawing := false;
 end;
end;

还有其他代码（上面未显示）来处理鼠标向下和鼠标向上，以确定何时按下按钮。如果需要，我可以在某处上传完整的示例代码。

Answer 4

对所有人：

我解决了这个问题。试图在其 OnClick 处理程序中释放按钮是问题所在。我阅读了许多作者的建议，认为这是很糟糕的做法。所以我删除了 Free 调用并跟踪 ObjectList 中的按钮。而在 actWaitListExecute 中，只需清除对象列表，这将清除所有按钮，并重新绘制新按钮。

在表单声明中添加：

  private
    { Private declarations }
    FButton : TButton;
    FButtonList : TObjectList;

在 FormCreate 添加：

  FButtonList := TObjectList.Create;

添加 FormDestroy：

procedure TfMain.FormDestroy(Sender: TObject);
begin
  FButtonList.Free;
end;

修改 actWaitListExecute 以添加如下所示的最后一行：

procedure TfMain.actWaitListExecute(Sender: TObject);
var
  li: TListItem;
  s:  string;
  btRect: TRect;
  p:  PInteger;
begin
  lstWaitList.Items.Clear;
  lstWaitList.Clear;
  FButtonList.Clear;

还要修改 actWaitListExecute 中的代码：

  FButton := TButton.Create(lstWaitList);
  FButtonList.Add(FButton);
  with  FButton do
  begin
    Parent := lstWaitList;
    Caption := 'Check Out';
    Tag := integer(li);
    OnClick := WaitingListCheckOutBtnClick;

    btRect := li.DisplayRect(drBounds);
    btRect.Left := btRect.Left + lstWaitList.Column[0].Width +
      lstWaitList.Column[1].Width + lstWaitList.Column[2].Width;
    btRect.Right := btRect.Left + lstWaitList.Column[3].Width;
    BoundsRect := btRect;
  end;

一切都按预期进行......一个快乐的结局:)