28.04.2014, 12:44 | #1 (permalink) |
Новичок
Регистрация: 28.04.2014
Сообщений: 7
Сказал(а) спасибо: 0
Поблагодарили 0 раз(а) в 0 сообщениях
Репутация: 10
|
Создание меню в Паскале ABC
каждый пункт меню - вызов одной из задачи программы. После работы очередной задачи должен быть возврат в меню. Буду очень благодарна за помощь! Вот сама программа: Код:
program matritsa; const n=8; type matr= array[1..n,1..n] of integer; var a: matr; i, j, k,l,ko,sm : integer; Procedure findk (a:matr; var k:integer ); var i, j: integer; begin for i:=1 to n do begin k:=i; for j:=1 to n do if A[i,j] <> A [j,i] then begin k:=0; break; end; if k>0 then break; end; end; begin for i:=1 to n do for j:=1 to n do begin write('a[',i,',',j,']='); read(a[i,j]) end; findk(a, k); writeln(k); writeln; for i:=1 to n do begin for j:=1 to n do write(a[i,j]:3); writeln; end; writeln('Совпадающие строки и столбцы;'); l:=0;{считаем что совпадающих строк и столбцов нет} for k:=1 to n do begin i:=0;{считаем что в данных строке и столбце совпадений нет } for j:=1 to n do if a[k,j]=a[j,k] then i:=i+1;{если есть, считаем} if i=n then{если все совпали} begin writeln('Строка и столбец № ',k);{выводим на экран} l:=1;{фиксируем что есть такие} end; end; if l=0 then writeln('Таких строк и столбцов нет!'); writeln; for i:=1 to n do begin ko:=0;{считаем что отрицательных в строке нет} for j:=1 to n do if a[i,j]<0 then {если нашли} begin ko:=1;{фиксируем} break;{больше не ищем} end; if ko=1 then{если есть отрицательные} begin sm:=0;{сумма=0} for k:=1 to n do sm:=sm+a[i,k];{считаем сумму в строке} writeln('Сумма в строке ',i,'=',sm); end; end; readln end. |
28.04.2014, 12:44 | |
Helpmaster
Member
Регистрация: 08.03.2016
Сообщений: 0
|
Данные топики имеют сходства с вашим, рекомендую прочитать Выпадающее меню Создать меню Меню в Паскале |
28.04.2014, 13:55 | #3 (permalink) | |
Новичок
Регистрация: 28.04.2014
Сообщений: 7
Сказал(а) спасибо: 0
Поблагодарили 0 раз(а) в 0 сообщениях
Репутация: 10
|
Цитата:
Для заданной матрицы размером 8x8 найти такие k, что k-я строка матрицы совпадает с k-м столбцом (оформить в виде процедуры). Найти сумму элементов в тех строках, которые содержат хотя бы один отрицательный элемент (оформить в виде функции). |
|
28.04.2014, 14:49 | #4 (permalink) | |
Специалист
Регистрация: 27.08.2008
Адрес: Санкт-Петербург
Сообщений: 27,807
Сказал(а) спасибо: 340
Поблагодарили 583 раз(а) в 208 сообщениях
Репутация: 113184
|
Цитата:
Код:
const n=8; type matr= array[1..n,1..n] of integer; vect= array[1..n] of integer; var a,b: matr; i,j,l,sum : integer; Procedure findk(q1,q2:vect; k:integer); var p:integer; bu:boolean; begin bu:=true; for p:=1 to n do if q1[p]<>q2[p] then bu:=false; if bu then write(k:3); end; Function FindSum(q:vect):Integer; var p,S:integer; bu:boolean; begin bu:=true; S:=0; for p:=1 to n do begin Inc(S,q[p]); if q[p]<0 then bu:=false; end; if bu then S:=-32000; FindSum:=S; end; Begin for i:=1 to n do for j:=1 to n do begin write('a[',i,',',j,']= '); readln(a[i,j]); b[j,i]:=a[i,j]; end; writeln; for i:=1 to n do begin for j:=1 to n do write(a[i,j]:4); writeln; end; writeln; Repeat Writeln('Enter the action number:'); Writeln(' 1 - FindK'); Writeln(' 2 - FindSums'); Writeln(' 3 - Exit'); Readln(l); Case l of 1: begin write('K: '); for i:=1 to n do FindK(a[i],b[i],i); writeln; end; 2: begin for i:=1 to n do begin sum:=FindSum(a[i]); if sum<>-32000 then writeln('i= ',i,' Sum= ',Sum); end; end; else l:=3; end; {Case} Until l=3; End. |
|
28.04.2014, 15:28 | #5 (permalink) | |
Новичок
Регистрация: 28.04.2014
Сообщений: 7
Сказал(а) спасибо: 0
Поблагодарили 0 раз(а) в 0 сообщениях
Репутация: 10
|
Цитата:
|
|
Ads | |
Member
Регистрация: 31.10.2006
Сообщений: 40200
Записей в дневнике: 0
Сказал(а) спасибо: 0
Поблагодарили 0 раз(а) в 0 сообщениях
Репутация: 55070
|
29.04.2014, 09:31 | #8 (permalink) |
Специалист
Регистрация: 27.08.2008
Адрес: Санкт-Петербург
Сообщений: 27,807
Сказал(а) спасибо: 340
Поблагодарили 583 раз(а) в 208 сообщениях
Репутация: 113184
|
Да можно было бы и графическое, или, на худой конец, разукрасить текстовое всякими там CRT-шными рюшечками (фон, цвет, размер окошка и т.п.), но вот беда - у заказчицы не нормальный Паскаль, а этот... это... эта... как бы по-приличнее выразиться... ну, в общем, АВС. А в нём всё с ног на голову поставлено, да так и оставлено.
|
07.05.2014, 12:01 | #9 (permalink) | |
Новичок
Регистрация: 28.04.2014
Сообщений: 7
Сказал(а) спасибо: 0
Поблагодарили 0 раз(а) в 0 сообщениях
Репутация: 10
|
Цитата:
|
|
07.05.2014, 14:34 | #10 (permalink) | |
Специалист
Регистрация: 27.08.2008
Адрес: Санкт-Петербург
Сообщений: 27,807
Сказал(а) спасибо: 340
Поблагодарили 583 раз(а) в 208 сообщениях
Репутация: 113184
|
Цитата:
Но вообще-то... А Вы точно сообщение процитировали? Может быть, там говорится "Нельзя преобразовать тип array [1..8] of integer к array [1..8, 1..8] of integer" или наоборот? Попробуйте так: Вместо Код:
type matr= array[1..n,1..n] of integer; vect= array[1..n] of integer; Код:
type vect= array[1..n] of integer; matr= array[1..n] of vect; вместо Код:
readln(a[i,j]); b[j,i]:=a[i,j]; Код:
readln(a[i][j]); b[j][i]:=a[i][j]; |
|
Ads | |
Member
Регистрация: 31.10.2006
Сообщений: 40200
Записей в дневнике: 0
Сказал(а) спасибо: 0
Поблагодарили 0 раз(а) в 0 сообщениях
Репутация: 55070
|
|
|