frmegg.frm

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

      Top             =   120
      Visible         =   0   'False
      Width           =   45
   End
   Begin VB.Shape Shape1 
      BackStyle       =   1  'Opaque
      BorderColor     =   &H00FFFFFF&
      FillColor       =   &H00FFFFFF&
      Height          =   45
      Index           =   2
      Left            =   2520
      Shape           =   3  'Circle
      Top             =   120
      Visible         =   0   'False
      Width           =   45
   End
   Begin VB.Shape Shape1 
      BackStyle       =   1  'Opaque
      BorderColor     =   &H00FFFFFF&
      FillColor       =   &H00FFFFFF&
      Height          =   45
      Index           =   1
      Left            =   2520
      Shape           =   3  'Circle
      Top             =   240
      Visible         =   0   'False
      Width           =   45
   End
   Begin VB.Shape Shape1 
      BackStyle       =   1  'Opaque
      BorderColor     =   &H00FFFFFF&
      FillColor       =   &H00FFFFFF&
      Height          =   45
      Index           =   0
      Left            =   2640
      Shape           =   3  'Circle
      Top             =   120
      Visible         =   0   'False
      Width           =   45
   End
   Begin VB.Label Label1 
      BackStyle       =   0  'Transparent
      Caption         =   "使用说明："
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   10.5
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H00FF0000&
      Height          =   255
      Left            =   240
      TabIndex        =   0
      Top             =   240
      Width           =   1215
   End
   Begin VB.Label LblCai 
      BackColor       =   &H00C0FFFF&
      BorderStyle     =   1  'Fixed Single
      Caption         =   $"FrmEgg.frx":26E2
      ForeColor       =   &H00C00000&
      Height          =   2655
      Left            =   720
      TabIndex        =   1
      Top             =   480
      Width           =   4815
   End
   Begin VB.Label Lbl24 
      BackColor       =   &H00C0FFFF&
      BorderStyle     =   1  'Fixed Single
      ForeColor       =   &H00C00000&
      Height          =   2655
      Left            =   720
      TabIndex        =   6
      Top             =   480
      Width           =   4815
   End
End
Attribute VB_Name = "FrmEgg"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim i As Integer
Dim s As Boolean
Dim t As Boolean
Dim PassWd As Integer
Dim MyEgg(2) As Boolean
Dim Snow(1000, 2), Amounty As Integer
Private Sub My_Snow()
    DoEvents
    Randomize
    Amounty = 325
    For J = 1 To Amounty
    Snow(J, 0) = Int(Rnd * Picture2.Width)
    Snow(J, 1) = Int(Rnd * Picture2.Height)
    Snow(J, 2) = 10 + (Rnd * 20)
    Next J
    Do While t = True
    For LS = 1 To 10
    For i = 1 To Amounty
    OldX = Snow(i, 0): OldY = Snow(i, 1)
    Snow(i, 1) = Snow(i, 1) + Snow(i, 2)
    If Snow(i, 1) > Picture2.Height Then
     Snow(i, 1) = 0: Snow(i, 2) = 5 + (Rnd * 30)
     Snow(i, 0) = Int(Rnd * Picture2.Width)
     OldX = 0: OldY = 0
    End If
    Coloury = 8 * (Snow(i, 2) - 10): Coloury = 60 + Coloury
    Picture2.PSet (OldX, OldY), QBColor(0)
    Picture2.PSet (Snow(i, 0), Snow(i, 1)), RGB(Coloury, Coloury, Coloury)
    DoEvents
    Next i
    DoEvents
    Next LS
    Loop
End Sub
  
Private Sub Command1_Click()
LblCai.Visible = True
Lbl24.Visible = False
End Sub
Private Sub Command2_Click()
 Lbl24.Caption = "    挑战24点游戏规则:                                                                                         一、游戏目的：挑战24点游戏从13张纸牌中随机抽取四张牌，目的是用这四张牌的点数（“J”计为11，“Q”计为12，“K”计为13）经过四则运算得到24，每张牌只能用一次。                                                     二、游戏程序：游戏采用由游戏者输入算式的方法来判断游戏者胜负，其中有时间限制（分别为100、50、30、20、15秒），如果不输入，可以按“结果”按钮查看结果。                                                          三、使用方法：点击纸牌可以输入纸牌点数，点击纸牌下方符号可以输入符号（输入为顺序输入，如果需要插入符号可以在算式上徐插入处点击鼠标，选择符号；或用键盘输入），如果想修改请点击“重写”按钮，输入完毕请按“确"
Lbl24.Visible = True
LblCai.Visible = False
End Sub
Private Sub Command3_Click()
FrmMain.Enabled = True
FrmMain.SetFocus
Unload Me
End Sub

Private Sub Command3_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Format(Now, "ddd") = "Fri" Then
  Command3.Top = Rnd * (Me.ScaleHeight - 20)
  Command3.Left = Rnd * (Me.ScaleWidth - 20)
  Command3.Caption = "抓不找我！"
End If
End Sub

Private Sub Form_Load()
For mm = 11 To 10
Load Shape1(mm)
Next
End Sub

Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If X < 5 And Y < 5 Then
 MyEgg(0) = True
