frmgame.frm

猜字迷的游戏

VERSION 5.00
Object = "{248DD890-BB45-11CF-9ABC-0080C7E7B78D}#1.0#0"; "MSWINSCK.OCX"
Begin VB.Form frmGame 
   Caption         =   "大家来玩猜数字"
   ClientHeight    =   4524
   ClientLeft      =   1596
   ClientTop       =   1548
   ClientWidth     =   4632
   Icon            =   "frmGame.frx":0000
   LinkTopic       =   "Form1"
   ScaleHeight     =   377
   ScaleMode       =   3  '像素
   ScaleWidth      =   386
   Begin VB.CommandButton cmdSendMessage 
      Caption         =   "传送"
      Height          =   372
      Left            =   2760
      TabIndex        =   14
      Top             =   4080
      Visible         =   0   'False
      Width           =   1212
   End
   Begin VB.TextBox txtSendMessage 
      Height          =   336
      Left            =   600
      TabIndex        =   12
      Top             =   4080
      Visible         =   0   'False
      Width           =   2052
   End
   Begin VB.ListBox lstDataBase 
      Height          =   768
      Left            =   2760
      TabIndex        =   9
      Top             =   1200
      Visible         =   0   'False
      Width           =   1692
   End
   Begin MSWinsockLib.Winsock wskConnect 
      Left            =   120
      Top             =   120
      _ExtentX        =   593
      _ExtentY        =   593
      _Version        =   393216
   End
   Begin VB.CommandButton cmdGameStart 
      Caption         =   "游戏开始"
      Height          =   372
      Left            =   2760
      TabIndex        =   6
      Top             =   3600
      Width           =   1212
   End
   Begin VB.TextBox txtUserInput 
      Enabled         =   0   'False
      Height          =   372
      Left            =   2760
      TabIndex        =   5
      Top             =   2160
      Width           =   1692
   End
   Begin VB.TextBox txtCPUInput 
      Enabled         =   0   'False
      Height          =   372
      Left            =   2760
      TabIndex        =   4
      Top             =   120
      Width           =   1692
   End
   Begin VB.ListBox lstUserRecord 
      Height          =   1848
      Left            =   600
      TabIndex        =   2
      Top             =   2160
      Width           =   2052
   End
   Begin VB.ListBox lstCPURecord 
      Height          =   1848
      Left            =   600
      TabIndex        =   0
      Top             =   120
      Width           =   2052
   End
   Begin VB.Label lblSendMessage 
      Caption         =   "传送讯息"
      Height          =   492
      Left            =   120
      TabIndex        =   13
      Top             =   4020
      Visible         =   0   'False
      Width           =   492
   End
   Begin VB.Label lblMyMessage 
      Height          =   852
      Left            =   2760
      TabIndex        =   11
      Top             =   2640
      Visible         =   0   'False
      Width           =   1692
   End
   Begin VB.Label lblConnectUserMessage 
      Height          =   1332
      Left            =   2760
      TabIndex        =   10
      Top             =   600
      Visible         =   0   'False
      Width           =   1812
   End
   Begin VB.Line Line1 
      BorderColor     =   &H8000000E&
      Index           =   1
      X1              =   0
      X2              =   800
      Y1              =   1
      Y2              =   1
   End
   Begin VB.Line Line1 
      BorderColor     =   &H80000010&
      Index           =   0
      X1              =   0
      X2              =   800
      Y1              =   0
      Y2              =   0
   End
   Begin VB.Label lblUserNumber 
      Height          =   252
      Left            =   2760
      TabIndex        =   8
      Top             =   2640
      Visible         =   0   'False
      Width           =   1692
   End
   Begin VB.Label lblCPUNumber 
      Height          =   252
      Left            =   2760
      TabIndex        =   7
      Top             =   600
      Visible         =   0   'False
      Width           =   1692
   End
   Begin VB.Label lblUserName 
      Caption         =   "USER"
      Height          =   252
      Index           =   2
      Left            =   60
      TabIndex        =   3
      Top             =   2160
      Width           =   492
   End
   Begin VB.Label lblUserName 
      Caption         =   "CPU"
      Height          =   252
      Index           =   1
      Left            =   120
      TabIndex        =   1
      Top             =   120
      Width           =   372
   End
   Begin VB.Menu GameSetUP 
      Caption         =   "游戏设定"
      Begin VB.Menu Level 
         Caption         =   "难度"
         Begin VB.Menu LevelHard 
            Caption         =   "难     - 4个数字"
         End
         Begin VB.Menu LevelNormal 
            Caption         =   "普通 - 3个数字"
         End
         Begin VB.Menu LevelEasy 
            Caption         =   "简单 - 2个数字"
         End
      End
   End
   Begin VB.Menu NetButter 
      Caption         =   "网路对战"
   End
   Begin VB.Menu ConnectClose 
      Caption         =   "切断连线"
      Visible         =   0   'False
   End
   Begin VB.Menu ExitGame 
      Caption         =   "离开"
   End
   Begin VB.Menu AboutNumberGame 
      Caption         =   "关于"
   End
