Membuat Game Puzzle dengan Visual FoxPro

Visual FoxPro tidak harus selalu berurusan dengan Database lho ?
VFP bisa juga digunakan untuk membuat Game yang sederhana,
seperti game puzzle ini. Kopi-kan coding dibawah ini ke File .PRG kemudian jalankan File .PRG
dari Command Window dengan perintah "Do " .... Have Fun :-)
Sorot coding dibawah ini, kemudian kopi-kan ke File .PRG ....

SET TALK OFF
SET BELL OFF

LOCAL oForm
oForm = CREATEOBJECT("menuutama")
oForm.SHOW()
READ EVENTS

CLOSE ALL
CLEAR ALL
RETURN

DEFINE CLASS ConvertToBMP AS CUSTOM

DWORDOFFSET = 2147483648
WORDOFFSET = 32768
FileGambar = ""
FileBMP = ""
Ukuran = 0

PROCEDURE Convert
LOCAL x, Y, tinggi, lebar
x = CREATEOBJECT('form')
x.CAPTION="Konversi Grafis"
x.ALWAYSONTOP=.T.
x.WIDTH=644
x.HEIGHT=500
x.BACKCOLOR = RGB(255,255,255)
x.ADDOBJECT('Gambar','Image')
Y = x.Gambar
Y.PICTURE = THIS.FileGambar
IF (Y.WIDTH>640) .OR. (Y.HEIGHT>480)
IF (Y.WIDTH>Y.HEIGHT)
lebar=640
tinggi=(640*(Y.HEIGHT/Y.WIDTH))+1
ELSE
tinggi=480
lebar=(480*(Y.WIDTH/Y.HEIGHT))+1
ENDIF
Y.STRETCH = 1
Y.WIDTH=lebar
Y.HEIGHT=tinggi
ELSE
Y.STRETCH = 0
ENDIF
Y.MOVE(1,1)
Y.VISIBLE = .T.
x.ADDOBJECT("Lab1","Label")
x.lab1.BACKSTYLE=0
x.lab1.AUTOSIZE=.T.
x.lab1.CAPTION="Silakan tunggu, konversi grafis sedang dalam proses ..."
x.lab1.FONTSIZE=10
x.lab1.FONTBOLD=.T.
x.lab1.TOP=482
x.lab1.LEFT=5
x.lab1.VISIBLE=.T.
tinggi=FLOOR(Y.HEIGHT/THIS.Ukuran)
lebar=FLOOR(Y.WIDTH/THIS.Ukuran)
x.SHOW()

hitung=0
FOR a=1 TO THIS.Ukuran
FOR b=1 TO THIS.Ukuran
IF !((a=THIS.Ukuran) AND (b=THIS.Ukuran))
hitung = hitung + 1
IF hitung<10
chitung="0"+STR(hitung,1)
ELSE
chitung=STR(hitung,2)
ENDIF
WAIT WINDOW "Membuat Potongan Gambar yang ke-"+TRANSFORM(hitung) NOWAIT
THIS.BuildBMP(x,THIS.FileBMP+chitung+".BMP",Y.LEFT+((b-1)*lebar),Y.LEFT+(b*lebar),Y.TOP+((a-1)*tinggi),Y.TOP+(a*tinggi))
ENDIF
ENDFOR
ENDFOR
WAIT WINDOW "Konversi Grafis selesai" NOWAIT
x.RELEASE
ENDPROC

PROCEDURE BuildBMP
LPARAMETERS toForm, tcFile, tnX1, tnX2, tnY1, tnY2
LOCAL nX1, nX2, nY1, nY2, nWidth, nHeight, nPixels, i, j, cBMP, cColArray,cPad
nX1 = THIS.TVL(tnX1, 0)
nX2 = THIS.TVL(tnX2, toForm.WIDTH-1)
nY1 = THIS.TVL(tnY1, 0)
nY2 = THIS.TVL(tnY2, toForm.HEIGHT-1)
nWidth = nX2 - nX1 + 1

cPad = REPLICATE(CHR(0),MOD(nWidth,4))

