form1.frm

vb 24点计算.是一个智力小游戏

         Height          =   1395
         Left            =   0
         TabIndex        =   40
         Top             =   0
         Width           =   4220
      End
      Begin VB.Label Label1 
         Alignment       =   2  'Center
         BackColor       =   &H00CECFCE&
         BeginProperty Font 
            Name            =   "宋体"
            Size            =   15
            Charset         =   134
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   255
         Left            =   960
         TabIndex        =   41
         Top             =   1440
         Width           =   2295
      End
   End
   Begin VB.Image imgTitleMinimize 
      Height          =   195
      Left            =   4440
      Picture         =   "Form1.frx":165A98
      ToolTipText     =   "最小化"
      Top             =   150
      Width           =   195
   End
   Begin VB.Image imgTitleClose 
      Height          =   195
      Left            =   4680
      Picture         =   "Form1.frx":165CE2
      ToolTipText     =   "关闭"
      Top             =   150
      Width           =   195
   End
   Begin VB.Image imgTitleHelp 
      Height          =   195
      Left            =   4200
      Picture         =   "Form1.frx":165F2C
      ToolTipText     =   "帮助"
      Top             =   150
      Width           =   195
   End
   Begin VB.Image ImageMoveForm 
      Height          =   375
      Left            =   0
      Top             =   0
      Width           =   5055
   End
   Begin VB.Menu Game 
      Caption         =   "游戏"
      Index           =   1
      Begin VB.Menu herolist 
         Caption         =   "英雄榜"
         Index           =   1
         Shortcut        =   ^H
      End
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False

'                         部分控件使用说明
'CardsPicture(0~3) 用于显示扑克
'CardsPictureClip 控件用于转接图片用
'ProgressBarPicture 控件用于显示时间进程
'ProgressBarPictureClip 控件里装了显示在时间进程里的图片
'CardsImageList 控件里装了 53 张扑克牌
'TimeSlider 控件用于设置答题时间长度
'Text1 控件用于答题时使用或显示正确答案使用
'BreakButton 按钮即相当于键盘上的"退格键"也相当于键盘上的"删除键"
'ImageMove 用于移动窗体
'
Dim sProgressBarPictureY As Single '进程状态指示针
Dim iCardsImageListIndex(4) As Integer '这四个变量的数值将分别指很图片列表中的四张扑克 即：四个1~53的数值
Dim iCardsNumber As Integer '此变量将用于用户测试某数能不能构成24点
Dim TestNumberFour As Boolean  '当用户选了四个数字后 TestOKButton 为可用，即：些变量用于控制TestOKButton按钮是否可用？
Dim iFindError As Integer '返回表达式错误的位置
Dim iErrorLong As Integer '返回表达式错误的长度
Dim ReturnErrorString As String '返回表达式错误信息
Dim TimeOFF As Boolean  '判断是否开启答题时间
Dim TimeSliderVisible As Boolean  '答题时间长度

Dim T As Boolean '区别按住BreakButton、LeftButton、RightButton与单击BreakButton、LeftButton、RightButton

Private Type Usernumber '将用于判断数据的漏输或重复输入某个数据用
  Number As Integer   '用户输入的一个数
  Use As Boolean   ''标记是否被使用过
  Error As Boolean   '标记是否是错误的数据 即：不是程序中给出的数据
  Strat As Integer  '此数在表达式中的开始位置
  Long As Integer   '此数的长度
End Type

Private Sub Add_button_Click()
'在文本框中添加一加号
Text1.SelText = Add_button.Caption
Text1.SetFocus  '使光标始终都留在文本框中
'当检测到用户输入的数据合法并表达式格式正确时OK按钮获得焦距
 If (InputNumber(Text1.Text) = True) Then
    If InputOperator(Text1.Text) = True Then
     OKButton.Enabled = True
     OKButton.SetFocus
   End If
End If


End Sub

Private Sub AnswerButton_Click()
Dim iAnswer As Integer

     iAnswer = OperatorModule.Operator()                           '调用24点表达式计算函数

    If iAnswer = 24 Then                                          'operater函数能返回24的值说有解
      Text1.Text = OperatorModule.OperateorString + "=24"
    Else                                                           '答题错误所要做的动作
      Text1.Text = "本题无解 "
    End If

      OKButton.Enabled = False
      AnswerButton.Enabled = False
      
      TestButton.Enabled = True
      StartButton.Enabled = True
      TimeButton.Enabled = True
      StartButton.SetFocus


End Sub

Private Sub BreakButton_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Timer4 = True '当鼠标按住被光标一直删除左边的数据
End Sub

Private Sub BreakButton_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
Timer4 = False '当放开鼠标时光标停止删除左边的数据
End Sub

Private Sub CardsNumber_1_Click()
TestCards (1)  '调用TestCards函数 参数为1 即其数值大小为1 以下调用TestCards函数的按钮其含意雷相
End Sub

Private Sub CardsNumber_10_Click()
TestCards (10)

End Sub

Private Sub CardsNumber_11_Click()
TestCards (11)

End Sub

Private Sub CardsNumber_12_Click()
TestCards (12)

End Sub

Private Sub CardsNumber_13_Click()
TestCards (13)

End Sub

Private Sub CardsNumber_2_Click()
TestCards (2)

End Sub

Private Sub CardsNumber_3_Click()
TestCards (3)

End Sub

Private Sub CardsNumber_4_Click()
TestCards (4)

End Sub

Private Sub CardsNumber_5_Click()
TestCards (5)

End Sub

