德爾福的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; 

，一切都會按預期.....一個美好的結局:)