Главная страница
    Top.Mail.Ru    Яндекс.Метрика
Форум: "Начинающим";
Текущий архив: 2013.03.22;
Скачать: [xml.tar.bz2];

Вниз

Создать несколько экз. класса сразу.   Найти похожие ветки 

 
Димка На   (2012-03-11 16:20) [0]

Нужно к примеру создать 1000 экземпляров класса TMyClass, можно ли нормальным способом 1 раз выделить под это память и затем инициализировать каждый объект? Если да, то как?

PS. Интересуют более менее нормальные способы.


 
icWasya ©   (2012-03-11 16:40) [1]

Можно переопределить классовые методы NewInstance  и FreeInstance
Например так
procedure InitMyClassMemory(ClassCount:Integer);
type
 TMyClass = class
   class function NewInstance:TObject; override;
   class procedure FreeInstance; override;
   class procedure InitMemory(ClassCount:Integer);
 end;

implementation

Var
 MyClassMemory:Array of Byte; // это память под класс
 MyClassLastIndex:Integer;// количество созданых экземпляров

// инициализируем память
class procedure TMyClass.InitMemory(ClassCount:Integer);
begin
 MyClassLastIndex:=0;
 SetLength(MyClassMemory,ClassCount*InstanceSize);
end;
// вместо выделения памяти
class function  TMyClass.NewInstance:TObject;
begin
 Result:=TObject(@MyClassMemory[MyClassLastIndex]);
 MyClassLastIndex:=MyClassLastIndex+InstanceSize;
end;

// вместо освобождения памяти
class procedure TMyClass.FreeInstance;
begin
 Exit;
end;

initialization
 TMyClass.InitMemory(1000);


Контроль за наличием инициализации и выход за границу массива - по вкусу.

Далее делаем обычный TMyClass.Create - и память будет выделяться из массива MyClassMemory.


 
Dimka Maslov ©   (2012-03-11 16:59) [2]


> icWasya ©   (11.03.12 16:40) [1]


только надо бы

Result := InitInstance(@MyClassMemory[MyClassLastIndex]);


и не забыть всю эту память где-нибудь грохануть.


 
Ega23 ©   (2012-03-11 17:25) [3]


> Нужно к примеру создать 1000 экземпляров класса TMyClass,

uses Contnrs;

TMyClassList = class (TObjectList)
private
 function GetItem(Index: Integer): TMyClass;
public
 function AddMyObject: TMyClass;
 property Items[Index: Integer]: TMyClass read GetItem; default;
end;

function TMyClassList.AddMyObject: TMyClass;
begin
 Result := TMyClass.Create;
 Add(Result);
end;

function TMyClassList.GetItem(Index: Integer): TMyClass;
begin
 Result := TMyClassL(inherited GetItem(Index));
end;

list := TMyClassList.create;
for i := 0 to 999 do
 list.AddMyObject;
 


 
Ega23 ©   (2012-03-11 17:26) [4]

И не надо изобретать велосипед.


 
Димка На   (2012-03-11 17:32) [5]


> list := TMyClassList.create;
> for i := 0 to 999 do
>  list.AddMyObject;
>  

и будет 1000 выделений памяти..
Вопрос не в том как на них ссылки деражть, а как не выделять 100500 раз память, а разом.


 
Jeer ©   (2012-03-11 17:46) [6]

Если в объектах нет "динамики" - можно, если есть - глупая затея.


 
CRLF   (2012-03-11 19:15) [7]


> и будет 1000 выделений памяти..
А даже если выделишь память один раз, конструкторы вызывать придётся тысячу раз. Есть мнение, что не там ты оптимизируешь.


 
Anatoly Podgoretsky ©   (2012-03-11 19:34) [8]

Это не строки, здесь выигрыша нет


 
oxffff ©   (2012-03-12 00:07) [9]

Набросок

function TForm1.Alloc<T>(Count:integer):T;
var p:pointer;
   i:integer;
   obj:T;
begin
Getmem(p,T.InstanceSize*Count);
ZeroMemory(p,T.InstanceSize*Count);
for i:=1 to Count do
begin
T.InitInstance(p);
obj:=T(Tobject(p));
obj.create();
//obj.AfterConstruction; <- вызовится в конструкторе поскольку dl = -1
inc(pbyte(p),T.InstanceSize);
end;
end;

Пример
Alloc<TPersistent>(100);


 
oxffff ©   (2012-03-12 00:09) [10]

