Показать сообщение отдельно
Старый 15.11.2010, 12:41   #5 (permalink)
Vladimir_S
Специалист
 
Регистрация: 27.08.2008
Адрес: Санкт-Петербург
Сообщений: 27,807
Сказал(а) спасибо: 340
Поблагодарили 583 раз(а) в 208 сообщениях
Репутация: 113184
По умолчанию

Ладно, написал целиком.
Программа зациклена; чтобы выйти из нее, следует ввести нулевой (несуществующий) номер запрашиваемого места (N=0).
Код:
VAR
 R:ARRAY[1..9,1..5] of Byte;
 N:Byte;
 i,j:Integer;
 b,found:Boolean;

Procedure Matrix_output(var bm:boolean);
 VAR
  N_even, N_odd:BYTE;
  i,j:Integer;
 Begin
  N_even:=0;
  N_odd:=0;
  For i:=1 to 9 do
   begin
    for j:=1 to 4 do
     begin
      write(R[i,j]:4);
      If (R[i,j]>0) and ((R[i,j] mod 2)=0) then Inc(N_even);
      If (R[i,j]>0) and ((R[i,j] mod 2)=1) then Inc(N_odd);
     end;
    writeln;
   end;
  Writeln;
  Writeln(N_even, ' even places and ',N_odd,' odd places are free');
  If N_even+N_odd=0 then bm:=true else bm:=false;
 End;

BEGIN
 For i:=1 to 9 do
  For j:=1 to 4 do
   R[i,j]:=j+(i-1)*4;
 Matrix_output(b);
 found:=false;
 REPEAT
  Write('N= ');
  ReadLn(N);
  If N>0 then
   Repeat
    i:=((N-1) div 4)+1;
    j:=((N-1) mod 4)+1;
    if R[i,j]>0 then
     begin
      found:=true;
      R[i,j]:=0;
     end else
      writeln('Sorry, but this place is already occupied; try another');
   Until found or b;
  Matrix_output(b);
 UNTIL b OR (N=0);
 If b then
  begin
   writeln('Sorry, but there are no free places');
   ReadLn;
  end;
END.
Vladimir_S вне форума   Ответить с цитированием
Ads

Яндекс

Member
 
Регистрация: 31.10.2006
Сообщений: 40200
Записей в дневнике: 0
Сказал(а) спасибо: 0
Поблагодарили 0 раз(а) в 0 сообщениях
Репутация: 55070