Private Sub CardsNumber_6_Click()
TestCards (6)

End Sub

Private Sub CardsNumber_7_Click()
TestCards (7)

End Sub

Private Sub CardsNumber_8_Click()
TestCards (8)

End Sub

Private Sub CardsNumber_9_Click()
TestCards (9)

End Sub

Private Sub BreakButton_Click()
'退一格
T = False
If Text1.SelText <> "" Then '删除光标所选的字符
 Text1.SelText = ""
 iErrorLong = 0
Else
 If Len(Text1.Text) > 0 Then '文本框不为空
  If Text1.SelStart > 0 Then  '光标不在表达式的最左边 就删除光标前的一个字符
    Text1.SelStart = Text1.SelStart - 1
    Text1.SelLength = 1
    Text1.SelText = ""
  Else                      '光标在表达式的最左边 就删除光标后的一个字符
    Text1.SelStart = 0
    Text1.SelLength = 1
    Text1.SelText = ""
  End If
 End If
End If
 Text1.SetFocus  '使光标始终都留在文本框中
 
 '当检测到用户输入的数据合法并表达式格式正确时OK按钮获得焦距
 If (InputNumber(Text1.Text) = True) Then
    If InputOperator(Text1.Text) = True Then
     OKButton.Enabled = True
     OKButton.SetFocus
   End If
End If

 
End Sub


Private Sub ClearCardsButton_Click()


If iCardsNumber > 0 Then '只有当iCardsNumber变量大于0时执行清除操作才有意议
     iCardsNumber = 0
     TestNumberFour = False
     TestOKButton.Enabled = False
     Label1.Caption = ""

     CardsPictureClip.Picture = CardsImageList.ListImages(53).Picture '将要显示的图片先装到剪切框中
     a = px(CardsPicture(0), CardsPictureClip, 1)
     CardsPictureClip.Picture = CardsImageList.ListImages(53).Picture '将要显示的图片先装到剪切框中
     a = px(CardsPicture(1), CardsPictureClip, 1)
     CardsPictureClip.Picture = CardsImageList.ListImages(53).Picture '将要显示的图片先装到剪切框中
     a = px(CardsPicture(2), CardsPictureClip, 1)
     CardsPictureClip.Picture = CardsImageList.ListImages(53).Picture '将要显示的图片先装到剪切框中
     a = px(CardsPicture(3), CardsPictureClip, 1)



     '显示四张扑克  原本有了上面的图片方法可以不要下面的四行语句，但由于上面的图片是画出来的所以显示出来的图像很容易丢失 所以就再加上下面的语句以保证图像稳定
     CardsPicture(0).Picture = CardsImageList.ListImages(53).Picture
     CardsPicture(1).Picture = CardsImageList.ListImages(53).Picture
     CardsPicture(2).Picture = CardsImageList.ListImages(53).Picture
     CardsPicture(3).Picture = CardsImageList.ListImages(53).Picture
End If
End Sub





Private Sub Command1_Click()
Dim tt As Integer
tt = iTimes * (TimeSlider.Value) / (ProgressBarPicture.ScaleWidth / 10)
   
    If CheckTop10("c:\top10.txt", tt) = True Then
                      frmUsr.Show
                      WriteTop10 frmUsr.tUsrName.Text, "c:\top10.txt", iTimes
                        Unload frmUsr
               End If
End Sub

Private Sub Divide_Button_Click()
'在文本框中添加一除号
Text1.SelText = Divide_Button.Caption
Text1.SetFocus '使光标始终都留在文本框中

'当检测到用户输入的数据合法并表达式格式正确时OK按钮获得焦距
 If (InputNumber(Text1.Text) = True) Then
    If InputOperator(Text1.Text) = True Then
     OKButton.Enabled = True
     OKButton.SetFocus
   End If
End If


End Sub


Private Sub Form_Load()


TimeOFF = True '默认开启答题时间
' 默认答题时间为50秒
Timer1.Interval = (TimeSlider.Value * 1000) / (ProgressBarPicture.ScaleWidth / 10) '设置两次调用Timer控件的Timer事件间隔的毫秒数
TimeSlider.Visible = False '初始化时用于时间滑杆控件不可见
TimeSliderVisible = False

Timer1.Enabled = False '刚开始时时间不可用
OperatorInputFrame.Enabled = False '表达式输入按钮不可用
TestFrame.Visible = False  '刚开始时测试控制按钮不可见
AnswerButton.Enabled = False
OKButton.Enabled = False
iErrorLong = 0 '错误长度初始化为0
'将四个Frame控件和一个Label控件的背景颜色设成跟窗体背景颜色一样
Frame1.BackColor = RGB(206, 207, 206)
Frame2.BackColor = RGB(206, 207, 206)
TestFrame.BackColor = RGB(206, 207, 206)
OperatorInputFrame.BackColor = RGB(206, 207, 206)
Label1.BackColor = RGB(206, 207, 206)





End Sub
Private Sub TestCards(Num As Integer)
'参数num是用户选择的数值
Dim iCount As Integer
If iCardsNumber = 4 Then iCardsNumber = 0
If iCardsNumber = 3 Then TestNumberFour = True  '用户已经选够了牌数

If TestNumberFour Then
   TestOKButton.Enabled = True
   TestOKButton.SetFocus
Else
  TestOKButton.Enabled = False
End If

  Randomize  '初始化随机
 tt = Int(Rnd() * 4 + 1) '产生一个随机数
 
 Select Case tt   '用于显示四种不同种类的牌
       Case 1
       iCount = 0 + Num