Форум: "Основная";
Текущий архив: 2004.05.16;
Скачать: [xml.tar.bz2];

Вниз

Динамический массив   Найти похожие ветки 

← →
Татьяна   (2004-04-27 18:37) [0]

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

A: Array of myRecord;

A[n] := nil - не работает (Incopatible types: "Record" and "Pointer")

---

← →
Gero ©   (2004-04-27 18:37) [1]

А зачем?

---

← →
Тимохов ©   (2004-04-27 18:38) [2]

> Татьяна   (27.04.04 18:37)  

Раядом есть ветка "Класс и дин. массив".
Посмотрите ответ Юрия Зотова.

---

← →
Татьяна   (2004-04-27 18:38) [3]

В каком плане "зачем"? Надо удалить.

---

← →
MBo ©   (2004-04-27 18:41) [4]

сдвинуть следующие элементы вниз в цикле или c помощью Move

---

← →
Татьяна   (2004-04-27 18:42) [5]

Супер! Спасибо.

---

← →
Гаврила ©   (2004-04-27 18:42) [6]

Используйте TList, храните в нем PmyRecord

---

← →
PVOzerski ©   (2004-04-27 19:30) [7]

>сдвинуть следующие элементы вниз в цикле или c помощью Move
А потом еще Setlength

---

← →
Тимохов ©   (2004-04-27 19:34) [8]

> >сдвинуть следующие элементы вниз в цикле или c помощью
> Move
> А потом еще Setlength

а перед тем, как решится на пользование move убедится, что в записи нет длинных строк и других динамических массивов.

---

← →
Jack128 ©   (2004-04-27 19:43) [9]

Идея с Move оформленная как класс

unit uArrays;

interface

uses
 SysUtils;

type

 EArrayError = class(Exception);

 // Внимание: нельзя использовать наследников TBaseArray для хранения массивов
 // типов string, dynamic arrays, Variant, других ссылочных типов и записей,
 // содержащих эти типы !!!

 TArraySortProc = function (const Item1, Item2): integer;

 TBaseArray = class(TObject)
 private
   FData: PChar;
   FElementSize: integer;
   FCapacity: integer;
   FCount: integer;
   procedure SetCapacity(const Value: integer);
   procedure SetCount(const Value: integer);
   procedure QuickSort(L, R: Integer; SCompare: TArraySortProc);
 protected
   function GetPItem(Index: Integer): Pointer;
   procedure CheckRange(Index: integer);
   procedure Grow; virtual;
   property Data: PChar read FData;
   procedure SetItem(Index: integer; const Value);
   procedure GetItem(Index: integer; var Value);
   procedure Add(const Value);
 public
   constructor Create(AElementSize: Cardinal);
   destructor Destroy; override;
   property Count: integer read FCount write SetCount;
   property Capacity: integer read FCapacity write SetCapacity;
   property ElementSize: Integer read FElementSize;

   procedure Insert(Index: Integer; const NewItem);
   procedure Assign(Source: TBaseArray); virtual;
   procedure Delete(index: integer);
   procedure Pack;
   procedure Sort(ASortProc: TArraySortProc);
 end;

 TIntegerArray = class(TBaseArray)
 private
   function GetIntItem(index: integer): Integer;
   procedure SetIntItem(index: integer; Value: integer);
 public
   constructor Create();
   property Items[index: integer]: integer read GetIntItem write SetIntItem; default;
   procedure Insert(Index: Integer; NewItem: Integer);
   procedure Add(Value: integer);
 end;

 TDoubleArray = class(TBaseArray)
 private
   function GetDoubleItem(index: integer): Double;
   procedure SetDoubleItem(index: integer; Value: Double);
 public
   constructor Create();
   property Items[index: integer]: Double read GetDoubleItem write SetDoubleItem; default;
   procedure Add(Value: Double);
   procedure Insert(Index: Integer; NewItem: Double);
 end;

implementation

const
 SArrayIndexError = "Array index out of bounds (%d)";

{ TBaseArray }

procedure TBaseArray.Add(const Value);
begin
 if Capacity = Count then Grow;
 Move(Value, FData[Count * ElementSize], ElementSize);
 inc(FCount);
end;

procedure TBaseArray.Assign(Source: TBaseArray);
begin
 if Source.ElementSize <> ElementSize then
   raise EArrayError.Create("Не могу присвоить массивы с разными размерами элементов");
 Count := Source.Count;
 Move(Source.FData^, FData^, Count * ElementSize);  
end;

procedure TBaseArray.CheckRange(Index: integer);
begin
 if (Index < 0) or (Index >= Count) then
   EArrayError.CreateFmt(SArrayIndexError, [Index]);
end;