nHeight = nY2 - nY1 + 1
nPixels = nWidth * nHeight
IF nPixels <>
RETURN .F.
ENDIF

cBMP = 'BM' + THIS.NumToDWord(54 + nWidth * nHeight * 3) + THIS.NumToWord(0) + THIS.NumToWord(0) + THIS.NumToDWord(54)
cBMP = cBMP + THIS.GetBMPInfoHeader(nWidth, nHeight)
cColArray = ''
FOR j = nY2 TO nY1 STEP -1
FOR i = nX1 TO nX2
cColArray = cColArray + THIS.GetBinaryColor(toForm.POINT(i,j))
ENDFOR
cColArray = cColArray + cPad
ENDFOR
cBMP = cBMP + cColArray
STRTOFILE(cBMP, tcFile)
ENDPROC

PROCEDURE GetBMPInfoHeader
LPARAMETERS tnWidth, tnHeight
LOCAL cHeader, cZero
cZero = THIS.NumToDWord(0)
cHeader = THIS.NumToDWord(40) + THIS.NumToDWord(tnWidth) + THIS.NumToDWord(tnHeight)
cHeader = cHeader + THIS.NumToWord(1) + THIS.NumToWord(24) + cZero + cZero
cHeader = cHeader + THIS.NumToDWord(3780) + THIS.NumToDWord(3780) + cZero + cZero
RETURN cHeader
ENDPROC

PROCEDURE GetBinaryColor
LPARAMETERS tnColor
RETURN SUBSTR(BINTOC(MAX(tnColor,0) - THIS.DWORDOFFSET),2)
ENDPROC

PROCEDURE NumToDWord
LPARAMETERS tnVal
LOCAL cBin
cBin = BINTOC(tnVal - THIS.DWORDOFFSET)
RETURN SUBSTR(cBin,4,1) + SUBSTR(cBin,3,1) + SUBSTR(cBin,2,1) +SUBSTR(cBin,1,1)
ENDPROC

PROCEDURE NumToWord
LPARAMETERS tnVal
LOCAL cBin
cBin = BINTOC(tnVal - THIS.WORDOFFSET, 2)
RETURN SUBSTR(cBin,2,1) + SUBSTR(cBin,1,1)
ENDPROC

PROCEDURE TVL
LPARAMETERS tuParamValue, tuInitValue
RETURN IIF(VARTYPE(tuParamValue) = VARTYPE(tuInitValue), tuParamValue,tuInitValue)
ENDPROC
ENDDEFINE

DEFINE CLASS gamepuzzle AS FORM

TOP = 3
LEFT = 9
HEIGHT = 500
WIDTH = 683
CAPTION = "Permainan Puzzle, http://www.fox-id.com"
MAXBUTTON = .F.
poskosong = (0)
Ukuran = (0)
NAME = "gamepuzzle"
mode_acak = .F.

ADD OBJECT command1 AS COMMANDBUTTON WITH ;
AUTOSIZE = .T., ;
TOP = 465, ;
LEFT = 7, ;
HEIGHT = 27, ;
WIDTH = 116, ;
CAPTION = "\ NAME = "Command1"

PROCEDURE acak
LOCAL nilai,cString
THISFORM.LOCKSCREEN= .T.
THISFORM.mode_acak=.T.
FOR a=1 TO (THISFORM.Ukuran*100)
nilai=MOD(FLOOR(RAND()*100),4)
DO CASE
CASE nilai=0 && Atas
cString=THISFORM.cari(THISFORM.poskosong-THISFORM.Ukuran)
CASE nilai=1 && Kanan
cString=THISFORM.cari(THISFORM.poskosong+1)
CASE nilai=2 && Bawah
cString=THISFORM.cari(THISFORM.poskosong+THISFORM.Ukuran)
CASE nilai=3 && Kiri
cString=THISFORM.cari(THISFORM.poskosong-1)
ENDCASE
IF !EMPTY(cString)
THISFORM.&cString..CLICK
ENDIF
ENDFOR
THISFORM.LOCKSCREEN= .F.
THISFORM.mode_acak=.F.
RETURN
ENDPROC

