Dynamic arrays an approach

Problem/Question/Abstract:

An approach to do dynamic arrays the easy way

Answer:

type
  TDISIntArray = array of integer;

  TDISFindArrayMode = (famNone, famFirst, famNext, famPrior, famLast);
  TDISSortArrayMode = (samAscending, samDescending);

  EDISArray = class(Exception);

  TDISIntegerArray = class(TObject)
  private
    fLastFindMode: TDISFindArrayMode;
    fComma: Char;
    fArray: TDISIntArray;
    fItemCount: Integer;
    fFindIndex: Integer;
    fDuplicates: Boolean;
    function GetArray(Index: integer): integer;
    procedure SetArray(Index: integer; Value: integer);
    procedure SetDuplicates(Value: Boolean);

    procedure Swap(var a, b: integer);
    procedure QuickSort(Source: TDISIntArray; Mode: TDISSortArrayMode; left, right:
      integer);

    procedure Copy(Source: TDISIntArray; var Dest: TDISIntArray);
  protected
  public
    constructor Create;
    destructor Destroy; override;

    procedure Clear;
    function Add(Value: integer): boolean;
    procedure Delete(Index: integer);
    function Find(Value: integer; Mode: TDISFindArrayMode): integer;

    function Min: integer;
    function Max: integer;
    function Sum: integer;
    function Average: integer;

    function Contains(Value: integer): Boolean;
    function Commatext: string;

    procedure Sort(Mode: TDISSortArrayMode);

    procedure SaveToFile(FileName: string);
    function LoadFromFile(FileName: string): boolean;

    property AddDuplicates: Boolean read fDuplicates write SetDuplicates;
    property Items[Index: integer]: integer read GetArray write SetArray;
    property Count: Integer read fItemCount;

    property CommaSeparator: Char read fComma write fComma;
  end;

implementation

function ReplaceChars(value: string; v1, v2: char): string;
var
  ts: string;
  i: integer;
begin
  ts := value;
  for i := 1 to length(ts) do
    if ts[i] = v1 then
      ts[i] := v2;
  result := ts;
end;

////////////////////////////////////////////////
// TDISIntegerArray
////////////////////////////////////////////////

constructor TDISIntegerArray.Create;
begin
  fItemCount := 0;
  fDuplicates := True;
  fLastFindMode := famNone;
  fComma := ',';
end;

destructor TDISIntegerArray.Destroy;
begin
  inherited Destroy;
end;

function TDISIntegerArray.Min: integer;
var
  TA: TDISIntArray;
begin
  Copy(fArray, Ta);
  QuickSort(Ta, samAscending, low(fArray), high(fArray));
  Result := Ta[0];
end;

function TDISIntegerArray.Max: integer;
var
  TA: TDISIntArray;
begin
  Copy(fArray, Ta);
  QuickSort(Ta, samDescending, low(fArray), high(fArray));
  Result := Ta[0];
end;

function TDISIntegerArray.Sum: integer;
var
  i: integer;
begin
  Result := 0;
  for i := low(fArray) to high(fArray) do
    Result := Result + fArray[i];
end;

function TDISIntegerArray.Average: integer;
begin
  Result := Sum div fItemCount;
end;

procedure TDISIntegerArray.SaveToFile(FileName: string);
var
  Tl: TStringList;
begin
  Tl := TStringList.Create;
  Tl.Text := CommaText;
  Tl.SaveToFile(FileName);
  Tl.Free;
end;

function TDISIntegerArray.LoadFromFile(FileName: string): boolean;
var
  Tl: TStringList;
  Ts: string;
  j: integer;
