module1.bas

简单的猜数字、二十四点游戏

Attribute VB_Name = "Module1"
Public MyA(3) As String
Public Pm, Pn, Po As Integer
Public Pi, Pj, Pk, Pl As Integer
Public MaxGameTime As Integer
Public ABSFlag As Boolean
Public FFlag As Boolean
Public Game24Answer As Double
Public Game24Box(10) As String
Public AddNum As Integer
Public FormFlag As Boolean
Public Declare Function RegSetValueEx Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, lpData As Any, ByVal cbData As Long) As Long         ' Note that if you declare the lpData parameter as String, you must pass it By Value.
Public Declare Function RegCreateKey Lib "advapi32.dll" Alias "RegCreateKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Public Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Public Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Public Const HKEY_LOCAL_MACHINE = &H80000002
Public Declare Function RegDeleteValue Lib "advapi32.dll" Alias "RegDeleteValueA" (ByVal hKey As Long, ByVal lpValueName As String) As Long
Public Declare Function DeleteFile Lib "kernel32" Alias "DeleteFileA" (ByVal lpFileName As String) As Long
Public OldPntX As Integer
Public OldPntY As Integer
Public Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Public Type POINTAPI
        X As Long
        Y As Long
End Type
Public Pnt As POINTAPI

Public Function PanDuan(NumP() As Integer) As Boolean
On Error Resume Next
Dim AddNum1 As Double
Dim AddNum2 As Double
Dim AddNum3 As Double
PanDuan = False
Pm = 0
Pn = 0
Po = 0
Pi = 0
Pj = 0
Pk = 0
Pl = 0
For Pi = 0 To 3

 For Pj = 0 To 3
  If Pj <> Pi Then
    For Pk = 0 To 3
     If Pk <> Pj And Pk <> Pi Then
        For Pl = 0 To 3
          If Pl <> Pk And Pl <> Pj And Pl <> Pi Then
              For Pm = 0 To 3
                For Pn = 0 To 3
                  For Po = 0 To 3
                    '1((x,y),z),k
                    If Pm = 0 Then AddNum1 = NumP(Pi) + NumP(Pj)
                    If Pm = 1 Then AddNum1 = NumP(Pi) - NumP(Pj)
                    If Pm = 2 Then AddNum1 = NumP(Pi) * NumP(Pj)
                    If Pm = 3 Then AddNum1 = NumP(Pi) / NumP(Pj)
                    
                    If Pn = 0 Then AddNum2 = AddNum1 + NumP(Pk)
                    If Pn = 1 Then AddNum2 = AddNum1 - NumP(Pk)
                    If Pn = 2 Then AddNum2 = AddNum1 * NumP(Pk)
                    If Pn = 3 Then AddNum2 = AddNum1 / NumP(Pk)
                    
                    If Po = 0 Then AddNum3 = AddNum2 + NumP(Pl)
                    If Po = 1 Then AddNum3 = AddNum2 - NumP(Pl)
                    If Po = 2 Then AddNum3 = AddNum2 * NumP(Pl)
                    If Po = 3 Then AddNum3 = AddNum2 / NumP(Pl)
                    If AddNum3 = 24 Then
                       PanDuan = True
                       AddNum = 1
                       Exit Function
                    End If
                    '2(x,y),(z,k)
                    If Pm = 0 Then AddNum1 = NumP(Pi) + NumP(Pj)
                    If Pm = 1 Then AddNum1 = NumP(Pi) - NumP(Pj)
                    If Pm = 2 Then AddNum1 = NumP(Pi) * NumP(Pj)
                    If Pm = 3 Then AddNum1 = NumP(Pi) / NumP(Pj)
                    
                    If Po = 0 Then AddNum2 = NumP(Pk) + NumP(Pl)
                    If Po = 1 Then AddNum2 = NumP(Pk) - NumP(Pl)
                    If Po = 2 Then AddNum2 = NumP(Pk) * NumP(Pl)
                    If Po = 3 Then AddNum2 = NumP(Pk) / NumP(Pl)
                    
                    If Pn = 0 Then AddNum3 = AddNum1 + AddNum2
                    If Pn = 1 Then AddNum3 = AddNum1 - AddNum2
                    If Pn = 2 Then AddNum3 = AddNum1 * AddNum2
                    If Pn = 3 Then AddNum3 = AddNum1 / AddNum2
                    If AddNum3 = 24 Then
                       PanDuan = True
                       AddNum = 2
                       Exit Function
                    End If
                    '3(x,(y,z)),k
                    If Pn = 0 Then AddNum1 = NumP(Pj) + NumP(Pk)
                    If Pn = 1 Then AddNum1 = NumP(Pj) - NumP(Pk)
                    If Pn = 2 Then AddNum1 = NumP(Pj) * NumP(Pk)
                    If Pn = 3 Then AddNum1 = NumP(Pj) / NumP(Pk)
                    
                    If Pm = 0 Then AddNum2 = NumP(Pi) + AddNum1
                    If Pm = 1 Then AddNum2 = NumP(Pi) - AddNum1
                    If Pm = 2 Then AddNum2 = NumP(Pi) * AddNum1
                    If Pm = 3 Then AddNum2 = NumP(Pi) / AddNum1
                    
                    If Po = 0 Then AddNum3 = AddNum2 + NumP(Pl)
                    If Po = 1 Then AddNum3 = AddNum2 - NumP(Pl)
                    If Po = 2 Then AddNum3 = AddNum2 * NumP(Pl)
                    If Po = 3 Then AddNum3 = AddNum2 / NumP(Pl)
                    If AddNum3 = 24 Then
                      PanDuan = True
                      AddNum = 3
                      Exit Function
                    End If
                    '4x,((y,z),k)
                    If Pn = 0 Then AddNum1 = NumP(Pj) + NumP(Pk)
                    If Pn = 1 Then AddNum1 = NumP(Pj) - NumP(Pk)
                    If Pn = 2 Then AddNum1 = NumP(Pj) * NumP(Pk)
                    If Pn = 3 Then AddNum1 = NumP(Pj) / NumP(Pk)
                    
                    If Po = 0 Then AddNum2 = AddNum1 + NumP(Pl)
                    If Po = 1 Then AddNum2 = AddNum1 - NumP(Pl)
                    If Po = 2 Then AddNum2 = AddNum1 * NumP(Pl)
                    If Po = 3 Then AddNum2 = AddNum1 / NumP(Pl)
                    
                    If Pm = 0 Then AddNum3 = NumP(Pi) + AddNum2
                    If Pm = 1 Then AddNum3 = NumP(Pi) - AddNum2
                    If Pm = 2 Then AddNum3 = NumP(Pi) * AddNum2
                    If Pm = 3 Then AddNum3 = NumP(Pi) / AddNum2
                    If AddNum3 = 24 Then
                       PanDuan = True
                       AddNum = 4
                       Exit Function
                    End If
                    '5x,(y,(z,k))
                    
                    If Po = 0 Then AddNum1 = NumP(Pk) + NumP(Pl)
                    If Po = 1 Then AddNum1 = NumP(Pk) - NumP(Pl)
                    If Po = 2 Then AddNum1 = NumP(Pk) * NumP(Pl)
                    If Po = 3 Then AddNum1 = NumP(Pk) / NumP(Pl)
                    
                    If Pn = 0 Then AddNum2 = NumP(Pj) + AddNum1
                    If Pn = 1 Then AddNum2 = NumP(Pj) - AddNum1
                    If Pn = 2 Then AddNum2 = NumP(Pj) * AddNum1
                    If Pn = 3 Then AddNum2 = NumP(Pj) / AddNum1
                    
                    If Pm = 0 Then AddNum3 = NumP(Pi) + AddNum2
                    If Pm = 1 Then AddNum3 = NumP(Pi) - AddNum2
                    If Pm = 2 Then AddNum3 = NumP(Pi) * AddNum2
                    If Pm = 3 Then AddNum3 = NumP(Pi) / AddNum2
                    If AddNum3 = 24 Then
                       PanDuan = True
                       AddNum = 5
                       Exit Function
                    End If
       
                  Next
                  DoEvents
                Next
                DoEvents
              Next
              DoEvents
           End If
         Next
         DoEvents
       End If
     Next
     DoEvents
   End If
 Next
 DoEvents
