Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > Delphi программирование > Паскаль, Turbo Pascal, PascalABC.NET
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 04.05.2009, 00:51   #1
ApXoH
Пользователь
 
Регистрация: 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.
ApXoH вне форума Ответить с цитированием
Старый 04.05.2009, 02:41   #2
Dirt
Пользователь
 
Регистрация: 28.03.2009
Сообщений: 60
По умолчанию

Здраствуйте.

Код:
замените это:
if a[i,(j mod 2)] <0 then k:=k+1;


на это:
if (j mod 2) <> 0 then 
   if a[i,j] < 0 then k:=k+1;
Dirt вне форума Ответить с цитированием
Старый 04.05.2009, 10:39   #3
Dirt
Пользователь
 
Регистрация: 28.03.2009
Сообщений: 60
По умолчанию

Код:
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;
   for i:=1 to n do 
    begin
     for j:=1 to l do 
      begin
       if a[i,j]>0 then c:=c+1;
      end;
    end;
  writeln;
  writeln('poloshitelinih = ',c);
 end;

Procedure Otr;
 begin
  k:=0;
  for i:=1 to n do
   begin
    for j:=1 to l do
     begin
      if (j mod 2) <> 0 then
      if a[i,j] < 0 then k:=k+1;
     end;
   end;
  writeln;
  writeln('Otritsatelinih elementov v neciotnih stolbtsah =',k);
 end;
begin
1:clrscr;
repeat
 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.
Dirt вне форума Ответить с цитированием
Старый 04.05.2009, 10:57   #4
alex_fcsm
Участник клуба
 
Аватар для alex_fcsm
 
Регистрация: 10.11.2008
Сообщений: 1,502
По умолчанию

Чтобы так не сделать?

Код:
.......
repeat
 clrscr;
 write('kol-vo strok n=');
 readln(n);
 write('kol-vo stolb l=');
 readln(l);
until (n>0) and (l>0);
.......
Нормальное состояние техники - нерабочее, все остальное частный случай.
alex_fcsm вне форума Ответить с цитированием
Старый 04.05.2009, 11:47   #5
Dirt
Пользователь
 
Регистрация: 28.03.2009
Сообщений: 60
По умолчанию

Цитата:
Сообщение от alex_fcsm Посмотреть сообщение
Чтобы так не сделать?

Код:
.......
repeat
 clrscr;
 write('kol-vo strok n=');
 readln(n);
 write('kol-vo stolb l=');
 readln(l);
until (n>0) and (l>0);
.......

Хозяин барин
Dirt вне форума Ответить с цитированием
Старый 04.05.2009, 12:52   #6
ApXoH
Пользователь
 
Регистрация: 31.03.2009
Сообщений: 11
По умолчанию

Оу огромнейшое спасибо))))))
ApXoH вне форума Ответить с цитированием
Старый 04.05.2009, 14:22   #7
ApXoH
Пользователь
 
Регистрация: 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.
ApXoH вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц



Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Помогите переделать программу немного. 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