Mega Code Archive
How to Make a dynamic array at runtime
<![CDATA[
Title: How to Make a dynamic array at runtime
type
TForm1 = class(TForm)
Button1: TButton;
private
procedure _InitRecord(p: Pointer; typeInfo: Pointer);
procedure _InitArray(p: Pointer; typeInfo: Pointer; elemCount: Cardinal);
public
{ Public declarations }
end;
const
tkLString = 10;
tkWString = 11;
tkVariant = 12;
tkArray = 13;
tkRecord = 14;
tkInterface = 15;
tkDynArray = 17;
procedure tform1._InitRecord(p: Pointer; typeInfo: Pointer);
{$IFDEF PUREPASCAL}
var
FT: PFieldTable;
I: Cardinal;
begin
FT := PFieldTable(Integer(typeInfo) + Byte(PTypeInfo(typeInfo).Name[0]));
for I := FT.Count-1 downto 0 do
_InitializeArray(Pointer(Cardinal(P) + FT.Fields[I].Offset), FT.Fields[I].TypeInfo^, 1);
end;
{$ELSE}
asm
{ - EAX pointer to record to be initialized }
{ EDX pointer to type info }
XOR ECX,ECX
PUSH EBX
MOV CL,[EDX+1] { type name length }
PUSH ESI
PUSH EDI
MOV EBX,EAX // PIC safe. See comment above
LEA ESI,[EDX+ECX+2+8] { address of destructable fields }
MOV EDI,[EDX+ECX+2+4] { number of destructable fields }
@@loop:
MOV EDX,[ESI]
MOV EAX,[ESI+4]
ADD EAX,EBX
MOV EDX,[EDX]
MOV ECX,1
CALL _InitArray
ADD ESI,8
DEC EDI
JG @@loop
POP EDI
POP ESI
POP EBX
end;
{$ENDIF}
procedure tform1._InitArray(p: Pointer; typeInfo: Pointer; elemCount: Cardinal);
{$IFDEF PUREPASCAL}
var
FT: PFieldTable;
begin
if elemCount = 0 then Exit;
case PTypeInfo(typeInfo).Kind of
tkLString, tkWString, tkInterface, tkDynArray:
while elemCount 0 do
begin
PInteger(P)^ := 0;
Inc(Integer(P), 4);
Dec(elemCount);
end;
tkVariant:
while elemCount 0 do
begin
PInteger(P)^ := 0;
PInteger(Integer(P)+4)^ := 0;
PInteger(Integer(P)+8)^ := 0;
PInteger(Integer(P)+12)^ := 0;
Inc(Integer(P), sizeof(Variant));
Dec(elemCount);
end;
tkArray:
begin
FT := PFieldTable(Integer(typeInfo) + Byte(PTypeInfo(typeInfo).Name[0]));
while elemCount 0 do
begin
_InitializeArray(P, FT.Fields[0].TypeInfo^, FT.Count);
Inc(Integer(P), FT.Size);
Dec(elemCount);
end;
end;
tkRecord:
begin
FT := PFieldTable(Integer(typeInfo) + Byte(PTypeInfo(typeInfo).Name[0]));
while elemCount 0 do
begin
_InitializeRecord(P, typeInfo);
Inc(Integer(P), FT.Size);
Dec(elemCount);
end;
end;
else
Error(reInvalidPtr);
end;
end;
{$ELSE}
asm
{ - EAX pointer to data to be initialized }
{ EDX pointer to type info describing data }
{ ECX number of elements of that type }
TEST ECX, ECX
JZ @@zerolength
PUSH EBX
PUSH ESI
PUSH EDI
MOV EBX,EAX // PIC safe. See comment above
MOV ESI,EDX
MOV EDI,ECX
XOR EDX,EDX
MOV AL,[ESI]
MOV DL,[ESI+1]
XOR ECX,ECX
CMP AL,tkLString
JE @@LString
CMP AL,tkWString
JE @@WString
CMP AL,tkVariant
JE @@Variant
CMP AL,tkArray
JE @@Array
CMP AL,tkRecord
JE @@Record
CMP AL,tkInterface
JE @@Interface
CMP AL,tkDynArray
JE @@DynArray
MOV AL,reInvalidPtr
POP EDI
POP ESI
POP EBX
JMP @Error
@@LString:
@@WString:
@@Interface:
@@DynArray:
MOV [EBX],ECX
ADD EBX,4
DEC EDI
JG @@LString
JMP @@exit
@@Variant:
MOV [EBX ],ECX
MOV [EBX+ 4],ECX
MOV [EBX+ 8],ECX
MOV [EBX+12],ECX
ADD EBX,16
DEC EDI
JG @@Variant
JMP @@exit
@@Array:
PUSH EBP
MOV EBP,EDX
@@ArrayLoop:
MOV EDX,[ESI+EBP+2+8] // address of destructable fields typeinfo
MOV EAX,EBX
ADD EBX,[ESI+EBP+2] // size in bytes of the array data
MOV ECX,[ESI+EBP+2+4] // number of destructable fields
MOV EDX,[EDX]
CALL _InitArray
DEC EDI
JG @@ArrayLoop
POP EBP
JMP @@exit
@@Record:
PUSH EBP
MOV EBP,EDX
@@RecordLoop:
MOV EAX,EBX
ADD EBX,[ESI+EBP+2]
MOV EDX,ESI
CALL _InitRecord
DEC EDI
JG @@RecordLoop
POP EBP
@@exit:
POP EDI
POP ESI
POP EBX
@@zerolength:
@Error:
end;
{$ENDIF}
]]>