PROCEDURE cari
LPARAMETERS npos
LOCAL abc, cString, balik, ketemu
ketemu=.F.
FOR abc=1 TO ((THISFORM.Ukuran^2)-1)
cString="Puzzle"+IIF(abc>9,STR(abc,2),"0"+STR(abc,1))
IF THISFORM.&cString..Posisi=npos
ketemu=.T.
balik=cString
EXIT
ENDIF
ENDFOR
IF !ketemu
balik=""
ENDIF
RETURN (balik)
ENDPROC

PROCEDURE menang
LOCAL win, cString
win=.T.
FOR abc=1 TO ((THISFORM.Ukuran^2)-1)
cString="Puzzle"+IIF(abc>9,STR(abc,2),"0"+STR(abc,1))
IF THISFORM.&cString..Posisi!=abc
win=.F.
EXIT
ENDIF
ENDFOR
RETURN (win)
ENDPROC

PROCEDURE INIT
LOCAL hitung, cString
CLEAR RESOURCES
DO CASE
CASE settings.Ukuran=1
THISFORM.Ukuran = 4
CASE settings.Ukuran=2
THISFORM.Ukuran = 6
CASE settings.Ukuran=3
THISFORM.Ukuran = 8
ENDCASE
hitung=0
THISFORM.poskosong=THISFORM.Ukuran^2
FOR kolom=1 TO THISFORM.Ukuran
FOR baris=1 TO THISFORM.Ukuran
IF !((kolom=THISFORM.Ukuran) .AND. (baris=THISFORM.Ukuran))
hitung = hitung + 1
cString = "Puzzle"+IIF(hitung>9,STR(hitung,2),"0"+STR(hitung,1))
THISFORM.ADDOBJECT(cString,"Potongan")
THISFORM.&cString..PICTURE=SYS(2023)+"\Fox_ID"+cString+".BMP"
THISFORM.&cString..LEFT=10+(baris-1)*THISFORM.&cString..WIDTH
THISFORM.&cString..TOP=10+(kolom-1)*THISFORM.&cString..HEIGHT
THISFORM.&cString..Posisi=hitung
THISFORM.&cString..VISIBLE = .T.
ENDIF
ENDFOR
ENDFOR
THISFORM.WIDTH=20+(THISFORM.&cString..WIDTH*THISFORM.Ukuran)
THISFORM.HEIGHT=70+(THISFORM.&cString..HEIGHT*THISFORM.Ukuran)
THISFORM.command1.TOP=THISFORM.HEIGHT - 45
THISFORM.BORDERSTYLE= 2
THISFORM.AUTOCENTER= .T.
THISFORM.acak
ENDPROC

PROCEDURE command1.CLICK
LOCAL oForm
oForm = CREATEOBJECT('form')
WITH oForm
.CAPTION = "Gambar Aslinya"
.ALWAYSONTOP = .T.
.MAXBUTTON = .F.
.WIDTH = 644
.HEIGHT = 484
.BACKCOLOR = RGB(255,255,255)
.ADDOBJECT('Gambar','Image')
Y = .Gambar
ENDWITH
Y.PICTURE = settings.path_pic
IF (Y.WIDTH>640) .OR. (Y.HEIGHT>480)
IF (Y.WIDTH>Y.HEIGHT)
lebar=640
tinggi=(640*(Y.HEIGHT/Y.WIDTH))+1
ELSE
tinggi=480
lebar=(480*(Y.WIDTH/Y.HEIGHT))+1
ENDIF
Y.STRETCH = 1
Y.WIDTH = lebar
Y.HEIGHT = tinggi
ELSE
Y.STRETCH = 0
ENDIF
Y.MOVE(1,1)
Y.VISIBLE = .T.
oForm.AUTOCENTER = .T.
oForm.SHOW(1)
ENDPROC

ENDDEFINE

DEFINE CLASS menuutama AS FORM

DATASESSION = 2
HEIGHT = 296
WIDTH = 418
AUTOCENTER = .T.
BORDERSTYLE = 2
CAPTION = "Permainan Puzzle"
NAME = "menuutama"

ADD OBJECT edit1 AS EDITBOX WITH ;
HEIGHT = 132, ;
LEFT = 23, ;
READONLY = .T., ;
TOP = 10, ;
WIDTH = 371, ;
NAME = "Edit1"

ADD OBJECT command1 AS COMMANDBUTTON WITH ;
AUTOSIZE = .T., ;
TOP = 152, ;
LEFT = 23, ;
HEIGHT = 27, ;
WIDTH = 97, ;
CAPTION = "Ambil Gambar", ;
NAME = "Command1"

ADD OBJECT namafile AS LABEL WITH ;
BACKSTYLE = 0, ;
CAPTION = "", ;
HEIGHT = 17, ;
LEFT = 125, ;
TOP = 158, ;
WIDTH = 278, ;
NAME = "NamaFile"

ADD OBJECT optiongroup2 AS OPTIONGROUP WITH ;
AUTOSIZE = .T., ;
BUTTONCOUNT = 3, ;
BACKSTYLE = 0, ;
VALUE = 1, ;
HEIGHT = 65, ;
LEFT = 23, ;
TOP = 202, ;
WIDTH = 133, ;
NAME = "Optiongroup2", ;
Option1.BACKSTYLE = 0, ;
Option1.CAPTION = "Pemula ( 4 x 4)", ;
Option1.VALUE = 1, ;
Option1.HEIGHT = 17, ;
Option1.LEFT = 5, ;
Option1.STYLE = 0, ;
Option1.TOP = 5, ;
Option1.WIDTH = 123, ;
Option1.AUTOSIZE = .F., ;
Option1.NAME = "Option1", ;
Option2.BACKSTYLE = 0, ;
Option2.CAPTION = "Profesional ( 6 x 6 )", ;
Option2.HEIGHT = 17, ;
Option2.LEFT = 5, ;
Option2.STYLE = 0, ;
Option2.TOP = 24, ;
Option2.WIDTH = 123, ;
Option2.AUTOSIZE = .F., ;
Option2.NAME = "Option2", ;
Option3.BACKSTYLE = 0, ;
Option3.CAPTION = "Mahir ( 8 x 8 )", ;
Option3.HEIGHT = 17, ;
Option3.LEFT = 5, ;
Option3.STYLE = 0, ;
Option3.TOP = 43, ;
Option3.WIDTH = 123, ;
Option3.AUTOSIZE = .F., ;
Option3.NAME = "Option3"

ADD OBJECT label3 AS LABEL WITH ;
AUTOSIZE = .T., ;
BACKSTYLE = 0, ;
CAPTION = "Tingkatan :", ;
HEIGHT = 17, ;
LEFT = 23, ;
TOP = 184, ;
WIDTH = 62, ;
NAME = "Label3"

ADD OBJECT command2 AS COMMANDBUTTON WITH ;
TOP = 206, ;
LEFT = 244, ;
HEIGHT = 60, ;
WIDTH = 84, ;
FONTBOLD = .T., ;
FONTSIZE = 14, ;
CAPTION = "\ NAME = "Command2"

ADD OBJECT label2 AS LABEL WITH ;
AUTOSIZE = .T., ;
FONTBOLD = .T., ;
BACKSTYLE = 0, ;
CAPTION = "http://www.fox-id.com , Komunitas Programmer FoxPro Indonesia", ;
HEIGHT = 17, ;
LEFT = 5, ;
TOP = 275, ;
WIDTH = 373, ;
FORECOLOR = RGB(255,0,0), ;
NAME = "Label2"

PROCEDURE INIT
SET TALK OFF
SET BELL OFF
IF FILE("Settings.DBF")
USE settings.DBF ALIAS settings IN 0
THISFORM.namafile.CAPTION=settings.path_pic
THISFORM.optiongroup2.VALUE=settings.Ukuran
ELSE
CREATE TABLE settings FREE ( path_pic M(4), Ukuran N(1) )
APPEND BLANK
THISFORM.namafile.CAPTION=""
ENDIF
THISFORM.edit1.VALUE=;
"Permainan ini saya dedikasikan untuk para pecinta Visual FoxPro di Indonesia pada umumnya, dan pengunjung Fox-ID pada "+;
"khususnya. Semoga game ini bisa menjadi penghibur dikala suntuk bikin program ... hehehehe"+CHR(013)+CHR(013)+;
"Salam,"+CHR(013)+CHR(013)+;
"Handi Rusli"
RETURN
ENDPROC

