📄 主窗体.frm

📁 简单时间程序,可以定时执行任务,显示当前时间到前台窗口
💻 FRM
📖 第 1 页 / 共 2 页
字号:
上一页 12
Label5.BorderStyle = 1
End Sub

Private Sub Label5_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
Label5.BorderStyle = 0
End Sub

Private Sub MaskEdBox1_Change() '输入查询日期
If Len(MaskEdBox1.ClipText) = 8 And MaskEdBox1.ClipText >= 19000201 And MaskEdBox1.ClipText <= 20451231 Then
  If CInt(Mid(MaskEdBox1.ClipText, 5, 2)) > 12 Or CInt(Mid(MaskEdBox1.ClipText, 5, 2)) = 0 Then
          提示.Show
          提示.Timer1 = False
          提示.tsc.Text = "输入的月份错误,请重新输入!"
          SetFormTopmost 提示
  Else
    Select Case CInt(Mid(MaskEdBox1.ClipText, 5, 2))
     Case 2
      If CInt(Left(MaskEdBox1.ClipText, 4)) Mod 4 = 0 Or CInt(Left(MaskEdBox1.ClipText, 4)) Mod 400 = 0 Then
          If CInt(Right(MaskEdBox1.ClipText, 2)) > 29 Then
          提示.Show
          提示.Timer1 = False
          提示.tsc.Text = "输入的日期越界,请重新输入!"
          SetFormTopmost 提示
          Else
        CnCalendar1.Value = MaskEdBox1.Text
        Label4.Caption = "查询的日期是:" + MaskEdBox1.Text + CnCalendar1.GetChineseDate + " 属相:" + CnCalendar1.GetChineseAnimal
          End If
       Else
          If CInt(Right(MaskEdBox1.ClipText, 2)) > 28 Then
          提示.Show
          提示.Timer1 = False
          提示.tsc.Text = "输入的日期越界,请重新输入!"
          SetFormTopmost 提示
          Else
        CnCalendar1.Value = MaskEdBox1.Text
        Label4.Caption = "查询的日期是:" + MaskEdBox1.Text + " 属相是:" + CnCalendar1.GetChineseAnimal
          End If
       End If
     Case 1, 3, 5, 7, 8, 10, 12
          If CInt(Right(MaskEdBox1.ClipText, 2)) > 31 Then
          提示.Show
           提示.Timer1 = False
         提示.tsc.Text = "输入的日期越界,请重新输入!"
          SetFormTopmost 提示
          Else
        CnCalendar1.Value = MaskEdBox1.Text
        Label4.Caption = "查询的日期是:" + MaskEdBox1.Text + " 属相是:" + CnCalendar1.GetChineseAnimal
          End If
     Case 4, 6, 9, 11
          If CInt(Right(MaskEdBox1.ClipText, 2)) > 30 Then
          提示.Show
           提示.Timer1 = False
         提示.tsc.Text = "输入的日期越界,请重新输入!"
          SetFormTopmost 提示
          Else
        CnCalendar1.Value = MaskEdBox1.Text
        Label4.Caption = "查询的日期是:" + MaskEdBox1.Text + " 属相是:" + CnCalendar1.GetChineseAnimal
          End If
    End Select
  End If
End If
End Sub

Private Sub MaskEdBox1_GotFocus()
MaskEdBox1.SelStart = 0
End Sub

Private Sub MediumPlayer_Click()
player.Show
End Sub

Private Sub miaob_Click()
秒表.Show
End Sub

Private Sub sjtz_Click()
时间控制.Show

End Sub

Private Sub sjxs_Click()
XTSJXS.Show

End Sub

Private Sub Timer1_Timer()
Label1.Caption = Time

If kg = True Then
reswidth = Screen.Width '自动隐藏
GetCursorPos z

 '向右隐藏
If Me.Left >= (reswidth - Me.Width) Then
'鼠标在窗体之外

   If (z.Y < Me.Top \ Screen.TwipsPerPixelX Or z.Y > (Me.Top + Me.Height) \ Screen.TwipsPerPixelX) Or (z.X < Me.Left \ Screen.TwipsPerPixelX Or z.X > (Me.Left + Me.Width) \ Screen.TwipsPerPixelX) Then
     Me.Left = reswidth - 50
   End If
   
