?? 主窗體.frm
字號(hào):
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() '輸入查詢(xún)?nèi)掌?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 = "輸入的月份錯(cuò)誤,請(qǐng)重新輸入!"
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 = "輸入的日期越界,請(qǐng)重新輸入!"
SetFormTopmost 提示
Else
CnCalendar1.Value = MaskEdBox1.Text
Label4.Caption = "查詢(xún)的日期是:" + MaskEdBox1.Text + CnCalendar1.GetChineseDate + " 屬相:" + CnCalendar1.GetChineseAnimal
End If
Else
If CInt(Right(MaskEdBox1.ClipText, 2)) > 28 Then
提示.Show
提示.Timer1 = False
提示.tsc.Text = "輸入的日期越界,請(qǐng)重新輸入!"
SetFormTopmost 提示
Else
CnCalendar1.Value = MaskEdBox1.Text
Label4.Caption = "查詢(xún)的日期是:" + 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 = "輸入的日期越界,請(qǐng)重新輸入!"
SetFormTopmost 提示
Else
CnCalendar1.Value = MaskEdBox1.Text
Label4.Caption = "查詢(xún)的日期是:" + MaskEdBox1.Text + " 屬相是:" + CnCalendar1.GetChineseAnimal
End If
Case 4, 6, 9, 11
If CInt(Right(MaskEdBox1.ClipText, 2)) > 30 Then
提示.Show
提示.Timer1 = False
提示.tsc.Text = "輸入的日期越界,請(qǐng)重新輸入!"
SetFormTopmost 提示
Else
CnCalendar1.Value = MaskEdBox1.Text
Label4.Caption = "查詢(xún)的日期是:" + 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()
時(shí)間控制.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 '自動(dòng)隱藏
GetCursorPos z
'向右隱藏
If Me.Left >= (reswidth - Me.Width) Then
'鼠標(biāo)在窗體之外
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
'恢復(fù)顯示
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
'進(jìn)入標(biāo)題欄
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, "「開(kāi)始」菜單") <> 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 '定時(shí)執(zhí)行任務(wù)
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) = "系統(tǒng)" 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.時(shí)間, 2)) * 3600 + Val(Mid(aaa.時(shí)間, 4, 2)) * 60 + Val(Right(aaa.時(shí)間, 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) = "系統(tǒng)" Then
xzs = GetTickCount \ 1000
End If
Select Case dis - xzs
Case 15
If Left(aaa.操作類(lèi)型, 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.操作類(lèi)型, 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.操作類(lèi)型, 4)
Case "系統(tǒng)操作"
Select Case Left(aaa.操作, 2)
Case "注銷(xiāo)"
Call LOGOFF
exit_Click
Case "待機(jī)"
Call xiumian
yjkg = True
Case "關(guān)機(jī)"
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
寫(xiě)入創(chuàng)建 "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
寫(xiě)入創(chuàng)建 "form", "autohide", "False", MyName
End If
End Sub
Private Sub Yunx_Click()
yun.Show
End Sub
Private Sub zhuxiao_Click()
mybox = MsgBox("真的要注銷(xiāo)嗎?" + Chr(13) & Chr(10) + "如果注銷(xiāo)請(qǐng)保存好你的資料!!", 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 主窗體
寫(xiě)入創(chuàng)建 "form", "zuiqian", "True", MyName
Else
SetFormTopBOTTOM 主窗體
zuiqian.Checked = False
寫(xiě)入創(chuàng)建 "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 '查找記錄數(shù)
b = b + 1
Loop
If b = 1 Then
Else
Seek #a, 1
Do While Seek(a) < b '循環(huán)至文件尾。
Get #a, , jl '讀入一個(gè)記錄。
te = InStr(jl.周期, Chr(0))
If te = 0 Then
tep = jl.周期
Else
tep = Left(jl.周期, te - 1)
End If
Select Case tep
Case "每天"
寫(xiě)入創(chuàng)建 "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
寫(xiě)入創(chuàng)建 "Time", CStr(i), Seek(a) - 1, MyName
i = i + 1
End If
Case "每月"
If InStr(Right(Date, 2), Trim(jl.月份星期)) <> 0 Then
寫(xiě)入創(chuàng)建 "Time", CStr(i), Seek(a) - 1, MyName
i = i + 1
End If
Case "系統(tǒng)"
寫(xiě)入創(chuàng)建 "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
?? 快捷鍵說(shuō)明
復(fù)制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號(hào)
Ctrl + =
減小字號(hào)
Ctrl + -