Нарисовать шахматную доску, при этом пометить все поля, кторые бьет ферзь крестиками, а другие - ноликами. - Turbo Pascal

Узнай цену своей работы

Формулировка задачи:

Заданные два символа - латинская буква (a-h) и цифра (1-8). Рассматривая их как координаты поля шахматной доски, на котором находится ферзь, нарисовать шахматную доску, при этом пометить все поля, кторые бьет ферзь крестиками, а другие - ноликами.

Решение задачи: «Нарисовать шахматную доску, при этом пометить все поля, кторые бьет ферзь крестиками, а другие - ноликами.»

textual
Листинг программы
uses crt,graph;
procedure Kletka(x1,y1,c:integer;d:integer);
begin
Setcolor(c);
setlinestyle(0,0,1);
Setfillstyle(1,c);
Bar(x1,y1,x1+d,y1+d);
end;
procedure Quin(v,g,x1,y1,r:integer);
begin
setcolor(2);
setlinestyle(0,0,3);
settextstyle(0,0,3);
Circle(x1+r*(2*v-1),y1+r*(2*g-1),r-3);
settextstyle(0,0,3);
OuttextXY(x1+r*(2*v-1)-10,y1+r*(2*g-1)-10,'Q');
end;
procedure Krest(j,i,x1,y1,r:integer);
begin
setcolor(12);
setlinestyle(0,0,3);
line(x1+r*(2*j-1)-10,y1+r*(2*i-1)-10,x1+r*(2*j-1)+10,y1+r*(2*i-1)+10);
line(x1+r*(2*j-1)-10,y1+r*(2*i-1)+10,x1+r*(2*j-1)+10,y1+r*(2*i-1)-10);
end;
procedure Zero(j,i,x1,y1,r:integer);
begin
setcolor(8);
setlinestyle(0,0,1);
circle(x1+r*(2*j-1),y1+r*(2*i-1),r div 2-3);
end;
 
var gd,gm,x1,y1,x2,y2,d1,i,j,r:integer;
    v,c:char;
    v1,g:byte;
begin
clrscr;
repeat
write('Vvedite simvol vertikali [a..h] v=');
readln(v);
until v in ['a'..'h'];
v1:=ord(v)-96;
repeat
write('Vvedite nomer gorizontali [1..8] g=');
readln(g);
until g in [1..8];
g:=8-g+1;
initgraph(gd,gm,'');
d1:=round((getmaxY-60)/8);
r:=d1 div 2;
Setcolor(4);
Rectangle(1,1,8*d1+50,8*d1+60);
Setfillstyle(1,4);
Bar(1,1,8*d1+50,8*d1+60);
x1:=30;y1:=20;
for i:=1 to 8 do
  begin
    for j:=1 to 8 do
    if odd(i+j) then Kletka(x1+d1*(i-1),y1+d1*(j-1),15,d1)
    else Kletka(x1+d1*(i-1),y1+d1*(j-1),6,d1);
  end;
Setcolor(0);
for i:=0 to 7 do
outtextxy(30+d1*i+d1 div 2,450,chr(ord(i+97)));
for i:=7 downto 0 do
outtextxy(20,440-d1*i-d1 div 2,chr(ord(i+49)));
Quin(v1,g,x1,y1,r);
for i:=1 to 8 do
for j:=1 to 8 do
if (abs(i-g)=abs(j-v1))and((j<>v1)or(i<>g))then Krest(j,i,x1,y1,r)
else if (j<>v1)or(i<>g) then Zero(j,i,x1,y1,r);
readln;
closegraph
end.

Оцени полезность:

5   голосов , оценка 3.2 из 5
Похожие ответы