Переделать программу с двумерным статическим массивом ...., Ни как не пойму, как переделать... Опции

[Petrow]

Ни как не пойму, как переделать программу с двумерным статическим массивом в двумерный динамический массив..., но ещё нужно сделать так, чтобы сохранять таблицу в файл.

И ещё одно требование : Данные хранятся в виде динамической таблицы, организованной с помощью столбца указателей на строки(или строки указателей на столбцы - в зависимости от алгоритма). Описаны типы "указателей на таблицу" и "указатель на строку(столбец) таблицы"

И условие таково Среди чисел заданной строки таблицы найти такое, которое принадлежит наибольшему кол - ву столбцов таблицы.

program lr2;

uses
    crt;

const
    Pro = '    ';
    Pro1 = ' ';
    mmax = 50;
    nmax = 50;

type
    Telem = single;
    Tmas = array[1..mmax, 1..nmax] of Telem;
    Tmas1 = array[1..nmax] of TElem;
    TError = boolean;

procedure sravnenie(var a: Tmas; m, n: integer; var B: Tmas1; var nom: integer);
var
    i, j: integer;
    maxsum, sum: Telem;
begin
    nom := 0;
    maxsum := -1.0e20;
    for j := 1 to n do begin
        sum := 0;
        for i := 1 to m do
            sum := sum + a[i, j];
        if sum > maxsum then begin
            maxsum := sum;
            nom := j
        end;
    end;

    for j := 1 to n do begin
        B[j] := 0;
        for i := 1 to m do
            B[j] := B[j] + a[i, j] * a[i, nom]
    end
end;

procedure AskUser(var m,n:integer);
begin
    repeat
        write('‚ўҐ¤Ґ¬ Є®«ЁзҐбвў® бва®Є: '); readln(m);
        write('‚ўҐ¤Ґ¬ Є®«ЁзҐбвў® бв®«Ўж®ў: '); readln(n)
    until (m < mmax) and (n < nmax) and (m > 0) and (n > 0);
end;

{ Hitro berem massiw iz faila }
function ReadArray(var d: text; var a: Tmas; var m, n: integer): TError;
var
    i, j: integer;
begin
    ReadArray := false;
    {$I-}
    readln(d, m, n);
    {$I+}
    if IOResult <> 0 then begin
        writeln('ЌҐЇа ўЁ«м­л© д®а¬ в д ©« ');
        exit
    end;
    if (m in [1..mmax]) and (n in [1..nmax]) then begin
        {$I-}
        for i := 1 to m do begin
            for j := 1 to n do begin
                read(d, a[i, j]);
                if IOResult <> 0 then begin
                    writeln('?§ўЁ­ЁвҐ ®иЁЎЄ . ’ Ў«Ёж  ­Ґ ᮧ¤ ­ ');
                    exit
                end
            end;
            readln(d);
            if IOResult <> 0 then begin
                writeln('?§ўЁ­ЁвҐ ®иЁЎЄ . ’ Ў«Ёж  ­Ґ ᮧ¤ ­ ');
                exit
            end
        end;
        {$I+}
        ReadArray := true
    end
end;

   {‚ў®¤Ё¬ ¬ ббЁў "ђгЄ ¬Ё"}
function aReadArray(var a: Tmas; var m, n: integer): TError;
var
    i, j: integer;
begin
    AskUser(m, n);
    aReadArray := true;
    for i := 1 to m do
        for j := 1 to n do begin
            write('‚ўҐ¤ЁвҐ a[', i, ', ', j, ']: ');
            {$I-}
            readln(a[i, j]);
            {$I+}
            if IOResult <> 0 then begin
                writeln('ЋиЁЎЄ : ­Ґ пў«пҐвбп з¬б«®¬');
                aReadArray := false;
                exit
            end
        end
end;

function CreateArray(var a: Tmas; var m, n: integer): boolean;
var
    item: char;
    dname: string;
    d: text;
    i, j: integer;
begin
    writeln;
    writeln(Pro, '1. ‚ў®¤Ё¬ ¬ ббЁў Ё§ Є®­б®«Ё');
    writeln(Pro, '2. ‘®§¤ вм ¬ ббЁў б® б«гз ©­л¬Ё н«Ґ¬Ґ­в ¬Ё');
    writeln(Pro, '3. ‚ў®¤Ё¬ ¬ ббЁў Ё§ д ©« ');
    writeln(Pro, '4. Ћв¬Ґ­ ');
    write('‚лЎҐаЁвҐ ¤Ґ©бвўЁҐ: ');
    repeat
        item := ReadKey
    until item in ['0'..'3'];
    writeln(item);
    case item of
        '1': CreateArray := aReadArray(a, m, n);
        '2':begin
                AskUser(m, n);
                for i := 1 to m do
                    for j := 1 to n do
                        a[i, j] := random(201) - 100;
                CreateArray := true
            end;
        '3':begin
                {$I-}
                repeat
                    write('‚ўҐ¤ЁвҐ Ё¬п д ©« : ');
                    readln(dname);
                    Assign(d, Dname);
                    Reset(d)
                until IOResult = 0;
                {$I+}
                CreateArray := ReadArray(d, a, m, n);
                Close(d)
            end;
        '0': CreateArray := false
    end
end;

procedure PrintArray(Var a:Tmas;var m,n:integer);
var i,j:integer;
begin
    for i := 1 to m do begin
        for j := 1 to n do begin

            write(Pro1,a[i, j]:6:2)
        end;
        writeln
    end;
end;

procedure pak(var B:Tmas1;var a:Tmas;var nom,m,n:integer);
var
  j:integer;
begin
  sravnenie(a,m,n,B,nom);
   writeln('Nom: ', nom);
    for j := 1 to n do
        writeln(j, ': ',Pro1,B[j]:7:3);
end;

{ ’Ґбв®ў п Їа®жҐ¤га  }
procedure Test;
var
    item: char;
    m, n, nom: integer;
    a: Tmas;
    B:Tmas1;
    Rabotnik: boolean;
begin
    ClrScr;
    Randomize;
    Rabotnik := false;
    repeat
        ClrScr;
        writeln;
        writeln(Pro, '1. ‘®§¤ вм в Ў«Ёжг');
        writeln(Pro, '2. ЋЎа Ў®в вм в Ў«Ёжг');
        writeln(Pro, '3. ‚뢥бвЁ в Ў«Ёжг');
        writeln(Pro, '0. ‚л室');
        writeln;
        write('‚лЎҐаЁвҐ ¤Ґ©бўЁҐ: ');
        repeat
            item := ReadKey
        until item in ['0'..'3'];
        writeln(item);
        case item of
            '1': Rabotnik := CreateArray(a, m, n);
            '2':if Rabotnik then
                    sravnenie(a, m, n, B, nom)
                else
                    writeln('’ Ў«Ёж  ­Ґ бгйҐб⢥в');
            '3':if Rabotnik then begin
                    AskUser(m, n);
                    PrintArray(a, m, n);
                    Pak(B, a, nom, m, n)
                end
                else
                    writeln('’ Ў«Ёж  ­Ґ бгйҐбвўгҐв')
        end;
        ReadKey
    until item = '0'
end;

begin
    Test
end.