⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 bossremaintime.frm

📁 征途BOSS计时及各职业技能书查询小程序
💻 FRM
📖 第 1 页 / 共 4 页
字号:
Else
Check3.Caption = ""
End If
End If
End Sub

Private Sub Check4_Click()
If List1.ListIndex >= 0 Then
If Check4.Value = 1 Then
Check4.Caption = BossName
Else
Check4.Caption = ""
End If
End If
End Sub

Private Sub Check5_Click()
If List1.ListIndex >= 0 Then
If Check5.Value = 1 Then
Check5.Caption = BossName
Else
Check5.Caption = ""
End If
End If
End Sub

Private Sub Check6_Click()
If List1.ListIndex >= 0 Then
If Check6.Value = 1 Then
Check6.Caption = BossName
Else
Check6.Caption = ""
End If
End If
End Sub

Private Sub Command1_Click()
FormBossQuery.Show
Me.Hide
End Sub

Private Sub Command10_Click()
SetBossTime timekill, timeappear
Text10.Text = timekill
Text11.Text = timeappear
Timer4.Enabled = True '启动计时器
End Sub

Private Sub Command11_Click()
SetBossTime timekill, timeappear
Text12.Text = timekill
Text13.Text = timeappear
Timer5.Enabled = True '启动计时器
End Sub

Private Sub Command12_Click()
SetBossTime timekill, timeappear
Text14.Text = timekill
Text15.Text = timeappear
Timer6.Enabled = True '启动计时器
End Sub







Private Sub Command2_Click()
FormBossInfQuery.Show
 '删除重复项目
    For i = 0 To FormBossInfQuery.List1.ListCount - 1
    For j = 0 To FormBossInfQuery.List1.ListCount - 1
    If i = j Then GoTo tt
        If FormBossInfQuery.List1.List(j) = FormBossInfQuery.List1.List(i) Then
        FormBossInfQuery.List1.RemoveItem j
        End If
tt:     Next j
    Next i
End Sub

Private Sub Command5_Click()
'删除信息
If List1.ListIndex >= 0 Then
If MsgBox("真的要删除这条BOSS信息吗?", vbYesNo + vbExclamation) = vbYes Then
List1.RemoveItem List1.ListIndex
End If
End If
End Sub

Private Sub Command6_Click()
If LstViewResult.ListItems.Count > 0 Then '如果有项目
    If MsgBox("真的要删除吗?", vbQuestion + vbYesNo + vbDefaultButton2) = vbYes Then
        LstViewResult.ListItems.Remove LstViewResult.SelectedItem.Index
    End If
End If
End Sub

Private Sub Command7_Click()
SetBossTime timekill, timeappear  ' 调用通用过程得到怪死亡时间和下次刷新的时间
Text4.Text = timekill
Text5.Text = timeappear
Timer1.Enabled = True '启动计时器
End Sub

Private Sub Command8_Click()
SetBossTime timekill, timeappear
Text6.Text = timekill
Text7.Text = timeappear
Timer2.Enabled = True '启动计时器
End Sub

Private Sub Command9_Click()
SetBossTime timekill, timeappear
Text8.Text = timekill
Text9.Text = timeappear
Timer3.Enabled = True '启动计时器
End Sub

Private Sub Form_Load()
'Center form on screen.
FormBossRemainTime.Top = (Screen.Height - FormBossRemainTime.Height) / 2
FormBossRemainTime.Left = (Screen.Width - FormBossRemainTime.Width) / 2
'Set timer interval and varibles
    Timer1.Interval = 1000
    Timer2.Interval = 1000
    Timer3.Interval = 1000
    Timer4.Interval = 1000
    Timer5.Interval = 1000
    Timer6.Interval = 1000
'在列表中增加BOSS信息提示
With LstViewResult
        .ColumnHeaders.Add , , "BOSS名称", .Width * 0.5
        .ColumnHeaders.Add , , "出现时间", .Width / 2
    End With
End Sub





