Ver. 1.0 Beta, Nie masz kompilatora? Teraz możesz pisać skrypty ONLINE! Wersja podstawowa -nie zawiera wszystkich poleceń Pascala. Służy do nauki podstaw

Pascal

Kod źródłowy sapera


Poniżej kod źródłowy popularnej gry saper. Kod zbudowany w pascalu. Wymaga modułów, które można pobrać w dziale download z tej strony




{$N+}
program Saper;



uses
 Graph10e, Doors, Doors10e, Doors_Ev, Keyb_x, Standard, Fonts,
 MouseX, Buttons, Edits, Forms, Labels, Sz_ognie;



const
 MAX_SIZEX      = 35;
 MAX_SIZEY      = 18;

 OZN_NIEODSLONIETE     = 0;
 OZN_ROZMINOWANIE      = 1;
 OZN_NIEPEWNE          = 2;

 Dane                  = 'Saper';
 FontFile              = 'Font.fnt';
 FontFile2             = 'BigF.fnt';
 CursorFile            = 'kur.bmp';
 BestPlayersFile       = 'best.hsc';

 MaxBMP                = 5;
 MaxICO                = 2;

 SzerK                 =  8;
 WysK                  =  8;
 MaxMenu               =  5;
 MaxAut                =  20;
 MaxWin                =  26;
 MaxPom                =  15;

 TxtAut                : array[1..MaxAut] of string[30]=
 ('ALGORYTM PROGRAMU:',
  'STANIS¶AW KOGUT','',
  'GRAFIKA I INTERFACE:',
  'KAMIL SKOCZYLAS','',
  'WWW.PROGRAMOWANIE.VSZ.PL','','',
  'SAPER 2.0 WERSJA Z 7.01.2007','',
  'PROGRAM WYKORZYSTUJE SYSTEM',
  'DOORS NASZEGO AUTORSTWA','',
  'SAPER 2.0',
  'UDOST¨PNIONY JAKO FREEWARE','','',
  'ZROBIONE W:',
  'TURBO PASCAL 7.0');

 TxtWin                : array[1..MaxWin] of string[30]=
 ('GRATULUJEMY, WYGRA¶E—!',
  'ROZBROI¶E— WSZYSTKIE MINY',
  'MO˝ESZ SPRŕBOWA® NA WY˝SZYM','POZIOMIE',
  '','',
  'ALGORYTM PROGRAMU:',
  'STANIS¶AW KOGUT','',
  'GRAFIKA I INTERFACE:',
  'KAMIL SKOCZYLAS','',
  'WWW.PROGRAMOWANIE.VSZ.PL','','',
  'SAPER 2.0 WERSJA Z 7.01.2007','',
  'PROGRAM WYKORZYSTUJE SYSTEM',
  'DOORS NASZEGO AUTORSTWA','',
  'SAPER 2.0',
  'UDOST¨PNIONY JAKO FREEWARE','','',
  'ZROBIONE W:',
  'TURBO PASCAL 7.0');

 TxtPom                : array[1..MaxPom] of string[30]=
 ('SAPER 2.0',
  'TWOIM ZADANIEM JEST',
  'ODSZUKA® WSZYSTKIE MINY',
  'S¤ ONE LOSOWO UMIESZCZONE',
  'W POLACH NA PLANSZY. PO',
  'WSKAZANIU POLA LEWYM',
  'PRZYCISKIEM ODS¶ONI SI¨,',
  'PO WSKAZANIU PRAWYM MO˝ESZ',
  'OZNACZY® JAKO MIN¨ LUB',
  'MIEJSCE, KTŕREGO NIE JESTE—',
  'PEWIEN. GDY POLE JEST PUSTE',
  'KOMPUTER WY—WIETLI RŕWNIE˝',
  'ZAGRO˝ENIE CZYLI ILE MIN',
  'BEZPO—REDNIO STYKA SI¨ Z',
  'TYM POLEM.');

 kolory : array[1..8] of Word = ($001f,$03e0,$f100,$0000,
                                 $0000,$0000,$0000,$0000);

 menu   : array[1..MaxMenu] of string[12]=
 ('Start','Ustawienia','Wyniki','Pomoc','Autorzy');