End
Attribute VB_Name = "frmGame"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim CPUNumber As String       '电脑或对手要让自己猜的号码
Dim UserNumber As String      '自己要让对手猜的号码

Dim CPUArray() As Integer     '电脑的AI用的判断阵列
Dim CPUArraySUM As Integer    '阵列总数
Dim rndFlag()                 '

Dim GAME_NUMBER As Integer    '游戏要猜的数字个数 (2 ~ 4)
Dim FormatString As String    '"00" ~ "0000"
Private Function CheckSameNumber(cNumber As String) As Boolean
'Check Same Number,If Find Return True

Dim i%, j%
For i% = 1 To GAME_NUMBER - 1
    For j% = i% + 1 To GAME_NUMBER
        If Mid$(cNumber, i, 1) = Mid$(cNumber, j, 1) Then
           CheckSameNumber = True
        End If
    Next j%
Next i%

End Function

Private Function CheckUserNumber(xNumber As String, AnsNumber As String) As Boolean

'User猜电脑数字的判断
'Check Input Error , If Error Exit Sub
'Check Match Number,If 4A then User Win Exit Sub
'Else Call CPUGo,换电脑猜User的数字
'假如电脑猜对,就GameOver罗!

Dim i%, j%, MatchA%, MatchB%

If Len(xNumber) <> GAME_NUMBER Then
   MsgBox "请输入正确数字！", , Me.Caption
   Exit Function
End If

If CheckSameNumber(xNumber) = True Then
   MsgBox "数字重覆！", , Me.Caption
   Exit Function
End If

For i% = 1 To GAME_NUMBER
    For j% = 1 To GAME_NUMBER
        If Mid$(xNumber, i, 1) = Mid$(AnsNumber, j, 1) Then
           If i% = j% Then
              MatchA = MatchA + 1
           Else
              MatchB = MatchB + 1
           End If
        End If
    Next j%
Next i%

lstUserRecord.AddItem xNumber & Space(3) & Format$(MatchA, "0") & "A" & Format$(MatchB, "0") & "B"

If MatchA <> GAME_NUMBER And ConnectStatus = False Then
   Me.Caption = "电脑思考中..."
   Me.MousePointer = 11
   DoEvents
   If CPUGo() <> True Then
      Me.MousePointer = 0
      Me.Caption = "大家来玩猜数字"
   Else
      Me.MousePointer = 0
      Me.Caption = "大家来玩猜数字"
      cmdGameStart.Caption = "游戏开始"
      txtUserInput.Enabled = False
      NetButter.Enabled = True
      GameSetUP.Enabled = True
      MsgBox "电脑赢了！" & vbCrLf & "电脑的答案是...  " & CPUNumber, , Me.Caption
   End If
ElseIf MatchA = GAME_NUMBER Then
   CheckUserNumber = True
   Exit Function
End If



End Function

Private Function CPUGo() As Boolean
'1.从电脑的判断阵列中乱数取出一个,当电脑要猜的数字 1~9999(or 999 or 99) 有不合法的字已去除
'2.判断与User的解答相合的程度
'3.If 4A 电脑赢,Exit
'Else 判断阵列里那一些值有可能,把剩下的剃除

Dim x As String
Dim i%, j%, MatchA%, MatchB%, A%, B%, iTemp%, k%
ReDim ArrayTemp(1 To CPUArraySUM)

For i% = 1 To GAME_NUMBER
    x = Format$(CPUArray(GetRandomNo(CPUArraySUM)), FormatString)
Next i%

For i% = 1 To GAME_NUMBER
    For j% = 1 To GAME_NUMBER
        If Mid$(x, i, 1) = Mid$(UserNumber, j, 1) Then
           If i% = j% Then
              MatchA = MatchA + 1
           Else
              MatchB = MatchB + 1
           End If
        End If
    Next j%
Next i%

lstCPURecord.AddItem x & Space(3) & Format$(MatchA, "0") & "A" & Format$(MatchB, "0") & "B"