PROCEDURE DESTROY
CLEAR EVENTS
ENDPROC

PROCEDURE command1.CLICK
THISFORM.namafile.CAPTION=GETPICT()
RETURN
ENDPROC

PROCEDURE command2.CLICK
IF EMPTY(THISFORM.namafile.CAPTION)
=MESSAGEBOX("Gambar belum dipilih",48,"Oops !!!")
ELSE
LOCAL oConvert, oFormPuzzle
IF !(ALLTRIM(settings.path_pic)==THISFORM.namafile.CAPTION) .OR. (settings.Ukuran!=THISFORM.optiongroup2.VALUE)
REPLACE path_pic WITH THISFORM.namafile.CAPTION, ;
Ukuran WITH THISFORM.optiongroup2.VALUE IN settings
FLUSH
oConvert=CREATEOBJECT("ConvertToBMP")
oConvert.FileGambar=THISFORM.namafile.CAPTION
oConvert.FileBMP=SYS(2023)+"\Fox_IDPuzzle"
DELETE FILE (SYS(2023)+"\Fox_IDPuzzle*.BMP")
DO CASE
CASE THISFORM.optiongroup2.VALUE=1
oConvert.Ukuran=4
CASE THISFORM.optiongroup2.VALUE=2
oConvert.Ukuran=6
CASE THISFORM.optiongroup2.VALUE=3
oConvert.Ukuran=8
ENDCASE
oConvert.Convert
ENDIF
oFormPuzzle=CREATEOBJECT("GamePuzzle")
oFormPuzzle.SHOW(1)
ENDIF
RETURN
ENDPROC

ENDDEFINE

DEFINE CLASS potongan AS IMAGE

BORDERSTYLE = 1
HEIGHT = 90
WIDTH = 100
Posisi = (0)
NAME = "potongan"

PROCEDURE CLICK
LOCAL nPindah
DO CASE
CASE settings.Ukuran=1
nPindah = 4
CASE settings.Ukuran=2
nPindah = 6
CASE settings.Ukuran=3
nPindah = 8
ENDCASE
DO CASE
CASE (THIS.Posisi+nPindah)=THIS.PARENT.poskosong && turun ke bawah
THIS.TOP=THIS.TOP+THIS.HEIGHT
THIS.PARENT.poskosong=THIS.Posisi
THIS.Posisi=THIS.Posisi+nPindah
CASE (THIS.Posisi-nPindah)=THIS.PARENT.poskosong && naik ke atas
THIS.TOP=THIS.TOP-THIS.HEIGHT
THIS.PARENT.poskosong=THIS.Posisi
THIS.Posisi=THIS.Posisi-nPindah
CASE (((THIS.Posisi-1)=THIS.PARENT.poskosong) .AND. (MOD(THIS.Posisi,nPindah)!=1)) && bergeser ke kiri
THIS.LEFT=THIS.LEFT-THIS.WIDTH
THIS.PARENT.poskosong=THIS.Posisi
THIS.Posisi=THIS.Posisi-1
CASE (((THIS.Posisi+1)=THIS.PARENT.poskosong) .AND. (MOD(THIS.Posisi,nPindah)!=0)) && bergeser ke kanan
THIS.LEFT=THIS.LEFT+THIS.WIDTH
THIS.PARENT.poskosong=THIS.Posisi
THIS.Posisi = THIS.Posisi + 1
ENDCASE
IF !(THIS.PARENT.mode_acak)
IF THIS.PARENT.menang()
=MESSAGEBOX("Anda Menang",64,"Horeee !!!")
ENDIF
ENDIF
ENDPROC

ENDDEFINE

nah ini membuktikan bahwa visual foxpro tidak kalah menariknya sama pemrograman lainnya
selamat menikmati gamenya deh.....(supported by Taz fox-id)