Kod ¼ród³owy saperaPoni¿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.
|