捡 金豆 (Bantuni) source code
捡 金豆 is the first game I compiled. This game is the PC version of the 捡 金子 in NOKIA 3310. I always can't understand the rules of this game. This is still what I read when I went home, I learned: put the beans in the small bowl in the back in the bowl, if the last bean falls into your big bowl. You will get a new opportunity. If the last bean falls into your empty bowl, you will get a beans from the opponent's small bowl. Multi-winged beans.
The following is the main source code:
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; N5: TMENUITEM; MEXIT: TMENUITEM; imagelist1: timelist; ivagelist; undo: tbutton; mHelp: tMenuitem; help: tbutton; strout: tbutton; rnd: tbutton; sw: 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: TObje ct); 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;
// 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; POTM, POTM, TPOTM, TPOTM, JPOTO, JPOTM, SPOTM, JPOTO, JPOTM, SPOTM: 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]: = END;
Procedure Win; Var Sumo, Summ, I: Integer; Begin Sumo: = 0; SUMM: = 0; OK: = FALSE; for i: = 1 to 6 do begin suom: = 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: = 'score:' INTTOSTR (SUMM) ':' INTOSTR (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 Procedure Searchii; Var i, J, K, S: Inteder; Begin Find: = FALSE; MAXSCORE: = 0; Score: = 0; for i: = 1 to 6 do beginix (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 Function OSEARCHIII: Integer; Var DIS, Min, I: Inteder; begin min: = 24; for i: = 1 to 6 do begin dissund, = i - poto [i]; if (disgu> 0) and (min> DIS) ................................................... .. Function QSearchi: Integer; var i, opp: = pot; qpotm: = potm; qgo: = ygo; maxScore: = 0; score: = 0; opp: = poto [0]; for i: = 1 to 6 do begin osnd (i); score: = poto [0] - opp; potm: = qpotm; pot: = qpoto; ygO: = QGO; if MaxScore END; End;} {Function QSearchii: Integer; Var I, OPP: Integer; beginResult: = i; end; Procedure Smove; 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; Procedure Omove; 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; POTM [POS]: = 0; POTM [7 - POS]: = 0; end; end; // end; win; end; procedure ssend (p: integer); Var M, I, J: Integer; begin jpotm: = potm; jpoto: = pot; jgom: = ygO; if ygo = true kilo m: = potm [p]; if (re = true) The begin MWAY [q] .pos: = P; MWAY [q] .Value: = m; end; // p: = 6-p; potm [p]: = 0; if (m> p) The 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); ELSE / / M <6 Omove (6, M); ELSE // m Procedure OSEND (P: Integer); Var M, I, J: Integer; Begin Jpotm: = Potm; JPoto: = POTW; 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 pot [i]: = POTO [i] 1; // tmp.temp.lines.add ('POTO [' INTOSTR (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); ELSE / / M
PROCEDURE MUNDO; BEGIN POTO: = Spoto; {Procedure Tmp.INITCLICK (Sender: TOBJECT); VAR i: integer; beginfor i: = 0 to 5 dobeginmgrid.cells [i, 0]: = INTOSTR (POTO [i 1]); mgrid.cells [i, 2 ]: = INTTOSTR (POTM [6-I]); End; mgrid.cells [0,1]: = INTOSTR (POTO [0]); mgrid.cells [5,1]: = INTOSTR (Potm [0]) ; if (ygo = true) thnbeginmp.caption: = '捡 金豆 轮 你 走!'; // sh.enabled: = false; endelsebeginmp.caption: = '捡 金豆 now look at me!'; Sh.enabled: = true; IF (OK = true) thnbeginsh.enabled: = false; ywinclick (self); ok: = false; minit; initclick (init); procedure minit; Var i: integer; beginfor i: = 1 to 6 dobeginpoto [i]: = 4; POTM [I]: = 4; End; POT [0]: = 0; POTM [0]: = 0; ygo: = true ; Procedure tmp.form; // var i: integer; begin ygo: = true; // ymove: = true; ai: = l2click; //EDit1.setfocus; sh.enable; InitClick (self); helpimg.hint: = 'game rules:' # 13 'puts the beans in the small bowl in the back in the bowl,' # 13 'If the last bean falls into your big bowl. ' # 13 ' you will get a new opportunity. If the beans after the most # 13 'fall into your empty bowl, you will get a beans from the' # 13 'opponent's opposite bowl. ' # 13 ' beans have wins. '; // mgrid.hint: =' The first line represents the other's small bowl. ' # 13 ' The second line is the first one of the other people. ' # 13 ' The last is your big bowl. ' # 13 ' Third line is your small bowl. ' # 13 ' purpose is to put the beans into your big bowl. ' # 13 ' Sorry, big bowls and small bowls are as big! END; Procedure tmp.mgridmouseup (sender: Tobject; Button: TMouseButton; Shift: TshiftState; x, y: integer; var col, row, p, q: longint; begin 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:' INTOSTR (P) ' ' q: ' INTOSTR (Q )); // Temp.Lines.Add (''); OSEND (P); InitClick (init); end else if (row = 2) THEN BEGIN P: = 6 - p; //temp.lines.add ( 'p:' INTOSTR (P) ' ' q: ' INTOSTR (Q)); //Temp.Lines.Add (' '); ssend (p); infickk (init); end; end; //Label1.caption: = 'col:' inttostr (color chr (10) CHR (13) 'Row:' INTOSTR (ROW) CHR (10) CHR (13) Value: ' INTSTOSTR (q); end; //mgrid.cells[col, row]: =' col ' INTOSTR (COL) //', ROW ' INTT Ostr (row); end; procedure tmp.exitclick (sender: TOBJECT); begin close; 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); Procedure tmp.ywinclick (sender: Tobject); var frmhelp: tfrmhelp: = tfrmhelp.create (self); try {copy who ywin: frmhelp.caption: = 'Congratulations, you won! '; YLOST: FRMHELP. CAPTION: =' Hey, you lose! '; Else frmhelp.caption: =' Unfortunately, this is a single. '; End;} if who =' ywin 'Then frmhelp.caption: =' Congratulations, you won! ' msg; if who =' YLOST 'THEN FRMHELP. CAPTION: =' 嘻嘻, you lose! ' msg; if who =' EQ 'Ten frmhelp.caption: =' Unfortunately, this is a single. '; 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 the popupmenu1.popup (mp.Left x, mp.top y); Procedure tmp.undoclick (sender: TOBJECT); Begin Sundo; // YGO: = NOT (YGO); InitClick (Self); Procedure tmp.helpclick (sero: THHELP; begin hhelp: = th Hhelp.create (self); type hhelp.showmodal; fin or hhelp.free; end; end; Procedure tmp.aboutclick (sender: Tobject); Var Aboutbox: TaboutBox; Begin Aboutbox: = TaboutBox.create (Self); TryBox.showModal; Finally Aboutbox.Free; end; end; Procedure tmp.shtimer (sender: TOBJECT); Begin if (YGO = false) THEN AI (Self); // while ygo = false do // SiClick (Self); {procedure tmp.siclick (sender: TOBJECT); beginspoto: = pot; spotm: = potm; sgO: = ygO; searchi; initclick (self); End;} Procedure tmp.rndclick (sender: TOBJECT); Begin While (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); Procedure tmp.twoclick (sender: TOBJECT); Begin setCheck (sender); AI: = NOCLICK; Procedure tmp.nocclick (sender: TOBJECT); VAR CXZ: Integer; Begin CXZ: = 0; Procedure tmp.no1click (sender: TOBJECT); Begin SetCheck (sender); AI: = rndclick; Procedure tmp.l2click (sender: TOBJECT); begin jpoto: = pot; jpotm: = potm; jgo: = ygo; searchi; inflick Procedure tmp.l3click (sender: TOBJECT); Begin Jpoto: = POTO; JPOTM: = POTM; JGO: = YGO; POS: = qsearchi; OSEND (POS); InitClick (Self); 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 ('Do you really want to restart the game?', MTConfirmation, [mbyes, mbno], 0) = mryester dam minit; initclick (init); end; ; Procedure tmp.initclick (sender: Tobject); var i: integer; begin for i: = 0 to 5 do begin mgrid.cells [i, 0]: = INTOSTR (POTO [i 1]); mgrid.cells [i , 2]: = INTOSTR (POTM [6 - I]); End; mgrid.cells [0, 1]: = INTTOSTR (POTO [0]); mgrid.cells [5, 1]: = INTOSTR (POTM [0 ]); If (ygO = true) THEN becom mp.caption: = '捡 金豆 轮 到 你!'; // sh.enabled: = false; Else Begin mp.caption: = '捡 金豆 now Look at me! '; SH.Enabled: = true; end; if (ok = true) THEN BEGIN SH.Enabled: = false; ywinclick (self); OK: = false; minit; inflick (init); End; end. I have a lot of features that have not been achieved, such as help; then I have to prepare for exams, code is very bad. I want to write a good note and give it to you. I am too lazy to write, sorry! In fact, I have already written once, customary input date; I pressed a F5, I will not come in STOP! BY CXZ 2002.05.21