Private Sub List1_Click()
   If Right(List1.Text, 6) = "绿色BOSS" And Mid(List1.Text, 6, 3) = "山大王" Then  '战马任务boss山大王刷新时间是1小时
        Text1.Text = 1
        BossName = Left(List1.Text, (Len(List1.Text) - 6))
    '把BOSS信息添加到单选按钮中
    End If
         If Right(List1.Text, 6) = "绿色BOSS" And Mid(List1.Text, 6, 3) <> "山大王" And Mid(List1.Text, 6, 4) <> "叛军大将" Then '其它的绿色BOSS刷新时间3小时
            Text1.Text = 3
    End If
    If Right(List1.Text, 6) = "紫色BOSS" Then
            MsgBox " 对不起,我的等级现在还不能打这样的怪"
            Command7.Enabled = False
    Else
            Command7.Enabled = True
        BossName = Left(List1.Text, (Len(List1.Text) - 6))
    End If
        If Right(List1, 2) = "金怪" And InStr(List1.Text, "南郊") Then
        Text1.Text = 2.2 '南郊异军训兽师刷新时间2小时13分
        BossName = Left(List1.Text, (Len(List1.Text) - 2))
        End If
        If Right(List1, 2) = "金怪" And Mid(List1.Text, 1, 2) <> "南郊" Then
        Text1.Text = 2
        BossName = Left(List1.Text, (Len(List1.Text) - 2))
    End If
        '如果是蓝怪
    If Right(List1, 2) = "蓝怪" Then
        Text1.Text = 2
        BossName = Left(List1.Text, (Len(List1.Text) - 2))
    End If
End Sub



Private Sub Timer1_Timer()
timeappear = CStr(Text5.Text)
TimetoMinute timecome '调用小时化分钟通用过程
Text2.Text = "剩余时间:" & timecome & "分钟"
AutoAlarm
InfScroll
Select Case timecome
Case 10, 20, 30
Timer2.Interval = 5000
Timer3.Interval = 5000
Case Else
Timer2.Interval = 1000
Timer3.Interval = 1000
End Select
If Time = CStr(Text5) Then
name1 = Check1.Caption
SetCaptionTimeEnd
'清空时间
Text4.Text = ""
Text5.Text = ""
Timer1.Enabled = False '停止计时器
End If
End Sub

Private Sub Timer2_Timer()
timeappear = CStr(Text7.Text)
TimetoMinute timecome
Text3.Text = "剩余时间:" & timecome & "分钟"
name1 = Check2.Caption
AutoAlarm
InfScroll
Select Case timecome
Case 10, 20, 30
Timer1.Interval = 5000
Timer3.Interval = 5000
Case Else
Timer1.Interval = 1000
Timer3.Interval = 1000
End Select
If Time = CStr(Text7) Then
name1 = Check2.Caption
SetCaptionTimeEnd '到时间的提示信息
'清空时间
Text6.Text = ""
Text7.Text = ""
Timer2.Enabled = False '停止计时器
End If
End Sub
 
Sub SetBossTime(timekill, timeappear)
'此过程自动得到怪的死亡时间
TimeBossRefresh = Text1.Text * 60 '自动得到怪的刷新时间
timekill = Time '得到怪死亡时间
'自动得到怪下次刷新时间
'如果怪出现的时间是晚上12 点以后
'val函数可以从系统时间取出小时值
timehour = Val(Time)
If timehour >= 23 Then
Mid(timehour, 1, 2) = Str(timehour - 24)
TimeMinute = Minute(Time) + Val(TimeBossRefresh)
TimeSecond = Format(Time, "ss")
timeappear = TimeSerial(timehour, TimeMinute, TimeSecond) '得到怪下次出现时间
Else
timehour = Format(Time, "hh")
TimeMinute = Format(Time, "nn") + Val(TimeBossRefresh)
TimeSecond = Format(Time, "ss")
timeappear = TimeSerial(timehour, TimeMinute, TimeSecond) '得到怪下次出现时间
End If
If timehour = 22 Or timehour = 23 Then '22点到23点这是一个特殊的时间段。因为timeserial函数只能识别小时数为0~23
Mid(timehour, 1, 2) = Str(timehour - 24)
TimeMinute = Minute(Time) + Val(TimeBossRefresh)
TimeSecond = Format(Time, "ss")
timeappear = TimeSerial(timehour, TimeMinute, TimeSecond) '得到怪下次出现时间
End If
End Sub
 Sub AutoAlarm()
 '20,10分钟自动提示
     Select Case timecome
     Case 10, 20, 30
     FormBossQuery.Label9.Visible = True
        FormBossQuery.Label9.Caption = inf & "还有" & timecome & "分钟," & name1 & inf1
        CaptionInf
        '将信息加入到BOSS详细列表中去
        FormBossInfQuery.List1.AddItem inf & "还有" & timecome & "分钟,"
        FormBossInfQuery.List1.AddItem name1 & inf1
        '将现在的时间化成中国的时间显示,例如 2007-10-20转化为2007年10月20日
        tt = Format(Now, "mm/dd/yyyy")
        th = Format(Now, "h:mm")
        m = Left(tt, 2)
        d = Mid(tt, 4, 2)
        y = Right(tt, 4)
        sm = Trim(Str(m))
        sd = Trim(Str(d))
        sy = Trim(Str(y))
        hourchina = Left(th, 2) + "点"
        If Right(th, 2) > 10 Then
        minutechina = "0" + Right(th, 2) + "分"
        Else
        minutechina = Right(th, 2) + "分"
        End If
        timechina = sy + "年" + sm + "月" + sd + "日"
        FormBossInfQuery.List1.AddItem timechina & hourchina & minutechina
         Command2.Enabled = False
        Case Else
        FormBossQuery.Label9.Visible = False
         Command2.Enabled = True
        End Select
End Sub
Sub CaptionInf()
'如果窗口是最小化 ,则鸣叫以提示
If FormBossQuery.WindowState <> conminimized Then
Beep
FormBossQuery.Caption = "有新提示消息"
Else
FormBossQuery.Caption = "征途辅助(蓝\黄\金\绿色BOSS\紫色BOSS及技能书掉落查询)"
End If
End Sub

Private Sub Timer3_Timer()
timeappear = CStr(Text9.Text)
TimetoMinute timecome
Text16.Text = "剩余时间:" & timecome & "分钟"
AutoAlarm
InfScroll
Select Case timecome
Case 10, 20, 30
Timer1.Interval = 5000
Timer2.Interval = 5000
Case Else
Timer1.Interval = 1000
Timer2.Interval = 1000
End Select
If Time = CStr(Text9) Then
name1 = Check3.Caption
SetCaptionTimeEnd '到时间的提示信息
'清空时间
Text8.Text = ""
Text9.Text = ""
Timer3.Enabled = False '停止计时器
End If
End Sub

Private Sub Timer4_Timer()
timeappear = CStr(Text11.Text)
TimetoMinute timecome
Text17.Text = "剩余时间:" & timecome & "分钟"
AutoAlarm
InfScroll
If Time = CStr(Text11) Then
name1 = Check4.Caption
SetCaptionTimeEnd '到时间的提示信息
'清空时间
Text10.Text = ""
Text11.Text = ""
Timer4.Enabled = False '停止计时器
End If
End Sub

Private Sub Timer5_Timer()
timeappear = CStr(Text13.Text)
TimetoMinute timecome
Text18.Text = "剩余时间:" & timecome & "分钟"
AutoAlarm
InfScroll
If Time = CStr(Text13) Then
name1 = Check2.Caption
SetCaptionTimeEnd '到时间的提示信息
'清空时间
Text12.Text = ""
Text13.Text = ""
Timer5.Enabled = False '停止计时器
End If
End Sub

Private Sub Timer6_Timer()
timeappear = CStr(Text15.Text)
TimetoMinute timecome
Text19.Text = "剩余时间:" & timecome & "分钟"
AutoAlarm
InfScroll
If Time = CStr(Text15) Then
name1 = Check6.Caption
SetCaptionTimeEnd '到时间的提示信息
'清空时间
Text14.Text = ""
Text15.Text = ""
Timer6.Enabled = False '停止计时器
End If
End Sub


⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -