Текущий архив: 2005.06.14;
Скачать: CL | DM;

Вниз

деление объекта   Найти похожие ветки 

← →
Antol   (2005-05-28 22:39) [0]

У меня есть объект. Мне нужно, чтобы через определенное время он делился (из него создавался такой же). Как это можно сделать?

---

← →
Yanis ©   (2005-05-28 22:41) [1]

Если нет ошибки в 17 строке, то магия поможет :)
А вообще вопрос не понятен. Поясни пожалуйста.

---

← →
Просто Джо ©   (2005-05-28 23:25) [2]

Если я правильно понял.
Мой рецепт таков. Заводишь менеджер, он же "фабрика" объектов. То есть класс, который умеет создавать объекты определенных типов. Кроме того, он отвечает за сохранение в своих внутренних структурах ссылок на все порожденные объекты. Также, он несет ответственность за удаление своих объектов.
Когда реализуешь такой менеджер, считай -- самое главное сделал. После этого заводишь в менеджере таймер и в определенное время менежер создает объекты.
Если расписал непонятно, напиши что именно. Может быть вечерком набросая схематичный код.

---

← →
Просто Джо ©   (2005-05-29 02:28) [3]

Привожу обещанный код.
-------------------------
Вот вариант 1, упрощенный. Код соответствует описанию, данному в [2].

Через определенные промежутки времени менеджер создает и добавляет в свой внутренний список новый объект TCustomObject. Доступ к существующим объектам предоставляется через индексное default-свойство Items менеджера. Количество созданных объектов можно узнать по значению свойства Count.
Менеджер создается и начинает отсчет автоматически при старте программы. При выходе из программы менеджер автоматически уничтожается. Доступ к нему можно получить через глобальную переменную ObjectManager.

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

unit ObjMgr;

interface
uses Contnrs, ExtCtrls;

type
 // Объект, экземпляры которого будут "множится"
 TCustomObject = class
   //
 end;

 // Менеджер объектов
 TObjManager = class
 private
   FList: TObjectList;
   FTimer: TTimer;
   function GetItems(Index: Integer): TCustomObject;
   procedure OnTimer (Sender: TObject);
   procedure StartTimer (Interval: Integer);
   function GetObjectCount: Integer;
 public
   constructor Create; overload;
   constructor Create (Interval: Integer); overload;
   destructor Destroy; override;
   procedure CreateChild;
   property Items[Index: Integer]: TCustomObject read GetItems; default;
   property ObjectCount: Integer read GetObjectCount;
 end;

var
 ObjectManager: TObjManager;
 
implementation

{ TObjManager }

constructor TObjManager.Create;
begin
 inherited;
 FList := TObjectList.Create(True);
 StartTimer(1000);
end;

constructor TObjManager.Create(Interval: Integer);
begin
 inherited Create;
 FList := TObjectList.Create(True);
 StartTimer(Interval);
end;

procedure TObjManager.CreateChild;
begin
 FList.Add(TCustomObject.Create)
end;

destructor TObjManager.Destroy;
begin
 FTimer.Free;
 FList.Free;
 inherited;
end;

function TObjManager.GetItems(Index: Integer): TCustomObject;
begin
 Result := TCustomObject(FList[Index])
end;

function TObjManager.GetObjectCount: Integer;
begin
 Result := FList.Count
end;

procedure TObjManager.OnTimer(Sender: TObject);
begin
 CreateChild
end;

procedure TObjManager.StartTimer(Interval: Integer);
begin
 FTimer := TTimer.Create(nil);
 FTimer.OnTimer := OnTimer;
 FTimer.Interval := Interval;
 FTimer.Enabled := True;
end;

initialization
 ObjectManager := TObjManager.Create(2000);

finalization
 ObjectManager.Free;
 
end.


---

← →
Просто Джо ©   (2005-05-29 02:33) [4]

Вот вариант 2, усложненный.
-----------------------------

Через определенные промежутки времени менеджер создает копию КАЖДОГО объекта, находящегося в его списке и сохраняет ее во внутреннем списке. Доступ к объектам в списке аналогичен предыдущему примеру. Класс, описывающий объект поддерживает метод Assign, в котором мы указываем какие именно свойства объекта необходимо передавать его копии. Все остальное -- по аналогии с предыдущим примером.
Обрати внимание на комментарии в коде.
-------------

unit ObjMgr2;

