!!15パズル by くまぷー
!!2007/04/23
!!All Rights Reserved
!!教員のための三四郎活用術
!!http://kumapooh.typepad.jp/
Call Init
MsgBox("パネルをシャッフルします。")
Randomize(ThisTime())
%X=5
%Y=8
for %i = 1 To 3000
%DX = Int(Rand() * 3)-1
%DY = Int(Rand() * 3)-1
If Abs(%DX + %DY) = 1 Then
If Cells(%Y+%DY, %X+%DX) = "" Then
continue for
Else
Cells(%Y, %X) = Cells(%Y+%DY, %X+%DX)
Cells(%Y+%DY, %X+%DX) = ""
%Y = %Y+%DY
%X = %X+%DX
End If
End if
next
MsgBox("新しいゲームを始めます。")
Do While %MyKey <> "{ESC}"
Set %MyRange = Range?
%MyKey=GetKey(2,0)
try
%Cnt =%MyRange.Cells.Count
Exception
Case "ConstraintError"
MsgBox("Quit")
stop
end try
If %Cnt = 1 Then
If Row(%MyRange) > 4 And Row(%MyRange)< 9 And \\
Col(%MyRange)>1 And Col(%MyRange)<6 Then
For %dy = -1 To 1
For %dx = -1 To 1
If Abs(%dy + %dx)=1 Then
If Row(%MyRange)+%dy > 4 And Row(%MyRange)+%dy< 9 And \\
Col(%MyRange)+%dx>1 And Col(%MyRange)+%dx<6 Then
If Cells(Row(%MyRange)+%dy, Col(%MyRange)+%dx)="" Then
Cells(Row(%MyRange)+%dy, Col(%MyRange)+%dx)=\\
Cells(Row(%MyRange), Col(%MyRange))
Cells(Row(%MyRange), Col(%MyRange))=""
End If
End If
End If
Next
Next
If IsGameOver Then
MsgBox("Very Good!!")
Stop
End If
End If
End If
Loop
Function IsGameOver() As Boolean
%i=1
IsGameOver=True
For %y = 5 To 8
For %x = 2 To 5
If %i = 16 Then
%i = ""
End If
If Cells(%y, %x)<> %i Then
IsGameOver=False
End If
%i=%i+1
Next
Next
End Function
Sub Init()
%i=1
For %y = 5 To 8
For %x = 2 To 5
If %i = 16 Then
%i = ""
End If
Cells(%y, %x)=%i
%i=%i+1
Next
Next
End Sub
注 \\は行継続文字
赤字のコードはESCキー押下でゲームを中止するためのもの。
青字のコードはエラー対策のためのもの。
コメント