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.
|
