Форум программистов [Powered by Invision Power Board]

Код


type arrtype : array[1..1] of integer;
var myarr : ^arrtype; counter : byte;
begin
   counter := counter + 1;
   getmem(myarr, counter * sizeof(integer));
end.

Код


type arrtype : array[1..1] of integer;
var myarr : ^arrtype; counter : byte;
begin
   getmem(myarr + counter * sizeof(integer), sizeof(integer));
   counter := counter + 1;
end.

Код

program zz;

type
  arrtype = array[1..1] of integer;
  Parrtype = ^arrtype;

procedure ResizeArray(var arr: Parrtype; oldSize, newSize: integer); // изменить размер массива
var
  a2: Parrtype; // временный указатель на старую память
  sz: integer; // размер содержимого, которое нужно перенести
begin
   a2 := arr; // запоминаем указатель на старую память
   sz := oldSize;
   if oldSize > newSize then sz := newSize; // если уменьшаем размер, то переносить не всё
   getmem(arr, newSize * sizeof(integer)); // выделяем новый блок памяти
   move(a2^, arr^, sz * sizeof(integer)); // переносим из старого блока
   FreeMem(a2, oldSize); // старый блок освобождаем!!!
end;

var
  myarr,arr2: Parrtype;
  counter: byte;
begin
   counter := 2;
   getmem(myarr, counter * sizeof(integer));
   myarr^[1] := 10;
   myarr^[counter] := 20;
   ResizeArray(myarr, counter, counter+1); // добавили
   counter := counter+1;
   myarr^[counter] := 30;
   WriteLn(myarr^[1]);
   WriteLn(myarr^[counter-1]);
   WriteLn(myarr^[counter]);
   FreeMem(myarr, counter);
   ReadLn;
end.

Код


procedure DynArraySetLength(var a: Pointer; typeInfo: Pointer; dimCnt: Longint; lengthVec: PLongint);
var
  i: Integer;
  newLength, oldLength, minLength: Longint;
  elSize: Longint;
  neededSize: Longint;
  p, pp: Pointer;
begin
  p := a;

  // Fetch the new length of the array in this dimension, and the old length
  newLength := PLongint(lengthVec)^;
  if newLength <= 0 then
  begin
    if newLength < 0 then
      Error(reRangeError);
    DynArrayClear(a, typeInfo);
    exit;
  end;

  oldLength := 0;
  if p <> nil then
  begin
    Dec(PLongint(p));
    oldLength := PLongint(p)^;
    Dec(PLongint(p));
  end;

  // Calculate the needed size of the heap object
  Inc(PChar(typeInfo), Length(PDynArrayTypeInfo(typeInfo).name));
  elSize := PDynArrayTypeInfo(typeInfo).elSize;
  if PDynArrayTypeInfo(typeInfo).elType <> nil then
    typeInfo := PDynArrayTypeInfo(typeInfo).elType^
  else
    typeInfo := nil;
  neededSize := newLength*elSize;
  if neededSize div newLength <> elSize then
    Error(reRangeError);
  Inc(neededSize, Sizeof(Longint)*2);

  // If the heap object isn't shared (ref count = 1), just resize it. Otherwise, we make a copy
  if (p = nil) or (PLongint(p)^ = 1) then
  begin
    pp := p;
    if (newLength < oldLength) and (typeInfo <> nil) then
      FinalizeArray(PChar(p) + Sizeof(Longint)*2 + newLength*elSize, typeInfo, oldLength - newLength);
    ReallocMem(pp, neededSize);
    p := pp;
  end
  else
  begin
    Dec(PLongint(p)^);
    GetMem(p, neededSize);
    minLength := oldLength;
    if minLength > newLength then
      minLength := newLength;
    if typeInfo <> nil then
    begin
      FillChar((PChar(p) + Sizeof(Longint)*2)^, minLength*elSize, 0);
      CopyArray(PChar(p) + Sizeof(Longint)*2, a, typeInfo, minLength)
    end
    else
      Move(PChar(a)^, (PChar(p) + Sizeof(Longint)*2)^, minLength*elSize);
  end;

  // The heap object will now have a ref count of 1 and the new length
  PLongint(p)^ := 1;
  Inc(PLongint(p));
  PLongint(p)^ := newLength;
  Inc(PLongint(p));

  // Set the new memory to all zero bits
  FillChar((PChar(p) + elSize * oldLength)^, elSize * (newLength - oldLength), 0);

  // Take care of the inner dimensions, if any
  if dimCnt > 1 then
  begin
    Inc(lengthVec);
    Dec(dimCnt);
    for i := 0 to newLength-1 do
      DynArraySetLength(PPointerArray(p)[i], typeInfo, dimCnt, lengthVec);
  end;
  a := p;
end;

Код


    a2: array of integer;
    const c1 = 20000;
         c2 = 50000;
begin

     SetLength(a2, c1);
     for i := 0 to Length(a2)-1 do
       a2[i] := i + 1;

     SetLength(a2, c2);

     for i := 0 to c1-1 do
       if a2[i] <> i+1 then
          raise Exception.Create('Алярм');
end;