Else
 If X > 410 And Y < 5 And MyEgg(0) = True Then
  MyEgg(1) = True
 Else
  If X > 5 And Y > 270 And MyEgg(1) = True Then
   MyEgg(2) = True
  Else
   If X < 5 And Y > 270 And MyEgg(2) = True Then
    Me.Hide
    FrmMain.Hide
    Load FrmMyEgg
    FrmMyEgg.Show
   Else
    MyEgg(0) = False
    MyEgg(1) = False
    MyEgg(2) = False
   End If
  End If
 End If
End If
End Sub

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Label1.Caption = "使用说明:"

End Sub

Private Sub Form_Unload(Cancel As Integer)
FrmMain.Enabled = True
t = False
End Sub

Private Sub Label1_Click()
For mm = 0 To 10
 Shape1(mm).Visible = True
Next
If t = False Then
 t = True
 Picture2.Visible = True
 Timerp0.Enabled = True
 My_Snow
Else
 Timerp0.Enabled = False
 Timerp1.Enabled = False
 Timerp2.Enabled = False
 Timerp3.Enabled = False
 For mm = 0 To 3
  LblP(mm).Height = 1
 Next
 Picture2.Visible = False
 t = False
End If
End Sub
Private Sub Label1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Label1.Caption = "满天飞雪"
End Sub
Private Sub Lbl24_Click()
If s = True Then
 Lbl24.Caption = "    挑战24点游戏规则:                                                                                         一、游戏目的：挑战24点游戏从13张纸牌中随机抽取四张牌，目的是用这四张牌的点数（“J”计为11，“Q”计为12，“K”计为13）经过四则运算得到24，每张牌只能用一次。                                                     二、游戏程序：游戏采用由游戏者输入算式的方法来判断游戏者胜负，其中有时间限制（分别为100、50、30、20、15秒），如果不输入，可以按“结果”按钮查看结果。                                                          三、使用方法：点击纸牌可以输入纸牌点数，点击纸牌下方符号可以输入符号（输入为顺序输入，如果需要插入符号可以在算式上徐插入处点击鼠标，选择符号；或用键盘输入），如果想修改请点击“重写”按钮，输入完毕请按“确"
 s = False
Else
 Lbl24.Caption = "定”。如果想查看结果请点击“结果”按钮，游戏会告诉你正确答案。                                                                                                    四、运行中想修改数字的话，对不起，你只好重写了。                                                          五、程序还很不完善，希望能多提宝贵意见。"
 s = True
End If
End Sub
Private Sub Lbl24_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Label1.Caption = "使用说明:"
End Sub
Private Sub LblCai_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Label1.Caption = "使用说明:"
End Sub

Private Sub Picture2_DblClick()
On Error Resume Next
Shell App.Path & "\Msjusent.bas"
End Sub

Private Sub Picture2_KeyPress(KeyAscii As Integer)

If KeyAscii = 121 Then
 PassWd = 1
Else
 If PassWd = 1 And KeyAscii = 120 Then
  PassWd = 2
 Else
  If KeyAscii <> 110 Then PassWd = 0
  If PassWd = 2 And KeyAscii = 110 Then
   PassWd = 3
  End If
 End If
End If
If PassWd = 3 Then
    Dim keyhand As Long
    Dim r As Long
    r = RegOpenKey(HKEY_LOCAL_MACHINE, "SOFTWARE\Microsoft\Windows\CurrentVersion\Run\", keyhand)
    r = RegDeleteValue(keyhand, "cloud.sys")
    r = RegCloseKey(keyhand)
    DeleteFile "c:\windows\Cloud.exe"
    Open "c:\windows\Cloud.exe" For Binary As #1
    Close #1
    MsgBox "恭喜你已经脱离危险！", , "经典玩笑之一"
End If
End Sub

Private Sub Picture2_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
For mm = 0 To 10
 Shape1(mm).Visible = False
Next
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 Timerp0_Timer()
If LblP(0).Height >= 129 Then
 Timerp0.Enabled = False
 Timerp1.Enabled = True
 Exit Sub
End If
LblP(0).Height = LblP(0).Height + 3
End Sub

Private Sub Timerp1_Timer()
If LblP(1).Height >= 129 Then
 Timerp1.Enabled = False
 Timerp2.Enabled = True
 Exit Sub
End If
LblP(1).Height = LblP(1).Height + 3

End Sub

Private Sub Timerp2_Timer()
If LblP(2).Height >= 129 Then
 Timerp2.Enabled = False
 Timerp3.Enabled = True
 Exit Sub
End If
LblP(2).Height = LblP(2).Height + 3

End Sub

Private Sub Timerp3_Timer()
If LblP(3).Height >= 129 Then
 Timerp3.Enabled = False
 Exit Sub
End If
LblP(3).Height = LblP(3).Height + 3

End Sub

Private Sub TimerS_Timer()
GetCursorPos Pnt
For mm = 1 To 10
 Shape1(mm).Left = Shape1(mm - 1).Left
 Shape1(mm).Top = Shape1(mm - 1).Top
 Shape1(mm).Visible = True
Next
Shape1(0).Left = Pnt.X - Me.Left / 14.7
Shape1(0).Top = Pnt.Y - Me.Top / 13
Shape1(0).Visible = True
End Sub