捡金豆游戏源代码

捡金豆 (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;

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;

//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;

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;

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;

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;

}

{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;

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;

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;

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;

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;

//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;

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;

Procedure TMp.aboutClick(Sender: TObject);

Var

aboutbox: Taboutbox;

Begin

AboutBox := TAboutBox.Create(Self);

Try

AboutBox.ShowModal;

Finally

AboutBox.Free;

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;

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.

我有很多功能没有实现，如帮助；那时我要准备考试，

代码写得很糟糕。

我本想给你写好NOTE再给公布。

我懒得写了，Sorry!

其实我刚才已经写过一次了，习惯性的输入日期；

我按了个F5,我按Stop也来不及！

by cxz 2002.05.21