Next
End Function
Public Function JiSuanAnswer(StrNum As String) As Boolean
On Error GoTo LL
FormFlag = False
JiSuanAnswer = False
Dim LofStr As Integer
Dim Li As Integer
Dim Lm As Integer
Dim MidStr As String
Dim GameJi(3) As Integer
LofStr = Len(StrNum)
For Li = 1 To LofStr
  MidStr = Mid(StrNum, Li, 1)
  If Asc(MidStr) > 48 And Asc(MidStr) < 58 Or MidStr = "A" Or MidStr = "B" Or MidStr = "C" Or MidStr = "D" Or Asc(MidStr) = 42 Or Asc(MidStr) = 43 Or Asc(MidStr) = 45 Or Asc(MidStr) = 47 Then
   If MidStr = "A" Then
    Game24Box(Lm) = 10
   Else
    If MidStr = "B" Then
     Game24Box(Lm) = 11
    Else
       If MidStr = "C" Then
        Game24Box(Lm) = 12
       Else
          If MidStr = "D" Then
           Game24Box(Lm) = 13
          Else
           Game24Box(Lm) = MidStr
          End If
       End If
    End If
   End If
  
   Lm = Lm + 1
  End If
  If MidStr = ")" Then
   Select Case Game24Box(Lm - 2)
    Case "+"
     Game24Answer = Val(Game24Box(Lm - 3)) + Val(Game24Box(Lm - 1))
     Game24Box(Lm - 3) = Game24Answer
     Lm = Lm - 2
    Case "-"
     Game24Answer = Val(Game24Box(Lm - 3)) - Val(Game24Box(Lm - 1))
     Game24Box(Lm - 3) = Game24Answer
     Lm = Lm - 2
    Case "*"
     Game24Answer = Val(Game24Box(Lm - 3)) * Val(Game24Box(Lm - 1))
     Game24Box(Lm - 3) = Game24Answer
     Lm = Lm - 2
    Case "/"
     Game24Answer = Val(Game24Box(Lm - 3)) / Val(Game24Box(Lm - 1))
     Game24Box(Lm - 3) = Game24Answer
     Lm = Lm - 2
   End Select
  End If