If MatchA = GAME_NUMBER Then
   CPUGo = True
   Exit Function
End If
    
iTemp% = CPUArraySUM
CPUArraySUM = 0
For k% = 1 To iTemp%
    A = 0: B = 0
    For i% = 1 To GAME_NUMBER
        For j% = 1 To GAME_NUMBER
            If Mid$(x, i, 1) = Mid$(Format$(CPUArray(k%), FormatString), j, 1) Then
               If i% = j% Then
                  A = A + 1
               Else
                  B = B + 1
               End If
            End If
        Next j%
    Next i%
    
    If A = MatchA And B = MatchB Then
       CPUArraySUM = CPUArraySUM + 1
       ArrayTemp(CPUArraySUM) = CPUArray(k%)
    End If
Next k%

lstDataBase.Clear
lstDataBase.AddItem "预测分析...余" & Format$(CPUArraySUM, "0") & "笔"
ReDim CPUArray(1 To CPUArraySUM)
For i% = 1 To CPUArraySUM
    CPUArray(i%) = ArrayTemp(i%)
    lstDataBase.AddItem Format$(ArrayTemp(i%), FormatString)
Next i%
End Function


Private Sub SetGAME_NUMBER(Num As String)
'Set Game Level
Dim i As Integer

Select Case Num
Case "4"
     GAME_NUMBER = 4
     FormatString = ""
     For i% = 1 To GAME_NUMBER
         FormatString = FormatString & "0"
     Next i%
     LevelHard.Checked = vbChecked
     LevelNormal.Checked = vbUnchecked
     LevelEasy.Checked = vbUnchecked
Case "3"
     GAME_NUMBER = 3
     FormatString = ""
     For i% = 1 To GAME_NUMBER
         FormatString = FormatString & "0"
     Next i%
     LevelHard.Checked = vbUnchecked
     LevelNormal.Checked = vbChecked
     LevelEasy.Checked = vbUnchecked
Case "2"
     GAME_NUMBER = 2
     FormatString = ""
     For i% = 1 To GAME_NUMBER
          FormatString = FormatString & "0"
     Next i%
     LevelHard.Checked = vbUnchecked
     LevelNormal.Checked = vbUnchecked
     LevelEasy.Checked = vbChecked
End Select
End Sub

Private Sub GetResquestData(MsgType As String, msgData As String)

End Sub

Private Sub ResetConnectData()
'重置连线模式的资料

lblSendMessage.Visible = True
txtSendMessage.Visible = True
cmdSendMessage.Visible = True
cmdGameStart.Enabled = True
GameSetUP.Enabled = True
ConnectStatus = True

Dim i As Integer
GAME_NUMBER = 3
FormatString = ""
For i% = 1 To GAME_NUMBER
     FormatString = FormatString & "0"
Next i%
LevelHard.Checked = vbUnchecked
LevelNormal.Checked = vbChecked
LevelEasy.Checked = vbUnchecked
End Sub

Private Sub SendMsgToUser(sendMsg As String)
'送Message给User,假如对方已断线,会发生错误,所以加On Error叙述

On Error Resume Next
wskConnect.SendData sendMsg
Select Case Left(sendMsg, 1)
Case GAME_MSG
Case Else
     lblMyMessage.Caption = Right$(sendMsg, Len(sendMsg) - 1)
End Select
End Sub

Private Sub AboutNumberGame_Click()
frmAbout.Show 1
End Sub

Private Sub cmdGameStart_Click()
Dim x As String

'Check Connect Status
'If False (Not Net Batter) Input Game Number
'   Then Check Number Error,If No Error Then Reset All the Game Data,Game Start
'If Connect Status True(Net Batter)
'   If ConnectType = CLIENT then Exit
'   Else Input Game Number,Send Message to Client ,Disable Menu and Command Button
'   Wait Client Response
   

If ConnectStatus = False Then
   x = InputBox("请输入你要让对方猜的" & Format$(GAME_NUMBER, "0") & "位数字", Me.Caption)
Else
   If ConnectType = CONNECT_CLIENT Then
      MsgBox "User端不能主动开始游戏！请由Server端开始新游戏", , Me.Caption
      Exit Sub
   End If

   x = InputBox("请输入你要让电脑猜的" & Format$(GAME_NUMBER, "0") & "位数字", Me.Caption)
End If

If Len(x) <> GAME_NUMBER Then
   MsgBox "长度错误，请重新输入", , Me.Caption