德尔福的TListView当“免费”被称为

Question

（德尔福XE使用）添加的按钮不会消失。在按钮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有一个名为发件人的成员，则最终将释放该发件人而不是本地发件人。

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

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

编辑：好了，如果你确信Free被调用，然后Free被调用，如果Free结束没有引发异常，则该按钮被销毁。这真的很简单。 （尝试在代码运行后再次点击按钮，除非出现这种情况，否则不会发生任何异常。）如果您之后仍然看到按钮，那就是另一个问题。这意味着父级（TListView）不会重新绘制自己。尝试调用其Invalidate方法，这将使Windows重新正确地重绘它。

Answer 2

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

首先，您需要了解TListview是Microsoft公共控件（ComCtl32）的包装，并且在运行时动态地将TButton放入其中，这是一个糟糕的黑客攻击。例如，如果用户调整表单的大小以使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 3

首先，我不知道为什么你的解决方案不起作用。所有的部分单独采取工作正常，但组合的解决方案不起作用。也许这种方法过于复杂，并掩盖了一些问题，也许这是愚蠢的“我写我替代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 4

要全部：

我解决了这个问题。试图释放OnClick处理程序中的按钮是个问题。我从很多作者那里听取了这样的建议，认为这是不好的做法所以我删除了Free Call并跟踪ObjectList中的按钮。并且在actWaitListExecute中，只需清除对象列表，这将清除所有按钮，并重新绘制新的对象。

在Form声明补充：

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; 

，一切都会按预期.....一个美好的结局:)