Delphi TListView - добавленная кнопка не исчезает при вызове «Free»

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;

Изображение:

Answer 1

Ну, я вижу две потенциальные проблемы.Во-первых, вы используете блок with, который может заставить компилятор разрешать некоторые идентификаторы иначе, чем, как вы думаете, они должны разрешать.Например, если в TfCheckOut есть член с именем Sender, вы в конечном итоге освободите его вместо локального Sender.

Во-вторых, вызов TButton(Sender).Free находится внутри условного выражения и активируется только в том случае, если этот вызовShowModal is returning mrOK`.Вы вошли в отладчик и убедились, что эта ветвь кода выполняется?

Что касается вашего вопроса о том, чтобы не освобождать кнопку в своем собственном обработчике событий, то это вполне законно с точки зрения кода.Это не очень хорошая идея, и ее освобождение может привести к возникновению исключения после завершения обработчика события, но оно не должно ничего не делать , что вы видите здесь.Это почти наверняка показывает, что Free вообще не вызывается.Если вы хотите безопасно освободить его, обратите внимание на обмен сообщениями.Вы захотите создать идентификатор сообщения и обработчик для него в своей форме, затем PostMessage (не SendMessage) это сообщение для вашей формы с элементом управления в качестве параметра, и обработчик сообщений должен освободить кнопку.Таким образом вы гарантируете, что обработчик событий больше не работает.

РЕДАКТИРОВАТЬ: ОК, поэтому, если вы уверены, что вызывается Free, то Freecall, и если Free завершает работу без вызова исключения, кнопка уничтожается.Это действительно так просто.(Попробуйте нажать кнопку еще раз после запуска этого кода. Если что-то очень, очень странное не происходит, ничего не произойдет.) Если вы все еще видите кнопку после этого, это другая проблема.Это означает, что родитель (TListView) не перерисовывает себя.Попробуйте вызвать его Invalidate метод, который заставит Windows перекрасить его должным образом.

Answer 2

Прежде всего, я понятия не имею, почему ваше решение не работает. Все части, взятые отдельно, работают нормально, но комбинированное решение не работает. Возможно, этот подход слишком сложен и скрывает какую-то проблему, может быть, это одна из тех глупых фраз «Я написал вместо меня», которые вы иногда никогда не видите, глядя на свой собственный код ...

В любом случае, вот быстрая реализация, которая работает . Он не берет необработанные данные из базы данных, я использовал 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

To All:

Я решил проблему.Попытка освободить кнопку в обработчике 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;

И все работает как положено ..... счастливый конец :) 1020 *

Answer 4

Динамическое создание TButton в TListview - неправильный подход.

Во-первых, вы должны понимать, что TListview - это обертка для общего элемента управления Microsoft (ComCtl32), и что размещение TButton там динамически во время выполнения - плохой хак. Что бы вы сделали, например, если бы пользователь изменил размер формы так, чтобы появилось ровно 3,5 кнопки? как вы собираетесь зажать кнопку, чтобы половина ее была видна? Или вы бы сделали частичные строки, не имеющие видимой кнопки? Вы действительно уверены, что справитесь со всеми странностями, которые могут произойти, когда пользователь прокручивает колесико мыши, и вам нужно динамически на ходу восстанавливать элементы управления? Вы не должны генерировать элементы управления и освобождать их в процедурах рисования или при нажатии мышкой вниз или вверх.

Если вы действительно хотите, чтобы там была кнопка, вам нужны два состояния изображения: не нажатое и нажатое изображение, которое вы рисуете владельцем в правильном месте, когда сфокусирована правильная ячейка. И наведением мыши, в этой области вы обнаруживаете щелчок

однако, если вы настаиваете, то я бы сделал это:

1. Создайте кнопку или кнопки один раз, динамически, в начале программы, и сделайте каждую кнопку видимой или невидимой по мере необходимости.
2. Показать или скрыть элементы массива button-or-button-control-массив, вместо того, чтобы выделять их, скрывать вместо освобождения, когда у вас слишком много кнопок.

Ваше изображение показывает одну кнопку на строку, поэтому предположим, что вам понадобится массив из примерно 30 кнопок, созданный во время выполнения и сохраненный в массиве управления (TList или Array of 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;

Существует другой код, не показанный выше, для управления мышью вниз и мышью вверх, чтобы выяснить, когда нажимается кнопка. Я могу загрузить полный пример кода куда-нибудь, если вы хотите.