Else

 '向左隐藏
 If Me.Left <= 0 Then
   If (z.Y < Me.Top \ Screen.TwipsPerPixelX Or z.Y > (Me.Top + Me.Height) \ Screen.TwipsPerPixelX) Or (z.X < Me.Left \ Screen.TwipsPerPixelX Or z.X > (Me.Left + Me.Width) \ Screen.TwipsPerPixelX) Then
    Me.Left = -Me.Width + 50
   End If
 Else
 '向上隐藏
  If Me.Top <= 0 Then
     If (z.Y < Me.Top \ Screen.TwipsPerPixelX Or z.Y > (Me.Top + Me.Height) \ Screen.TwipsPerPixelX) Or (z.X < Me.Left \ Screen.TwipsPerPixelX Or z.X > (Me.Left + Me.Width) \ Screen.TwipsPerPixelX) Then
     Me.Top = -Me.Height + 50
     End If
  End If
 End If
End If
'恢复显示
If Me.Left > 0 Then
'右
   If (z.X + 10) >= reswidth \ Screen.TwipsPerPixelX And Me.Left >= (reswidth - Me.Width) _
    And z.Y > Me.Top \ Screen.TwipsPerPixelX And z.Y < (Me.Top + Me.Height) \ Screen.TwipsPerPixelX And z.X > Me.Left \ Screen.TwipsPerPixelX And z.X < (Me.Left + Me.Width) \ Screen.TwipsPerPixelX Then
      Me.Left = reswidth - Me.Width
   End If
Else
'左
   If (z.X - 10) <= 0 And Me.Left <= 0 And z.Y > Me.Top \ Screen.TwipsPerPixelX And z.Y < (Me.Top + Me.Height) \ Screen.TwipsPerPixelX And z.X > Me.Left \ Screen.TwipsPerPixelX And z.X < (Me.Left + Me.Width) \ Screen.TwipsPerPixelX Then
   Me.Left = 0
   End If
End If
'上
   If (z.Y - 10) <= 0 And Me.Top <= 0 And z.Y > Me.Top \ Screen.TwipsPerPixelX And z.Y < (Me.Top + Me.Height) \ Screen.TwipsPerPixelX And z.X > Me.Left \ Screen.TwipsPerPixelX And z.X < (Me.Left + Me.Width) \ Screen.TwipsPerPixelX Then
     Me.Top = 0
   End If
End If

If kg1 = True Then
'进入标题栏
 If JubingM = 0 Then
  CapJB
  JubingM = JubingQ
 Else
  CapJB
 If JubingQ <> JubingM Then
    gaixie
 Else
    gengxin
 End If
  
End If

If (InStr(BiaotiOut, "Program Manager") <> 0 Or InStr(BiaotiOut, "「开始」菜单") <> 0) And kg = True Then
  Select Case Me.Left
   Case Is <= 0
   Me.Left = 0
   Case Is >= reswidth - 50
   Me.Left = reswidth - Me.Width
  End Select
  If Me.Top <= 0 Then
   Me.Top = 0
  End If
End If

End If

