Четверг, 19.06.2025, 18:26
Приветствую Вас Гость | RSS
Меню сайта
fff
  • Индексация
  • Девочки
    Форма входа
    Категории раздела
    Теория алгоритмов [3]
    Теория алгоритмов
    Code Snippets [1]
    Code Snippets
    Все о PHP [20]
    Все о PHP
    Visual C++ [13]
    Visual C++
    WIN32 API [7]
    WIN32 API
    Delphi [72]
    Delphi
    ASP [2]
    ASP
    Java [67]
    Java
    VBScript [6]
    VBScript
    CGI [2]
    CGI
    VRML [2]
    VRML
    PERL [9]
    PERL
    HTML [4]
    HTML
    XML [10]
    XML
    Архив записей

    Статьи по Оптимизации

    ПРОГРАММИРОВАНИЕ! СОЗДАНИЕ САЙТОВ И ИХ ОПТИМИЗАЦИЯ

    Главная » Статьи » Программирование » Delphi

    Массив в Delphi
    Массив в Delphi
    Вот несколько функций для операций с двухмерными массивами. Самый простой путь для создания собственной библиотеки. Процедуры 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;

    Самый простой путь - создать массив динамически
    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)

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

    модуль для создания двух очень простых классов обработки динамических массивов
    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 | Добавил: Merlin (07.12.2009)
    Просмотров: 1517 | Комментарии: 2 | Рейтинг: 0.0/0
    Всего комментариев: 0
    Имя *:
    Email *:
    Код *: