Mega Code Archive
Dynamic arrays an approach
<![CDATA[
Title: Dynamic arrays an approach
Question: An approach to do dynamic arrays the easy way
enjoy,
Ronald
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] while pivot end;
samDescending:
begin
while Source[lower] pivot do inc(lower);
while pivot Source[upper] do dec(upper);
end;
end;
if lower begin
swap(Source[lower],Source[upper]);
inc(lower);
dec(upper);
end;
Until lower upper;
if left if lower 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 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 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 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;
]]>