Dim dis As Long '定时执行任务
Dim xzs As Long
Dim lj As String
Dim a As Integer
Dim hc As String
Dim aaa As MyJiLu
abc = 1
If Left(aaa.周期, 2) = "系统" Then
xzs = GetTickCount \ 1000
Else
xzs = Val(Left(Format(Time, "hh:mm:ss"), 2)) * 3600 + Val(Mid(Format(Time, "hh:mm:ss"), 4, 2)) * 60 + Val(Right(Format(Time, "hh:mm:ss"), 2))
End If
If rws > 0 Then
  Do While abc <= rws
     读取 "Time", CStr(abc), hc, MyName
     a = FreeFile
     lj = App.Path + "\" + "time.gs"
    Open lj For Random As #a Len = Len(aaa)
     If Val(hc) = Null Or Val(hc) = 0 Then
     Else
     Get #a, Val(hc), aaa
     End If
    Close #a
    dis = Val(Left(aaa.时间, 2)) * 3600 + Val(Mid(aaa.时间, 4, 2)) * 60 + Val(Right(aaa.时间, 2))
    abc = abc + 1
     Dim temptext As String
     Dim tempjs As Integer
     tempjs = InStr(aaa.操作, Chr(0)) - 1
     Select Case tempjs
      Case 0
     temptext = aaa.操作
      Case Is < 0
     temptext = Trim(aaa.操作)
      Case Is > 0
     temptext = Trim(Left(aaa.操作, tempjs))
     End Select
     If Left(aaa.周期, 2) = "系统" Then
     xzs = GetTickCount \ 1000
     End If
    Select Case dis - xzs
    Case 15
    If Left(aaa.操作类型, 4) = "仅仅提示" Then
    Else
     If Left(aaa.是否提示, 2) = "提示" Then
        If Left(aaa.可否取消, 4) = "可以取消" Then
         提示.jlh = abc
         提示.取消.Caption = "取消"
         xx = Trim(Left(aaa.提示消息, InStr(aaa.提示消息, Chr(0)) - 1))
         yy = temptext
         提示.Show
         提示.Timer1.Enabled = True
         yjkg = False
        Else
         xx = Trim(Left(aaa.提示消息, InStr(aaa.提示消息, Chr(0)) - 1))
         yy = temptext
         提示.Show
         提示.Timer1.Enabled = True
         yjkg = False
        End If
      End If
    End If
    Case -86385
    If Left(aaa.操作类型, 4) = "仅仅提示" Then
    Else
     If Left(aaa.是否提示, 2) = "提示" Then
        If Left(aaa.可否取消, 4) = "可以取消" Then
         提示.jlh = abc
         提示.取消.Caption = "取消"
         xx = Trim(Left(aaa.提示消息, InStr(aaa.提示消息, Chr(0)) - 1))
         yy = temptext
         提示.Show
         提示.Timer1.Enabled = True
         yjkg = False
        Else
         xx = Trim(Left(aaa.提示消息, InStr(aaa.提示消息, Chr(0)) - 1))
          yy = temptext
         提示.Show
         提示.Timer1.Enabled = True
         yjkg = False
        End If
      End If
    End If
    Case 0
     Select Case Left(aaa.操作类型, 4)
     Case "系统操作"
      Select Case Left(aaa.操作, 2)
       Case "注销"
        Call LOGOFF
        exit_Click
       Case "待机"
         Call xiumian
         yjkg = True
       Case "关机"
         Call shutdown
         exit_Click
       Case "重启"
         Call reboot
         exit_Click
       End Select
    Case "外部程序"
     YunXing (temptext)
     yjkg = True
    Case "仅仅提示"
     提示.Show
     提示.Timer1 = False
     提示.tsc.Text = "提示:" + Trim(Left(aaa.提示消息, InStr(aaa.提示消息, Chr(0)) - 1))
     yjkg = True
    End Select
   End Select
  Loop
End If
End Sub

Private Sub tsb_Click()
ts.lngb = 主窗体.Label1.BackColor
ts.lngf = 主窗体.Label1.ForeColor
ts.Show
ts.ctname = "主窗体"
End Sub

Private Sub wannl_Click()
Me.Height = 3915
Me.Width = 4485
MaskEdBox1.SelStart = 0
reswidth = Screen.Width
  Select Case Me.Left
   Case Is <= 0
   Me.Left = 1
   Case Is >= reswidth - 50
   Me.Left = reswidth - Me.Width - 1
  End Select
  If Me.Top <= 0 Then
   Me.Top = 1
  End If
End Sub

Private Sub xinj_Click()
AddTime.Show
End Sub

Private Sub yinc_Click()
If yinc.Checked = False Then
  kg = True
  yinc.Checked = True
  写入创建 "form", "autohide", "True", MyName