interface
uses SysUtils, Classes, Contnrs, ExtCtrls;

type
 // Объект, экземпляры которого будут "множится"
 TClonableObject = class (TPersistent)
 private
   FProperty1: Integer;
   FProperty2: string;
   // создает и возвращает копию текущего объекта
   function Clone: TClonableObject;
 public
   // присваивает объекту свойства объекта Source
   procedure Assign(Source: TPersistent); override;
   // это два тестовых свойства
   property Property1: Integer read FProperty1;
   property Property2: string read FProperty2;
 end;

 // Менеджер объектов
 TClonableObjManager = class
 private
   FList: TObjectList;
   FTimer: TTimer;
   function GetItems(Index: Integer): TClonableObject;
   procedure OnTimer (Sender: TObject);
   procedure StartTimer (Interval: Integer);
   function GetObjectCount: Integer;
   procedure DoCloneChildren;
 public
   procedure CreateChild;
   constructor Create; overload;
   constructor Create (Interval: Integer); overload;
   destructor Destroy; override;
   property Items[Index: Integer]: TClonableObject read GetItems; default;
   property ObjectCount: Integer read GetObjectCount;
 end;

var
 ClonableObjectManager: TClonableObjManager;

implementation

{ TObjManager }

constructor TClonableObjManager.Create;
begin
 inherited;
 FList := TObjectList.Create(True);
 StartTimer(1000);
end;

constructor TClonableObjManager.Create(Interval: Integer);
begin
 inherited Create;
 FList := TObjectList.Create(True);
 StartTimer(Interval);
end;

procedure TClonableObjManager.CreateChild;
begin
 FList.Add(TClonableObject.Create)
end;

destructor TClonableObjManager.Destroy;
begin
 FTimer.Free;
 FList.Free;
 inherited;
end;

procedure TClonableObjManager.DoCloneChildren;
var
 I: Integer;
begin
 // если есть объекты в списке, клонируем каждый из них
 // если список пуст, то создаем один объект и добавляем его в список
 if FList.Count <> 0 then
   for I := 0 to FList.Count-1 do
     FList.Add(Items[I].Clone)
 else
   CreateChild
end;

function TClonableObjManager.GetItems(Index: Integer): TClonableObject;
begin
 Result := TClonableObject(FList[Index])
end;

function TClonableObjManager.GetObjectCount: Integer;
begin
 Result := FList.Count
end;

procedure TClonableObjManager.OnTimer(Sender: TObject);
begin
 DoCloneChildren
end;

procedure TClonableObjManager.StartTimer(Interval: Integer);
begin
 FTimer := TTimer.Create(nil);
 FTimer.OnTimer := OnTimer;
 FTimer.Interval := Interval;
 FTimer.Enabled := True;
end;

{ TCustomObject }

procedure TClonableObject.Assign(Source: TPersistent);
begin
 if Source is TClonableObject then
 begin
   // здесь копируешь значение всех свойств,
   // которые должны копироваться при клонировании
   FProperty1 := TClonableObject(Source).FProperty1;
   FProperty2 := TClonableObject(Source).FProperty2;
 end
 else
   raise Exception.Create("Source is not TCustomObject.");
end;

function TClonableObject.Clone: TClonableObject;
begin
 // создаем новый объект того же типа
 Result := TClonableObject.Create;
 // и передаем ему наши свойства
 Result.Assign(Self);
end;

initialization
 // создаем глобальный менеджер
 // который каждые 2 сек будет клонировать
 // содержащиеся в нем объекты
 ClonableObjectManager := TClonableObjManager.Create(2000);

finalization
 ClonableObjectManager.Free;

end.


---

← →
Просто Джо ©   (2005-05-29 02:43) [5]

Демонстрация работы.
-------------------------------
Сохраняешь каждый из приведенных юнитов в отдельных файлах ObjMgr.pas и ObjMgr2.pas, соответственно. Включаешь их в проект.
В uses юнита главной формы включаешь юниты ObjMgr и ObjMgr2.
На главной форме помещаешь два компонента TLabel и один TTimer. В обработчике OnTimer таймера пишешь:
 
Label1.Caption :=
   Format ("Objects: %d",[ObjectManager.ObjectCount]);

 Label2.Caption :=
   Format ("Objects: %d",[ClonableObjectManager.ObjectCount]);

И поставь у таймера интервал в 1 сек.