constructor TBaseArray.Create(AElementSize: Cardinal);
begin
 inherited Create;
 FElementSize := AElementSize;
 FData := nil;
 FCount := 0;
 FCapacity := 0;
end;

procedure TBaseArray.Delete(index: integer);
begin
 CheckRange(Index);
 if Index <> (Count - 1) then
   Move(GetPItem(index + 1)^, GetPItem(index)^, (Count - 1 - Index) * FElementSize);
 dec(FCount);
end;

destructor TBaseArray.Destroy;
begin
 if Assigned(FData) then FreeMem(FData);
 inherited;
end;

procedure TBaseArray.GetItem(Index: integer; var Value);
begin
 CheckRange(Index);
 Move(GetPItem(Index)^, Value, FElementSize);
end;

procedure TBaseArray.Grow;
var
 Delta: Integer;
begin
 if FCapacity > 64 then
   Delta := FCapacity div 4
 else
   if FCapacity > 8 then
     Delta := 16
   else
     Delta := 4;
 SetCapacity(FCapacity + Delta);
end;

procedure TBaseArray.Pack;
begin
 Capacity := Count;
end;

procedure TBaseArray.SetCapacity(const Value: integer);
begin
 if FCapacity = Value then Exit;
 if Value < Count then Count := Value;
 ReallocMem(FData, Value * FElementSize);
 FCapacity := Value;
end;

procedure TBaseArray.SetCount(const Value: integer);
begin
 if Value > Capacity then  
 begin  
   Capacity := Value;
   FillChar(PChar(FData + FCount * FElementSize)^,
      (Value - FCount) * FElementSize, #0);
 end;
 FCount := Value;  
end;

procedure TBaseArray.SetItem(Index: integer; const Value);
begin
 CheckRange(Index);
 Move(Value, GetPItem(Index)^, FElementSize);
end;

procedure TBaseArray.QuickSort(L, R: Integer; SCompare: TArraySortProc);
var
 I, J: Integer;
 P, T: Pointer;
begin
 GetMem(T, ElementSize);
 try
   repeat
     I := L;
     J := R;
     P := GetPItem((L + R) shr 1);
     repeat
       while SCompare(GetPItem(I)^, P^) < 0 do
         Inc(I);
       while SCompare(GetPItem(J)^, P^) > 0 do
         Dec(J);
       if I <= J then
       begin
         GetItem(I, T^);
         Move(GetPItem(J)^, GetPItem(I)^, ElementSize); // Item[I] := Item[J];
         SetItem(J, T^);
         Inc(I);
         Dec(J);
       end;
     until I > J;
     if L < J then
       QuickSort(L, J, SCompare);
     L := I;
   until I >= R;
 finally
   FreeMem(T);
 end;
end;

procedure TBaseArray.Sort(ASortProc: TArraySortProc);
begin
 if Count > 1 then
   QuickSort(0, Count - 1, ASortProc);
end;

function TBaseArray.GetPItem(Index: Integer): Pointer;
begin
 Result := @FData[Index * ElementSize];
end;

procedure TBaseArray.Insert(Index: Integer; const NewItem);
begin
 if Index = Count then
   Add(NewItem)
 else
 begin
   CheckRange(Index);
   if Count = Capacity then Grow;
   Move(GetPItem(Index)^, GetPItem(Index + 1)^, ElementSize * (Count - Index));
   SetItem(Index, NewItem);
   inc(FCount);
 end;
end;

{ TIntegerArray }

procedure TIntegerArray.Add(Value: integer);
begin
 inherited Add(Value);
end;

constructor TIntegerArray.Create;
begin
 inherited Create(SizeOf(Integer));
end;

function TIntegerArray.GetIntItem(index: integer): Integer;
begin
 GetItem(index, Result);
end;

procedure TIntegerArray.Insert(Index, NewItem: Integer);
begin
 inherited Insert(Index, NewItem);
end;

procedure TIntegerArray.SetIntItem(index, Value: integer);
begin
 SetItem(index, Value);
end;

{ TDoubleArray }

procedure TDoubleArray.Add(Value: Double);
begin
 inherited Add(Value);
end;

constructor TDoubleArray.Create;
begin
 inherited Create(SizeOf(Double));
end;

function TDoubleArray.GetDoubleItem(index: integer): Double;
begin
 GetItem(Index, Result);
end;

procedure TDoubleArray.Insert(Index: Integer; NewItem: Double);
begin
 inherited Insert(Index, NewItem);
end;

procedure TDoubleArray.SetDoubleItem(index: integer; Value: Double);
begin
 SetItem(Index, Value);
end;

end.

---

Страницы: 1 вся ветка

Форум: "Основная";
Текущий архив: 2004.05.16;
Скачать: [xml.tar.bz2];

Наверх

Память: 0.5 MB
Время: 0.039 c