guessform.frm

猜数字游戏

VERSION 5.00
Begin VB.Form GuessForm 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "猜数字"
   ClientHeight    =   2610
   ClientLeft      =   150
   ClientTop       =   435
   ClientWidth     =   4740
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   ScaleHeight     =   2610
   ScaleWidth      =   4740
   StartUpPosition =   2  'CenterScreen
   Begin VB.CommandButton Command1 
      Caption         =   "暂停"
      Height          =   375
      Left            =   1560
      TabIndex        =   10
      Top             =   1320
      Width           =   855
   End
   Begin VB.Timer Timer1 
      Interval        =   1
      Left            =   3360
      Top             =   960
   End
   Begin VB.ListBox List1 
      Height          =   1620
      ItemData        =   "GuessForm.frx":0000
      Left            =   2760
      List            =   "GuessForm.frx":0002
      TabIndex        =   8
      Top             =   600
      Width           =   1695
   End
   Begin VB.CommandButton btExit 
      Caption         =   "退出"
      Height          =   375
      Left            =   1560
      TabIndex        =   7
      Top             =   1920
      Width           =   855
   End
   Begin VB.CommandButton btOK 
      Caption         =   "确定"
      Enabled         =   0   'False
      Height          =   375
      Left            =   240
      TabIndex        =   6
      Top             =   1920
      Width           =   1095
   End
   Begin VB.CommandButton btRestart 
      Caption         =   "重新开始"
      Height          =   375
      Left            =   240
      TabIndex        =   5
      Top             =   1320
      Width           =   1095
   End
   Begin VB.TextBox TBNUM4 
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   9.75
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   375
      Left            =   2040
      TabIndex        =   3
      Top             =   120
      Width           =   495
   End
   Begin VB.TextBox TBNUM3 
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   9.75
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   375
      Left            =   1440
      TabIndex        =   2
      Top             =   120
      Width           =   495
   End
   Begin VB.TextBox TBNUM2 
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   9.75
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   375
      Left            =   840
      TabIndex        =   1
      Top             =   120
      Width           =   495
   End
   Begin VB.TextBox TBNUM1 
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   9.75
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   375
      Left            =   240
      TabIndex        =   0
      Top             =   120
      Width           =   495
   End
   Begin VB.Label Label2 
      AutoSize        =   -1  'True
      BackColor       =   &H80000008&
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   12
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H0000C000&
      Height          =   300
      Left            =   3120
      TabIndex        =   9
      Top             =   120
      Width           =   60
   End
   Begin VB.Label Label1 
      Alignment       =   2  'Center
      BorderStyle     =   1  'Fixed Single
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   9.75
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   375
      Left            =   240
      TabIndex        =   4
      Top             =   720
      Width           =   2295
   End
   Begin VB.Menu File 
      Caption         =   "文件（F）"
      Begin VB.Menu OK 
         Caption         =   "确定"
      End
      Begin VB.Menu restar 
         Caption         =   "重新开始"
      End
      Begin VB.Menu div 
         Caption         =   ""
         Visible         =   0   'False
         WindowList      =   -1  'True
      End
      Begin VB.Menu exit 
         Caption         =   "退出"
      End
   End
   Begin VB.Menu Help 
      Caption         =   "帮助（H）"
      Begin VB.Menu About 
         Caption         =   "关于猜数字"
      End
   End
End
Attribute VB_Name = "GuessForm"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim flag As Boolean
Dim initnum(1 To 4) As Integer
Dim times As Integer
Dim h0 As Integer
'ho,mo,so为初始时间
Dim m0 As Integer
Dim s0 As Integer
Dim temp1 As Integer
Dim temp2 As Integer
Dim x1 As Integer
Dim x2 As Integer


Public Sub reset()
    Dim i, j As Integer
Randomize (10)
    For i = 1 To 4
     Do
        flag = False
        initnum(i) = Rnd(1) * 10
        
        If initnum(i) = 10 Then
            flag = True
        End If
      For j = 1 To i - 1
        If initnum(i) = initnum(j) Then
            flag = True
        End If
      Next
    Loop Until flag = False
   Next
   
    TBNUM1.Text = ""
    TBNUM2.Text = ""
    TBNUM3.Text = ""
    TBNUM4.Text = ""
    times = 8
    Label1.Caption = "你还有8次机会"
    List1.Clear
    flag = False
    btOK.Enabled = True
    'GuessForm.TBNUM1.SetFocus
