Top.Mail.Ru
Мастера DELPHI, Delphi programming community Титульная страница Поиск, карта сайта Написать письмо 
| Новости | Поиск | FAQ | Статьи | Книги | Новости VCL |
| Форумы ЧАТ | Орешник | KOL и MCK |
Форумы -» Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG

« предыдущая ветвь | форум | следующая ветвь »

Создание динамических массивов [D6, Win95/98, WinME, NT4, Win2k, WinXP]


Ученик ©   (2002-09-19 09:20:00) 

function CreateDynArray(Elements : array of const) : Pointer;
Может у кого-нибудь есть готовая реализация ?


Ученик   (2002-09-19 11:48:00) [1]

>qube © (19.09.02 11:32)
Ученик © (19.09.02 10:25)


qube   (2002-09-19 11:32:00) [2]

procedure DynArrayFromVariant(var DynArray: Pointer; const V: Variant; TypeInfo: Pointer);

Description

Call DynArrayFromVariant to copy the contents of a variant (V) to an existing dynamic array variable (DynArray).

DynArray is a dynamic array variable whose value is assigned from the Variant.

V is the Variant to copy. Its value must be an array.

TypeInfo points to the runtime type information that identifies the type of array elements. You can obtain this pointer using the TypeInfo function.


Ученик   (2002-09-19 11:28:00) [3]

Забавно,

procedure TForm1.Button1Click(Sender: TObject);
var
A : TIntegerArray;
begin
A := CreateDynArray([1, 2, 3, 4]);

В A значение не попадает, но адрес A передается в ECX


Separator   (2002-09-19 10:51:00) [4]

Я наверное не доконца понял, что нужно сделать


Ученик   (2002-09-19 10:45:00) [5]

Задача всплывает в том или ином виде на форуме постоянно, наверно, было бы полезно многим


Separator   (2002-09-19 10:28:00) [6]

Готовое врядли у кого-нибудь найдется, попробуй сам написать, это будет намного проще, так как сделаешь именно то, что тебе нужно


Ученик   (2002-09-19 10:25:00) [7]

>Alx2 © (19.09.02 10:15)
Развивая-DynArrayFromVariant, но тоже не то, надеялся, что у кого-нибудь есть готовое.


Separator   (2002-09-19 10:17:00) [8]

> немного не правильно :))


Alx2   (2002-09-19 10:15:00) [9]

>Ученик © (19.09.02 10:05)
В стремлении к универсальности? :)

Совсем не то, правда, но где-то рядом :):
function VarArrayOf(const Values: array of Variant): Variant;


Ученик   (2002-09-19 10:05:00) [10]

>Separator © (19.09.02 10:00)
?????


Separator   (2002-09-19 10:00:00) [11]

А не легче тщгда сделать так:

procedure TForm1.Button1Click(Sender: TObject);
var
A : TIntegerArray;
F : TFontArray;
begin
SetLength(A, 4);
A:= [1,2,3,4];
end;


Ученик   (2002-09-19 09:55:00) [12]

>Separator © (19.09.02 09:46)
Спасибо, но имелось ввиду немного другое (когда ж я научусь вопросы задавать)

type
TIntegerArray = array of Integer;
TFontArray = array of TFont;

procedure TForm1.Button1Click(Sender: TObject);
var
A : TIntegerArray;
F : TFontArray;
begin
A := CreateDynArray([1, 2, 3, 4]);
F := CreateDynArray([Font1, Font2, Font3, Font4]);
end;


Separator   (2002-09-19 09:46:00) [13]

var
DynArray: array of array of const;
ArraysCreate: array of boolean;
ArraysCount: word = 0;

function CreateDynArray: integer;
var
Res: integer;

procedure AddArrayEnd;
begin
Inc(ArraysCount);
SetLength(DynArray, ArraysCount);
SetLength(DynArray[ArraysCount-1], 1);
SetLength(ArraysCreate, ArraysCount);
ArraysCreate(ArraysCount-1):= true;
Res:= ArraysCount-1
end;

procedure AddArrayNotEnd(N: word);
begin
SetLength(DynArray[N], 1);
ArraysCreate(N):= true;
Res:= N
end;

begin
Result:= -1;
if ArraysCount<>0 then
begin
for i:= 0 to ArraysCount-1 do
if not ArraysCreate[i] then
begin
AddArrayNotEnd(i);
break
end;
if Res=-1 then
AddArrayEnd
end
else
AddArrayEnd;
Result:= Res
end;

procedure DynArrayDestroy(N: word)
var
i: integer;
begin
if N<ArraysCount then
begin
SetLength(DynArray[N], 0);
ArraysCreate(N):= false
for i:= ArraysCount-1 downto 0 do
if not ArraysCreate(i) then
begin
Dec(ArraysCount);
SetLength(DynArray, ArraysCount);
SetLength(ArraysCreate, ArraysCount)
end
else
break
end
end;

В общем попробуй так, правда я тока счас написал, но вроде работает :)


Наверх

Титульная страница Поиск, карта сайта Написать письмо