Удаление потомка в процессе

 
0
 
Delphi, Kylix & Pascal
ava
Budy | 21.03.2013, 10:34
:Приветствую

Есть объект-родитель, который хранит список созданных им объектов-потомков. Также родитель имеет метод для удаления потомка. Если потомок решает, что он закончил работу и должен освободить память, то вызывает родительский метод. И вот тут я получаю 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.
Kommentare (5)
ava
pseud | 21.03.2013, 09:37 #
Т.е. решение о создании объект принимает один класс, а об удалении - сам объект? Что-то тут не так.
ava
Budy | 21.03.2013, 09:43 #
Цитата (pseud @ 21.3.2013,  12:37)
Т.е. решение о создании объект принимает один класс, а об удалении - сам объект? Что-то тут не так.

Именно, сам потомок должен инициировать собственное уничтожение.
ava
pseud | 21.03.2013, 10:02 #
Если касательно конкретно описанного кода, то оптимально так:

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

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

Если же это абстрактное представление некой бизнес-логики каких-то бизнес-объектов, то подход должен быть другим. Лучше подробнее опишите реальную задачу.
Дочерние объекты должен удалять владелец. А если уничтожение инициирует сам объект, то либо поимеем AbstractError, либо надо, чтобы он выставлял некий флаг о своем уничтожении, а родитель совсем в другом методе делал очистку помеченных дочерних объектов.
ava
Budy | 21.03.2013, 11:17 #
Начал рыть глубже, нашел хороший пример
Как объекту удалить самого себя?
Собсно, вопрос снят
ava
Budy | 21.03.2013, 11:46 #
Забыл выложить исходник. Вот


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.
Registrieren Sie sich oder melden Sie sich an, um schreiben zu können.
Unternehmen des Tages
Вы также можете добавить свою фирму в каталог IT-фирм, и публиковать статьи, новости, вакансии и другую информацию от имени фирмы.
Подробнее
Mitwirkende
  Budy   pseud
advanced
Absenden