Запускаешь проект на выполнение и радуешься :)
Каждые 2 сек количество объектов в первом менеджере будет увеличиваться на 1.
Каждые 2 сек количество объектов во втором менеджере будет удваиваться, таким образом, ты будешь иметь удовольствие наблюдать за степенями двойки, что есть весьма поучительно и наглядно демонстрирует тщету человеческого существования :)))

---

← →
DrPass ©   (2005-05-29 03:25) [6]

А слабО сделать размножение объектов не делением, а путем спаривания? Так, чтобы потомок получил часть VMT от папы, и часть - от мамы :)

---

← →
Defunct ©   (2005-05-29 03:30) [7]

Навеяно идеей Просто Джо:

unit fLifeSim;

interface

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

type
 TForm2 = class(TForm)
   Button1: TButton;
   Timer1: TTimer;
   Button2: TButton;
   procedure Button1Click(Sender: TObject);
   procedure Button2Click(Sender: TObject);
   procedure Timer1Timer(Sender: TObject);
 private
   { Private declarations }
 public
   { Public declarations }
 end;

var
 Form2: TForm2;

implementation
{$R *.dfm}

uses Contnrs;

type

 TCell = class
 private
   fRect     : TRect;
   fCanvas   : TCanvas;

   function    Fission:TCell;
 protected
   procedure   Draw;
 public

   procedure   Simulate;
   constructor Create(const Canvas: TCanvas; const Rect: TRect);dynamic;
   destructor  Destroy;override;
 end;

 TCellManager = class(TObjectList)
    procedure Simulate;
    destructor Destroy;override;
 end;

var Cells : TCellManager;
{ TManager }

procedure TCellManager.Simulate;
var
 i : integer;
begin
 for i := 0 to Count - 1 do
     TCell(Items[i]).Simulate
end;

destructor TCellManager.Destroy;
var
 i : integer;
begin
 for i := Count-1 downto 0 do
     Items[i].Free
end;

{ TCell }
constructor TCell.Create(const Canvas: TCanvas; const Rect: TRect);
begin
 if Assigned(Canvas) then
    fCanvas := Canvas
 else
    raise Exception.Create("no canvas assigned");
 fRect := Rect;
 Cells.Add( Self )
end;

function TCell.Fission: TCell;

   function GetDivVector( const Rect:TRect):TPoint;
   var
      Px, Py : TPoint;
   begin
      Result := Point(0, 0);

      Px := Point( Rect.Left, Rect.Right );
      Py := Point( Rect.Top, Rect.Bottom );

      if (Px.Y - Px.X) > (Py.Y - Py.X) then // horisontal div
         Result.X := (Px.Y - Px.X) div 2
      else // Vert div
         Result.Y := (Py.Y - Py.X) div 2
   end;

   function GetRectPiece( const Rect: TRect; const DivVector:TPoint; Up:Boolean):TRect;
   begin
      Result := Rect;

      if Up then
         begin
            Result.Right := Result.Right - DivVector.X;
            Result.Bottom := Result.Bottom - DivVector.Y;
         end
      else
         begin
            Result.Left := Result.Left + DivVector.X;
            Result.Top := Result.Top + DivVector.Y;
         end;
   end;

var
 Dv : TPoint;

begin
 Dv := GetDivVector( fRect );

 if (Dv.X > 0) or (Dv.Y > 0) then // the cell still can be divided
    begin
      Result := TCell.Create( fCanvas, GetRectPiece( fRect, Dv, False ) );
      fRect := GetRectPiece( fRect, Dv, True );
      Application.ProcessMessages
    end
 else
    Result := nil;
end;

procedure TCell.Simulate;
var
  NewCell : TCell;
begin
  NewCell := Self.Fission;
  if NewCell <> nil then
     NewCell.Draw;
  Draw
end;

procedure TCell.Draw;
begin
  with fCanvas do
  begin
     Pen.Color := Random( $FFFFFF);
     Brush.Color := Random( $FFFFFF);
     FillRect( fRect )
  end
end;

destructor TCell.Destroy;
begin
 inherited;
end;

procedure TForm2.Button1Click(Sender: TObject);
begin
 TCell.Create( Canvas, Self.ClientRect );
end;

procedure TForm2.Timer1Timer(Sender: TObject);
begin
 Cells.Simulate;
end;

initialization
 Cells := TCellManager.Create;

finalization
 Cells.Free

end.

---

← →
Просто Джо ©   (2005-05-29 04:04) [8]

