上級70回のコード

 #If  Win64 Then
   Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As LongPtr) #Else 
   Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long) #End  If

Sub クラス無し()
   
   Dim hitoA(0 To 2) As Variant
   Dim hitoB(0 To 2) As Variant
   Dim hitobito(0 To 1) As Variant
   
   Dim x As Integer
   Dim y As Integer
   
   Randomize
   
   hitoA(0) = 6
   hitoA(1) = 6
   hitoA(2) = "漢"
   
   hitoB(0) = 3
   hitoB(1) = 3
   hitoB(2) = "女"
   
   hitobito(0) = hitoA
   hitobito(1) = hitoB
   
   Do While True
       
       Range("a1:k11") = ""
       
       For i = 0 To 1
       
           muki = Int(4 * Rnd)
           Select Case muki
           
               Case 0: '上
                   y = -1
                   x = 0
               Case 1: '右
                   y = 0
                   x = 1
               Case 2: '下
                   y = 1
                   x = 0
               Case 3: '左
                   y = 0
                   x = -1
           End Select
           
           If hitobito(i)(0) + x > 0 And hitobito(i)(0) + x < 10 Then
               If hitobito(i)(1) + y > 0 And hitobito(i)(1) + y < 10 Then
               
                   Call move(x, y, hitobito(i))
               End If
           End If
           
           Cells(hitobito(i)(1), hitobito(i)(0)) = hitobito(i)(2)
       Next i
       
       DoEvents
       Sleep 500
   Loop
   
End Sub

Sub move(x As Integer, y As Integer, hito As Variant)
           
   hito(1) = hito(1) + y
   hito(0) = hito(0) + x
End Sub


Public x As Integer
Public y As Integer
Public moji As String

Public Sub Init(x As Integer, y As Integer, moji As String)

   Me.x = x
   Me.y = y
   Me.moji = moji
   
End Sub

Public Sub move(x, y)

   Me.x = Me.x + x
   Me.y = Me.y + y
   
End Sub
 #If  Win64 Then
   Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As LongPtr) #Else 
   Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long) #End  If
Sub test()
   Dim hito As Human
   
   Set hito = New Human
   hito.x = 10
   
   
End Sub
Sub クラス有り()
   
   Dim hitobito(0 To 1) As Human
   
   Dim x As Integer
   Dim y As Integer
   
   Randomize
       
   Set hitobito(0) = New Human
   Set hitobito(1) = New Human
   
   Call hitobito(0).Init(6, 6, "漢")
   Call hitobito(1).Init(3, 3, "女")
   
   Do While True
       
       Range("a1:k11") = ""
       
       For i = 0 To 1
       
           muki = Int(4 * Rnd)
           Select Case muki
           
               Case 0: '上
                   y = -1
                   x = 0
               Case 1: '右
                   y = 0
                   x = 1
               Case 2: '下
                   y = 1
                   x = 0
               Case 3: '左
                   y = 0
                   x = -1
           End Select
           
           If hitobito(i).x + x > 0 And hitobito(i).x + x < 10 Then
               If hitobito(i).y + y > 0 And hitobito(i).y + y < 10 Then
           
                   Call hitobito(i).move(x, y)
                   
               End If
           End If
           
           Cells(hitobito(i).y, hitobito(i).x) = hitobito(i).moji
           
       Next i
       
       DoEvents
       Sleep 500
   Loop
End Sub

この記事が気に入ったらサポートをしてみませんか?