End Sub
Public Sub subOK()
        Dim InputNum(4) As Integer
        Dim i As Integer, j As Integer
        Dim a As Integer, b As Integer
        Dim flag As Integer
        Dim s As String

        If TBNUM1.Text = "" Or TBNUM2.Text = "" Or TBNUM3.Text = "" Or TBNUM4.Text = "" Then
            MsgBox ("必须输入4个数字")
            '判断用户是否已经输入了4个数字
        Else
            InputNum(1) = Val(TBNUM1.Text)
            InputNum(2) = Val(TBNUM2.Text)
            InputNum(3) = Val(TBNUM3.Text)
            InputNum(4) = Val(TBNUM4.Text)
            '将游戏者的输入存入数组，以方便通过循环语句对其进行判断

            flag = 0
            For i = 1 To 3
                If InputNum(i) > 9 Or InputNum(i) < 0 Then
                    MsgBox ("输入数字超出范围")
                    flag = 1
                End If
                '判断游戏者的输入是否在0到9之间

                For j = i + 1 To 4
                    If InputNum(i) = InputNum(j) And i <> j Then
                        MsgBox ("输入的四个数字不能重复")
                        flag = 1
                    End If
                Next
                '判断游戏者输入的四个数字是否重复
            Next

            If flag = 0 Then
                For i = 1 To 4
                    For j = 1 To 4
                        If InputNum(i) = initnum(j) Then
                            If i = j Then a = a + 1 Else b = b + 1
                        End If
                    Next
                Next
                '判断游戏者输入的数字的数值及位置是否正确，如果数值及位置都正确，则a的值加1；如果只是数值正确而位置不对，则b的值加1

                s = TBNUM1.Text & TBNUM2.Text & TBNUM3.Text & TBNUM4.Text & ":" & a & "A" & b & "B"
                List1.AddItem (s)
                '显示中间结果
                times = times - 1
                Label1.Caption = "您还有" & times & "次机会"
                '对游戏者的剩余次数进行递减

                If a = 4 Or times = 0 Then
                    If a = 4 Then
                        MsgBox ("恭喜过关！")
                        Timer1.Enabled = False
                    Else: MsgBox ("正确答案应为" & initnum(1) & initnum(2) & initnum(3) & initnum(4))
                        Timer1.Enabled = False
                    End If
                    '判断游戏的结束和游戏者的胜负
                    btOK.Enabled = False
                    '游戏结束，将BTOK按钮设为无效
                End If
            End If
        End If
    End Sub



Private Sub About_Click()
Dim frmabout As New fAbout
frmabout.Show
End Sub

Private Sub btExit_Click()
    Unload Me
End Sub

Private Sub btOK_Click()
    GuessForm.subOK
End Sub

Private Sub btRestart_Click()
    Timer1.Enabled = True
    Label2.Caption = ""
    h0 = Val(Time$)
    m0 = Minute(Time$)
    s0 = Second(Time$)

    GuessForm.reset
End Sub

Private Sub Command1_Click()
    If Command1.Caption = "暂停" Then
        Timer1.Enabled = False
        Command1.Caption = "开始"
        
        temp1 = x1
        temp2 = x2
    
    Else
     If Command1.Caption = "开始" Then
        Timer1.Enabled = True
        
        h0 = Val(Time$)
        m0 = Minute(Time$)
        s0 = Second(Time$)
        
        Command1.Caption = "暂停"
     End If
   End If
    
End Sub

Private Sub exit_Click()
    Unload Me
End Sub

Private Sub Form_Load()
    
    h0 = Val(Time$)
    m0 = Minute(Time$)
    s0 = Second(Time$)
    GuessForm.reset
End Sub

Private Sub OK_Click()
    GuessForm.subOK
End Sub

Private Sub restar_Click()
    GuessForm.reset
End Sub

Private Sub TBNUM1_KeyPress(KeyAscii As Integer)
If Asc(KeyAscii) > 57 Or Asc(KeyAscii) < 48 Then
            '判断输入是否为数字
            MsgBox ("请输入正确的字符")
            TBNUM1.Text = ""
            '显示提示信息并清空文本框
        Else
            TBNUM2.SetFocus
            TBNUM2.SelStart = 0
            TBNUM2.SelLength = 1
            '当TBNum1有输入的时候，自动将焦点转移到TBNum2上
        End If
End Sub



Private Sub TBNUM2_KeyPress(KeyAscii As Integer)
If Asc(KeyAscii) > 57 Or Asc(KeyAscii) < 48 Then
            '判断输入是否为数字
            MsgBox ("请输入正确的字符")
            TBNUM2.Text = ""
            '显示提示信息并清空文本框
        Else
            TBNUM3.SetFocus
            TBNUM3.SelStart = 0
            TBNUM3.SelLength = 1
                        
            '当TBNum1有输入的时候，自动将焦点转移到TBNum2上
        End If
End Sub

Private Sub TBNUM3_KeyPress(KeyAscii As Integer)
If Asc(KeyAscii) > 57 Or Asc(KeyAscii) < 48 Then
            '判断输入是否为数字
            MsgBox ("请输入正确的字符")
            TBNUM3.Text = ""
            '显示提示信息并清空文本框
        Else
            TBNUM4.SetFocus
            TBNUM4.SelStart = 0
            TBNUM4.SelLength = 1
                        
            '当TBNum1有输入的时候，自动将焦点转移到TBNum2上
        End If
End Sub

Private Sub TBNUM4_KeyPress(KeyAscii As Integer)
If Asc(KeyAscii) > 57 Or Asc(KeyAscii) < 48 Then
            '判断输入是否为数字
            MsgBox ("请输入正确的字符")
            TBNUM4.Text = ""
            '显示提示信息并清空文本框
        Else
            btOK.SetFocus
                        
            '当TBNum1有输入的时候，自动将焦点转移到TBNum2上
        End If
End Sub

Private Sub Timer1_Timer()
Dim gg As Integer
Dim h As Integer
Dim m As Integer
Dim s As Integer
'Dim x1 As Integer
'Dim x2 As Integer

h = Val(Time$)
m = Minute(Time$)
s = Second(Time$)
gg = (h - h0) * 3600 + (m - m0) * 60 + (s - s0)
x1 = temp1 + Int(gg / 60)
x2 = temp2 + (gg - (Int(gg / 60)) * 60)
Label2.Caption = Str(x1) + " 分" + Str(x2) + " 秒"

End Sub