📄 form1.frm
字号:
Width = 180
End
Begin VB.Label Label9
AutoSize = -1 'True
Caption = "年"
Height = 180
Index = 2
Left = 1520
TabIndex = 32
Top = 850
Width = 180
End
Begin VB.Label Label13
AutoSize = -1 'True
Caption = "日"
Height = 180
Index = 1
Left = 3000
TabIndex = 31
Top = 600
Width = 180
End
Begin VB.Label Label12
AutoSize = -1 'True
Caption = "月"
Height = 180
Index = 1
Left = 2250
TabIndex = 30
Top = 600
Width = 180
End
Begin VB.Label Label9
AutoSize = -1 'True
Caption = "年"
Height = 180
Index = 1
Left = 1520
TabIndex = 29
Top = 600
Width = 180
End
Begin VB.Label Label13
AutoSize = -1 'True
Caption = "日"
Height = 180
Index = 0
Left = 3000
TabIndex = 27
Top = 300
Width = 180
End
Begin VB.Label Label12
AutoSize = -1 'True
Caption = "月"
Height = 180
Index = 0
Left = 2250
TabIndex = 26
Top = 300
Width = 180
End
Begin VB.Label Label9
AutoSize = -1 'True
Caption = "年"
Height = 180
Index = 0
Left = 1520
TabIndex = 24
Top = 300
Width = 180
End
Begin VB.Label Labelsx
AutoSize = -1 'True
Caption = "生 肖："
Height = 180
Left = 120
TabIndex = 15
Top = 1150
Width = 900
End
Begin VB.Label Labelxq
Caption = "星期"
Height = 255
Left = 1520
TabIndex = 14
Top = 1150
Width = 735
End
Begin VB.Label Label6
AutoSize = -1 'True
Caption = "天干地支："
Height = 180
Left = 120
TabIndex = 13
Top = 850
Width = 900
End
Begin VB.Label Label5
AutoSize = -1 'True
Caption = "农 历："
Height = 180
Left = 120
TabIndex = 12
Top = 600
Width = 900
End
Begin VB.Label Label4
AutoSize = -1 'True
Caption = "公 历："
Height = 180
Left = 120
TabIndex = 11
Top = 300
Width = 900
End
End
Begin VB.Timer Timer2
Enabled = 0 'False
Interval = 1000
Left = 5160
Top = 0
End
Begin VB.TextBox Text2
Height = 270
Left = 1080
TabIndex = 8
Text = "11:28:00"
Top = 120
Width = 855
End
Begin VB.TextBox Text1
Height = 270
Left = 1080
TabIndex = 5
Text = "16:30:00"
Top = 480
Width = 855
End
Begin VB.OptionButton Option1
Caption = "Option1"
Height = 375
Left = 10
TabIndex = 4
Top = 1200
Width = 2280
End
Begin VB.OptionButton Option2
Caption = "Option2"
Height = 375
Left = 0
TabIndex = 3
Top = 1680
Width = 2400
End
Begin VB.CommandButton Command2
Caption = "退出"
Height = 375
Left = 1200
TabIndex = 2
Top = 2160
Width = 975
End
Begin VB.CommandButton Command1
Caption = "确定"
Height = 375
Left = 120
TabIndex = 1
Top = 2160
Width = 975
End
Begin VB.Timer Timer1
Interval = 1000
Left = 5160
Top = 0
End
Begin VB.Label Label2
Caption = "aa"
Height = 255
Left = 1080
TabIndex = 9
Top = 840
Width = 1455
End
Begin VB.Label Label1
Caption = "关机时间："
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H000000C0&
Height = 255
Index = 1
Left = 50
TabIndex = 7
Top = 480
Width = 1815
End
Begin VB.Label Label3
Caption = "现在时间："
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H000000C0&
Height = 255
Left = 50
TabIndex = 6
Top = 840
Width = 1455
End
Begin VB.Label Label1
Caption = "关机时间："
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H000000C0&
Height = 255
Index = 0
Left = 50
TabIndex = 0
Top = 120
Width = 1815
End
Begin VB.Menu mnuTray
Caption = "Popup"
Enabled = 0 'False
Visible = 0 'False
Begin VB.Menu mnugjsz
Caption = "设置关机时间"
End
Begin VB.Menu mnufxx
Caption = "发消息"
Enabled = 0 'False
Visible = 0 'False
End
Begin VB.Menu mnucloseCD
Caption = "关闭CD"
End
Begin VB.Menu mnuopenCD
Caption = "弹出CD"
End
Begin VB.Menu a
Caption = "-"
End
Begin VB.Menu mnucq
Caption = "重启PC"
End
Begin VB.Menu mnuzx
Caption = "注销"
End
Begin VB.Menu mnuclosecomputer
Caption = "关机"
Shortcut = {F11}
End
Begin VB.Menu b
Caption = "-"
End
Begin VB.Menu mnutc
Caption = "退出"
End
End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hWnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
Private Declare Function GetPrivateProfileString Lib "kernel32" Alias "GetPrivateProfileStringA" (ByVal lpApplicationName As String, lpKeyName As Any, ByVal lpDefault As String, ByVal lpRetunedString As String, ByVal nSize As Long, ByVal lpFileName As String) As Long
Private Declare Function WritePrivateProfileString Lib "kernel32" Alias "WritePrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpString As Any, ByVal lplFileName As String) As Long
'Public Declare Function RegisterServiceProcess Lib "kernel32" (ByVal ProcessID As Long, ByVal ServiceFlags As Long) As Long
'Public Declare Function GetCurrentProcessId Lib "kernel32" () As Long
Private r As Long
Private entry As String
Private entry1 As String
'Private entry2 As String
'Private entry3 As String
'Private entry4 As String
Private iniPath As String
Dim t As Integer
Dim zd As Integer
Dim xdzt As Integer
'Dim ztzt As Integer
Public Serverlistxs As Integer
Dim js As Integer
Dim nowTime As Variant
Dim txtTime As Variant
Dim txtTime1 As Variant
Dim returnstring
Public LastState As Integer
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Const WM_SYSCOMMAND = &H112
Private Const SC_MOVE = &HF010&
Private Const SC_RESTORE = &HF120&
Private Const SC_SIZE = &HF000&
Private Declare Function CDdoor Lib "winmm.dll" Alias "mciSendStringA" _
( _
ByVal lpstrCommand As String, _
ByVal lpstrReturnString As String, _
ByVal uReturnLength As Long, _
ByVal hwndCallback As Long _
) As Long
Public Sub CheckExist(fm As Form)
Dim title As String
If App.PrevInstance Then
title = App.title
Call MsgBox("这程式已执行", vbCritical)
App.title = "" '如此才不会Avtivate到自己
fm.Caption = ""
AppActivate title 'activate先前就已行的程式
End
End If
End Sub
Function GetFromINI(AppName As String, KeyName As String, FileName As String) As String
Dim RetStr As String
RetStr = String(255, Chr(0))
GetFromINI = Left(RetStr, GetPrivateProfileString(AppName, ByVal KeyName, "", RetStr, Len(RetStr), FileName))
End Function
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -