VPF::Удаление потомка в процессе - Форум программистов

Budy

Дата 21.3.2013, 09:34 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 616
Регистрация: 6.2.2004
Где: Екатеринбург

Репутация: 1
Всего: 2

:Приветствую

Есть объект-родитель, который хранит список созданных им объектов-потомков. Также родитель имеет метод для удаления потомка. Если потомок решает, что он закончил работу и должен освободить память, то вызывает родительский метод. И вот тут я получаю AbstractError.
Пока что нашел выход - для родителя добавил стек задач и по таймеру удаляю потомков. Может есть еще варианты?

Следующий пример наглядно отображает мою логику.
p.s. Поиск не помог.

Код


unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  TParentButton = class(TButton)
  public
    childs: Array of TButton;
    constructor Create(AOwner: TComponent); override;
    procedure AddChild(Sender: TObject);
    procedure DeleteChild(Sender: TObject);
  end;

  TForm1 = class(TForm)
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    parentButton: TParentButton;
  end;

var
  Form1: TForm1;
  y: Integer;

implementation

{$R *.dfm}

//==============================================================================
//    TParentButton
//==============================================================================

constructor TParentButton.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  Left := 8;
  Top := 8;
  Caption := 'Add child';
  OnClick := AddChild;
  Show;
end;

procedure TParentButton.AddChild(Sender: TObject);
var
  i: Integer;
begin
  i := Length(childs);
  SetLength(childs, i+1);

  childs[i] := TButton.Create(Parent);
  childs[i].Parent := Parent;
  childs[i].Show;

  childs[i].Left := 100;
  childs[i].Top := y * 30 + 8;
  childs[i].Caption := 'Delete #' + IntToStr(i);
  childs[i].OnClick := DeleteChild;

  Inc(y);
end;

procedure TParentButton.DeleteChild(Sender: TObject);
var
  i, k: Integer;
begin
  k := -1;
  for i:=0 to High(childs) do
    if childs[i] = Sender then
    begin
      k := i;
      Break;
    end;

  if k=-1 then Exit;

  // delete child
  childs[k].Free;
end;

//==============================================================================
//    TForm1
//==============================================================================

procedure TForm1.FormCreate(Sender: TObject);
begin
  parentButton := TParentButton.Create(Self);
  parentButton.Parent := Self;
  parentButton.Show;
end;

end.

--------------------

Как ты назовешь свой корабль, так на нем и напишут
user posted image

pseud

Дата 21.3.2013, 09:37 (ссылка)

(нет голосов)

Загрузка ...

Экспёрт Тыдыщ

Профиль
Группа: Завсегдатай
Сообщений: 1175
Регистрация: 18.5.2007
Где: Минск, Беларусь

Репутация: 10
Всего: 40

Т.е. решение о создании объект принимает один класс, а об удалении - сам объект? Что-то тут не так.

--------------------

Испытание чужого терпения можно считать успешным, если оно лопнуло...

Budy

Дата 21.3.2013, 09:43 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 616
Регистрация: 6.2.2004
Где: Екатеринбург

Репутация: 1
Всего: 2

Цитата(pseud @ 21.3.2013, 12:37)

Т.е. решение о создании объект принимает один класс, а об удалении - сам объект? Что-то тут не так.

Именно, сам потомок должен инициировать собственное уничтожение.

--------------------

Как ты назовешь свой корабль, так на нем и напишут
user posted image

pseud

Дата 21.3.2013, 10:02 (ссылка)

(нет голосов)

Загрузка ...

Экспёрт Тыдыщ

Профиль
Группа: Завсегдатай
Сообщений: 1175
Регистрация: 18.5.2007
Где: Минск, Беларусь

Репутация: 10
Всего: 40

Если касательно конкретно описанного кода, то оптимально так:

Код


procedure TParentButton.DeleteChild(Sender: TObject);
begin
  TButton(Sender).Visible := False;
end;

Кнопки много не "весят", удалятся потом при закрытии приложения (или формы).

Если же это абстрактное представление некой бизнес-логики каких-то бизнес-объектов, то подход должен быть другим. Лучше подробнее опишите реальную задачу.
Дочерние объекты должен удалять владелец. А если уничтожение инициирует сам объект, то либо поимеем AbstractError, либо надо, чтобы он выставлял некий флаг о своем уничтожении, а родитель совсем в другом методе делал очистку помеченных дочерних объектов.

Это сообщение отредактировал(а) pseud - 21.3.2013, 10:03

--------------------

Испытание чужого терпения можно считать успешным, если оно лопнуло...

Budy

Дата 21.3.2013, 11:17 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 616
Регистрация: 6.2.2004
Где: Екатеринбург

Репутация: 1
Всего: 2

Начал рыть глубже, нашел хороший пример
Как объекту удалить самого себя?
Собсно, вопрос снят

--------------------

Как ты назовешь свой корабль, так на нем и напишут
user posted image

Budy

Дата 21.3.2013, 11:46 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 616
Регистрация: 6.2.2004
Где: Екатеринбург

Репутация: 1
Всего: 2

Забыл выложить исходник. Вот

Код


unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

const
  UM_BASE = WM_USER+1;
  UM_FreeObject = UM_BASE+1;
  UM_RegisterObject = UM_BASE+2;
  UM_UnRegisterObject = UM_BASE+3;

type

  // TOwnerClass

  TOwnerClass = class
  private
    FList: TList;
    FWnd: THandle;
    FFreeObjectsOnDestroy: Boolean;
    procedure WndProc(var M: TMessage);
  public
    constructor Create(FreeObjectsOnDestroy: Boolean=True);
    destructor Destroy; override;
    procedure RegisterObject(p: Pointer);     // добавление объекта в список
    procedure UnRegisterObject(p: Pointer);   // удаление объекта из списка
    procedure FreeObject(p: Pointer);         // удаление из списка и уничтожение объекта
  end;

  // TParentButton

  TParentButton = class(TButton)
  public
    list: TOwnerClass;
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure AddChild(Sender: TObject);
    procedure DeleteChild(Sender: TObject);
  end;

  // TForm1

  TForm1 = class(TForm)
    btnClear: TButton;
    procedure FormCreate(Sender: TObject);
    procedure btnClearClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    parentButton: TParentButton;
  end;

var
  Form1: TForm1;
  y: Integer;

implementation

{$R *.dfm}

//==============================================================================
//    TOwnerClass
//==============================================================================

constructor TOwnerClass.Create(FreeObjectsOnDestroy: Boolean=True);
begin
  FList := TList.Create;
  FWnd := AllocateHWND(WndProc);
  FFreeObjectsOnDestroy := FreeObjectsOnDestroy;
end;

destructor TOwnerClass.Destroy;
begin
  DeallocateHWND(FWnd);
  if FFreeObjectsOnDestroy then
  begin
    while FList.Count>0 do
    begin
      TObject(FList[0]).Free;
      FList.Delete(0);
    end;
  end;
  FList.Free;
end;

procedure TOwnerClass.FreeObject(p: Pointer);
begin
  if p<>nil then PostMessage(FWnd,UM_FreeObject,Integer(p),0);
end;

procedure TOwnerClass.RegisterObject(p: Pointer);
begin
  if p<>nil then PostMessage(FWnd,UM_RegisterObject,Integer(p),0);
end;

procedure TOwnerClass.UnRegisterObject(p: Pointer);
begin
  if p<>nil then PostMessage(FWnd,UM_UnRegisterObject,Integer(p),0);
end;

procedure TOwnerClass.WndProc(var M: TMessage);
var
  i: Integer;
begin
  case M.Msg of
    UM_FreeObject, UM_UnRegisterObject:
      begin
        for i := FList.Count-1 downto 0 do
        begin
          if Pointer(M.WParam)=FList[i] then
          begin
            if M.Msg=UM_FreeObject then
              TObject(FList[i]).Free;
            FList.Delete(i);
          end;
        end;
      end;
    UM_RegisterObject:
      FList.Add(Pointer(M.WParam));
  else
    DefWIndowProc(FWnd,M.Msg,M.WParam,M.LParam);
  end;
end;

//==============================================================================
//    TParentButton
//==============================================================================

constructor TParentButton.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  
  Left := 8;
  Top := 8;
  Caption := 'Add child';
  OnClick := AddChild;

  list := TOwnerClass.Create(True);

  Parent := TWinControl(AOwner);
end;

destructor TParentButton.Destroy;
begin
  list.Free;

  inherited Destroy;
end;

procedure TParentButton.AddChild(Sender: TObject);
var
  button: TButton;
begin
  button := TButton.Create(Parent);
  button.OnClick := DeleteChild;

  button.Left := 100;
  button.Top := y * 30 + 8;
  button.Caption := 'Delete #' + IntToStr(list.FList.Count);

  Inc(y);

  list.RegisterObject(button);

  button.parent := Parent;
end;

procedure TParentButton.DeleteChild(Sender: TObject);
begin
  list.FreeObject(Sender);
end;

//==============================================================================
//    TForm1
//==============================================================================

procedure TForm1.FormCreate(Sender: TObject);
begin
  parentButton := TParentButton.Create(Self);
end;

procedure TForm1.btnClearClick(Sender: TObject);
begin
  if Assigned(parentButton) then
    parentButton.Free;
end;

end.

Присоединённый файл ( Кол-во скачиваний: 0 )

Объект_удаляет_сам_себя.zip 18,27 Kb

--------------------

Как ты назовешь свой корабль, так на нем и напишут
user posted image

1 Пользователей читают эту тему (1 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема \| Delphi: Общие вопросы \| Следующая тема »