捡金豆 (Bantuni)源代码
捡金豆是我编的第一个游戏。
本游戏是Nokia 3310中的捡金豆的PC版，
以前我总是看不懂此游戏规则。这还是我五
一回家时看哥哥玩才知道的 ：把小碗中的
豆子放入后面的碗中，如果最后的豆子落入
你的大碗。你将得到一次新的机会。如果最
后的豆子落入你的空碗，你将从对手对立的
小碗中得到豆子。豆子多者胜。
下面是主要的源代码：
Unit bani;
Interface
Uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
DBCGrids, Grids, StdCtrls, jpeg, ExtCtrls, about, fhelp, Menus, ImgList, ahelp;
Const N = 6;
MAx = 200;
Type
TMp = class(TForm)
Mgrid: TStringGrid;
init: TButton;
new: TButton;
exit: TButton;
hide: TButton;
mainimg: TImage;
newimg: TImage;
helpimg: TImage;
ywin: TButton;
PopupMenu1: TPopupMenu;
mnew: TMenuItem;
mundo: TMenuItem;
N3: TMenuItem;
mabout: TMenuItem;
N5: TMenuItem;
mexit: TMenuItem;
ImageList1: TImageList;
undo: TButton;
mhelp: TMenuItem;
help: TButton;
about: TButton;
si: TButton;
sh: TTimer;
rnd: TButton;
two: TMenuItem;
NO1: TMenuItem;
NO2: TMenuItem;
NO3: TMenuItem;
NO4: TMenuItem;
NO5: TMenuItem;
N9: TMenuItem;
no: TButton;
L2: TButton;
l3: TButton;
Button1: TButton;
Procedure initClick(Sender: TObject);
Procedure FormCreate(Sender: TObject);
Procedure MgridMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
Procedure exitClick(Sender: TObject);
Procedure FormKeyDown(Sender: TObject; Var Key: Word;
Shift: TShiftState);
Procedure hideClick(Sender: TObject);
Procedure helpimgClick(Sender: TObject);
Procedure ywinClick(Sender: TObject);
Procedure mainimgMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
Procedure undoClick(Sender: TObject);
Procedure helpClick(Sender: TObject);
Procedure aboutClick(Sender: TObject);
Procedure shTimer(Sender: TObject);
// procedure siClick(Sender: TObject);
Procedure rndClick(Sender: TObject);
Procedure twoClick(Sender: TObject);
Procedure noClick(Sender: TObject);
Procedure NO1Click(Sender: TObject);
Procedure L2Click(Sender: TObject);
Procedure l3Click(Sender: TObject);
Procedure NO2Click(Sender: TObject);
Procedure NO3Click(Sender: TObject);
Procedure newimgClick(Sender: TObject);
//procedure iClick(Sender: TObject);
// procedure MgridClick(Sender: TObject);
Private
{ Private declarations }
// procedure ssend(p:integer):forword;
Public
{ Public declarations }
End;
type
Way = Record
pos: integer;
value: integer;
End;
tai = procedure(Sender: TObject) Of Object;
Var
Mp: TMp;
poto, potm, tpoto, tpotm, Jpoto, Jpotm, spoto, spotm, qpoto, qpotm: array[0..N] Of integer;
MAXS, MINS: WAY;
MWAY: array[1..MAX] Of WAY;
Ygo, Ymove, Find, re, ok, sgo, jgo, qgo: boolean;
pos, q, maxscore, score: integer;
msg, who: String;
//msg :string;
// who:(Ywin,Ylost,eq);
ai: tai;
Procedure win;
Procedure omove(p, m: integer);
Procedure smove(p, m: integer);
Procedure osend(p: integer);
Procedure ssend(p: integer);
Procedure searchi;
Procedure searchii;
Procedure sundo;
Procedure mundo;
Procedure minit;
Implementation
{$R *.DFM}
Procedure minit;
Var
i: integer;
Begin
For i := 1 To 6 Do
Begin
poto[i] := 4;
potm[i] := 4;
End;
poto[0] := 0;
potm[0] := 0;
End;
Procedure win;
Var
sumo, summ, i: integer;
Begin
sumo := 0;
summ := 0;
ok := false;
For i := 1 To 6 Do
Begin
sumo := sumo + poto[i];
summ := summ + potm[i];
End;
If (sumo = 0) Or (summ = 0) Then
Begin
potm[0] := summ + potm[0];
poto[0] := sumo + poto[0];
sumo := poto[0];
summ := potm[0];
msg := '比分：' + inttostr(summ) + ':' + inttostr(sumo);
For i := 1 To 6 Do
Begin
potm[i] := 0;
poto[i] := 0;
End;
ok := true;
End;
If (ok = true) Then
Begin
// sh.Enabled :=false;
If (summ>sumo) Then
// msg:='You win!' ;
who := 'ywin';
if(summ = sumo) Then
//msg:='EQ!'
who := 'eq';
If (summ<sumo) Then
//msg:='You lost!';
who := 'ylost';
// showmessage(who);
End;
End;
Procedure searchii;
Var
i, j, k, s: integer;
Begin
find := false;
maxscore := 0;
score := 0;
For i := 1 To 6 Do
Begin
If (poto[i] = 0) And (potm[i]<>0) Then
Begin
k := 1;
For j := i + 1 To 6 Do
Begin
s := poto[j] Mod 13;
If (s = k) Then
Begin
score := potm[7 - i] + 1;
find := true;
End;
If (maxscore<score) Then
Begin
maxscore := score;
pos := j;
End;
inc(k);
End;
End;
End;
//if pos<> 0 then
//osend(pos);
If not(find) Then
Begin
While (poto[pos] = 0) Or (pos = 0) Do
Begin
Randomize;
pos := random(5) + 1;
End;
End;
osend(pos);
End;
Procedure searchi;
Var
i: integer;
Begin
find := false;
For i := 1 To 6 Do
Begin
If (poto[i] = i) Then
Begin
find := true;
osend(i);
//searchi;
End
// else continue;
End;
If not(find) Then searchii;
End;
Function osearchiii: integer;
Var
dis, min, i: integer;
Begin
min := 24;
For i := 1 To 6 Do
Begin
dis := i - poto[i];
If (dis>0) And (min>dis) Then
Begin
min := dis;
pos := 0;
End;
End;
result := pos;
End;
Function qsearchi: integer;
Var
i, opp: integer;
Begin
qpoto := poto;
qpotm := potm;
qgo := ygo;
maxscore := 0;
score := 0;
opp := poto[0];
For i := 1 To 6 Do
Begin
osend(i);
score := poto[0] - opp;
potm := qpotm;
poto := qpoto;
ygo := qgo;
If maxscore<score Then
Begin
maxscore := score;
pos := i;
End;
End;
While (poto[pos] = 0) Or (pos = 0) Do
Begin
Randomize;
pos := random(5) + 1;
// osend(pos);
End;
//osend(pos);
result := pos;
End;
{
function osearchiV:integer;
var i,j,k,s:integer;
begin
score:=0;
maxscore:=0;
for i := 1 to 6 do
begin
if (potm[7-i]<>0) and(poto[0]=0) then
begin
end;
end;
end;
}
{function qsearchii:integer;
var i,opp:integer;
begin
result:=i;
end; }
Procedure smove(p, m: integer);
Var
t, i, j: integer;
Begin
i := P;
// if p<>0 then
For j := m Downto 1 Do
Begin
potm[i] := potm[i] + 1;
i := i - 1;
End;
pos := i + 1;
t := potm[pos];
If (pos<>0) Then
Begin
//if (ygo=true) and (pos<>0) and(t=1) then
If (ygo = true)and(t = 1) Then
Begin
potm[0] := potm[0] + poto[7 - pos] + 1;
potm[pos] := 0;
poto[7 - pos] := 0;
End;
ygo := not(Ygo);
End;
win;
End;
Procedure omove(p, m: integer);
Var
t, i, j: integer;
Begin
i := P;
//if p<>0 then
// begin
For j := m Downto 1 Do
Begin
poto[i] := poto[i] + 1;
i := i - 1;
End;
pos := i + 1;
t := poto[pos];
If (pos<>0) Then
Begin
ygo := not(Ygo);
//if (ygo=true) and (pos<>0)and (t=1) then
If (ygo = true) and(t = 1) Then
Begin
poto[0] := poto[0] + potm[7 - pos] + 1;
poto[pos] := 0;
potm[7 - pos] := 0;
End;
End;
//end;
win;
End;
Procedure ssend(p: integer);
Var
m, i, j: integer;
Begin
jpotm := potm;
jpoto := poto;
jgo := ygo;
If ygo = true Then
Begin
m := potm[p];
If (re = true) Then
Begin
Mway[q].pos := p;
mway[q].value := m;
End;
//p:=6-p;
potm[p] := 0;
If (m>p) Then
Begin
m := m - p;
For i := p - 1 Downto 0 Do
Begin
potm[i] := potm[i] + 1;
End;
If (m>6) Then
Begin
For j := 6 Downto 1 Do
poto[j] := poto[j] + 1;
m := m - 6;
smove(6, m);
End
else//m<6
omove(6, m);
End
else//m<p;
smove(p - 1, m);
End;
End;
Procedure osend(p: integer);
Var
m, i, j: integer;
Begin
jpotm := potm;
jpoto := poto;
jgo := ygo;
If (ygo = false) Then
Begin
m := poto[p];
If (re = true) Then
Begin
Mway[q].pos := p;
mway[q].value := m;
End;
poto[p] := 0;
If (m>p) Then
Begin
m := m - p;
For i := p - 1 Downto 0 Do
Begin
poto[i] := poto[i] + 1;
// tmp.temp.lines.add('poto['+inttostr(i)+']='+inttostr(poto[i]));
End;
If (m>6) Then
Begin
For j := 6 Downto 1 Do
Begin
potm[j] := potm[j] + 1;
End;
m := m - 6;
omove(6, m);
End
Else
//m>6
smove(6, m);
End
else//m<p
omove(p - 1, m);
End;
End;
Procedure sundo;
Begin
poto := jpoto;
potm := jpotm;
ygo := jgo;
End;
Procedure mundo;
Begin
poto := spoto;
potm := spotm;
ygo := sgo;
End;
{procedure TMp.initClick(Sender: TObject);
var i:integer;
begin
for i :=0 to 5 do
begin
mgrid.Cells[i,0]:=inttostr(poto[i+1]);
mgrid.Cells[i,2]:=inttostr(potm[6-i]);
end;
mgrid.Cells[0,1]:=inttostr(poto[0]);
mgrid.Cells[5,1]:=inttostr(potm[0]);
if (ygo=true) then
begin
mp.Caption :='捡金豆 轮到你走了!';
// sh.Enabled :=false;
end
else
begin
mp.caption:='捡金豆 现在看我的了!';
sh.Enabled :=true;
end;
if (ok=true) then
begin
sh.Enabled :=false;
ywinclick(self);
ok:=false;
minit;
initclick(init);
end;
end;
procedure minit;
var i:integer;
begin
for i :=1 to 6 do
begin
poto[i]:=4;
potm[i]:=4;
end;
poto[0]:=0;
potm[0]:=0;
ygo:=true;
end; }
Procedure TMp.FormCreate(Sender: TObject);
//var i:integer;
Begin
Ygo := true;
//Ymove:=true;
ai := l2click;
//edit1.SetFocus ;
sh.Enabled := false;
minit;
initClick(self);
helpimg.Hint := ' 游戏规则:' + #13 + '把小碗中的豆子放入后面的碗中，' + #13 + '如果最后的豆子落入你的大碗。' + #13 + '你将得到一次新的机会。如果最' + #13 + '后的豆子落入你的空碗，你将从' + #13 + '对手对立的小碗中得到豆子。' + #13 + '豆子多者胜。';
// Mgrid.Hint:='第一行表示对方的小碗。'+#13+'第二行第一个是对方的大碗。'+#13+'最后一个是你的大碗。'+#13+'第三行是你的小碗。'+#13+'目的就是把豆子捡入你的大碗。'+#13+'不好意思，大碗和小碗一样大！' ;
End;
Procedure TMp.MgridMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
Var
col, row, p, q: longint;
Begin
mgrid.MouseToCell(X, Y, Col, Row);
If mgrid.cells[col, row]<>'' Then
Begin
q := strtoint(mgrid.cells[col, row]);
p := col;
If (p>= 0)and (p<6)and (q<>0) Then
Begin
If (row = 0) Then
Begin
p := p + 1;
// temp.lines.add('p:'+inttostr(p)+' '+'q:'+inttostr(q));
// temp.lines.add('');
osend(p);
initclick(init);
End
Else If (row = 2) Then
Begin
p := 6 - p;
//temp.lines.add('p:'+inttostr(p)+' '+'q:'+inttostr(q));
//temp.lines.add('');
ssend(p);
initclick(init);
End;
End;
//label1.Caption :='col:'+inttostr(col)+chr(10)+chr(13)+'row:'+inttostr(row)+chr(10)+chr(13)+'Value:'+inttostr(q);
End;
//mgrid.Cells[Col, Row] := 'Col ' + IntToStr(Col) +
// ',Row ' + IntToStr(Row);
End;
Procedure TMp.exitClick(Sender: TObject);
Begin
close;
End;
Procedure TMp.FormKeyDown(Sender: TObject; Var Key: Word;
Shift: TShiftState);
Begin
// if (ssCtrl in Shift) and (chr(Key) in ['A', 'a']) then
// ShowMessage('Ctrl-A');
End;
Procedure TMp.hideClick(Sender: TObject);
Begin
//form.show;
//I don't known. iS it only can use if project?
End;
Procedure TMp.helpimgClick(Sender: TObject);
Begin
helpclick(self);
End;
Procedure TMp.ywinClick(Sender: TObject);
Var
frmhelp: Tfrmhelp;
Begin
frmhelp := Tfrmhelp.Create(Self);
Try
{case who of
ywin: frmhelp.Caption := '恭喜，你赢了！';
ylost: frmhelp. Caption := '嘻嘻，你输了！';
else
frmhelp.Caption := '可惜，这是个平局。';
end; }
If who = 'ywin' Then
frmhelp.Caption := '恭喜，你赢了！' + msg;
If who = 'ylost' Then
frmhelp. Caption := '嘻嘻，你输了！' + msg;
If who = 'eq' Then
frmhelp.Caption := '可惜，这是个平局。';
frmhelp.Showmodal;
Finally
frmhelp.Free;
// newclick(self);
End;
End;
Procedure TMp.mainimgMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
Begin
If button = mbright Then
popupmenu1.popup(mp.left + x, mp.Top + y);
End;
Procedure TMp.undoClick(Sender: TObject);
Begin
sundo;
//ygo:=not(Ygo);
initclick(self);
End;
Procedure TMp.helpClick(Sender: TObject);
Var
hhelp: Thhelp;
Begin
hhelp := Thhelp.Create(Self);
Try
hhelp.Showmodal;
Finally
hhelp.Free;
End;
End;
Procedure TMp.aboutClick(Sender: TObject);
Var
aboutbox: Taboutbox;
Begin
AboutBox := TAboutBox.Create(Self);
Try
AboutBox.ShowModal;
Finally
AboutBox.Free;
End;
End;
Procedure TMp.shTimer(Sender: TObject);
Begin
If (ygo = false) Then
ai(self);
//while ygo=false do
//siclick(self);
End;
{procedure TMp.siClick(Sender: TObject);
begin
spoto:=poto;
spotm:=potm;
sgo:=ygo;
searchi;
initclick(self);
end; }
Procedure TMp.rndClick(Sender: TObject);
Begin
While (poto[pos] = 0) Or (pos = 0) Do
Begin
Randomize;
pos := random(5) + 1;
End;
osend(pos);
End;
Procedure SetCheck(Sender: TObject);
Var
Item: TMenuItem;
Begin
Item := Sender As TMenuItem;
Item.Checked := not(item.checked);
End;
Procedure TMp.twoClick(Sender: TObject);
Begin
setcheck(sender);
ai := noclick;
End;
Procedure TMp.noClick(Sender: TObject);
Var
cxz: integer;
Begin
cxz := 0;
End;
Procedure TMp.NO1Click(Sender: TObject);
Begin
setcheck(sender);
ai := rndclick;
End;
Procedure TMp.L2Click(Sender: TObject);
Begin
jpoto := poto;
jpotm := potm;
jgo := ygo;
searchi;
initclick(self);
End;
Procedure TMp.l3Click(Sender: TObject);
Begin
jpoto := poto;
jpotm := potm;
jgo := ygo;
pos := qsearchi;
osend(pos);
initclick(self);
End;
Procedure TMp.NO2Click(Sender: TObject);
Begin
setcheck(sender);
ai := l2click;
End;
Procedure TMp.NO3Click(Sender: TObject);
Begin
setcheck(sender);
ai := l3click;
End;
Procedure TMp.newimgClick(Sender: TObject);
Begin
If MessageDlg('你真的想重新开始游戏吗？',
mtConfirmation, [mbYes, mbNo], 0) = mrYes Then
Begin
minit;
initclick(init);
End;
End;
Procedure TMp.initClick(Sender: TObject);
Var
i: integer;
Begin
For i := 0 To 5 Do
Begin
mgrid.Cells[i, 0] := inttostr(poto[i + 1]);
mgrid.Cells[i, 2] := inttostr(potm[6 - i]);
End;
mgrid.Cells[0, 1] := inttostr(poto[0]);
mgrid.Cells[5, 1] := inttostr(potm[0]);
If (ygo = true) Then
Begin
mp.Caption := '捡金豆 轮到你走了!';
// sh.Enabled :=false;
End
Else
Begin
mp.caption := '捡金豆 现在看我的了!';
sh.Enabled := true;
End;
If (ok = true) Then
Begin
sh.Enabled := false;
ywinclick(self);
ok := false;
minit;
initclick(init);
End;
End;
End.
我有很多功能没有实现，如帮助；那时我要准备考试，
代码写得很糟糕。
我本想给你写好NOTE再给公布。
我懒得写了，Sorry!
其实我刚才已经写过一次了，习惯性的输入日期；
我按了个F5,我按Stop也来不及！
by cxz 2002.05.21
|
本类阅读TOP10