📄 frmsettime.frm
字号:
EndProperty
Height = 255
Left = 1800
TabIndex = 7
Top = 960
Width = 255
End
Begin VB.Label Label3
BackColor = &H00FFC0C0&
Caption = "时"
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 1800
TabIndex = 6
Top = 360
Width = 255
End
Begin VB.Label Label2
BackColor = &H00FFC0C0&
Caption = "下班时间："
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 120
TabIndex = 3
Top = 960
Width = 975
End
Begin VB.Label Label1
BackColor = &H00FFC0C0&
Caption = "上班时间："
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 120
TabIndex = 2
Top = 360
Width = 975
End
End
Begin VB.Frame Frame1
Appearance = 0 'Flat
BackColor = &H00FFC0C0&
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H80000008&
Height = 1455
Left = 120
TabIndex = 0
Top = 120
Width = 2415
Begin VB.Frame Frame4
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 1215
Left = 0
TabIndex = 22
Top = 2760
Width = 5775
Begin VB.TextBox Text2
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 405
Left = 960
TabIndex = 24
Top = 660
Width = 735
End
Begin VB.TextBox Text1
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 405
Left = 2665
TabIndex = 23
Top = 660
Width = 735
End
Begin VB.Label Label14
AutoSize = -1 'True
Caption = "视为加班"
Height = 285
Left = 4440
TabIndex = 28
Top = 720
Width = 1140
End
Begin VB.Label Label13
AutoSize = -1 'True
Caption = "分"
Height = 285
Left = 3600
TabIndex = 27
Top = 720
Width = 285
End
Begin VB.Label Label12
AutoSize = -1 'True
Caption = "小时"
Height = 285
Left = 1890
TabIndex = 26
Top = 720
Width = 570
End
Begin VB.Label Label11
AutoSize = -1 'True
Caption = "超出正常工作时间"
Height = 285
Left = 120
TabIndex = 25
Top = 240
Width = 2280
End
End
Begin VB.OptionButton OpWinter
BackColor = &H00FFC0C0&
Caption = "冬季上下班时间"
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 240
Left = 240
TabIndex = 14
Top = 840
Width = 2055
End
Begin VB.OptionButton OpSummer
BackColor = &H00FFC0C0&
Caption = "夏季上下班时间"
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 240
Left = 240
TabIndex = 13
Top = 360
Width = 2055
End
End
End
Attribute VB_Name = "frmSetTime"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim Temp As Integer
Private Sub cmdOk_Click()
On Error GoTo ErrMsg
If txtUpMin.Text < 0 Or txtUpMin.Text > 60 Then
MsgBox "上班时间填写有误，请核实！", vbOKOnly + vbExclamation, "系统提示"
Exit Sub
End If
If txtDownMin.Text < 0 Or txtDownMin.Text > 60 Then
MsgBox "下班时间填写有误，请核实！", vbOKOnly + vbExclamation, "系统提示"
Exit Sub
End If
If txtUpHour.Text < 0 Or txtUpHour.Text > 12 Then
MsgBox "上班时间填写有误，请核实！", vbOKOnly + vbExclamation, "系统提示"
Exit Sub
End If
If txtDownHour.Text < 0 Or txtDownHour.Text > 24 Then
MsgBox "下班时间填写有误，请核实！", vbOKOnly + vbExclamation, "系统提示"
Exit Sub
End If
If txtChiMin.Text = " " And txtCHiHour.Text = "" Then
MsgBox "请填写迟到、早退时间。", vbOKOnly + vbExclamation, "系统提示"
Exit Sub
End If
If txtJiaMin.Text = " " And txtJiaHour.Text = "" Then
MsgBox "请填写加班时间。", vbOKOnly + vbExclamation, "系统提示"
Exit Sub
End If
If txtChiMin.Text > 60 Or txtChiMin < 0 Or txtCHiHour.Text > 12 Or txtCHiHour.Text < 0 Then
MsgBox "填写迟到、早退时间有误，请核实！", vbOKOnly + vbExclamation, "系统提示"
Exit Sub
End If
If txtJiaMin.Text > 60 Or txtJiaMin < 0 Or txtJiaHour.Text > 12 Or txtJiaHour.Text < 0 Then
MsgBox "填写加班时间有误，请核实！", vbOKOnly + vbExclamation, "系统提示"
Exit Sub
End If
If txtDownHour.Text > 0 And txtDownHour.Text < 12 Then
txtDownHour.Text = txtDownHour.Text + 12
End If
If OpSummer.Value = True Then
adoCon.Execute ("update Time set UpHour='" & Trim(txtUpHour.Text) & "',UpMin='" & Trim(txtUpMin.Text) & "',DownHour='" & Trim(txtDownHour.Text) & "',DownMin='" & Trim(txtDownMin.Text) & "'where Type='Summer'")
adoCon.Execute ("update Time set UpHour='" & Trim(txtUpHour.Text) & "',UpMin='" & Trim(txtUpMin.Text) & "',DownHour='" & Trim(txtDownHour.Text) & "',DownMin='" & Trim(txtDownMin.Text) & "'where Type='Nom'")
Else
If OpWinter.Value = True Then
adoCon.Execute ("update Time set UpHour='" & Trim(txtUpHour.Text) & "',UpMin='" & Trim(txtUpMin.Text) & "',DownHour='" & Trim(txtDownHour.Text) & "',DownMin='" & Trim(txtDownMin.Text) & "'where Type='Winter'")
adoCon.Execute ("update Time set UpHour='" & Trim(txtUpHour.Text) & "',UpMin='" & Trim(txtUpMin.Text) & "',DownHour='" & Trim(txtDownHour.Text) & "',DownMin='" & Trim(txtDownMin.Text) & "'where Type='Nom'")
Else
adoCon.Execute ("update Time set UpHour='" & Trim(txtUpHour.Text) & "',UpMin='" & Trim(txtUpMin.Text) & "',DownHour='" & Trim(txtDownHour.Text) & "',DownMin='" & Trim(txtDownMin.Text) & "'where Type='Nom'")
End If
End If
adoCon.Execute ("delete Time where Type='JiaBan'or Type='KuangQin'")
adoCon.Execute ("insert into Time values('" & txtJiaHour.Text & "','" & txtJiaMin & "','0','0','JiaBan')")
adoCon.Execute ("insert into Time values('" & txtCHiHour & "','" & txtChiMin & "','0','0','KuangQin')")
MsgBox "上班时间是：上午" & Trim(txtUpHour.Text) & "时" & Trim(txtUpMin.Text) & "分" + Chr(13) + "下班时间是：下午" & Trim(txtDownHour.Text) & "时" & Trim(txtDownMin.Text) & "分" + Chr(13) + "超出正常工作时间" + Trim(txtJiaHour.Text) + "小时" + Trim(txtJiaMin.Text) + "分为加班。" + Chr(13) + "迟到、早退超过" + Trim(txtCHiHour.Text) + "小时" + Trim(txtChiMin.Text) + "分为旷勤", vbOKOnly, "时间设定成功"
Unload Me
ErrMsg:
If Err.Number <> 0 Then
Exit Sub
End If
End Sub
Private Sub cmdQuit_Click()
Unload Me
End Sub
Private Sub Form_Load()
If lNum = 0 Then
cmdOk.Enabled = False
End If
Me.Move (Screen.Width - Me.Width) / 2, (Screen.Height - Me.Height) / 2 - 1000
Temp = 0
'判断是否没有时间记录
txtUpHour.Text = "08"
txtUpMin.Text = "00"
txtDownMin.Text = "05"
txtDownHour.Text = "00"
txtJiaHour.Text = "01"
txtJiaMin.Text = "00"
txtCHiHour.Text = "00"
txtChiMin.Text = "00"
OpH24.Value = True
Set adoRs = adoCon.Execute("select * from Time ")
If adoRs.EOF Then
adoCon.Execute ("insert into Time values ('8','0','5','0','Nom')")
End If
'是否有一般记录
Set adoRs = adoCon.Execute("select * from Time where Type='Nom'")
If adoRs.EOF Then
adoCon.Execute ("insert into Time values ('8','0','5','0','Nom')")
Else
txtUpHour.Text = adoRs!UpHour
txtUpMin.Text = adoRs!UpMin
txtDownMin.Text = adoRs!DownMin
txtDownHour.Text = adoRs!DownHour
End If
Set adoRs = adoCon.Execute("select * from Time where Type ='JiaBan'")
txtJiaHour.Text = adoRs!UpHour
txtJiaMin.Text = adoRs!UpMin
Set adoRs = adoCon.Execute("select * from Time where Type ='KuangQin'")
txtChiMin.Text = adoRs!UpMin
txtCHiHour.Text = adoRs!UpHour
'是否有夏季记录
Set adoRs = adoCon.Execute("select * from Time where Type ='Summer'")
If adoRs.EOF Then
adoCon.Execute ("insert into Time values ('08','0','5','0','Summer')")
End If
'是否有冬季记录
Set adoRs = adoCon.Execute("select * from Time where Type ='Winter'")
If adoRs.EOF Then
adoCon.Execute ("insert into Time values ('08','30','5','30','Winter')")
End If
End Sub
Private Sub OpH12_Click()
If OpH12.Value = True Then
If txtDownHour.Text < 24 And txtDownHour.Text > 12 Then
txtDownHour.Text = txtDownHour.Text - 12
End If
End If
End Sub
Private Sub OpH24_Click()
If OpH24.Value = True Then
If txtDownHour.Text < 12 And txtDownHour.Text > 0 Then
txtDownHour.Text = txtDownHour.Text + 12
End If
End If
End Sub
Private Sub OpSummer_Click()
Set adoRs = adoCon.Execute("select * from Time where Type ='Summer'")
If Not adoRs.EOF Then
txtUpHour.Text = adoRs!UpHour
txtUpMin.Text = adoRs!UpMin
txtDownHour.Text = adoRs!DownHour
txtDownMin.Text = adoRs!DownMin
End If
If OpH12.Value = True Then
If txtDownHour.Text < 24 And txtDownHour.Text > 12 Then
txtDownHour.Text = txtDownHour.Text - 12
End If
End If
End Sub
Private Sub OpWinter_Click()
Set adoRs = adoCon.Execute("select * from Time where Type='Winter'")
If Not adoRs.EOF Then
txtUpHour.Text = adoRs!UpHour
txtUpMin.Text = adoRs!UpMin
txtDownHour.Text = adoRs!DownHour
txtDownMin.Text = adoRs!DownMin
End If
If OpH12.Value = True Then
If txtDownHour.Text > 12 Then
txtDownHour.Text = txtDownHour.Text - 12
End If
End If
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -