|
|
Регистрация Восстановить пароль |
Регистрация | Задать вопрос |
Заплачу за решение |
Новые сообщения |
Сообщения за день |
Расширенный поиск |
Правила |
Всё прочитано |
|
Опции темы | Поиск в этой теме |
04.05.2009, 00:51 | #1 |
Пользователь
Регистрация: 31.03.2009
Сообщений: 11
|
Помогите немного исправить Прогу
Программа:
Из Двумерного массива найти количество положительных элементов каждой строки и отрицательных элементов нечетных столбцов. Используя Процедуры. Задача в принципе очень легкая но я хоть убей не могу понять как найти количество отрицательных элементов в нечетных столбах((( Может поможете??? И если считаете что программа совсем неправильна - то прошу ващей помощи такому чайнику как я =D Program p1; uses crt; var a:array[1..100,1..100] of integer; y,i,c,j,k,n,l:integer; label 1; Procedure Pol; begin c:=0; begin for i:=1 to n do begin for j:=1 to l do begin if [a,j]>0 then c:=c+1; end; end; end; writeln; writeln('poloshitelinih = ',c); end; Procedure Otr; begin k:=0; begin for i:=1 to n do begin for j:=1 to l do begin if a[i,(j mod 2)] <0 then k:=k+1; end; end; end; writeln; writeln('Otritsatelinih elementov v neciotnih stolbtsah =',k); end; begin 1:clrscr; repaet write('kol-vo strok n='); readln(n); write('kol-vo stolb l='); readln(l); until (n<0) and (l>0); If (n<0) or (l<0) then goto 1; writeln('Vvedite elementi massiva: '); for i:=1 to n do begin for j:=1 to l do begin write('a[',i,',',j,']='); readln(a[i,j]); end; end; writeln; for i:=1 to n do begin for j:=1 to l do begin write(a[i,j],' '); end; writeln; end; writeln; Pol; Otr; readkey; end. |
04.05.2009, 02:41 | #2 |
Пользователь
Регистрация: 28.03.2009
Сообщений: 60
|
Здраствуйте.
Код:
|
04.05.2009, 10:39 | #3 |
Пользователь
Регистрация: 28.03.2009
Сообщений: 60
|
Код:
|
04.05.2009, 10:57 | #4 |
Участник клуба
Регистрация: 10.11.2008
Сообщений: 1,502
|
Чтобы так не сделать?
Код:
Нормальное состояние техники - нерабочее, все остальное частный случай.
|
04.05.2009, 11:47 | #5 |
Пользователь
Регистрация: 28.03.2009
Сообщений: 60
|
|
04.05.2009, 12:52 | #6 |
Пользователь
Регистрация: 31.03.2009
Сообщений: 11
|
Оу огромнейшое спасибо))))))
|
04.05.2009, 14:22 | #7 |
Пользователь
Регистрация: 31.03.2009
Сообщений: 11
|
Не поможете еще разок???
Вот программа: Создать фаил, содержащий сведения о том, какие из пяти предпологаемых дисциплин по выбору желает слушать судент.Структура записи: фамилия студента, индекс группы, 5 дисциплин, средний бал успеваемости .Количество записей - 25 Нужно чтобы программа еще печатала список студентов желающих прослушать дисциплину "X". если число желающих превышает 8 человек, то отобрать студентов, имеющих более высокий средний бал успеваемости. Я нашел прогу на нее в Нэте, но проблема в том что мой паскаль не хочет включать дерективу {$APPTYPE CONSOLE} и не может работать с SetLength. Если вам не сложно - прошу помочь ее исправить - буду жудко благодарен)) program Project1; {$APPTYPE CONSOLE} uses SysUtils; type stud=record fio:string[100]; ind:string[10]; discipline:array[1..5] of char; mark:real; end; var a,i,j,n,w,max:integer; boo:boolean; f:file of stud; st,buf:stud; gr:array of stud; procedure CreateList; begin ASSIGN(f,'C:/stud.DAT'); REWRITE(f); RESET(f); for i:=1 to 25 do begin writeln('Input record # ',i); write('Name '); readln(st.fio); write('Input group index '); readln(st.ind); for j:=1 to 5 do begin write('Input discipline # ',j); readln(st.discipline[j]); end; write('Input mark '); readln(st.mark); WRITE(f,st); end; close(f); writeln end; procedure ShowList; begin with buf do begin writeln('Name: ',fio ); writeln('Index: ',ind); writeln('Mark: ',mark); end; end; procedure ShareList; begin writeln('Input discipline number'); readln(a); SetLength(gr,25); boo:=false; ASSIGN(f,'C:/stud.DAT'); RESET(f); i:=1; while not eof(f) do begin read(f,st); if st.discipline[a]='1' then begin boo:=true; gr[i].fio:=st.fio; gr[i].ind:=st.ind; gr[i].mark:=st.mark; i:=i+1; end; end; if boo=false then writeln('Nobody wants this disciplines') else begin n:=i-1; if n>8 then begin max:=1; for j:=1 to 8 do begin for i:=2 to n do begin if gr[i].mark>gr[max].Mark then max:=i; end; buf:=gr[max]; gr[max].mark:=0; showlist; end; end else for i:=1 to n do begin buf:=gr[i]; showlist; end; end; SetLength(gr,0); close(f); end; begin W:=0; WHILE W<>3 DO BEGIN WRITELN('1 - Create List'); WRITELN('2 - Show Discipline List'); WRITELN('3 - Exit'); READLN(W); CASE W OF 1: CreateList; 2: ShareList; END; END; end. |
Похожие темы | ||||
Тема | Автор | Раздел | Ответов | Последнее сообщение |
Помогите переделать программу немного. | texcel | Общие вопросы C/C++ | 1 | 16.02.2009 19:42 |
Помогите исправить прогу(Cреда MSDEV visual c++ 6.0) | JOFRIF | Помощь студентам | 4 | 04.06.2008 14:15 |
Помогите исправить прогу так чтобы препода удовлетворяла))) | 812 | Помощь студентам | 3 | 25.05.2008 12:34 |
Помогите немного доделать программку на Дельфях | HAMMAN | Помощь студентам | 7 | 16.05.2007 23:05 |