Валентин Озеров - Советы по Delphi. Версия 1.0.6

Procedure SetElement(row: TDynArrayNDX; column: TMatrixNDX; const NewValue: TDynArrayBaseType);

Protected

mtxElements: PMatrixElements;

Public

Constructor Create(NumRows : TDynArrayNDX; NumColumns : TMatrixNDX);

Destructor Destroy; override;

Property rows: TDynArrayNDX read fRows;

Property columns: TMatrixNDX read fColumns;

Property Element[row : TDynArrayNDX; column : TMatrixNDX] : TDynArrayBaseType read GetElement write SetElement; default;

END;

IMPLEMENTATION

(*

--

-- методы TDynArray

--

*)

Constructor TDynArray.Create(NumElements : TDynArrayNDX);

BEGIN {==TDynArray.Create==}

inherited Create;

fDimension:= NumElements;

GetMem(Elements, fDimension*sizeof(TDynArrayBaseType));

fMemAllocated:= fDimension*sizeof(TDynArrayBaseType);

FillChar(Elements^, fMemAllocated, 0);

END; {==TDynArray.Create==}

Destructor TDynArray.Destroy;

BEGIN {==TDynArray.Destroy==}

FreeMem(Elements, fMemAllocated);

inherited Destroy;

END; {==TDynArray.Destroy==}

Procedure TDynArray.Resize(NewDimension: TDynArrayNDX);

BEGIN {TDynArray.Resize==}

if (NewDimension < 1) then raise EDynArrayRangeError.CreateFMT('Индекс вышел за границы диапазона : %d', [NewDimension]);

Elements:= ReAllocMem(Elements, fMemAllocated, NewDimension*sizeof(TDynArrayBaseType));

fDimension:= NewDimension;

fMemAllocated:= fDimension*sizeof(TDynArrayBaseType);

END; {TDynArray.Resize==}

Function TDynArray.GetElement(N: TDynArrayNDX) : TDynArrayBaseType;

BEGIN {==TDynArray.GetElement==}

if (N < 1) OR (N > fDimension) then raise EDynArrayRangeError.CreateFMT('Индекс вышел за границы диапазона : %d', [N]);

result:= Elements^[N];

END; {==TDynArray.GetElement==}

Procedure TDynArray.SetElement(N: TDynArrayNDX; const NewValue: TDynArrayBaseType);

BEGIN {==TDynArray.SetElement==}

if (N < 1) OR (N > fDimension) then raise EDynArrayRangeError.CreateFMT('Индекс вышел за границы диапазона : %d', [N]);

Elements^[N]:= NewValue;

END; {==TDynArray.SetElement==}

(*

--

-- методы TDynaMatrix

--

*)

Constructor TDynaMatrix.Create(NumRows: TDynArrayNDX; NumColumns: TMatrixNDX);

Var col : TMatrixNDX;

BEGIN {==TDynaMatrix.Create==}

inherited Create;

fRows:= NumRows;

fColumns:= NumColumns;

{= выделение памяти для массива указателей (т.е. для массива TDynArrays) =}

GetMem(mtxElements, fColumns*sizeof(TDynArray));

fMemAllocated:= fColumns*sizeof(TDynArray);

{= теперь выделяем память для каждого столбца матрицы =}

for col := 1 to fColumns do BEGIN

mtxElements^[col]:= TDynArray.Create(fRows);

inc(fMemAllocated, mtxElements^[col].fMemAllocated);

END;

END; {==TDynaMatrix.Create==}

Destructor TDynaMatrix.Destroy;

Var col : TMatrixNDX;

BEGIN {==TDynaMatrix.Destroy;==}

for col:= fColumns downto 1 do BEGIN

dec(fMemAllocated, mtxElements^[col].fMemAllocated);

mtxElements^[col].Free;

END;

FreeMem(mtxElements, fMemAllocated);

inherited Destroy;

END; {==TDynaMatrix.Destroy;==}

Function TDynaMatrix.GetElement(row: TDynArrayNDX; column: TMatrixNDX): TDynArrayBaseType;

BEGIN {==TDynaMatrix.GetElement==}

if (row < 1) OR (row > fRows) then raise EDynArrayRangeError.CreateFMT('Индекс строки вышел за границы диапазона : %d', [row]);

if (column < 1) OR (column > fColumns) then raise EDynArrayRangeError.CreateFMT('Индекс столбца вышел за границы диапазона : %d', [column]);

result:= mtxElements^[column].Elements^[row];

END; {==TDynaMatrix.GetElement==}

Procedure TDynaMatrix.SetElement(row: TDynArrayNDX; column: TMatrixNDX; const NewValue: TDynArrayBaseType);

BEGIN {==TDynaMatrix.SetElement==}

if (row < 1) OR (row > fRows) then raise EDynArrayRangeError.CreateFMT('Индекс строки вышел за границы диапазона : %d', [row]);

if (column < 1) OR (column > fColumns) then raise EDynArrayRangeError.CreateFMT('Индекс столбца вышел за границы диапазона : %d', [column]);

mtxElements^[column].Elements^[row]:= NewValue;

END; {==TDynaMatrix.SetElement==}

END.

-Тестовая программа для модуля DynArray-

uses DynArray, WinCRT;

Const

NumRows: integer = 7;

NumCols: integer = 5;

Var

M: TDynaMatrix;

row, col: integer;

BEGIN

M:= TDynaMatrix.Create(NumRows, NumCols);

for row:= 1 to M.Rows do for col:= 1 to M.Columns do M[row, col]:= row + col/10;

writeln('Матрица');

for row:= 1 to M.Rows do BEGIN

for col:= 1 to M.Columns do write(M[row, col]:5:1);

writeln;

END;

writeln;

writeln('Перемещение');

for col:= 1 to M.Columns do BEGIN

for row:= 1 to M.Rows do write(M[row, col]:5:1);

writeln;

END;

M.Free;

END.

uses DB, DBTables, StdCtrls;

procedure TForm1.Button1Click(Sender: TObject);

var

tSource, TDest: TTable;

begin

TSource:= TTable.create(self);

with tsTSource do begin

DatabaseName:= 'dbdemos';

TableName:= 'customer.db';

open;

end;

TDest:= TTable.create(self);

with TDest do begin

DatabaseName:= 'dbdemos';

TableName:= 'MyNewTbl.db';

FieldDefs.Assign(TSource.FieldDefs);

IndexDefs.Assign(TSource.IndexDefs);

CreateTable;

end;

TSource.close;

end;