GAME TETRIS
Membuat game tetris dengan foxpro itu susah susah gampang. Tapi saya saranin coba aj dlu...
Langkah-langkah memuat game tetris ini sbb:
- buka foxpro nya
- buat project baru n kasi nama to project
- liat project manager n klik tab code
- copy kode yg d bwh ini k itu tmpat....
PUBLIC ffff = CreateObject('frm')ff.visible = .T.RETURN#DEFINE tetris 4#DEFINE c0 128 && color constant#DEFINE c1 196 && color constant#DEFINE sqee_width 20#DEFINE sqee_height 20#DEFINE bucketWidth 12#DEFINE bucketHeight 24#DEFINE dropInterval 200 && millisecond#DEFINE keyLeft 19#DEFINE keyRight 4#DEFINE keyDrop 32#DEFINE keyRotate 5DEFINE CLASS sqee As Shape Owner = 0 && (0)empty, (1)debris, all others - Figure.Mode Width = sqee_width Height = sqee_height BorderColor = RGB (240,240,255) BackColor = RGB(255,255,255)ENDDEFINEDEFINE CLASS figure As Custom DIMEN arrX [tetris] DIMEN arrY [tetris] dY = 1 dX = 1 mode = 0 main = .F. BackColor = 0 turned_counter = 0 turned_counter_dy = 0 turned_counter_dx = 0 turned_clockwise = 0 turned_clockwise_dy = 0 turned_clockwise_dx = 0 PROCEDURE init THIS.BackColor = THIS.get_color() THIS.after_init ENDPROC PROCEDURE assign_neighbours (tl, tly, tlx, tr, try, trx) THIS.turned_counter = tl THIS.turned_counter_dy = tly THIS.turned_counter_dx = tlx THIS.turned_clockwise = tr THIS.turned_clockwise_dy = try THIS.turned_clockwise_dx = trx ENDPROC PROCEDURE init_arr (y1,x1, y2,x2, y3,x3, y4,x4) THIS.arrX [1] = x1 THIS.arrX [2] = x2 THIS.arrX [3] = x3 THIS.arrX [4] = x4 THIS.arrY [1] = y1 THIS.arrY [2] = y2 THIS.arrY [3] = y3 THIS.arrY [4] = y4 ENDPROC PROCEDURE reset_figure STORE 1 TO THIS.dY, THIS.dX ENDPROC FUNCTION get_color () DO CASE CASE INLIST (THIS.mode, 1,11) RETURN RGB (c1,c0,c0) CASE THIS.mode = 2 RETURN RGB (c1,c1,c0) CASE INLIST (THIS.mode, 3,31,32,33) RETURN RGB (c1,c0,c1) CASE INLIST (THIS.mode, 4,41) RETURN RGB (c0,c1,c1) CASE INLIST (THIS.mode, 5,51) RETURN RGB (c0,c1,c0) CASE INLIST (THIS.mode, 6,61,62,63) RETURN RGB (c0,c0,c1) CASE INLIST (THIS.mode, 7,71,72,73) RETURN RGB (c0,c0,c0) OTHER RETURN RGB (c1,c1,c1) ENDCASE ENDFUNC PROCEDURE set_state (numColor, numOwner) LOCAL ii FOR ii=1 TO tetris WITH ThisForm.d.arr [ THIS.dY+THIS.arrY[ii], THIS.dX+THIS.arrX[ii] ] .BackColor = numColor .Owner = numOwner ENDWITH ENDFOR ENDPROC PROCEDURE set_visible THIS.set_state (THIS.BackColor, THIS.mode) ENDPROC PROCEDURE set_free THIS.set_state (THIS.Parent.BackColor, 0) ENDPROC PROCEDURE set_debris THIS.set_state (THIS.BackColor, -1) ENDPROC PROCEDURE set_owner (numOwner) LOCAL ii FOR ii=1 TO tetris WITH ThisForm.d.arr [ THIS.dY+THIS.arrY[ii], THIS.dX+THIS.arrX[ii] ] .Owner = numOwner ENDWITH ENDFOR ENDPROC PROCEDURE conflict (dY,dX, allowedMode)
LOCAL ii
FOR ii=1 TO tetris
IF Not (BETW(dY+THIS.dY+THIS.arrY[ii], 1, bucketHeight);
And BETW(dX+THIS.dX+THIS.arrX[ii], 1, bucketWidth))
RETURN .T.
ENDIF
WITH ThisForm.d.arr [ dY+THIS.dY+THIS.arrY[ii], dX+THIS.dX+THIS.arrX[ii] ]
IF Not (.Owner=0 Or .Owner=THIS.mode Or .Owner=allowedMode)
RETURN .T.
ENDIF
ENDWITH
ENDFOR
RETURN .F.
ENDPROC
FUNCTION move_ (dY,dX)
IF THIS.Conflict (dY,dX,0)
RETURN .F.
ELSE
THIS.set_free
THIS.dY = THIS.dY + dY
THIS.dX = THIS.dX + dX
THIS.set_visible
RETURN .T.
ENDIF
ENDPROC
PROCEDURE move_down
RETURN THIS.move_ (1,0)
ENDPROC
PROCEDURE move_left
RETURN THIS.move_ (0,-1)
ENDPROC
PROCEDURE move_right
RETURN THIS.move_ (0,1)
ENDPROC
ENDDEFINE
DEFINE CLASS f1 As figure && vertical stick
mode = 1
main = .T.
PROCEDURE after_init
THIS.init_arr (0,0, 1,0, 2,0, 3,0)
THIS.assign_neighbours (11,2,-1, 11,2,-2)
ENDPROC
ENDDEFINE
DEFINE CLASS f11 As figure && horizontal stick
mode = 11
main = .F.
PROCEDURE after_init
THIS.init_arr (0,0, 0,1, 0,2, 0,3)
THIS.assign_neighbours (1,-2,1, 1,-2,2)
ENDPROC
ENDDEFINE
DEFINE CLASS f2 As figure && square
mode = 2
main = .T.
PROCEDURE after_init
THIS.init_arr (0,0, 0,1, 1,0, 1,1)
THIS.assign_neighbours (2,0,0, 2,0,0)
ENDPROC
ENDDEFINE
DEFINE CLASS f3 As figure && t-bone
mode = 3
main = .T.
PROCEDURE after_init
THIS.init_arr (0,0, 0,1, 0,2, 1,1)
THIS.assign_neighbours (32,0,0, 31,0,0)
ENDPROC
ENDDEFINE
DEFINE CLASS f31 As figure && t-bone rotated
mode = 31
main = .F.
PROCEDURE after_init
THIS.init_arr (0,0, 1,0, 2,0, 1,1)
THIS.assign_neighbours (3,0,0, 33,0,0)
ENDPROC
ENDDEFINE
DEFINE CLASS f32 As figure && t-bone rotated
mode = 32
main = .F.
PROCEDURE after_init
THIS.init_arr (0,1, 1,1, 2,1, 1,0)
THIS.assign_neighbours (33,0,0, 3,0,0)
ENDPROC
ENDDEFINE
DEFINE CLASS f33 As figure && t-bone rotated
mode = 33
main = .F.
PROCEDURE after_init
THIS.init_arr (1,0, 1,1, 1,2, 0,1)
THIS.assign_neighbours (31,0,0, 32,0,0)
ENDPROC
ENDDEFINE
DEFINE CLASS f4 As figure && zed1
mode = 4
main = .T.
PROCEDURE after_init
THIS.init_arr (0,0, 0,1, 1,1, 1,2)
THIS.assign_neighbours (41,0,0, 41,0,0)
ENDPROC
ENDDEFINE
DEFINE CLASS f41 As figure && zed1 rotated
mode = 41
main = .F.
PROCEDURE after_init
THIS.init_arr (2,0, 1,0, 1,1, 0,1)
THIS.assign_neighbours (4,0,0, 4,0,0)
ENDPROC
ENDDEFINE
DEFINE CLASS f5 As figure && zed2
mode = 5
main = .T.
PROCEDURE after_init
THIS.init_arr (1,0, 1,1, 0,1, 0,2)
THIS.assign_neighbours (51,0,0, 51,0,0)
ENDPROC
ENDDEFINE
DEFINE CLASS f51 As figure && zed2 rotated
mode = 51
main = .F.
PROCEDURE after_init
THIS.init_arr (0,0, 1,0, 1,1, 2,1)
THIS.assign_neighbours (5,0,0, 5,0,0)
ENDPROC
ENDDEFINE
DEFINE CLASS f6 As figure && scrap1
mode = 6
main = .T.
PROCEDURE after_init
THIS.init_arr (0,0, 1,0, 2,0, 0,1)
THIS.assign_neighbours (62,0,0, 61,0,0)
ENDPROC
ENDDEFINE
DEFINE CLASS f61 As figure && scrap1 rotated
mode = 61
main = .F.
PROCEDURE after_init
THIS.init_arr (1,0, 1,1, 1,2, 0,0)
THIS.assign_neighbours (6,0,0, 63,0,0)
ENDPROC
ENDDEFINE
DEFINE CLASS f62 As figure && scrap1 rotated
mode = 62
main = .F.
PROCEDURE after_init
THIS.init_arr (0,0, 0,1, 0,2, 1,2)
THIS.assign_neighbours (63,0,0, 6,0,0)
ENDPROC
ENDDEFINE
DEFINE CLASS f63 As figure && scrap1 rotated
mode = 63
main = .F.
PROCEDURE after_init
THIS.init_arr (0,1, 1,1, 2,1, 2,0)
THIS.assign_neighbours (61,0,0, 62,0,0)
ENDPROC
ENDDEFINE
DEFINE CLASS f7 As figure && scrap2
mode = 7
main = .T.
PROCEDURE after_init
THIS.init_arr (0,0, 0,1, 1,1, 2,1)
THIS.assign_neighbours (72,0,0, 71,0,0)
ENDPROC
ENDDEFINE
DEFINE CLASS f71 As figure && scrap2 rotated
mode = 71
main = .F.
PROCEDURE after_init
THIS.init_arr (0,0, 0,1, 0,2, 1,0)
THIS.assign_neighbours (7,0,0, 73,0,0)
ENDPROC
ENDDEFINE
DEFINE CLASS f72 As figure && scrap2 rotated
mode = 72
main = .F.
PROCEDURE after_init
THIS.init_arr (1,0, 1,1, 1,2, 0,2)
THIS.assign_neighbours (73,0,0, 7,0,0)
ENDPROC
ENDDEFINE
DEFINE CLASS f73 As figure && scrap2 rotated
mode = 73
main = .F.
PROCEDURE after_init
THIS.init_arr (0,0, 1,0, 2,0, 2,1)
THIS.assign_neighbours (71,0,0, 72,0,0)
ENDPROC
ENDDEFINE
DEFINE CLASS bucket As Container
max_mode = 7
current_mode = 0
BackColor = RGB(255,255,255)
DIMEN ff [100]
ADD OBJECT ff[ 1] As f1
ADD OBJECT ff[11] As f11
ADD OBJECT ff[ 2] As f2
ADD OBJECT ff[ 3] As f3
ADD OBJECT ff[31] As f31
ADD OBJECT ff[32] As f32
ADD OBJECT ff[33] As f33
ADD OBJECT ff[ 4] As f4
ADD OBJECT ff[41] As f41
ADD OBJECT ff[ 5] As f5
ADD OBJECT ff[51] As f51
ADD OBJECT ff[ 6] As f6
ADD OBJECT ff[61] As f61
ADD OBJECT ff[62] As f62
ADD OBJECT ff[63] As f63
ADD OBJECT ff[ 7] As f7
ADD OBJECT ff[71] As f71
ADD OBJECT ff[72] As f72
ADD OBJECT ff[73] As f73
arr_size = bucketWidth * bucketHeight
DIMEN arr [bucketHeight, bucketWidth]
PROCEDURE Init
THIS.AddSquees
THIS.Width = sqee_width * bucketWidth
THIS.Height = sqee_height * bucketHeight
ENDPROC
PROCEDURE AddSquees
LOCAL lnY, lnX, lcName
FOR lnY=1 TO bucketHeight
FOR lnX=1 TO bucketWidth
lcName = STRTRAN('arr'+STR(lnY,2) + '_' + STR(lnX,2), ' ','0')
THIS.AddObject (lcName, 'sqee')
THIS.arr [lnY,lnX] = EVAL('THIS.'+lcName)
WITH THIS.arr [lnY,lnX]
.left = (lnX-1) * sqee_width
.top = (lnY-1) * sqee_height
.Owner = 0
.visible = .T.
ENDWITH
ENDFOR
ENDFOR
ENDPROC
PROCEDURE RemoveSquees
LOCAL lnY, lnX, lcName
FOR lnY=1 TO bucketHeight
FOR lnX=1 TO bucketWidth
lcName = STRTRAN('arr'+STR(lnY,2) + '_' + STR(lnX,2), ' ','0')
THIS.RemoveObject (lcName)
ENDFOR
ENDFOR
ENDPROC
FUNCTION init_figure
THIS.current_mode = INT (RAND() * THIS.max_mode) + 1
IF NOT BETW(THIS.current_mode, 1,THIS.max_mode)
THIS.current_mode = 1
ENDIF
WITH THIS.ff [THIS.current_mode]
.reset_figure
IF .conflict (0,0,0)
RETURN .F.
ENDIF
.set_visible
ENDWITH
RETURN .T.
ENDFUNC
FUNCTION debris_line (num) && if there is at least one line of debris
LOCAL ii
FOR ii=1 TO bucketWidth
IF THIS.arr [num, ii].Owner <> -1
RETURN .F.
ENDIF
ENDFOR
RETURN .T.
ENDFUNC
FUNCTION find_debris_line
LOCAL jj
FOR jj=bucketHeight TO 1 STEP -1
IF THIS.debris_line (jj)
RETURN jj
ENDIF
ENDFOR
RETURN 0
ENDFUNC
PROCEDURE shake_debris
LOCAL num, jj, ii, savedColor
num = THIS.find_debris_line()
IF num = 0
RETURN
ENDIF
* release line
FOR ii=1 TO bucketWidth
THIS.arr[num, ii].Owner = 0
THIS.arr[num, ii].BackColor = THIS.BackColor
ENDFOR
* drop all other lines
FOR jj=num-1 TO 1 STEP -1
FOR ii=1 TO bucketWidth
IF THIS.arr[jj,ii].Owner = -1
savedColor = THIS.arr [jj, ii].BackColor
THIS.arr [jj, ii].BackColor = THIS.BackColor
THIS.arr [jj, ii].Owner = 0
THIS.arr [jj+1, ii].BackColor = savedColor
THIS.arr [jj+1, ii].Owner = -1
ENDIF
ENDFOR
ENDFOR
ENDPROC
PROCEDURE rotate_figure (newMode, dY,dX)
LOCAL obj
WITH THIS.ff [THIS.current_mode]
obj = THIS.ff [.turned_clockwise]
obj.dY = .dY + .turned_clockwise_dY
obj.dX = .dX + .turned_clockwise_dX
ENDWITH
IF Not obj.Conflict (0,0,THIS.current_mode)
THIS.ff [THIS.current_mode].set_free
THIS.current_mode = obj.mode
THIS.ff [THIS.current_mode].set_visible
RETURN .T.
ELSE
RETURN .F.
ENDIF
ENDPROC
PROCEDURE rotate
WITH THIS.ff [THIS.current_mode]
DO WHILE .T.
IF THIS.rotate_figure (.turned_clockwise, .turned_clockwise_dY, .turned_clockwise_dX)
EXIT
ELSE
IF Not .move_right()
EXIT
ENDIF
ENDIF
ENDDO
ENDWITH
ENDPROC
PROCEDURE rotate_counter_clockwise
WITH THIS.ff [THIS.current_mode]
THIS.rotate (.turned_counter, .turned_counter_dY, .turned_counter_dX)
ENDWITH
ENDPROC
ENDDEFINE
DEFINE CLASS frm As Form
Caption = 'Tetris'
MaxButton = .F.
BorderStyle = 2
KeyPreview = .T.
ADD OBJECT d As bucket
ADD OBJECT t As Timer
PROCEDURE Init
WITH THIS.d
STORE 0 TO .top, .left
THIS.Width = .Width
THIS.Height = .Height
ENDWITH
THIS.d.init_figure
THIS.t.Interval = dropInterval && setting speed
ENDPROC
PROCEDURE Destroy
THIS.d.RemoveSquees
ENDPROC
PROCEDURE KeyPress
LPARAMETERS nKeyCode, nShiftAltCtrl
DO CASE
CASE nKeyCode=27
THIS.release
CASE nKeyCode=keyLeft
THIS.d.ff [THIS.d.current_mode].move_left
CASE nKeyCode=keyRight
THIS.d.ff [THIS.d.current_mode].move_right
CASE nKeyCode=keyDrop
DO WHILE THIS.d.ff [THIS.d.current_mode].move_down()
ENDDO
CASE nKeyCode=keyRotate
THIS.d.rotate
ENDCASE
ENDPROC
PROCEDURE t.Timer
LOCAL obj
WITH ThisForm.d
obj = .ff [.current_mode]
IF Not obj.move_down()
obj.set_debris
IF .init_figure()
obj = .ff [.current_mode]
ELSE
ThisForm.release && here you lost
ENDIF
ENDIF
.shake_debris
ENDWITH
ENDPROC
ENDDEFINE
5. terakhir klik run
Sorri blm sempurna to game,....
buat yg bs sempurnain kasih gw y.....
referensi:
http://d3mi-unsyiah.forumi.biz/foxpro-f45/membuat-game-tetris-dengan-vfp-t13.htm