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 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170
|
uses RTLConsts;
{$ALIGN ON}
type
_PMatrix = ^_Matrix;
_Matrix = array[0..0] of integer;
TMatrix = class
private
fYCount, fXCount, fCount : integer;
fMatrix : _PMatrix;
function GetSD(index: integer): integer;
procedure SetSD(index: integer; const value: integer);
function GetDD(X, Y: integer): integer;
procedure SetDD(X, Y: integer; const value: integer);
function GetMm: pointer;
protected
procedure IndexError(const aCurrentIndex, aMaxIndex: integer);
public
constructor Create;
// simple dimension
constructor CreateSD(const aCount: integer); reintroduce; overload;
property Count : integer read fCount;
property ItemsSD[index: integer]: integer read GetSD write SetSD;
// Double dimension
constructor CreateDD(const aXCount, aYCount: integer); reintroduce; overload;
property XCount : integer read fXCount;
property YCount : integer read fYCount;
property ItemsDD[X,Y: integer] : integer read GetDD write SetDD;
procedure Assign(Src: TMatrix);
procedure SDToString(Strings: TStrings);
procedure DDToString(Strings: TStrings);
property Memory : pointer read GetMm;
destructor Destroy; override;
end;
{ TMatrix }
procedure TMatrix.IndexError(const aCurrentIndex, aMaxIndex: integer);
function ReturnAddr: Pointer;
asm
mov eax,[ebp+4]
end;
begin
raise ERangeError.CreateFmt(sArgumentOutOfRange_Index, [aCurrentIndex, aMaxIndex]) at ReturnAddr;
end;
function TMatrix.GetMm: pointer;
begin
result := pointer(fMatrix);
end;
procedure TMatrix.Assign(Src: TMatrix);
begin
FreeMem(fMatrix, fCount shl 2);
fXCount := Src.fXCount;
fYCount := Src.fYCount;
fCount := Src.fCount;
fMatrix := AllocMem(fCount shl 2);
CopyMemory(fMatrix, Src.fMatrix, fCount shl 2);
end;
constructor TMatrix.Create;
begin
inherited;
fXCount := 0;
fYCount := 0;
fCount := 0;
fMatrix := nil;
end;
constructor TMatrix.CreateDD(const aXCount, aYCount: integer);
begin
fXCount := aXCount;
fYCount := aYCount;
fCount := aXCount * aYCount;
fMatrix := AllocMem(fCount shl 2);
ZeroMemory(fMatrix, fCount shl 2);
end;
constructor TMatrix.CreateSD(const aCount: integer);
begin
fXCount := trunc(sqrt(aCount));
fYCount := fXCount;
fCount := aCount;
fMatrix := AllocMem(fCount shl 2);
ZeroMemory(fMatrix, fCount shl 2);
end;
procedure TMatrix.DDToString(Strings: TStrings);
var S : string;
X,Y : integer;
const
coma : array[boolean] of char = (',',')');
begin
Strings.BeginUpdate;
try
Strings.Clear;
for Y := 0 to fYCount-1 do
begin
S := '(';
for X := 0 to fXCount-1 do
S := S + IntToStr(fMatrix[Y*fYCount + X])+coma[X = fXCount-1];
if Y < fYCount-1 then
S := S + ',';
Strings.Add(S);
end;
finally
Strings.EndUpdate;
end;
end;
destructor TMatrix.Destroy;
begin
FreeMem(fMatrix, fCount shl 2);
inherited;
end;
function TMatrix.GetDD(X, Y: integer): integer;
begin
if (X < 0) or (X >= fXCount) then IndexError(X, fXCount);
if (Y < 0) or (Y >= fYcount) then IndexError(Y, fYCount);
result := fMatrix[(Y * fYCount) + X];
end;
function TMatrix.GetSD(index: integer): integer;
begin
if (index < 0) or (index >= fXCount) then IndexError(index, fCount);
result := fMatrix[index];
end;
procedure TMatrix.SDToString(Strings: TStrings);
var S : string;
N : integer;
const
Coma : array[boolean] of Char = (')',',');
begin
Strings.BeginUpdate;
try
Strings.Clear;
S := S + '(';
for N := 0 to fCount-1 do
S := S + IntToStr(fMatrix[N]) + Coma[N < fCount-1];
Strings.Add(S);
finally
Strings.EndUpdate;
end;
end;
procedure TMatrix.SetDD(X, Y: integer; const value: integer);
begin
if (X < 0) or (X >= fXCount) then IndexError(X, fXCount);
if (Y < 0) or (Y >= fYcount) then IndexError(Y, fYCount);
fMatrix[(Y*fYCount) + X] := value;
end;
procedure TMatrix.SetSD(index: integer; const value: integer);
begin
if (index < 0) or (index >= fXCount) then IndexError(index, fCount);
fMatrix[index] := value;
end; |
Partager