Question

（使用：Delphi XE）

我将一个TButton添加到ListView的每一行。在按钮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;

图像：

enter image description here

Answer 1

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

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

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

编辑：好的，所以如果您确定正在调用Free，则会调用Free，如果Free完成而没有提高一个例外，然后按钮被销毁。这真的很简单。（尝试在此代码运行后再次单击该按钮。除非非常，非常奇怪，否则不会发生任何事情。）如果您之后仍然看到该按钮，那就是另一个问题。这意味着父（TListView）不重绘自身。尝试调用其Invalidate方法，这将使Windows正确重绘。

Answer 2

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

无论如何，这是工作的快速实现。它没有从数据库中获取原始数据，我使用TObjectList<>来存储数据，但概念是相同的。为了说清楚，我不支持在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;那些只是一个ListView和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放在那里，这是一个糟糕的黑客攻击。例如，如果用户调整表单大小以便恰好出现3.5个按钮，您会做什么？如何将按钮剪裁，使其中一半可见？或者你会让部分行没有可见的按钮？您是否确定可以处理当用户使用鼠标滚轮滚动并且您必须动态动态重新生成控件时可能发生的所有奇怪现象？你不应该在绘图例程中生成控件并释放它们，或者鼠标按下或向上消息。

如果你真的想要一个按钮，你需要的是两个图像状态，一个未按下和按下的图像，当正确的细胞被聚焦时，你所有者在正确的位置绘制。在鼠标按下时，在该区域中，您会检测到咔嗒声。

然而，如果你坚持，那么我会这样做：

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

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

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

enter image description here

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

所有者绘制代码：

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

一切都按预期工作......一个美好的结局：）

当调用'Free'时，Delphi TListView - 添加按钮不会消失

4 个答案: