Delphi TListView - added button does not go away when 'Free' is called

Question

(Using: Delphi XE)

I am adding a TButton to every row of a ListView. In the buttons OnClick handler is a Sender.Free. However (while the list row disappears because the dataset that populates the listview is updated,) the button remains on the listview when it should disappear. What am I doing wrong?

Here is my code that shows the creation of the button, and, the OnClick where it is to be freed:

(On another note, I know that its not good practice to destroy a component in its event handler. Is that what is wrong here? Can you suggest another method to remove the button?)

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;

Image:

Answer 1

Well, I see two potential problems. First, you're using a with block, which could make the compiler resolve some identifiers differently than what you think they're supposed to resolve as. For example, if TfCheckOut has a member called Sender, you'll end up freeing that instead of the local Sender.

Second, the TButton(Sender).Free call is inside a conditional, and will only activate if that call to ShowModalis returningmrOK`. Have you gone into the debugger and made sure that that code branch is executing?

With regard to your question about not freeing a button inside its own event handler, it's perfectly legal, code-wise, to do so. It's not a good idea, and freeing it might cause an exception to be raised after the event handler completes, but it shouldn't do nothing, which is what you're seeing here. That almost certainly shows that Free is not being called at all. If you want a way to free it safely, take a look at messaging. You'll want to create a message ID and a handler for it on your form, then PostMessage (not SendMessage) that message to your form with the control as a parameter, and the message handler should free the button. That way you ensure that the event handler isn't running anymore.

EDIT: OK, so if you're sure that Free is being called, then Free is being called, and if Free finishes without raising an exception then the button is being destroyed. It's really that simple. (Try clicking on the button again after this code has run. Unless something very, very strange is going on, nothing will happen.) If you're still seeing the button afterwards, that's a different problem. It means that the parent (the TListView) is not repainting itself. Try calling its Invalidate method, which will make Windows repaint it properly.

Answer 2

First of all, I have no idea why your solution doesn't work. All the pieces taken separately work fine, yet the combined solution doesn't work. Maybe the approach is overly-complicated and masks some issue, maybe it's one of those silly "I wrote i in stead of j" that you sometimes never see when looking at your own code...

Anyway, here's a quick implementation that does work. It doesn't take Raw data from a database, I used a TObjectList<> to store the data, but the concept is the same. To make it clear, I don't support the idea of putting buttons on a ListView, because the ListView wasn't designed to hold other controls. Just for fun, add enough raws to the list so vertical scroll-bars show up. Move the scrollbars down, your buttons do NOT move. Sure, you can hack something to work around the problem, but that doesn't change the root fact, it's a hack. What I'd do is switch to TVirtualTree, set it up to look like the list and draw the button column myself. Since the TVirtualTree control would be compiled into my executable, there's no chance of Windows upgrades braking my custom drawing.

PAS code:

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 for the form; Those it's just a form with a ListView and an OnFormcreate, nothing fancy:

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

Instantiating a TButton dynamically in a TListview is the wrong approach.

First you need to understand that TListview is a wrapper for a Microsoft common control (ComCtl32), and that putting a TButton in there dynamically at runtime, is a poor hack. What would you do, for example, if the user resizes the form so that exactly 3.5 buttons should appear? how are you going to have the button clipped so that half of it is visible? Or would you make partial rows not have a visible button? Are you really sure you can handle all the strangeness that could happen when the user scrolls with the mouse wheel and you have to dynamically on the fly regenerate controls? You are not supposed to be generating controls and freeing them, in paint routines, or mouse down or up messages.

If you really want a button in there, what you need is two image states, an unpressed and pressed image, which you owner-draw in the correct location, when the correct cell is focused. And on a mouse down, in that area, you detect a click.

however, if you insist, then I would do this:

1. Create the button or buttons once, dynamically, at the start of the program, and make each button visible or invisible as needed.
2. Show or hide your button-or-button-control-array elements, instead of allocating them, hide instead of freeing, when you have too many buttons.

Your image shows one button per row, so let's assume you would need an array of about 30 buttons, created at runtime and stored in a control array (TList or Array of TButton)

A typical example of a grid with owner drawn buttons in each row, these buttons are drawn inside the cells, and mouse down handling causes the button to be drawn in the down state or up state, as needed:

But to draw each item, one row at a time, I would get some owner-draw-a-button code and paint a button in each cell.

The owner draw code:

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

There is other code, not shown above, to handle mouse down and mouse up, to figure out when a button is pressed. I can upload the full sample code somewhere if you want it.

Answer 4

To All:

I solved the problem. Trying to Free the button in its OnClick handler was the problem. I read advice from many authors that this is plain bad practice. So I removed the Free call and keep track of the buttons in an ObjectList. And in actWaitListExecute, just Clear the objectlist, this clears all the buttons, and repaints new ones again.

In the Form declarations add:

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

In FormCreate add:

  FButtonList := TObjectList.Create;

Add FormDestroy:

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

Modify actWaitListExecute to add the last line shown below:

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

also modify code in 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;

And everything works as expected..... a happy ending :)