Parcourir un tableau dynamique

Fonction récursive pour parcourir les tableaux dynamiques en procédural, c’est dommage la fonction typeinfo ne gère pas les variables on doit entrer manuellement le type de variables
Fonction

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
type
    TArrayCallback = procedure (P:Pointer;ACount:integer)of object;
 
procedure Array_Walk(Source:Pointer;Dim:integer;Callb:TArrayCallback);
    procedure _Walk(Source:Pointer;Level:integer);
    var
     i,Len:integer;
    begin
       if not Assigned(Source) then Exit;
       Len:= Pinteger(Integer(Source)-4)^;
       if Level > 1 then
       begin
         for i := 0 to Len-1 do
           _Walk(PPointerArray(Source)[i],Level-1);
       end
        else
          Callb(Source,Len);
    end;
begin
   if Assigned(Source)and Assigned(Callb) then
   begin
      _Walk(Source,Dim);
   end;
end;

Exemple

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
procedure TForm1.ShowArray(P:Pointer;ACount:integer);
begin
  while ACount > 0 do
  begin  {P = Array of Word}
     Showmessagefmt('%d',[PWord(P)^]) ;
     Inc(PWord(P));
     dec(ACount);
  end;
end;
 
procedure TForm1.Button1Click(Sender: TObject);
Type T3DType= array of array of array of Word;
var
 Sp         :T3DType;
 x,y,z      :integer;
 ix,iy,iz   :integer;
 Dimension,i:integer;
begin
   i:=0;
   x:=2;
   y:=2;
   z:=2;
   SetLength(Sp,x,y,z);
   for ix := 0 to x-1 do
     for iy := 0 to y-1 do
       for iz := 0 to z-1 do
       begin
            Sp[ix,iy,iz]:=i;
            inc(i);
       end;
   { Dimension = 3}
   Dimension:=DynArrayDim(TypeInfo(T3DType));
   Array_Walk(Sp,Dimension,ShowArray);
end;