oxffff ©   (12.03.12 00:07) [9]
Сейчас попробую вкусность обернуть еще лучше.
Потом спать, утром как обычно ABAP, JAVA, JAVASCRIPT.


 
oxffff ©   (2012-03-12 00:24) [11]

Готово.
Усовершенствованная версия. :)

 TStuff<T:class,constructor>=class(TInterfacedObject,TFunc<integer,T>)
 protected
 Block:pointer;
 public
 function Invoke(idx:integer):T;
 constructor create(Count:integer);
 destructor destroy;override;
 end;

 TDemo=class
 procedure Demo;
 end;

function TForm1.Alloc<T>(Count:integer):TFunc<integer,T>;
begin
result:=TStuff<T>.create(Count);
end;

procedure TForm1.FormCreate(Sender: TObject);
var func:TFunc<integer,TDemo>;
begin
func:=Alloc<TDemo>(100);
func(0).Demo;
func(1).Demo;
func(2).Demo;
func:=nil;// by by memory block
end;

{ TStuff<T> }

constructor TStuff<T>.create(Count: integer);
var p:pointer;
   i:integer;
   obj:T;
begin
Getmem(Block,T.InstanceSize*Count);
ZeroMemory(Block,T.InstanceSize*Count);
p:=Block;
for i:=1 to Count do
begin
T.InitInstance(p);
obj:=T(Tobject(p));
obj.create();
//obj.AfterConstruction; <- вызовится в конструкторе поскольку dl = -1
inc(pbyte(p),T.InstanceSize);
end;
end;

destructor TStuff<T>.destroy;
begin
FreeMem(Block);
inherited;
end;

function TStuff<T>.Invoke(idx: integer): T;
var p:pointer;
begin
p:=Block;
inc(pbyte(p),T.InstanceSize*idx);
result:=T(Tobject(p));
end;

{ TDemo }

procedure TDemo.Demo;
begin
showmessage("Instance of "+ClassName+" at "+inttostr(integer(Self)));
end;


 
oxffff ©   (2012-03-12 00:30) [12]

Если нужно конструктор с параметрами, то можно добавить анонимный метод  инициализатор, который дергает нужный конструктор


 
Cobalt ©   (2012-03-12 14:24) [13]

А какова выгода от сего действия?


 
Inovet ©   (2012-03-12 20:47) [14]

> [13] Cobalt ©   (12.03.12 14:24)
> А какова выгода от сего действия?

Для каких-то специфических данных без динамического распределения памяти под их элементы, может и лучше.


 
asdawert   (2012-03-12 23:47) [15]


> oxffff ©   (12.03.12 00:24) [11]

Месье знает толк в извращениях ;)



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

Форум: "Начинающим";
Текущий архив: 2013.03.22;
Скачать: [xml.tar.bz2];

Наверх




Память: 0.48 MB
Время: 0.074 c
15-1347628556
Baks
2012-09-14 17:15
2013.03.22
Подскажите функцию сравнения чисел


3-1284795538
vhm
2010-09-18 11:38
2013.03.22
Подключение к MySQL


15-1337373003
Юрий
2012-05-19 00:30
2013.03.22
С днем рождения ! 19 мая 2012 суббота


15-1332164769
Empleado
2012-03-19 17:46
2013.03.22
Работа с формулами


15-1332516369
Хаус
2012-03-23 19:26
2013.03.22
Архитектура. Как правильно ее построить?





Afrikaans Albanian Arabic Armenian Azerbaijani Basque Belarusian Bulgarian Catalan Chinese (Simplified) Chinese (Traditional) Croatian Czech Danish Dutch English Estonian Filipino Finnish French
Galician Georgian German Greek Haitian Creole Hebrew Hindi Hungarian Icelandic Indonesian Irish Italian Japanese Korean Latvian Lithuanian Macedonian Malay Maltese Norwegian
Persian Polish Portuguese Romanian Russian Serbian Slovak Slovenian Spanish Swahili Swedish Thai Turkish Ukrainian Urdu Vietnamese Welsh Yiddish Bengali Bosnian
Cebuano Esperanto Gujarati Hausa Hmong Igbo Javanese Kannada Khmer Lao Latin Maori Marathi Mongolian Nepali Punjabi Somali Tamil Telugu Yoruba
Zulu
Английский Французский Немецкий Итальянский Португальский Русский Испанский