type
 TPole = record
   zasl  : Boolean; {czy pole jest zasloniete?}
   mina  : Boolean; {czy pole jest mina?}
   zagr  : Byte; {liczba min wokol pola}
   ozn   : Byte; {nieodsloniete, rozminowanie, niepewne}
   ow    : Boolean;
 end;

 TPlansza = array[0..MAX_SIZEY+1, 0..MAX_SIZEX+1] of TPole;

 TGracz = record
   Imie  : string [15];
   pkt   : LongInt;
   czas  : Word;
   min   : Integer;
   W, S  : Byte;
 end;



var
 pl    : TPlansza;
 s, w  : Byte;
 Kat   : string;
 Pict  : array[0..MaxBMP] OF TPicture;
 Ico   : array[0..MaxICO] OF TPicture;
 Gracz : array[1..10] of TGracz;
 Font  : PFont;
 BigF  : PFont;
 Buf   : TEkran10Eh;
 Cur   : TPicture;
 sb    : Byte;
 NewG  : PObject;
 Mines : PObject;
 Time  : PObject;
 Main  : PObject;
 AddX  : Integer;
 AddY  : Integer;
 mn    : Integer;
 maxmn : LongInt;
 czas  : LongInt;
 lx, ly: Integer;
 ax, ay: Integer; {pozycja wcisnietych dwoch klawiszy}
 TopW  : Single;



 Playing  : Boolean;
 Bar      : PObject;
 Settings : PObject;
 Et       : array[1..MaxMenu] of PObject;

 SpinX    : PObject;
 SpinY    : PObject;
 SpinM    : PObject;

 Best     : PObject;
 Pomoc    : PObject;
 Aut      : PObject;
 you      : TGracz;
 name     : PObject;
 submit   : PObject;
 place    : Byte;
 okbut    : PObject;
 Top      : Integer;
 XTop     : Integer;
 Poczatek : Boolean;
 odslWokol: Boolean;
 Animation: Boolean;




procedure WyznaczZagrozenie;
var
 i, j  : Byte;