begin
  Result := False;
  if FileExists(FileName) then
  begin
    Result := True;

    Tl := TStringList.Create;
    Tl.LoadFromFile(FileName);

    Ts := ReplaceChars(Trim(Tl.Text), ';', ',');
    Ts := ReplaceChars(Ts, '|', ',');
    Ts := ReplaceChars(Ts, #9, ',');

    Clear;
    while pos(',', Ts) > 0 do
    begin
      j := StrToIntDef(System.copy(Ts, 1, pos(',', Ts) - 1), 0);
      Add(j);
      System.Delete(Ts, 1, pos(',', Ts));
    end;
    Add(StrToIntDef(Ts, 0));

    Tl.Free;
  end;
end;

procedure TDISIntegerArray.Swap(var a, b: integer);
var
  t: integer;
begin
  t := a;
  a := b;
  b := t;
end;

procedure TDISIntegerArray.QuickSort(Source: TDISIntArray; Mode: TDISSortArrayMode;
  left, right: integer);
var
  pivot: integer;
  lower,
    upper,
    middle: integer;
begin
  lower := left;
  upper := right;
  middle := (left + right) div 2;
  pivot := Source[middle];
  repeat
    case Mode of
      samAscending:
        begin
          while Source[lower] < pivot do
            inc(lower);
          while pivot < Source[upper] do
            dec(upper);
        end;
      samDescending:
        begin
          while Source[lower] > pivot do
            inc(lower);
          while pivot > Source[upper] do
            dec(upper);
        end;
    end;

    if lower <= upper then
    begin
      swap(Source[lower], Source[upper]);
      inc(lower);
      dec(upper);
    end;
  until lower > upper;

  if left < upper then
    QuickSort(Source, Mode, left, upper);
  if lower < right then
    QuickSort(Source, Mode, lower, right);
end;

procedure TDISIntegerArray.Clear;
var
  i: integer;
begin
  for i := low(fArray) to high(fArray) do
    fArray[i] := 0;

  SetLength(fArray, 0);
  fItemCount := 0;
end;

function TDISIntegerArray.Commatext: string;
var
  i: integer;
begin
  Result := '';
  for i := low(fArray) to high(fArray) do
  begin
    Result := Result + IntToStr(fArray[i]);
    Result := Result + fComma;
  end;
  if Length(Result) > 0 then
    System.Delete(Result, length(Result), 1);
end;

procedure TDISIntegerArray.Sort(Mode: TDISSortArrayMode);
begin
  QuickSort(fArray, Mode, low(fArray), high(fArray));
end;

procedure TDISIntegerArray.SetDuplicates(Value: Boolean);
begin
  fDuplicates := Value;
end;

function TDISIntegerArray.Add(Value: integer): boolean;
begin
  Result := True;

if contains(Value) and (fDuplicates = False) then
  begin
    Result := False;
    exit;
  end;

inc(fItemCount);
SetLength(fArray, fItemCount);
fArray[fItemCount - 1] := Value;
end;

function TDISIntegerArray.Contains(Value: integer): Boolean;
var
  i: integer;
begin
  Result := False;
  for i := low(fArray) to high(fArray) do
  begin
    if fArray[i] = Value then
    begin
      Result := True;
      Break;
    end;
  end;
end;

function TDISIntegerArray.Find(Value: integer; Mode: TDISFindArrayMode): integer;
var
  i: integer;
begin
  Result := -1;

  case Mode of
    famNone, famFirst:
      begin
        fLastFindMode := Mode;
        fFindIndex := -1;
        for i := low(fArray) to high(fArray) do
        begin
          if fArray[i] = Value then
          begin
            if Mode = famFirst then
              fFindIndex := i + 1;
            Result := i;
            Break;
          end;
        end;
      end;
    famNext:
      begin

        if fLastFindMode = famPrior then
          inc(fFindIndex, 2);

        fLastFindMode := Mode;

        for i := fFindIndex to high(fArray) do
        begin
          if fArray[i] = Value then
          begin
            fFindIndex := i + 1;
            Result := i;
            Break;
          end;
        end;
      end;
    famPrior:
      begin

        if fLastFindMode = famNext then
          dec(fFindIndex, 2);

        fLastFindMode := Mode;

        for i := fFindIndex downto low(fArray) do
        begin
          if fArray[i] = Value then
          begin

            fFindIndex := i - 1;
            Result := i;
            Break;
          end;
        end;
      end;
    famLast:
      begin
        fFindIndex := -1;
        fLastFindMode := Mode;
        for i := high(fArray) downto low(fArray) do
        begin
          if fArray[i] = Value then
          begin

            fFindIndex := i - 1;
            Result := i;
            Break;
          end;
        end;
      end;
  end;
end;

procedure TDISIntegerArray.Copy(Source: TDISIntArray; var Dest: TDISIntArray);
var
  i: integer;
begin
  SetLength(Dest, 0);
  SetLength(Dest, Length(Source));

  for i := low(Source) to high(Source) do
    Dest[i] := Source[i];

end;

procedure TDISIntegerArray.Delete(Index: integer);
var
  TA: TDISIntArray;
  i: integer;
begin
  if (Index >= Low(fArray)) and (Index <= high(fArray)) then
  begin
    Copy(fArray, Ta);
    Clear;
    for i := low(Ta) to high(Ta) do
    begin
      if i <> Index then
        Add(Ta[i]);
    end;
    dec(fItemCount);
  end;
end;

function TDISIntegerArray.GetArray(Index: integer): integer;
begin
  if (Index >= Low(fArray)) and (Index <= high(fArray)) then
    Result := fArray[index]
  else
    raise EDISArray.Create(format('Index : %d is not valid index %d..%d.', [Index,
      low(fArray), high(fArray)]));
end;

procedure TDISIntegerArray.SetArray(Index: integer; Value: integer);
begin

if contains(Value) and (fDuplicates = False) then
  exit;

if Index < 0 then
  raise EDISArray.Create(format('Index : %d is not valid index.', [Index]))
else
begin
  if Index + 1 > fItemCount then
  begin
    fItemCount := Index + 1;
    SetLength(fArray, fItemCount);
    fArray[fItemCount - 1] := Value;
  end
  else
    fArray[Index] := Value;
end;
end;