Next
For Li = Lm To 5 Step -2
 If FuHao(Game24Box(Li - 2), Game24Box(Li - 4)) = True Then
  Select Case Game24Box(Li - 2)
   Case "+"
    Game24Answer = Val(Game24Box(Li - 3)) + Val(Game24Box(Li - 1))
    Game24Box(Li - 3) = Game24Answer
    Lm = Lm - 2
   Case "-"
    Game24Answer = Val(Game24Box(Li - 3)) - Val(Game24Box(Li - 1))
    Game24Box(Li - 3) = Game24Answer
    Lm = Lm - 2
   Case "*"
    Game24Answer = Val(Game24Box(Li - 3)) * Val(Game24Box(Li - 1))
    Game24Box(Li - 3) = Game24Answer
    Lm = Lm - 2
   Case "/"
    Game24Answer = Val(Game24Box(Li - 3)) / Val(Game24Box(Li - 1))
    Game24Box(Li - 3) = Game24Answer
    Lm = Lm - 2
  End Select
 Else
  Select Case Game24Box(Li - 4)
   Case "+"
    Game24Answer = Val(Game24Box(Li - 5)) + Val(Game24Box(Li - 3))
    Game24Box(Li - 5) = Game24Answer
    Lm = Lm - 2
   Case "-"
    Game24Answer = Val(Game24Box(Li - 5)) - Val(Game24Box(Li - 3))
    Game24Box(Li - 5) = Game24Answer
    Lm = Lm - 2
   Case "*"
    Game24Answer = Val(Game24Box(Li - 5)) * Val(Game24Box(Li - 3))
    Game24Box(Li - 5) = Game24Answer
    Lm = Lm - 2
   Case "/"
    Game24Answer = Val(Game24Box(Li - 5)) / Val(Game24Box(Li - 3))
    Game24Box(Li - 5) = Game24Answer
    Lm = Lm - 2
  End Select
  For ss = Li - 4 To Li - 2
   Game24Box(ss) = Game24Box(ss + 2)
  Next
 End If
Next
Select Case Game24Box(1)
 Case "+"
    Game24Answer = Val(Game24Box(0)) + Val(Game24Box(2))
    Game24Box(0) = Game24Answer
    Lm = 0
 Case "-"
    Game24Answer = Val(Game24Box(0)) - Val(Game24Box(2))
    Game24Box(0) = Game24Answer
    Lm = 0
 Case "*"
    Game24Answer = Val(Game24Box(0)) * Val(Game24Box(2))
    Game24Box(0) = Game24Answer
    Lm = 0
 Case "/"
    Game24Answer = Val(Game24Box(0)) / Val(Game24Box(2))
    Game24Box(0) = Game24Answer
    Lm = 0
End Select
If Game24Answer = 24 Then JiSuanAnswer = True
Exit Function
LL:
 MsgBox "算式错误,请检查后继续!", , "挑战24点V3.10版"
 FormFlag = True
End Function
Public Function FuHao(X As String, Y As String) As Boolean
FuHao = False
If X = "-" And Y = "+" Or X = "+" And Y = "+" Or X = "-" And Y = "-" Then
 FuHao = True
 Exit Function
 
Else
 If X = "/" And Y = "*" Then
  FuHao = True
  Exit Function
 End If
End If
If Y = "+" Or Y = "-" Then
 FuHao = True
End If
End Function