Выбрать главу

  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 coclass="underline" = 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, coclass="underline" integer;

BEGIN

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

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

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

 for row:= 1 to M.Rows do BEGIN

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

  writeln;

 END;

 writeln;

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

 for coclass="underline" = 1 to M.Columns do BEGIN

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

  writeln;

 END;

 M.Free;

END.

Базы данных

Создание

Создание db-файла во время работы приложения

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;