|
こんばんは
どの程度動かすとハングするのでしょうか?
問題無く動いている感じがしますけど、一応ループの中の変数宣言は外に出すとして
Option Explicit
Declare Function GetAsyncKeyState Lib "User32.dll" (ByVal vKey As Long) As Long
Declare Function GetTickCount Lib "kernel32" () As Long
Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Sub ReelData()
Dim Reel As Variant
Dim t1 As Long
Dim t2 As Long
Dim temp As String
Dim ReelV As Variant
Dim n(1 To 3) As Integer
Dim i As Integer
Dim GameFlag As Boolean
Dim ReelF(1 To 3) As Boolean
Reel = Worksheets("ReelData").Range("B3:D18")
ReelV = Range("B4:D4")
t2 = Worksheets("ReelData").Range("G2").Value
Do While GameFlag = False
' Dim t1 As Long
' Dim t2 As Long
t1 = GetTickCount
' t2 = Worksheets("ReelData").Range("G2").Value
Do While GetTickCount - t1 < t2
Sleep Worksheets("ReelData").Range("G2").Value
Loop
For i = 1 To 3
If ReelF(i) = False Then
n(i) = n(i) + 1
If n(i) > 16 Then
n(i) = 1
End If
'表示用文字列を格納
ReelV(1, i) = Reel(n(i), i)
End If
Next
'リールを一括画面表示
Range("B4:D4") = ReelV
'ボタンをPushしたら各リールを止める。
If GetAsyncKeyState(90) <> 0 Then 'z
ReelF(1) = True
End If
If GetAsyncKeyState(88) <> 0 Then 'x
ReelF(2) = True
End If
If GetAsyncKeyState(67) <> 0 Then 'c
ReelF(3) = True
End If
'全てのリールがストップしたらゲームを終了する。
If ReelF(1) Then
If ReelF(2) Then
If ReelF(3) Then
GameFlag = True
End If
End If
End If
Loop
' Dim temp As String
If Range("B4").Value = Range("C4").Value And Range("C4").Value = Range("D4").Value Then
If Range("B4").Value = 7 Then
temp = "大当たり!!!"
ElseIf Range("B4").Value = "BAR" Then
temp = "中当たり!!"
Else
temp = "小当たり!"
End If
Else
temp = "はずれ。。"
End If
MsgBox temp
End Sub
|
|