Delphi World - это проект, являющийся сборником статей и малодокументированных возможностей  по программированию в среде Delphi. Здесь вы найдёте работы по следующим категориям: delphi, delfi, borland, bds, дельфи, делфи, дэльфи, дэлфи, programming, example, программирование, исходные коды, code, исходники, source, sources, сорцы, сорсы, soft, programs, программы, and, how, delphiworld, базы данных, графика, игры, интернет, сети, компоненты, классы, мультимедиа, ос, железо, программа, интерфейс, рабочий стол, синтаксис, технологии, файловая система...
Массив в Delphi

Раздел 1:

Вот несколько функций для операций с двухмерными массивами. Самый простой путь для создания собственной библиотеки. Процедуры SetV и GetV позволяют читать и сохранять элементы массива VArray (его Вы можете объявить как угодно). Например:


type

  VArray: array[1..1] of double;
var

  X: ^VArray;
  NR, NC: Longint;

begin

  NR := 10000;
  NC := 100;
  if AllocArray(pointer(X), N * Sizeof(VArray)) then
    exit;
  SetV(X^, NC, 2000, 5, 3.27); { X[2000,5] := 3.27 }
end;

function AllocArray(var V: pointer; const N: longint): Boolean;
begin {распределяем память для массива V размера N}

  try
    GetMem(V, N);
  except
    ShowMessage('ОШИБКА выделения памяти. Размер:' + IntToStr(N));
    Result := True;
    exit;
  end;
  FillChar(V^, N, 0); {в случае включения длинных строк заполняем их нулями}
  Result := False;
end;

procedure SetV(var X: Varray; const N, ir, ic: LongInt; const value:
  double);
begin {заполняем элементами двухмерный массив X размером ? x N : X[ir,ic] := value}

  X[N * (ir - 1) + ic] := value;
end;

function GetV(const X: Varray; const N, ir, ic: Longint): double;
begin {возвращаем величины X[ir,ic] для двухмерного массива шириной N столбцов}

  Result := X[N * (ir - 1) + ic];
end;

Раздел 2:

Самый простой путь - создать массив динамически


Myarray := GetMem(rows * cols * sizeof(byte,word,single,double и пр.) 

сделайте функцию fetch_num типа


function fetch_num(r,c:integer) : single; 


result := pointer + row + col*rows 

и затем вместо myarray[2,3] напишите


myarray.fetch_num(2,3);

поместите эти функции в ваш объект и работа с массивами станет пустячным делом. Я экспериментировал с многомерными (вплоть до 8) динамическими сложными массивами и эти функции показали отличный результат.

Раздел 3

Вот способ создания одно- и двухмерных динамических массивов:


(*
--
-- модуль для создания двух очень простых классов обработки динамических массивов
--     TDynaArray   :  одномерный массив
--     TDynaMatrix  :  двумерный динамический массив
--
*)

unit DynArray;

interface

uses

  SysUtils;

type

  TDynArrayBaseType = double;

const

  vMaxElements = (High(Cardinal) - $F) div sizeof(TDynArrayBaseType);
  {= гарантирует максимально возможный массив =}

type

  TDynArrayNDX = 1..vMaxElements;
  TArrayElements = array[TDynArrayNDX] of TDynArrayBaseType;
  {= самый большой массив TDynArrayBaseType, который мы может объявить =}
  PArrayElements = ^TArrayElements;
  {= указатель на массив =}

  EDynArrayRangeError = class(ERangeError);

  TDynArray = class
  private
    fDimension: TDynArrayNDX;
    fMemAllocated: word;
    function GetElement(N: TDynArrayNDX): TDynArrayBaseType;
    procedure SetElement(N: TDynArrayNDX; const NewValue: TDynArrayBaseType);
  protected
    Elements: PArrayElements;
  public
    constructor Create(NumElements: TDynArrayNDX);
    destructor Destroy; override;
    procedure Resize(NewDimension: TDynArrayNDX); virtual;
    property dimension: TDynArrayNDX
      read fDimension;
    property Element[N: TDynArrayNDX]: TDynArrayBaseType
    read GetElement
      write SetElement;
    default;
  end;

const

  vMaxMatrixColumns = 65520 div sizeof(TDynArray);
  {= построение матрицы класса с использованием массива объектов TDynArray =}

type

  TMatrixNDX = 1..vMaxMatrixColumns;
  TMatrixElements = array[TMatrixNDX] of TDynArray;
  {= каждая колонка матрицы будет динамическим массивом =}
  PMatrixElements = ^TMatrixElements;
  {= указатель на массив указателей... =}

  TDynaMatrix = class
  private
    fRows: TDynArrayNDX;
    fColumns: TMatrixNDX;
    fMemAllocated: longint;
    function GetElement(row: TDynArrayNDX;
      column: TMatrixNDX): TDynArrayBaseType;
    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.

Проект Delphi World © Выпуск 2002 - 2004
Автор проекта: ___Nikolay