The program can draw the chessboard for playing the Checkers

Delphi & Pascal (česká wiki)
Přejít na: navigace, hledání
Category: Source in Pascal
sachovn.pngProgram: Sachovn.pas
File exe: Sachovn.exe

The program can draw the chessboard for playing the Checkers. It doesn't include, however, the module for the real game.
{ SACHOVN.PAS               Copyright (c) TrSek alias Zdeno Sekerak }
{ Program nakresli sachovnicu pre hranie damy.                      }
{ Neobsahuje vsak modul pre jej skutocnu hru.                       }
{                                                                   }
{ Datum:06.01.1996                             http://www.trsek.com }
 
program dama_sachovnica;
uses crt,dos,graph;
 
var pole:array[1..8,1..8] of byte;
    x,y,hrac:integer;
    xh,yh:array[1..2] of byte;
    Gd,Gm:integer;
    ErrorCode:integer;
    xd,yd:integer;
    ch:char;
 
procedure wait(rezim:char);
var y:integer;
begin
  if (UpCase(rezim)='T') then begin
     writeln;
     writeln('Stlac nejaky klaves ...');
    end
  else begin
    if gety>440 then y:=440
                else y:=gety;
    outtextxy(10,y+20,'Stlac neaky klaves ...');
  end;
 
  repeat until keypressed;
end;
 
procedure pol_sach(x,y,fig:integer);
var farba:integer;
begin
  { zmensi o jeden, aby nebol narocny prepocet pre bar }
  dec(x);dec(y);
 
  SetFillStyle(1,LightGray);         { Ak nieje nahodou cervena potom urcite cierna }
  if (round(x/2)=(x/2)) then begin
    if (round(y/2)<>(y/2)) then
       SetFillStyle(1,Red);
   end
  else begin
    if (round(y/2)=(y/2)) then
       SetFillStyle(1,Red);
  end;
 
  bar(10+xd*x,10+yd*y,10+xd*(x+1),10+yd*(y+1));
 
  if (fig<>0) then begin
    if (fig=1) then begin
       setcolor(Yellow);
       setfillstyle(1,DarkGray);
     end
    else begin
       setcolor(DarkGray);
       setfillstyle(1,Yellow);
     end;
 
    ellipse(10+round(xd*(x+0.5)),10+round(yd*(y+0.5)),0,360,round(xd/3),round(yd/3));
    floodfill(10+round(xd*(x+0.5)),10+round(yd*(y+0.5)),getcolor);
    pole[x+1,y+1]:=fig;
  end;
end;
 
begin
  Gd:=Detect;
  Initgraph(Gd,Gm,'');
  ErrorCode := GraphResult;
 
  { vznikla chyba pri inicializacii }
  if ErrorCode <> grOk then
  begin
    Writeln('Chyba grafiky: ', GraphErrorMsg(ErrorCode));
    wait('t');
    Halt(1);
  end;
 
  { Zisti sirku,vysku podla gr.karty }
  xd:=round((GetMaxx-20)/8);
  yd:=round((GetMaxy-20)/8);
  SetBkColor(Green);
  ClearDevice;
  Setcolor(White);
 
  for x:=1 to 8 do outtextxy(round((x-0.5)*xd)+10,Getmaxy-10,chr(x+48));
  for y:=1 to 8 do outtextxy(1,round((y-0.5)*yd)+10,chr(73-y));
 
  for x:=1 to 8 do
    for y:=1 to 8 do begin
       pol_sach(x,y,0);
       pole[x,y]:=0;
    end;
 
  for x:=1 to 8 do
     if (round(x/2)=(x/2)) then pol_sach(x,7,2)
                           else pol_sach(x,8,2);
 
  for x:=1 to 8 do
     if (round(x/2)=(x/2)) then pol_sach(x,1,1)
                           else pol_sach(x,2,1);
 
  xh[1]:=1;yh[1]:=1;
  xh[2]:=8;yh[2]:=2;
  hrac:=1;
 
  while(readkey<>#27) do;
  closegraph;
end.