主题:[原创]也来国庆献礼
很久以前,DOS下的Fox有个小游戏puzzle,工作之余玩一玩还是很不错的。后来它消失了,Foxer们觉得遗憾,于是Vfp8开始,它又回来了。俺照猫画虎编写一个,弥补6.0、7.0的遗憾。以下代码复制,保存成一个prg,运行。若有不如意之处,请自行修改。
**************************************************
*-- Name: VFP Game "Puzzle"
*-- Author: Ilikefox
*-- Time: 09/28/2007 19:45:09
*-- CopyLeft:) You can copy, modify, distribute... anything you like!
oPuzzle=CREATEOBJECT("puzzleform")
oPuzzle.show
READ events
DEFINE CLASS puzzleform AS form
Height = 229
Width = 132
DoCreate = .T.
AutoCenter = .T.
BorderStyle = 2
Caption = "Puzzle"
MaxButton = .F.
Name = "frmPuzzle"
ADD OBJECT panel1 AS panel WITH ;
Top = 12, ;
Left = 12, ;
TabIndex = 2, ;
Name = "Panel1"
ADD OBJECT cmdshuffle AS checkbox WITH ;
Top = 192, ;
Left = 12, ;
Height = 25, ;
Width = 109, ;
Caption = "\<Shuffle", ;
Style = 1, ;
Name = "cmdShuffle"
PROCEDURE Unload
CLEAR EVENTS
ENDPROC
PROCEDURE cmdshuffle.Click
LOCAL nValue, nPos, oPanel
this.Value=0
=RAND(-1)
oPanel=thisform.panel1
oPanel.LayoutArray=0
FOR nValue=1 TO 15
DO WHILE .t.
nPos=INT(16*RAND()+1)
IF oPanel.LayoutArray(nPos)=0
oPanel.LayoutArray(nPos)=nValue
EXIT
ENDIF
ENDDO
ENDFOR
oPanel.handalfocus
oPanel.shuffle
ENDPROC
ENDDEFINE
DEFINE CLASS panel AS container
Width = 108
Height = 164
SpecialEffect = 1
layoutstr = ""
Name = "panel"
DIMENSION layoutarray[16]
PROCEDURE shuffle
WITH this
FOR nI=1 TO 16
nValue=.LayoutArray(nI)
IF nValue>0
.controls(nValue).Position=nI
ENDIF
ENDFOR
ENDWITH
ENDPROC
PROCEDURE movetile
Lparameters oTile
Local nPos,nRow,nCol
nPos=oTile.Position
nRow=Ceiling(nPos/4)
nCol=nPos-(nRow-1)*4
With This
For nDegree=0 To 270 Step 90
nNextRow=nRow+Sin(Dtor(nDegree))
nNextCol=nCol+Cos(Dtor(nDegree))
nNextPos=(nNextRow-1)*4+nNextCol
If nNextRow*nNextCol<1 Or nNextRow>4 Or nNextCol>4
Loop
Endif
If .LayoutArray(nNextPos)=0
.LayoutArray(nNextPos)=.LayoutArray(nPos)
.LayoutArray(nPos)=0
oTile.Position=nNextPos
.getcurrentlayoutstr
.checkwinningcondition
Exit
Endif
Endfor
Endwith
ENDPROC
PROCEDURE getcurrentlayoutstr
With This
.LayoutStr=""
For nI=1 To 16
.LayoutStr=.LayoutStr+RIGHT(TRANSFORM(.LayoutArray(nI),"@0"),1)
Endfor
Endwith
ENDPROC
PROCEDURE checkwinningcondition
IF this.layoutstr="123456789ABCDEF0"
=MESSAGEBOX("We have a Winner!!!",48,"Congretuations")
ENDIF
ENDPROC
PROCEDURE handalfocus
this.cmdFocusHolder.setfocus
ENDPROC
PROCEDURE Init
Local nI
With This
*!* If File("Puzzle.CFG")
*!* **这里偷懒了,原本想采用一个文件保存上次结束游戏的状态。
*!* Else
This.LayoutArray=0
For nI=1 To 15
.LayoutArray(nI)=nI
Endfor
*!* Endif
For nI=1 To 15
cTileNum=Transform(nI)
.AddObject("Tile"+cTileNum,"Tile")
.controls(nI).Caption=cTileNum
.controls(nI).Visible=.T.
ENDFOR
.AddObject("cmdFocusHolder","CommandButton")
.cmdFocusHolder.width=10
.cmdFocusHolder.height=10
.cmdFocusHolder.left=200
.cmdFocusHolder.visible=.t.
.handalfocus
.shuffle
Endwith
ENDPROC
ENDDEFINE
DEFINE CLASS tile AS checkbox
Height = 40
Width = 26
FontBold = .F.
FontItalic = .F.
FontOutline = .F.
FontShadow = .F.
FontSize = 11
FontUnderline = .F.
FontCondense = .F.
FontExtend = .F.
Caption = "X"
MousePointer = 0
Style = 1
position = 0
Name = "tile"
PROCEDURE position_assign
LPARAMETERS vNewVal
LOCAL nRow,nCol
WITH THIS
.Position = m.vNewVal
nRow=CEILING(vNewVal/4)
nCol=vNewVal-4*(nRow-1)
.top=2+.height*(nRow-1)
.left=2+.width*(nCol-1)
ENDWITH
ENDPROC
PROCEDURE Click
This.Value=0
this.parent.handalFocus
This.Parent.MoveTile(This)
ENDPROC
ENDDEFINE
**************************************************
*-- Name: VFP Game "Puzzle"
*-- Author: Ilikefox
*-- Time: 09/28/2007 19:45:09
*-- CopyLeft:) You can copy, modify, distribute... anything you like!
oPuzzle=CREATEOBJECT("puzzleform")
oPuzzle.show
READ events
DEFINE CLASS puzzleform AS form
Height = 229
Width = 132
DoCreate = .T.
AutoCenter = .T.
BorderStyle = 2
Caption = "Puzzle"
MaxButton = .F.
Name = "frmPuzzle"
ADD OBJECT panel1 AS panel WITH ;
Top = 12, ;
Left = 12, ;
TabIndex = 2, ;
Name = "Panel1"
ADD OBJECT cmdshuffle AS checkbox WITH ;
Top = 192, ;
Left = 12, ;
Height = 25, ;
Width = 109, ;
Caption = "\<Shuffle", ;
Style = 1, ;
Name = "cmdShuffle"
PROCEDURE Unload
CLEAR EVENTS
ENDPROC
PROCEDURE cmdshuffle.Click
LOCAL nValue, nPos, oPanel
this.Value=0
=RAND(-1)
oPanel=thisform.panel1
oPanel.LayoutArray=0
FOR nValue=1 TO 15
DO WHILE .t.
nPos=INT(16*RAND()+1)
IF oPanel.LayoutArray(nPos)=0
oPanel.LayoutArray(nPos)=nValue
EXIT
ENDIF
ENDDO
ENDFOR
oPanel.handalfocus
oPanel.shuffle
ENDPROC
ENDDEFINE
DEFINE CLASS panel AS container
Width = 108
Height = 164
SpecialEffect = 1
layoutstr = ""
Name = "panel"
DIMENSION layoutarray[16]
PROCEDURE shuffle
WITH this
FOR nI=1 TO 16
nValue=.LayoutArray(nI)
IF nValue>0
.controls(nValue).Position=nI
ENDIF
ENDFOR
ENDWITH
ENDPROC
PROCEDURE movetile
Lparameters oTile
Local nPos,nRow,nCol
nPos=oTile.Position
nRow=Ceiling(nPos/4)
nCol=nPos-(nRow-1)*4
With This
For nDegree=0 To 270 Step 90
nNextRow=nRow+Sin(Dtor(nDegree))
nNextCol=nCol+Cos(Dtor(nDegree))
nNextPos=(nNextRow-1)*4+nNextCol
If nNextRow*nNextCol<1 Or nNextRow>4 Or nNextCol>4
Loop
Endif
If .LayoutArray(nNextPos)=0
.LayoutArray(nNextPos)=.LayoutArray(nPos)
.LayoutArray(nPos)=0
oTile.Position=nNextPos
.getcurrentlayoutstr
.checkwinningcondition
Exit
Endif
Endfor
Endwith
ENDPROC
PROCEDURE getcurrentlayoutstr
With This
.LayoutStr=""
For nI=1 To 16
.LayoutStr=.LayoutStr+RIGHT(TRANSFORM(.LayoutArray(nI),"@0"),1)
Endfor
Endwith
ENDPROC
PROCEDURE checkwinningcondition
IF this.layoutstr="123456789ABCDEF0"
=MESSAGEBOX("We have a Winner!!!",48,"Congretuations")
ENDIF
ENDPROC
PROCEDURE handalfocus
this.cmdFocusHolder.setfocus
ENDPROC
PROCEDURE Init
Local nI
With This
*!* If File("Puzzle.CFG")
*!* **这里偷懒了,原本想采用一个文件保存上次结束游戏的状态。
*!* Else
This.LayoutArray=0
For nI=1 To 15
.LayoutArray(nI)=nI
Endfor
*!* Endif
For nI=1 To 15
cTileNum=Transform(nI)
.AddObject("Tile"+cTileNum,"Tile")
.controls(nI).Caption=cTileNum
.controls(nI).Visible=.T.
ENDFOR
.AddObject("cmdFocusHolder","CommandButton")
.cmdFocusHolder.width=10
.cmdFocusHolder.height=10
.cmdFocusHolder.left=200
.cmdFocusHolder.visible=.t.
.handalfocus
.shuffle
Endwith
ENDPROC
ENDDEFINE
DEFINE CLASS tile AS checkbox
Height = 40
Width = 26
FontBold = .F.
FontItalic = .F.
FontOutline = .F.
FontShadow = .F.
FontSize = 11
FontUnderline = .F.
FontCondense = .F.
FontExtend = .F.
Caption = "X"
MousePointer = 0
Style = 1
position = 0
Name = "tile"
PROCEDURE position_assign
LPARAMETERS vNewVal
LOCAL nRow,nCol
WITH THIS
.Position = m.vNewVal
nRow=CEILING(vNewVal/4)
nCol=vNewVal-4*(nRow-1)
.top=2+.height*(nRow-1)
.left=2+.width*(nCol-1)
ENDWITH
ENDPROC
PROCEDURE Click
This.Value=0
this.parent.handalFocus
This.Parent.MoveTile(This)
ENDPROC
ENDDEFINE