begin
 for i:=1 to w do
   for j:=1 to s do
     if pl[i, j].mina then
     begin
       if (j>1) then
       begin
         Inc(pl[i, j-1].zagr);
         if (i>1) then
           Inc(pl[i-1, j-1].zagr);
         if (i            Inc(pl[i+1, j-1].zagr);
       end;
       if (j        begin
         Inc(pl[i, j+1].zagr);
         if (i>1) then
           Inc(pl[i-1, j+1].zagr);
         if (i            Inc(pl[i+1, j+1].zagr);
       end;
       if (i>1) then
         Inc(pl[i-1, j].zagr);
       if (i          Inc(pl[i+1, j].zagr);
     end;
end;


procedure UtworzPlansze(sz, wys : Byte; m : Word);
var
 i, j : Byte;

begin
 s := Min(sz, MAX_SIZEX);
 w := Min(wys, MAX_SIZEY);
 m := Min(m, (s*w div 2));
 mn  := m;
 maxmn:=m;

 for i:=1 to w do
   for j:=1 to s do
   begin
     pl[i, j].zasl := TRUE;
     pl[i, j].mina := FALSE;
     pl[i, j].zagr := 0;
     pl[i, j].ozn := OZN_NIEODSLONIETE;
     pl[i,j].ow := FALSE;
   end;

 while (m > 0) do
 begin
   repeat
     i := Random(w)+1;
     j := Random(s)+1;
   until (not pl[i, j].mina);
   pl[i, j].mina := TRUE;
   Dec(m);
 end;

 WyznaczZagrozenie;
 Playing:=False;
 PButtonParams(NewG^.Params)^.Picture:=Ico[0];

 Main^.SetActive;
 place:=0;
 Poczatek:=True;
end;


procedure Boom(x, y : Integer);
var
 i, j : Byte;
begin
 for i:=1 to w do
   for j:=1 to s do
     pl[i,j].zasl := FALSE;

 Playing:=False;
 PButtonParams(NewG^.Params)^.Picture:=Ico[1];
 lx:=x;
 ly:=y;

end;

procedure Win;
var i:Byte;
begin

 if not Playing then Exit;

 Playing:=False;
 PButtonParams(NewG^.Params)^.Picture:=Ico[2];
 you.czas:=Round((S_Ti-Czas)/18.2);
 you.pkt:=Round((Sqr(2*Maxmn)*1000)/(W*S*(Max(S_Ti-Czas, 18)/9.1))*10);
 PFormParams(Main^.Params)^.Caption:=IntToStr(you.pkt)+'PKT';
 you.min:=maxmn;
 you.S:=S;
 you.W:=W;

 Main^.Hide;
 Animation := true;


 for i:=1 to 10 do
 if you.pkt>Gracz[i].pkt then
 begin

   Name^.Resize(10, 5+13*i, 150, 15);
   Submit^.Resize(170, 5+13*i, 50, 15);

   Best^.Show;
   Name^.Show;
   Submit^.Show;

   place:=i;

   break;
 end;


end;

procedure Autorzy;far;
var i:Byte;
   x, y, h:Integer;
begin
 x:=Aut^.Pos^.X+Aut^.Pos^.Width SHR 1;
 y:=Aut^.Pos^.Y;
 h:=Aut^.Pos^.Height;

 for i:=1 to MaxAut do
 if (Y+10*i-10-Top>y) and (10*i+30-Top    V_CenterText(Buf, BigF, X, Y+10*i+20-Top, TxtAut[i], V_RGB($CC, $CC, $CC), 8);
end;

procedure Help;far;
var i:Byte;
   x, y:Integer;
begin
 x:=Pomoc^.Pos^.X+Aut^.Pos^.Width SHR 1;
 y:=Pomoc^.Pos^.Y;

 for i:=1 to MaxPom do
   V_CenterText(Buf, BigF, X, Y+9*i+14, TxtPom[i], V_RGB($CC, $CC, $CC), 8);
end;




procedure OdslonPole(x, y : Byte);
 procedure Odslon(x, y : Byte);
 begin
   if (pl[y, x].zasl) then
   begin
     pl[y, x].zasl := FALSE;
     if (pl[y, x].zagr = 0) then
     begin
       if (x>1) then
       begin
         OdslonPole(x-1, y);
         if (y>1) then
           OdslonPole(x-1, y-1);
         if (y            OdslonPole(x-1, y+1);
       end;
       if (x        begin
         OdslonPole(x+1, y);
         if (y>1) then
           OdslonPole(x+1, y-1);
         if (y            OdslonPole(x+1, y+1);
       end;
       if (y>1) then
           OdslonPole(x, y-1);
       if (y            OdslonPole(x, y+1);
     end;
   end;
 end;
begin
 if (pl[y, x].mina) then
   Boom(x, y)
 else
   Odslon(x, y);
end;


procedure LoadBMPs;
var i:Byte;
begin
 {WCZYTYWANIE OBRAZKOW}
 for i := 0 to MaxBMP do
   begin
     V_NewImage(Pict[i]);
     V_LoadBMP24(Pict[i], Kat+Dane+'p'+IntToStr(i)+'.bmp');

   end;

 for i := 0 to MaxICO do
   begin
     V_NewImage(Ico[i]);
     V_LoadBMP24(Ico[i], Kat+Dane+'i'+IntToStr(i)+'.bmp');

   end;

 V_NewImage(Cur);
 V_LoadBMP24(Cur, Kat+Dane+CursorFile);
 Cur^.Transparent:=TRUE;

end;

function GetValue(nr:Integer):string;
var temp:string;
begin
 temp:='';
 if nr<0 then temp:='-' else
 if nr<100 then temp:='0';
 if abs(nr)<10  then temp:=temp+'0';

 temp:=temp+IntToStr(Abs(nr));
 GetValue:=temp;
end;


procedure FreeBMPs;
var i:Byte;
begin
 {WCZYTYWANIE OBRAZKOW}
 for i := 0 to MaxBMP do
     V_FreeImage(Pict[i]);

 for i := 0 to MaxICO do
     V_FreeImage(Ico[i]);

 V_FreeImage(Cur);


end;

procedure ShowSettings;far;
begin
 Settings^.Show;
end;

procedure HideSettings;far;
begin
 Settings^.Visible:=False;
end;

procedure ShowBest;far;
begin
 Best^.Show;
end;

procedure HideBest;far;
begin
 Best^.Visible:=False;
end;

procedure ShowPomoc;far;
begin
 Pomoc^.Show;
end;

procedure HidePomoc;far;
begin
 Pomoc^.Visible:=False;
end;

procedure ShowAut;far;
begin
 Aut^.Show;
end;

procedure HideAut;far;
begin
 Aut^.Visible:=False;
end;

procedure LoadScores;
var F:File of TGracz;
   i:Byte;
begin
IF not FileExists(Kat+Dane+BestPlayersFile) then Exit;

 Assign(F, Kat+Dane+BestPlayersFile);
 Reset(F);
 i:=1;
 while not eof(f) and (i<=10) do
 begin
   Read(F, Gracz[i]);
   Inc(i);
 end;
 Close(F);

end;

procedure SaveScores;
var F:File of TGracz;
   i:Byte;
begin

 Assign(F, Kat+Dane+BestPlayersFile);
 Rewrite(F);
 i:=1;
 while (i<=10) do
 begin
   Write(F, Gracz[i]);
   Inc(i);
 end;
 Close(F);

end;


procedure Description;far;
var x, y:Integer;
begin
 x:=Settings^.Pos^.X;
 y:=Settings^.Pos^.Y;

 V_WriteXY(Buf, Font, X+52, Y+33, 'ROZMIAR POZIOMY', $FFFF, 6);
 V_WriteXY(Buf, Font, X+52, Y+53, 'ROZMIAR PIONOWY', $FFFF, 6);
 V_WriteXY(Buf, Font, X+52, Y+73, 'ILO—® MIN', $FFFF, 6);
end;


procedure Init;
var i:Byte;
   j:integer;
begin
 Randomize;

 Kat:=S_GetPath(ParamStr(0));

 LoadBMPs;
 LoadScores;

 F_NewFont(BigF);
 F_LoadFont(BigF, Kat+Dane+FontFile2);
 F_NewFont(Font);
 F_LoadFont(Font, Kat+Dane+FontFile);


 V_GetBuf(Buf);
 V_Set10Eh;

 D_CreateObject(Main);
 D_CreateForm(Main, 1);
 PFormParams(Main^.Params)^.Caption:='SAPER';
 PFormParams(Main^.Params)^.Alpha:=2;

 {USTAWIENIA}
 D_CreateObject(Settings);
 D_CreateForm(Settings, 1);
 PFormParams(Settings^.Params)^.Caption:='USTAWIENIA';
 PFormParams(Settings^.Params)^.Alpha:=2;
 Settings^.CanDrag:=True;
 Settings^.resize(20, 30, 150, 120);
 Settings^.Visible:=False;
 {PFormParams(Settings^.Params)^.OnlyActive:=True;}

 D_CreateChild(Settings, SpinX);
 D_CreateEdit(SpinX);
 PEditParams(SpinX^.Params)^.BkColor:=V_RGB($55, $55, $55);
 PEditParams(SpinX^.Params)^.Text:='10';
 SpinX^.Resize(10, 30, 30, 14);

 D_CreateChild(Settings, SpinY);
 D_CreateEdit(SpinY);
 PEditParams(SpinY^.Params)^.BkColor:=V_RGB($55, $55, $55);
 PEditParams(SpinY^.Params)^.Text:='10';
 SpinY^.Resize(10, 50, 30, 14);


 D_CreateChild(Settings, SpinM);
 D_CreateEdit(SpinM);
 PEditParams(SpinM^.Params)^.BkColor:=V_RGB($55, $55, $55);
 PEditParams(SpinM^.Params)^.Text:='10';
 SpinM^.Resize(10, 70, 30, 14);

 D_CreateChild(Settings, Okbut);
 D_CreateButton(okbut);
 PButtonParams(okbut^.Params)^.Text:='ZATWIERD«';
 okbut^.Resize(10, 90, 130, 20);

 D_CreateObject(Bar);
 D_CreateForm(Bar, 0);
 PFormParams(Bar^.Params)^.Caption:='';
 PFormParams(Bar^.Params)^.Alpha:=2;

 {TWORZENIE ETYKIET Z MENU}
 j:=5;
 for i:=1 to MaxMenu do
   begin
     D_CreateChild(Bar, Et[i]);
     D_CreateLabel(Et[i]);

     PLabelParams(Et[i]^.Params)^.Text:=Menu[i];
     PLabelParams(Et[i]^.Params)^.Style:=0;
     PLabelParams(Et[i]^.Params)^.Align:=2;
     PLabelParams(Et[i]^.Params)^.Link:=V_RGB($77, $77, $77);

     Et[i]^.Resize(j, 4, Length(Menu[i])*8, 8);

     j:=j+Length(Menu[i])*8+10;
   end;

 Bar^.Resize(0, 0, 320, 15);
 Bar^.CanDrag:=True;

 D_CreateObject(Best);
 D_CreateForm(Best, 1);
 PFormParams(Best^.Params)^.Caption:='NAJLEPSZE WYNIKI';
 PFormParams(Best^.Params)^.Alpha:=2;
 Best^.CanDrag:=True;
 Best^.Visible:=False;
 Best^.resize(10, 20, 300, 157);

 D_CreateChild(Best, Name);
 D_CreateEdit(Name);
 PEditParams(Name^.Params)^.BkColor:=V_RGB($55, $55, $55);
 PEditParams(Name^.Params)^.Text:='anonim';
 PEditParams(Name^.Params)^.MaxLength:=15;
 Name^.Resize(10, 50, 30, 14);

 D_CreateChild(Best, submit);
 D_CreateButton(submit);
 submit^.Resize(160, 50, 30, 14);

 Name^.Hide;
 Submit^.Hide;

 D_CreateObject(Pomoc);
 D_CreateForm(Pomoc, 1);
 PFormParams(Pomoc^.Params)^.Caption:='POMOC';
 PFormParams(Pomoc^.Params)^.Alpha:=2;
 Pomoc^.CanDrag:=True;
 Pomoc^.Visible:=False;

 D_CreateObject(Aut);
 D_CreateForm(Aut, 1);
 PFormParams(Aut^.Params)^.Caption:='AUTORZY';
 PFormParams(Aut^.Params)^.Alpha:=2;
 Aut^.CanDrag:=True;
 Aut^.Visible:=False;




 D_CreateChild(Main, NewG);
 D_CreateButton(NewG);
 NewG^.Resize(V_MaxEX SHR 1-8, 20, 16, 16);
 PButtonParams(NewG^.Params)^.Picture:=Ico[0];


 D_CreateChild(Main, Mines);
 D_CreateEdit(Mines);
 PEditParams(Mines^.Params)^.BkColor:=0;
 PEditParams(Mines^.Params)^.Color:=V_RGB($FF, 0, 0);


 D_CreateChild(Main, Time);
 D_CreateEdit(Time);
 PEditParams(Time^.Params)^.BkColor:=0;
 PEditParams(Time^.Params)^.Color:=V_RGB($FF, 0, 0);

 Main^.CanDrag:=True;


end;

procedure Done;
begin
 FreeBMPs;
 F_FreeFont(Font);
 F_FreeFont(BigF);
 V_FreeBuf(Buf);
 V_End10Eh;

 D_FreeAllMemory;
end;

procedure ShowLevel;far;
var i, j:Byte;
begin

 for i:=1 to W do
 for j:=1 to S do
   begin
     if (pl[i,j].ow) then
     begin
       pl[i,j].ow := FALSE;
       if (pl[i,j].ozn = OZN_NIEODSLONIETE) then
         V_KopiujObraz(Buf, Pict[3], Addx+(j-1)*SzerK, Addy+(i-1)*WysK);
     end
     else
     if Pl[i, j].Zasl then
     if ((abs(ay-i)<=1) and (abs(ax-j)<=1) and (Pl[i, j].Ozn=OZN_NIEODSLONIETE)) then
       V_KopiujObraz(Buf, Pict[3], Addx+(j-1)*SzerK, Addy+(i-1)*WysK) else
       V_KopiujObraz(Buf, Pict[Pl[i, j].Ozn], Addx+(j-1)*SzerK, Addy+(i-1)*WysK)
     else
     begin
       if (pl[i,j].mina) then
       begin
         if (ly=i) and (lx=j) then
         V_KopiujObraz(Buf, Pict[5], Addx+(j-1)*SzerK, Addy+(i-1)*WysK) else
         V_KopiujObraz(Buf, Pict[4], Addx+(j-1)*SzerK, Addy+(i-1)*WysK);

       end
       else begin
         V_KopiujObraz(Buf, Pict[3], Addx+(j-1)*SzerK, Addy+(i-1)*WysK);
         if Pl[i, j].Zagr>0 then
           V_WriteXY(Buf, Font,
                     (j-1)*SzerK+Addx,
                     (i-1)*WysK+Addy,
                     IntToStr(Pl[i, j].Zagr),
                     kolory[pl[i, j].zagr], 8);
       end;
     end;
   end;
end;

FUNCTION WOknie(x1, y1, x2, y2, mX, mY:Integer):Boolean;
BEGIN
 WOknie:=((mX>=X1) AND (mX<=x2) AND (mY>=Y1) AND (mY<=y2));
END;


procedure NewGame;far;
var t1:Integer;
   t2:Integer;
   t3:Integer;
begin
 t1:=Max(Round(StrToInt(PEditParams(SpinX^.Params)^.Text)), 8);
 t2:=Max(Round(StrToInt(PEditParams(SpinY^.Params)^.Text)), 8);
 t3:=Max(Round(StrToInt(PEditParams(SpinM^.Params)^.Text)), 5);
 TopW := -200;
 Animation:=False;

 UtworzPlansze(t1, t2, t3);

 Main^.Resize(V_MaxEX SHR 1-S*SzerK SHR 1-5, V_MaxEY SHR 1-(W*WysK) SHR 1-20, S*SzerK+10, W*WysK+45);
 NewG^.Resize(S*SzerK SHR 1-3, 20, 16, 16);
 Mines^.Resize(5, 20, S*SzerK SHR 1-10, 16);
 Time^.Resize(S*SzerK SHR 1+14, 20, S*SzerK SHR 1-10, 16);

 PEditParams(Time^.Params)^.Text:=GetValue(0);
 PFormParams(Main^.Params)^.Caption:='SAPER';
 Main^.Show;
end;

function ZliczMiny(x, y : Byte) : Byte;
var
 ile : Byte;
begin
 ile := 0;
 if (pl[y,x].ozn=OZN_ROZMINOWANIE) then
   Inc(ile);
 if (x>1) then
 begin
   if (pl[y, x-1].ozn=OZN_ROZMINOWANIE) then
     Inc(ile);
   if (y>1) and (pl[y-1, x-1].ozn=OZN_ROZMINOWANIE) then
     Inc(ile);
   if (y      Inc(ile);
 end;
 if (x  begin
   if (pl[y, x+1].mina) then
     Inc(ile);
   if (y>1) and (pl[y-1, x+1].ozn=OZN_ROZMINOWANIE) then
     Inc(ile);
   if (y      Inc(ile);
 end;
 if (y>1) and (pl[y-1, x].ozn=OZN_ROZMINOWANIE) then
   Inc(ile);
 if (y    Inc(ile);
 ZliczMiny := ile;
end;

procedure OdslonWokol(x, y : Integer);
begin
 if (x>1) then
 begin
   if (pl[y, x-1].ozn=OZN_NIEODSLONIETE) then
     OdslonPole(x-1, y);
   if (y>1) and (pl[y-1, x-1].ozn=OZN_NIEODSLONIETE) then
     OdslonPole(x-1, y-1);
   if (y      OdslonPole(x-1, y+1);
 end;
 if (x  begin
   if (pl[y, x+1].ozn=OZN_NIEODSLONIETE) then
     OdslonPole(x+1, y);
   if (y>1) and (pl[y-1, x+1].ozn=OZN_NIEODSLONIETE) then
     OdslonPole(x+1, y-1);
   if (y      OdslonPole(x+1, y+1);
 end;
 if (y>1) and (pl[y-1, x].ozn=OZN_NIEODSLONIETE) then
   OdslonPole(x, y-1);
 if (y    OdslonPole(x, y+1);
end;

procedure Click;
var kx, ky:Integer;
   Sx, Sy:Integer;
   mx, my:Integer;
   b     :Byte;
   tmp, i, j:Integer;
   ile  : Byte;
   ile_flag    : Byte;

{    function What(x, y : Integer) : Byte;
   begin
     if (x < 0)
   end;}
begin

 odslWokol := FALSE;
 MouseButtonsXY(mx, my, b);

 if not WOknie(AddX, AddY, Addx+SzerK*S, Addy+WysK*W, mx, my)then
   Exit;


 kx:=1+(Mx-AddX) DIV SzerK;
 ky:=1+(My-AddY) DIV WysK;

 ax := -1;
 ay := -1;

 if (sb=M_LEWY+M_PRAWY) and (b<>M_LEWY+M_PRAWY)then
 begin

   if (not pl[ky, kx].zasl and (pl[ky, kx].zagr > 0)) then
   begin
     ile_flag := 0;
     if (pl[ky-1, kx-1].ozn = OZN_ROZMINOWANIE) then Inc(ile_flag);
     if (pl[ky-1, kx].ozn = OZN_ROZMINOWANIE) then Inc(ile_flag);
     if (pl[ky-1, kx+1].ozn = OZN_ROZMINOWANIE) then Inc(ile_flag);
     if (pl[ky, kx+1].ozn = OZN_ROZMINOWANIE) then Inc(ile_flag);
     if (pl[ky+1, kx+1].ozn = OZN_ROZMINOWANIE) then Inc(ile_flag);
     if (pl[ky+1, kx].ozn = OZN_ROZMINOWANIE) then Inc(ile_flag);
     if (pl[ky+1, kx-1].ozn = OZN_ROZMINOWANIE) then Inc(ile_flag);
     if (pl[ky, kx-1].ozn = OZN_ROZMINOWANIE) then Inc(ile_flag);
     if (ile_flag = pl[ky, kx].zagr) then
        OdslonWokol(kx, ky);
   end;
 end else
 if (b=M_LEWY+M_PRAWY) then
 begin
   ax := kx;
   ay := ky;
 end;

{  if (sb=4) and (b=M_ZADEN)then
 begin
   odslWokol := TRUE;
   if (pl[ky,kx].zasl) then
     pl[ky,kx].ow := TRUE
   else begin
     if (pl[ky,kx].zagr>0) then
     BEGIN
       ile := ZliczMiny(kx, ky);
       if (ile >= pl[ky,kx].zagr) then
       OdslonWokol(kx, ky);
     END;
   end;

   if (kx>1) then
   begin
     if (pl[ky,kx-1].zasl) then
       pl[ky,kx-1].ow := TRUE;
     if (ky>1) and (pl[ky-1,kx-1].zasl) then
       pl[ky-1,kx-1].ow := TRUE;
     if (ky        pl[ky+1,kx-1].ow := TRUE;
   end;
   if (kx    begin
     if (pl[ky,kx+1].zasl) then
       pl[ky,kx+1].ow := TRUE;
     if (ky>1) and (pl[ky-1,kx+1].zasl)then
       pl[ky-1,kx+1].ow := TRUE;
     if (ky        pl[ky+1,kx+1].ow := TRUE;
   end;
   if (ky>1) and (pl[ky-1,kx].zasl) then
     pl[ky-1,kx].ow := TRUE;
   if (ky      pl[ky+1,kx].ow := TRUE;

 end
 else}

   if (b=M_LEWY) and Poczatek then
   begin
     sb:=M_ZADEN;
     Poczatek:=False;
     Playing:=True;
     czas:=S_Ti;
   end;

 if not Playing or (LastObj<>Main) then Exit;
 if sb=M_ZADEN THEN
 if (b=M_LEWY) then
   begin
     if (pl[ky, kx].ozn <> OZN_ROZMINOWANIE) then
       OdslonPole(kx, ky)
   end
   else if (b = M_PRAWY) then
   begin
     if (pl[ky, kx].zasl) then
     begin
       Inc(pl[ky, kx].ozn);
       if (pl[ky, kx].ozn > 2) then
         pl[ky, kx].ozn := 0;
       if pl[ky, kx].ozn=1 then
         Dec(mn)
       else if pl[ky, kx].ozn=2 then
         Inc(mn);
     end
  end;

 tmp:=0;

 for i:=1 to w do
 for j:=1 to s do
 if not pl[i, j].zasl then Inc(tmp);

 if tmp=W*S-MaxMn then win;

 sb := b;
end;


procedure SaveScore;far;
var i, j:Byte;


begin

 Name^.Hide;
 Submit^.Hide;

 for i:=1 to 10 do
   if Gracz[i].pkt    begin
     for j:=10 downto i+1 do
       Gracz[j]:=Gracz[j-1];

     you.Imie:=D_GetEditText(Name);
     Gracz[i]:=you;

     break;
   end;

 place:=0;
 SaveScores;
end;

procedure BestPlayers;far;
var i:Byte;
begin
 for i:=1 to 10 do
 if place<>i then
   V_CenterText(Buf, Font, Best^.Pos^.X+Best^.Pos^.Width SHR 1, Best^.Pos^.Y+10+13*i,

                     Gracz[i].Imie+' '+
                     IntToStr(Gracz[i].Pkt)+'pkt '+
                     IntToStr(Gracz[i].Czas)+'sek '+
                     'pole:'+
                     IntToStr(Gracz[i].S)+'x'+IntToStr(Gracz[i].W)+'x'+IntToStr(Gracz[i].Min)+'m',
                     V_RGB($CC, $CC, $CC), 6);
end;


procedure Animacja(Buf : TEkran10Eh);
var i:Byte;
   x, y, h:Integer;

begin
 V_RozmyjEkran(Buf, 1);
 MakeFire(Buf);

 x:=160;
 y:=-10;
 h:=200;

 TopW:=TopW+0.3;if (TopW>10*MaxWin) then TopW := -200;

 for i:=1 to MaxWin do
 {if (Y+10*i-TopW>y) and (10*i+30-TopW  begin
   V_CenterText(Buf, BigF, X, Y+10*i+20-Round(TopW), TxtWin[i], V_RGB($77, $44, $22), 8);
   V_CenterText(Buf, BigF, X, Y+10*i+20-1-Round(TopW), TxtWin[i], V_RGB($ff, $dd, $88), 8);
 end;


end;

procedure Play;
begin

 keyb_Init;
 NewGame;
 Animation := False;
 ax:=-1;
 ay:=-1;

 {NOWA GRA}
 D_NewEvent(NewG^.Events, NewGame, ON_MOUSE_CLICK);
 D_NewEvent(Et[1]^.Events, NewGame, ON_MOUSE_CLICK);
 D_NewEvent(okbut^.Events, NewGame, ON_MOUSE_CLICK);

 {USTAWIENIA}
 D_NewEvent(Et[2]^.Events, ShowSettings, ON_MOUSE_CLICK);
 D_NewEvent(PFormParams(Settings^.Params)^.CloseButton^.Events, HideSettings, ON_MOUSE_CLICK);

 {NAJLEPSZE WYNIKI}
 D_NewEvent(Et[3]^.Events, ShowBest, ON_MOUSE_CLICK);
 D_NewEvent(PFormParams(Best^.Params)^.CloseButton^.Events, HideBest, ON_MOUSE_CLICK);
 D_NewEvent(Submit^.Events, SaveScore, ON_MOUSE_CLICK);



 {POMOC}
 D_NewEvent(Et[4]^.Events, ShowPomoc, ON_MOUSE_CLICK);
 D_NewEvent(PFormParams(Pomoc^.Params)^.CloseButton^.Events, HidePomoc, ON_MOUSE_CLICK);

 {AUTORZY}
 D_NewEvent(Et[5]^.Events, ShowAut, ON_MOUSE_CLICK);
 D_NewEvent(PFormParams(Aut^.Params)^.CloseButton^.Events, HideAut, ON_MOUSE_CLICK);


 {PODCZAS RYSOWANIA OKNA SYSTEM DOORS WYWOLA PROCEDURE SHOW LEVEL}
 PFormParams(Main^.Params)^.Drawing:=ShowLevel;
 PFormParams(Settings^.Params)^.Drawing:=Description;
 PFormParams(Best^.Params)^.Drawing:=BestPlayers;
 PFormParams(Pomoc^.Params)^.Drawing:=Help;
 PFormParams(Aut^.Params)^.Drawing:=Autorzy;
 PEditParams(Time^.Params)^.Text:='000';
 Playing:=False;XTop:=-300;
 Poczatek:=True;



   repeat

     DE_GetEvents;

     if Animation then Animacja(Buf) else
        V_ClearScreen(Buf, V_RGB($55, $55, $55));

     AddX:=Main^.Pos^.X+5;
     AddY:=Main^.Pos^.Y+40;
     Main^.CanDrag:=NOT Playing;

     PEditParams(Mines^.Params)^.Text:=GetValue(Mn);

     if Aut^.Visible then
     begin
       Inc(XTop);
       if Xtop>400 then XTop:=-300;
       Top:=XTop div 2;
     end;

     if Playing then PEditParams(Time^.Params)^.Text:=GetValue(Round((S_Ti-Czas)/18.2));


     if DE_ObjectEvent(PFormParams(Main^.Params)^.CloseButton, ON_MOUSE_CLICK) then
        break;


     D10_DrawAll(Buf);

     D10_DrawCursor(Buf, Cur);

     {F12 zrzut ekranowy}
     if (port[$60]=88) then V_PrintScreen('saper.bmp');

     V_Vret;
     V_FlipBuf(Buf);
     Click;
     DE_DeleteEvents;

     if Key[VK_ESC] then Break;



   until false;


 keyb_End;

end;

begin
 Init;

 Play;

 Done;
end.

 

Strona korzysta z plików cookie w celu świadczenia usług Google (reklamy, statytyki) oraz Facebook. Jeśli chcesz zablokować pliki cookies wyłacz je w swojej przeglądarce. Potrzebujesz pomocy? kliknij