Форум программистов [Powered by Invision Power Board]

Версия для печати темы
Нажмите сюда для просмотра этой темы в оригинальном формате

Форум программистов > Центр помощи > [pascal] двумерные массивы

Автор: djem90 15.12.2008, 23:26

Шахматную доску представим как символьная матрица размера 8*8юДаны натуральные числа m  и n (1<=n<=8,1<=m<=8) номера вертикали и по горизонтали , определяющие местоположение ферзя. Соответствующий элемент матрицы надо положить равным символу << ф >>. Поля, находящиеся под угрозой ферзя , надо положить равным символу *,а остальные поля - символу  0.Данные операции оформляются в виде процедуры . Результат помещается в файл результата.

   var vertical, horizontal:integer;
field :array [1..8,1..8] of char;
positionhorizontal:char;
positoinH, positoinvertical:integer;
begin
   for vertical:=1 to 8
      for horizontal:=1 to 8
         field[vertical,horizontal]:' ';
   repeat
      write ('vedite horizontal position (a..h)'); readln(positionhorizontal);
   until (positionhorizontal>='a' or positionhorizontal>='A') and (positionhorizontal<='h' or positionhorizontal<='H');

   repeat
      write ('vedite vertical position (1..8)'); readln(positionvertical);
   until positionvertical >=1 and positionvertical <=8);
   positoinH:=ord(Lowcase(positoinhorizontal))-32
   field[positonH,postionvertical]:='F';
end.

for ii:=1 to 8 do if ii<>postionH then field[ii,positoinvertical]:='*';

не знаю что добавить

Автор: djem90 16.12.2008, 10:00

program kursovik;
type mas=array[1..10,1..10] of char;
var a:mas;
    s,i,j,n,m,k:integer;
    fd,fr:text;
procedure p(x:integer; y:integer; var b:mas);
begin
  for x:=1 to 8 do
  for y:=1 to 8 do
  b[x,y]:='0';
end;
begin
assign(fd,'vh.txt');
assign(fr,'vih.txt');
reset(fd);
rewrite(fr);
writeln(fr);
read(fd,n,m);
if (m>8) or (n>8)
  then writeln(fr,'Nedopustimie koordinati')
  else
   begin
    p(i,j,a);
     for i:=m to m do
     for j:=n to n do
      if () and            and             and
       then a[i,j]:='*';
a[m,n]:='k';
  for i:=1 to 8 do
   begin
     for j:=1 to 8 do
      write(fr,a[i,j]:2);
     writeln(fr);
    end;
   end;
close(fd);
close(fr);
end.

помогите пожелуйста с программой работает не правильно!

Автор: volvo877 16.12.2008, 11:14

Цитата(djem90 @ 16.12.2008, 09:00

)

помогите пожелуйста с программой работает не правильно!

Естественно, она у тебя даже не компилируется, как она может вообще работать?

Вот так тебе надо?

Код

const
  size = 8;
type
  arr = array[1 .. size, 1 .. size] of char;

var
  m, n: integer;


procedure p(var a: arr; di, dj: integer);
var i, j: integer;
begin
  i := m; j := n;
  while (i + di >= 1) and (i + di <= size) and
        (j + dj >= 1) and (j + dj <= size) do
    begin
      i := i + di; j := j + dj; a[i, j] := '*';
    end;
end;


var
  field: arr;
  i, j, di, dj: integer;

begin
  for i := 1 to size do
    for j := 1 to size do field[i, j] := ' ';
  m := 4; n := 4;

  field[m, n] := 'F';

  for di := -1 to 1 do
    for dj := -1 to 1 do begin
      if (di = 0) and (dj = 0) then continue;
      p(field, di, dj);
    end;

  for i := 1 to size do begin
    for j := 1 to size do write(field[i, j]:2);
    writeln;
  end;

end.

(в файл выведешь сам... Ввод M, N и проверку на их правильность - тоже, это у тебя в программе уже есть, значит, ты это делать умеешь)