Else
  If Me.Left <= 0 Then
    Me.Left = 0
  Else
   If meleft >= (reswidth - mewidth) Then
    Me.Left = reswidth - mewidth
   End If
  End If
  If Me.Top <= 0 Then
    Me.Top = 0
  End If
  yinc.Checked = False
  kg = False
  写入创建 "form", "autohide", "False", MyName
End If
End Sub

Private Sub Yunx_Click()
yun.Show
End Sub

Private Sub zhuxiao_Click()
mybox = MsgBox("真的要注销吗?" + Chr(13) & Chr(10) + "如果注销请保存好你的资料!!", vbYesNo + vbExclamation + vbDefaultButton2, "确定")
If mybox = 6 Then
  Call LOGOFF
  exit_Click
 Else
End If
End Sub

Private Sub zuiqian_Click()
If zuiqian.Checked = False Then
  zuiqian.Checked = True
  SetFormTopmost 主窗体
  写入创建 "form", "zuiqian", "True", MyName
Else
  SetFormTopBOTTOM 主窗体
  zuiqian.Checked = False
  写入创建 "form", "zuiqian", "False", MyName
End If
End Sub
Sub jlrw()
Dim a As Integer
Dim b As Integer
Dim JlPath As String
Dim jl As MyJiLu
Dim i As Integer
Dim te As Integer
Dim tep As String
If Right(App.Path, 1) = "\" Then
JlPath = App.Path + "time.gs"
Else
JlPath = App.Path + "\time.gs"
End If
a = FreeFile
i = 1
Open JlPath For Random As #a Len = Len(jl)
Do While Not EOF(a)
Get #a, , jl '查找记录数
  b = b + 1
Loop
 If b = 1 Then
 Else
 Seek #a, 1
  Do While Seek(a) < b '循环至文件尾。
  Get #a, , jl '读入一个记录。
  te = InStr(jl.周期, Chr(0))
  If te = 0 Then
  tep = jl.周期
  Else
  tep = Left(jl.周期, te - 1)
  End If
  Select Case tep
  Case "每天"
  写入创建 "Time", CStr(i), Seek(a) - 1, MyName
  i = i + 1
  Case "每周"
     Dim w As String
     w = Format(Now, "dddd")
     Select Case w: Case "Monday": w = "1 ": Case "Tuesday": w = "2 ": Case "Wednesday": w = "3 "
     Case "Thursday": w = "4 ": Case "Friday": w = "5 ": Case "Saturday": w = "6 ": Case "Sunday"
     w = "7 "
    End Select
    If w = jl.月份星期 Then
      写入创建 "Time", CStr(i), Seek(a) - 1, MyName
      i = i + 1
    End If
  Case "每月"
    If InStr(Right(Date, 2), Trim(jl.月份星期)) <> 0 Then
      写入创建 "Time", CStr(i), Seek(a) - 1, MyName
      i = i + 1
    End If
  Case "系统"
      写入创建 "Time", CStr(i), Seek(a) - 1, MyName
      i = i + 1
  End Select
  Loop
  rws = i - 1
 End If
Close #a
End Sub
 Sub tisi()
 主窗体.CnCalendar1.Value = Date
w = Format(Now, "dddd")
Select Case w
  Case "Monday"
   w = "星期一"
  Case "Tuesday"
   w = "星期二"
  Case "Wednesday"
   w = "星期三"
  Case "Thursday"
   w = "星期四"
  Case "Friday"
   w = "星期五"
  Case "Saturday"
   w = "星期六"
  Case "Sunday"
   w = "星期日"
End Select
主窗体.Label1.ToolTipText = "今天是：" & Date & " " & w & " " & 主窗体.CnCalendar1.GetChineseDate & " 属相:" & 主窗体.CnCalendar1.GetChineseAnimal
主窗体.Label4.Caption = "今天公历是：" & Date & " " & " 属相:" & 主窗体.CnCalendar1.GetChineseAnimal
End Sub
上一页 12
💿 文件大小 177 K
👤 上传用户 C69222090
📂 所属分类其他
🏷️ 相关标签

#程序 #定时 #窗口
⌨️ 快捷键说明

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