> [7] Defunct ©   (29.05.05 03:30)

Это зверство - Оно только через TaskManager снимается :) Уж очень занимательно было на это смотреть, вот и досмотрелся :))

---

← →
Defunct ©   (2005-05-29 04:19) [9]

Просто Джо ©   (29.05.05 04:04) [8]

хехе, деление прекращается, когда клетка занимает квадрат 1x1, так что можно было дождаться без снятия TaskManager"ом ;>

А вообще у таймера интервал больше бы поставить, или вместо таймера кнопку кликать ;>

---

← →
Anatoly Podgoretsky ©   (2005-05-29 11:21) [10]

Вообще то это умножение.

---

← →
Antol   (2005-05-29 11:52) [11]

Просто Джо ,Defunct огромное спасибо!!!

Просто Джо ,у меня наверное голова с утра плохо соображает, но как обратится к самому объекту?(где он должен находится, как его сохранить?)
сейчас у меня просто счетчики делений.

---

← →
Просто Джо ©   (2005-05-29 15:15) [12]

ObjectManager[Номер_объекта]
ClonableObjectManager[Номер_объекта]

---

← →
Antol   (2005-05-29 17:45) [13]

А можно вместо объекта использовать картинку нарисованную с использованием canvas?

---

← →
Antol   (2005-05-29 17:47) [14]

Удалено модератором

---

← →
ferr ©   (2005-05-29 18:14) [15]

Опиши полность задачу

---

← →
Antol   (2005-05-29 19:19) [16]

по просьбам трудящихся Задача:
используя объекты, отобразить процесс деления неполовой клетки человека с полным набором вакуолей и органоидов.
вставлять картинки нельзя.

---

← →
Defunct ©   (2005-05-29 19:22) [17]

Antol   (29.05.05 19:19) [16]

Видоизмените метод Draw и метод Fission в примере [7]

---

← →
ferr ©   (2005-05-29 19:41) [18]

Что подразумевается под объектом? Экземпляр класса?
В свете:

>Antol   (29.05.05 17:47) [14][Ответить]
> А можно вместо объекта использовать картинку
> нарисованную с использованием canvas?

---

← →
Antol   (2005-05-29 21:22) [19]

Я создала процедуру, которая рисует саму клетку с некоторыми вакуолями (в черновом варианте)

procedure kl (var x,y:integer);
begin
 with Form1.Canvas do
   begin
     ellipse (x-9*dx,y-5*dy,x+12*dx,y+10*dy);// êëåòêà
     Brush.Color:=ClOlive;
     ellipse (x,y,x+7*dx,y+7*dy);  //ÿäðî
     Brush.Color:=ClInactiveBorder;
     ellipse (x+2*dx,y+3*dy,x+4*dx,y+5*dy);  //ÿäåðöå
     Pen.width:=6;Pen.Color:=ClGray;
     arc(x-4*dx,y-dy, x+2*dx,y+5*dy,x-dx,y-dy, x-5*dx,y);//ìèòîõîíäðèè
     Pen.Color:=ClSkyBlue;
     Pen.width:=3;
     arc (x+5*dx,y-2*dy,x+9*dx,y+2*dy,x+10*dx,y,x+6*dx,y-2*dy,);//  ãîëüäæè
     arc (x+4*dx,y-dy,x+8*dx,y+3*dy,x+10*dx,y+dy,x+5*dx,y-dy);
    end;
end;
Она даже научилась ездить по экрану.

Вот она-то и должна делится.
Только как мне ее лучше сохранить - я сама не знаю.
Огромное спасибо всем за помощь.

---

← →
Digitman ©   (2005-05-30 08:41) [20]

> Я создала процедуру


> Вот она-то и должна делится


процедура должна делиться ?
вот это новость !)


> У меня есть объект


где в [19] хоть что-либо напоминающее созданный именно тобой объект ?

---

← →
SergP ©   (2005-05-30 08:48) [21]

>  [20] Digitman ©   (30.05.05 08:41)
>
> > Я создала процедуру
>
>
> > Вот она-то и должна делится
>
>
> процедура должна делиться ?
> вот это новость !)


И это еще не все....


> Она даже научилась ездить по экрану.

---

Страницы: 1 вся ветка

Текущий архив: 2005.06.14;
Скачать: CL | DM;

Наверх

Память: 0.55 MB
Время: 0.037 c