Удаление компонента по щелчку (самого себя)

[RRYTY]

непонятно, повторите вопрос

Так понимаю, что Application.QueueAsyncCall как раз и есть "отложенный запуск", про который речь идет. И он позволяет уничтожить кнопку своим же обработчиком. Верно?

[sts]

Так понимаю, что Application.QueueAsyncCall как раз и есть "отложенный запуск", про который речь идет. И он позволяет уничтожить кнопку своим же обработчиком. Верно?

Application.QueueAsyncCall позволяет вызвать некий метод заданного типа TDataEvent = procedure (Data: PtrInt) of object; (пример \lazarus\examples\messages\uasynccall.pas procedure TForm1.ComplexMethod(Data: PtrInt);) который будет вызван после обработки всех входящих сообщений перед переходом в режим ожидания новых (idle)

Application.ReleaseComponent использует этот функционал

Код: Выделить всё

procedure TApplication.ReleaseComponent(AComponent: TComponent);
var
  IsFirstItem: Boolean;
begin
  if csDestroying in AComponent.ComponentState then exit;
  //DebugLn(['TApplication.ReleaseComponent ',DbgSName(AComponent)]);
  if AppDestroying in FFlags then begin
    // free immediately
    AComponent.Free;
  end else begin
    // free later
    // => add to the FComponentsToRelease
    IsFirstItem:=FComponentsToRelease=nil;
    if IsFirstItem then
      FComponentsToRelease:=TFPList.Create
    else if FComponentsToRelease.IndexOf(AComponent)>=0 then
      exit;
    FComponentsToRelease.Add(AComponent);
    AComponent.FreeNotification(Self);
    if IsFirstItem then
      QueueAsyncCall(@FreeComponent, 0);
  end;
end;

procedure TApplication.FreeComponent(Data: PtrInt);
begin
  if Data<>0 then
    DebugLn(['HINT: TApplication.FreeComponent Data<>0 ignored']);
  ReleaseComponents;
end;

procedure TApplication.ReleaseComponents;
var
  Component: TComponent;
begin
  if FComponentsReleasing<>nil then exit; // currently releasing
  if (FComponentsToRelease<>nil) then begin
    if FComponentsToRelease.Count=0 then begin
      FreeAndNil(FComponentsToRelease);
      exit;
    end;
    // free components
    // Notes:
    //   - check TLCLComponent.LCLRefCount=0
    //   - during freeing new components can be added to the FComponentsToRelease
    //   - components can be removed from FComponentsToRelease and FComponentsReleasing
    FComponentsReleasing:=FComponentsToRelease;
    FComponentsToRelease:=nil;
    try
      while (FComponentsReleasing<>nil) and (FComponentsReleasing.Count>0) do
      begin
        Component:=TComponent(FComponentsReleasing[0]);
        FComponentsReleasing.Delete(0);
        if (Component is TLCLComponent)
        and (TLCLComponent(Component).LCLRefCount>0) then begin
          // add again to FComponentsToRelease
          ReleaseComponent(Component);
        end else begin
          // this might free some more components from FComponentsReleasing
          Component.Free;
        end;
      end;
    finally
      // add remaining to FComponentsToRelease
      while (FComponentsReleasing<>nil) and (FComponentsReleasing.Count>0) do
      begin
        Component:=TComponent(FComponentsReleasing[0]);
        FComponentsReleasing.Delete(0);
        ReleaseComponent(Component);
      end;
      FreeAndNil(FComponentsReleasing);
    end;
  end;
end;

зы: передать в Application.QueueAsyncCall метод AObject.Free нельзя
зы2: метод не должен принадлежать объекту который будет освобожден внутри метода

[wwswowsogon]

Вам же нужно просто удалить кнопку из диалога а удалять из памяти необязательно ).

Увы, оказалось, что из памяти удалять тоже нужно.
Вопрос, как это сделать.

В проекте динамически создается ряд объектов из TLabel. В какой-то момент они все удаляются, а потом пересоздаются заново с другими параметрами.

И что так:

Код: Выделить всё

   RemoveComponent(TButton(Sender ));

что так:

Код: Выделить всё

   if (Sender is TLabel) then Application.ReleaseComponent(TLabel(Sender))

Объект, удалённый вызовом Sender, остаётся существующим.
Это показывает проверка типа

Код: Выделить всё

for i := 0 to labelcount - 1 do
    begin

      if Assigned(arr_svdel_text[i]) then
        s := s + 'arr_svdel_text' + IntToStr(i) + ': Y' + #13
          else s := s + 'arr_svdel_text' + IntToStr(i) + ': N' + #13;
    end;

