CSDN博客

img CXZ9

捡金豆游戏源代码

发表于2002/5/22 9:57:00  1406人阅读

分类: Delphi源代码

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

 

 

 

 

0 0

相关博文

我的热门文章

img
取 消
img