Ver. 1.0 Beta, Don't have a compiler? Now you can write simple scripts ONLINE! This is a basic version -does not include all the Pascal statements. Only to learn basics

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.

 

ON-LINE scripts!

This website uses cookie files in order to provide Google services (advertisements, analitycs) and Facebook. If you want to block using cookies, turn them off in your browser settings. Need a help? Click me