и даже

Код: Выделить всё

TLabel(Sender) := nil;

не помогает.
И естественно, при создании заново объекта с тем же именем не происходит ничего хорошего.
Как можно поступить в таком случае?

P. S. На самом деле, в проекте просто есть таблица данных, формируемая из Label / StaticText, иногда обновляемая. Конечно, можно поступить проще и использовать для этого StringGrid или ListView, но мы не ищем лёгких путей.

[Vlad04]

Не совсем понял, в чём заключается "проблема". Накидал примерный проект. Проверьте, оно?
На форме кнопка "Создать кнопку" создаёт новые кнопки и присваивает им OnClick процедуру, которая их удаляет.
Созданные в IDE кнопки Button1? Button2 и Button3 по нажатию тоже удаляются.
Всё работает без ошибок. Или я всё-таки что-то не так понял?

[wwswowsogon]

Не совсем понял, в чём заключается "проблема". Накидал примерный проект. Проверьте, оно?
На форме кнопка "Создать кнопку" создаёт новые кнопки и присваивает им OnClick процедуру, которая их удаляет.
Созданные в IDE кнопки Button1? Button2 и Button3 по нажатию тоже удаляются.
Всё работает без ошибок. Или я всё-таки что-то не так понял?

Хм, ваш пример даёт мне опять же AccessViolation при удалении кнопки на строке

Код: Выделить всё

FreeAndNil(Sender);

Ну и проект не открылся. Какая версия Lazarus?

Здесь, конечно, явно чего-то не понимаю я. Осталось понять только - чего именно.

Вот демка, поясняющая проблему.
В ней статические компоненты успешно удаляются щелчком по самому себе.

Однако есть таблица данных, состоящая из label'ов, отображающая некий набор данных (массивов). При щелчке по метке Удалить в выбранной строке эта строка (набор label'ов) должна удаляться.
Происходит это так:

1. убираем весь массив динамических Label'ов;
2. убираем нужные данные из массива данных;
3. создаем заново массив label'ов на основе имеющегося набора данных.

Проблема в том, что на первом шаге тот Label, по которому щелкнули, не убирается из памяти, что видно в соответствующем сообщении при каждом удалении. Естественно, при следующем создании Label'а с таким же именем получаем fatal error.

https://disk.yandex.ru/d/BYSgKNnFLcjU4g

[RRYTY]

Работает, удаляет, уничтожает. Но, вне зависимости от произведенных или непроизведенных действий, генерирует на выходе такие ошибки:

64.png

32.png

Linux:

Код: Выделить всё

Heap dump by heaptrc unit of ./Things/Lazarus/CrDelBut/project1
939 memory blocks allocated : 1558269/1559432
939 memory blocks freed     : 1558269/1559432
0 unfreed memory blocks : 0
True heap size : 1605632
True free heap : 1605632

[Vlad04]

Это не ошибки. Это отчет об использовании памяти. И он, как раз, показывает, что ошибок по выделению/освобождению памяти нет.
Это значит, что все созданные компоненты удалены, память освобождена.

[RRYTY]

Это не ошибки. Это отчет об использовании памяти.

Что-то такое и предполагал. Значит, все в порядке, работает. Lazarus 2.2.4.

[Vlad04]

...
Вот демка, поясняющая проблему.
...

У меня демка ошибок не даёт... Lazarus 2.2.4 Win XP 32bit.
Вечером проверю на Win 10 64bit.

[wwswowsogon]

Возможно, пришла пора обновить Lazarus. Я на 1.8.4 сижу.

Добавлено спустя 1 минуту 42 секунды:
В демке, кстати, не всякий элемент удаляется с ошибкой. Только при щелчке по ссылке "Удалить", и не каждый, а, как правило, последний элемент (строка) даёт такой результат.

[RRYTY]

Демка:
Linux64, Lazarus 2.2.4.
Запуск 1. Удалил все, что удаляет самого себя, потом создал пять записей, после тыканья в ссылки "удалить" четвертая ссылка удалила строку, кроме себя и приложение перестало реагировать на пользователя.
Запуск 2. Создал 5 записей, на четвертом тычке во вторую ссылку сверху "удалить" осталась первая строчка и тыкаемая ссылка (вторая сверху), строка же удалилась. Дальшейшие тычки в оставшуюся ссылку приводит к полному игнорированию пользователя, как в запуске 1.

WindowsXP 32, Lazarus 2.2.4.
Создал пять записей. После четвертого тычка на второй ссылке сверху "Удалить" строка удаляется, ссылка остается. Дальнейшие тычки приводят к ошибке "Division by zero", удаляет первую строчку, дальше просто генерит ту же ошибку. Сама ссылка нагло остается. Сообщения при компиляции на скриншоте.

