Главная страница
    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.49 MB
Время: 0.058 c
15-1342612759
Кто б сомневался
2012-07-18 15:59
2013.03.22
Дженерики - примеры где с ними было бы лучше


15-1350926092
Дмитрий С
2012-10-22 21:14
2013.03.22
Электрический натягиватель троссика?


3-1284731391
Сергей М.
2010-09-17 17:49
2013.03.22
Провайдер VFPOLEDB.1 и запрет возврата удаленных запис


2-1340107316
sas9568635
2012-06-19 16:01
2013.03.22
Написать процедуру задержки в эмуляторе процессора КР580


15-1329926834
Unknown user
2012-02-22 20:07
2013.03.22
Balloon hint





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
Английский Французский Немецкий Итальянский Португальский Русский Испанский