Ввод из файла,меню,матрицы turbopascal.

[Amenus]

всем привет)

uses crt;

const
  n=6;
  m=6;

label lab1,lab2;

var
  a:array[1..n,1..m] of integer;
  x1,y1,x2,y2,d:integer;

begin
clrscr;
for y1:=1 to n do
  for x1:=1 to m do begin
    writeln('a[',y1,',',x1,']=');
    readln(a[y1,x1]);
    end;

for y1:=1 to n do begin
  for x1:=1 to m do
    write(a[y1,x1]:3);
    writeln;
    end;

for y1:=1 to n do
  for x1:=1 to m do begin
    d:=1;
    for y2:=1 to n do
      for x2:=1 to m do
        if (a[y1,x1]=a[y2,x2])and(not((y1=y2)and(x1=x2))) then inc(d);
    if d>=3 then begin writeln('bolse chem 2'); readln; halt; end;
    end;

for y1:=1 to n do
  for x1:=1 to m do
    for y2:=1 to n do
      for x2:=1 to m do
        if (a[y1,x1]=a[y2,x2])and(not((y1=y2)and(x1=x2))) then goto lab1;

if true then begin writeln('no same'); goto lab2; end;
lab1:
writeln('y1=',y1,' x1=',x1,' y2=',y2,' x2=',x2);
lab2:
readln;
end.

Это код программки.Задание Дана матрица целых чисел. Известно, что матрица содержит только два одинаковых элемента. Найти и напечатать значения их индексов.

Мне нужно реализовать ту же саму программу с вводом из файла(существует txt с матрицей 6х6).
Может быть неправильно сформулирую,но требуется сделать из этих 2-ух программ 1 большую,которую потом можно было бы сделать пунктом меню и чтобы она предлагала :"ввод с клавиатуры" или "ввод из файла".
И теперь окончательно систематизирую вопрос =) )
1)помогите с написание программы,которая содержит в себе функции ввода клавиатуры и ввода из файла для данного алгоритма.
2)объясните пожалуйста,как потом вставить её как пункт меню
3)помогите с созданием меню(справочные материалы приветствуются)

[aslanbek999]

Это не ответ на твои вопросы,но может помочь.

Тут в главной программе побробно описано как осуществлять выбор между способами ввода.
ты просто вместо ввода с клавиатуры делаешь ввод из файла, например F1:text/ А вот эту часть

  case (ask) of
    '1': EnterMatrix(n, m, matr);

меняешь на вот эту

case (ask) of
'1':for i:=1 to 5 do
     begin
      for j:=1 to 5 do
       read(f1,Matr[i,j]);
      readln(f1);

(******************************************
Программа находит значение максимального
элемента прямоугольной матрицы
-------------------------------------------
Pascal
-------------------------------------------
******************************************)
program MaxInMatrix;
const
  MAXCOUNT = 50; {максимальная размерность матрицы}
type
  {прямоугольная матрица}
  Matrix = array [1..MAXCOUNT, 1..MAXCOUNT] of real;
var
  matr: Matrix;
  n, m: integer; {реальные размерности матрицы}
  min, max: real; {границы диапазона случайных чисел}
  ask: char; {для ввода режима}
 
(*----------------------------------------
Ввод размерностей матрицы
----------------------------------------*)
procedure EnterMatrixSize(var x,y: integer);
begin
  {строки}
  repeat
    write('Введите количество строк матрицы (1..',MAXCOUNT,') ');
    readln(x);
    if (x<1) then
      writeln('Ошибка! Размерность матрицы не может быть '+
      'меньшей единицы. Повторите ввод.');
    if (x>MAXCOUNT) then
      writeln('Ошибка! Размерность матрицы не должна быть '+
      'большей ',MAXCOUNT,'. Повторите ввод.');
  until (x>0)and(x<=MAXCOUNT);
  {столбцы}
  repeat
    write('Введите количество столбцов матрицы (1..',MAXCOUNT,') ');
    readln(y);
    if (y<1) then
      writeln('Ошибка! Размерность матрицы не может быть '+
      'меньшей единицы. Повторите ввод.');
    if (y>MAXCOUNT) then
      writeln('Ошибка! Размерность матрицы не должна быть '+
      'большей ',MAXCOUNT,'. Повторите ввод.');
  until (y>0)and(y<=MAXCOUNT);
end;
 
(*----------------------------------------
Поэлементный ввод прямоугольной матрицы с клавиатуры
----------------------------------------*)
procedure EnterMatrix (x,y: integer; var M: Matrix);
var
  i,j: integer;
begin
  writeln('Введите элементы прямоугольной матрицы:');
  for i:=1 to x do
    for j:=1 to y do begin
      write('M[',i,',',j,'] = ');
      readln(M[i,j]);
    end;
end;
 
(*----------------------------------------
Генерация случайных элементов матрицы в
заданном диапазоне
----------------------------------------*)
procedure GenerateMatrix (x,y: integer; var M: Matrix);
var
  i,j: integer;
begin
  for i:=1 to x do
    for j:=1 to y do
      M[i,j] := random*(max-min)+min;
end;
 
(*----------------------------------------
Поэлементный вывод матрицы на экран в
"естественном" виде (т.е. по строкам)
----------------------------------------*)
procedure PrintMatrix(x,y: integer; M: Matrix);
var
  i,j: integer;
begin
  for i:=1 to x do begin
    for j:=1 to y do
      write(M[i,j]:6:2);
    writeln;
  end;
end;
 
(*----------------------------------------
Функция находит максимальный элемент матрицы
----------------------------------------*)
function MaxMatrix(M: Matrix; x, y: integer): real;
var
  max: real;
  i, j: integer;
begin
  max:=M[1,1];
  for i:=1 to x do
    for j:=1 to y do
      if max<M[i,j] then
        max := M[i,j];
  MaxMatrix := max;
end;
 
{основная программа}
begin
  writeln('Программа находит максимальное значение '+
  'элемента прямоугольной матрицы');
  EnterMatrixSize(n,m);
  {меню режимов}
  writeln('Выберите вариант заполнения матрицы:');
  writeln('1 - с клавиатуры');
  writeln('2 - случайными числами');
  repeat
    readln(ask);
    if (ask<>'1')and(ask<>'2') then
      writeln('Выберите режим 1 или 2, пожалуйста');
  until (ask='1')or(ask='2');
  case (ask) of
    '1': EnterMatrix(n, m, matr);
    '2': begin
      randomize;
      write('Введите нижнюю границу диапазона случайных чисел: ');
      readln(min);
      write('Введите верхнюю границу диапазона случайных чисел: ');
      readln(max);
      GenerateMatrix(n, m, matr);
    end;
  end;
  writeln('Получившаяся матрица:');
  PrintMatrix(n, m, matr);
  writeln('Максимальный элемент этой матрицы равер ',MaxMatrix(matr,n,m):8:3);
  writeln('Нажмите [Enter] для завершения программы');
  readln;
end.

[Amenus]

Реализовано двумя списка с помощью одного человека)
собственно код:

uses crt;

label lab1,lab2;

var
  a:array[1..100,1..100] of integer;
  x1,y1,x2,y2,d:integer;
  n,m,c:integer;

procedure readf;
var f:text; i:integer;
begin;
assign(f,'in.txt');
reset(f);
while not eoln(f) do begin read(f,i); inc(m); end;
close(f);
reset(f);
while not eof(f) do begin readln(f); inc(n); end;
close(f);

reset(f);
for y1:=1 to n do begin
  for x1:=1 to m do
    read(f,a[y1,x1]);
  readln(f);
  end;
close(f);
end;

procedure readk;
begin;
writeln('vvedi kolichestvo strok i stolbcov');
readln(n,m);
for y1:=1 to n do
  for x1:=1 to m do begin
    writeln('a[',y1,',',x1,']=');
    readln(a[y1,x1]);
    end;
end;

begin
clrscr;

writeln('1. s klaviaturi');
writeln('2. iz faila');
writeln('3. viiti');
repeat
  readln(c);
until (c=1)or(c=2)or(c=3);
case c of
  1:readk;
  2:readf;
  3:halt;
end;

for y1:=1 to n do begin
  for x1:=1 to m do
    write(a[y1,x1]:3);
    writeln;
    end;

for y1:=1 to n do
  for x1:=1 to m do begin
    d:=1;
    for y2:=1 to n do
      for x2:=1 to m do
        if (a[y1,x1]=a[y2,x2])and(not((y1=y2)and(x1=x2))) then inc(d);
    if d>=3 then begin writeln('bolse chem 2'); readln; halt; end;
    end;

for y1:=1 to n do
  for x1:=1 to m do
    for y2:=1 to n do
      for x2:=1 to m do
        if (a[y1,x1]=a[y2,x2])and(not((y1=y2)and(x1=x2))) then goto lab1;

if true then begin writeln('no same'); goto lab2; end;
lab1:
writeln('y1=',y1,' x1=',x1,' y2=',y2,' x2=',x2);
lab2:
readln;
end.

Огромное спасибо,что отлкликнулись)))!=)