Mess01.png

[wwswowsogon]

Демка:
Linux64, Lazarus 2.2.4.
Запуск 1. Удалил все, что удаляет самого себя, потом создал пять записей, после тыканья в ссылки "удалить" четвертая ссылка удалила строку, кроме себя и приложение перестало реагировать на пользователя.
Запуск 2. Создал 5 записей, на четвертом тычке во вторую ссылку сверху "удалить" осталась первая строчка и тыкаемая ссылка (вторая сверху), строка же удалилась. Дальшейшие тычки в оставшуюся ссылку приводит к полному игнорированию пользователя, как в запуске 1.

WindowsXP 32, Lazarus 2.2.4.
Создал пять записей. После четвертого тычка на второй ссылке сверху "Удалить" строка удаляется, ссылка остается. Дальнейшие тычки приводят к ошибке "Division by zero", удаляет первую строчку, дальше просто генерит ту же ошибку. Сама ссылка нагло остается. Сообщения при компиляции на скриншоте.

Mess01.png

Да, примерно так и происходит, при этом ещё проверка на Assigned показывает, что объект, по которому щелкнули, не убирается из памяти почему-то. Я думаю, что всему виной моё плохое знание языка и работы с объектами. Но не исключаю и других причин. Ну, в крайнем случае сделаю ListView вместо динамической таблицы.

По сообщениям компилятора - просто переменные лишние не убрал

[Vlad04]

wwswowsogon
Посмотрел Вашу демку внимательно...
Во-первых, почему Вы удаляете 4 массива полностью, а пятый - нет?

Код: Выделить всё

  for i := 0 to svcount - 1 do
    begin

      FreeAndNil(arr_svid_text[i]);
      FreeAndNil(arr_svip_text[i]);
      FreeAndNil(arr_svname_text[i]);
      FreeAndNil(arr_svopt_text[i]);

      if i = sv_index then
        begin

          //if (Sender is TLabel) then Application.ReleaseComponent(TLabel(Sender))
          RemoveComponent(TLabel(Sender));
          TLabel(Sender) := nil;
        end
          else
          FreeAndNil(arr_svdel_text[i]);
    end;

Правильно, в данном случае будет так

Код: Выделить всё

  for i := 0 to svcount - 1 do
    begin
      FreeAndNil(arr_svid_text[i]);
      FreeAndNil(arr_svip_text[i]);
      FreeAndNil(arr_svname_text[i]);
      FreeAndNil(arr_svopt_text[i]);
      FreeAndNil(arr_svdel_text[i]);
    end;

Хотя, имхо, весьма сомнительно каждый раз удалять и создавать массив полностью. Лучше удалять только указанный элемент, остальные сдвигать. Вы же 3 массива сдвигаете

Код: Выделить всё

  //Убираем выбранный элемент массива серверов
  //и ссмещаем на 1 вниз значения верхних элементов, если необходимо
  if (sv_index < (svcount - 1)) then
    for i := sv_index to svcount - 2 do
      begin

        arr_svid[i] := arr_svid[i + 1];
        arr_svname[i] := arr_svname[i + 1];
        arr_svip[i] := arr_svip[i + 1];
      end;

Но самая главная проблема имеет элементарное решение: замените все word на integer и всё взлетит.
До какого значения, по Вашему мнению будет продолжаться следующий цикл? Чему в цикле будут равны i и k?

Код: Выделить всё

var
  i, k: word;
begin
  k := 0;
  for i := 0 to k - 1 do
  begin
  end;

И ещё. Если вам нужно описать набор объектов, то лучше использовать не несколько массивов, а массив записей.
Вместо

Код: Выделить всё

    arr_svid, arr_svname, arr_svip: Array of String;

    arr_svid_text, arr_svname_text,
    arr_svip_text, arr_svopt_text, arr_svdel_text: Array of TLabel;

записать

Код: Выделить всё

type
  TMyServer = record
    arr_svid, arr_svname, arr_svip: String;
    arr_svid_text, arr_svname_text,
    arr_svip_text, arr_svopt_text, arr_svdel_text: TLabel;
  end;

var
  arr_server: array of TMyServer;

Но, учитывая, что вас в составе имеются TLabel, которые надо создавать и уничтожать корректно, наиболее правильным решением будет использовать не record, а class (или object), и конструкторе необходимые элементы создавать, а в деструкторе - удалять.

[wwswowsogon]

wwswowsogon
Посмотрел Вашу демку внимательно...
Во-первых, почему Вы удаляете 4 массива полностью, а пятый - нет?

Код: Выделить всё

  for i := 0 to svcount - 1 do
    begin

      FreeAndNil(arr_svid_text[i]);
      FreeAndNil(arr_svip_text[i]);
      FreeAndNil(arr_svname_text[i]);
      FreeAndNil(arr_svopt_text[i]);

      if i = sv_index then
        begin

          //if (Sender is TLabel) then Application.ReleaseComponent(TLabel(Sender))
          RemoveComponent(TLabel(Sender));
          TLabel(Sender) := nil;
        end
          else
          FreeAndNil(arr_svdel_text[i]);
    end;

Пятый тоже удаляется, ниже по тексту, но удаляется специальным образом (RemoveComponent(TLabel(Sender))), в случае, если по нему был сделан щелчок мышью.
Тему эту я создал именно потому, удалить все элементы с помощью FreeAndNil не получалось ну никак.

Правильно, в данном случае будет так

Код: Выделить всё

  for i := 0 to svcount - 1 do
    begin
      FreeAndNil(arr_svid_text[i]);
      FreeAndNil(arr_svip_text[i]);
      FreeAndNil(arr_svname_text[i]);
      FreeAndNil(arr_svopt_text[i]);
      FreeAndNil(arr_svdel_text[i]);
    end;

Обратите внимание, в процедуре TMain.DelSVAll() именно так и делаю, и это не вызывает проблем, поскольку вызов удаления происходит с помощью щелчка по другому компоненту, не относящемуся к динамически создаваемому массиву из TLabel:

Код: Выделить всё

procedure TMain.DelSVAll();
var
  sv_index: Word;
begin

  for sv_index := 0 to svcount - 1 do
    begin

      FreeAndNil(arr_svid_text[sv_index]);
      FreeAndNil(arr_svip_text[sv_index]);
      FreeAndNil(arr_svname_text[sv_index]);
      FreeAndNil(arr_svopt_text[sv_index]);
      FreeAndNil(arr_svdel_text[sv_index]);
    end; 

[/quote]

Хотя, имхо, весьма сомнительно каждый раз удалять и создавать массив полностью. Лучше удалять только указанный элемент, остальные сдвигать. Вы же 3 массива сдвигаете

Код: Выделить всё

  //Убираем выбранный элемент массива серверов
  //и ссмещаем на 1 вниз значения верхних элементов, если необходимо
  if (sv_index < (svcount - 1)) then
    for i := sv_index to svcount - 2 do
      begin

        arr_svid[i] := arr_svid[i + 1];
        arr_svname[i] := arr_svname[i + 1];
        arr_svip[i] := arr_svip[i + 1];
      end;

Поначалу я так и делал, но в процессе поиска, ради ясности, решил пойти по пути полного пересоздания массива TLabel.

Но самая главная проблема имеет элементарное решение: замените все word на integer и всё взлетит.

Заменил, и... разницы не заметил, честно говоря. Программа по-прежнему ведёт себя странно, ну и память от объекта не освобождается.
Возможно, я чего-то не понимаю, но, на мой взгляд, в данном случае замена Word на Integer особой роли не играет. Длина массива предполагается в в размере нескольких десятков элементов максимум.

До какого значения, по Вашему мнению будет продолжаться следующий цикл? Чему в цикле будут равны i и k?

Код: Выделить всё

var
  i, k: word;
begin
  k := 0;
  for i := 0 to k - 1 do
  begin
  end;

Да, с этим кодом что-то не так. Но я, вроде бы, такого не писал в демо. Вы на что-то намекаете?

И ещё. Если вам нужно описать набор объектов, то лучше использовать не несколько массивов, а массив записей.
Вместо

Код: Выделить всё

    arr_svid, arr_svname, arr_svip: Array of String;

    arr_svid_text, arr_svname_text,
    arr_svip_text, arr_svopt_text, arr_svdel_text: Array of TLabel;

записать

Код: Выделить всё

type
  TMyServer = record
    arr_svid, arr_svname, arr_svip: String;
    arr_svid_text, arr_svname_text,
    arr_svip_text, arr_svopt_text, arr_svdel_text: TLabel;
  end;

var
  arr_server: array of TMyServer;

Не спорю, можно и так. Имеет ли этот способ какие-то преимущества, кроме некоторого удобства для программиста?

[Vlad04]

Да, с этим кодом что-то не так. Но я, вроде бы, такого не писал в демо. Вы на что-то намекаете?

Думайте. Включите в параметрах проекта на вкладке Отладка проверку диапазона.