?? 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
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -