📄 frm_addworker.frm
字号:
End
Begin VB.ListBox Lst_Workers
Height = 3840
Left = 240
TabIndex = 18
Top = 360
Width = 2055
End
End
Begin VB.Frame Frame2
Caption = "添加职员"
Height = 1215
Left = 240
TabIndex = 11
Top = 240
Width = 7815
Begin VB.CommandButton Cmd_AddWorker
Caption = "添加"
Height = 255
Left = 4200
TabIndex = 16
Top = 240
Width = 1095
End
Begin VB.TextBox txt_NewworkerPwd
Height = 270
IMEMode = 3 'DISABLE
Left = 1320
PasswordChar = "*"
TabIndex = 15
Top = 720
Width = 1215
End
Begin VB.TextBox Txt_NewName
Height = 270
Left = 1320
TabIndex = 13
Top = 240
Width = 1215
End
Begin VB.Label Label5
Caption = "密码:"
Height = 255
Left = 360
TabIndex = 14
Top = 720
Width = 855
End
Begin VB.Label Label4
Caption = "职员名"
Height = 255
Left = 360
TabIndex = 12
Top = 360
Width = 735
End
End
End
Begin VB.Frame Frame1
Caption = "Frame1"
Height = 3615
Index = 0
Left = 360
TabIndex = 1
Top = 600
Width = 8295
Begin VB.CommandButton Cmd_CancelPwd
Caption = "退出"
Height = 375
Left = 3840
TabIndex = 9
Top = 2400
Width = 1575
End
Begin VB.CommandButton Cmd_OKPWD
Caption = "确定"
Height = 375
Left = 480
TabIndex = 8
Top = 2400
Width = 1695
End
Begin VB.TextBox txt_Confirm
Height = 270
IMEMode = 3 'DISABLE
Left = 1680
PasswordChar = "*"
TabIndex = 7
Top = 1080
Width = 1335
End
Begin VB.TextBox Txt_NewPWD
Height = 270
IMEMode = 3 'DISABLE
Left = 1680
PasswordChar = "*"
TabIndex = 6
Top = 720
Width = 1335
End
Begin VB.TextBox Txt_OldPWD
Height = 270
IMEMode = 3 'DISABLE
Left = 1680
PasswordChar = "*"
TabIndex = 5
Top = 360
Width = 1335
End
Begin VB.Label Label3
Caption = "确认新密码:"
Height = 255
Left = 360
TabIndex = 4
Top = 1080
Width = 1215
End
Begin VB.Label Label2
Caption = "新 密 码 :"
Height = 255
Left = 360
TabIndex = 3
Top = 720
Width = 1095
End
Begin VB.Label Label1
Caption = "旧 密 码 :"
Height = 255
Left = 360
TabIndex = 2
Top = 360
Width = 1095
End
End
Begin MSComctlLib.TabStrip TabStrip1
Height = 8535
Left = 120
TabIndex = 0
Top = 120
Width = 9495
_ExtentX = 16748
_ExtentY = 15055
_Version = 393216
BeginProperty Tabs {1EFB6598-857C-11D1-B16A-00C0F0283628}
NumTabs = 3
BeginProperty Tab1 {1EFB659A-857C-11D1-B16A-00C0F0283628}
Caption = "修改密码"
ImageVarType = 2
EndProperty
BeginProperty Tab2 {1EFB659A-857C-11D1-B16A-00C0F0283628}
Caption = "用户权限设置"
ImageVarType = 2
EndProperty
BeginProperty Tab3 {1EFB659A-857C-11D1-B16A-00C0F0283628}
Caption = "薪金计算"
ImageVarType = 2
EndProperty
EndProperty
End
End
Attribute VB_Name = "Frm_Worker"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim wksWorker As Workspace
Dim dbWorker As Database
Dim GrpSelected() As Boolean
Dim GrpChange() As Boolean
Dim FirstClickLstBox As Boolean
Dim intPeriod(5) As Integer
Private Sub Chk_Groups_Click(Index As Integer)
If Lst_Workers.ListIndex >= 0 Then Cmd_SetGroup.Enabled = True
For i = 0 To Chk_Groups.Count - 1
If Chk_Groups(i).Value = 1 Then
GrpChange(i) = True
Else
GrpChange(i) = False
End If
Next i
End Sub
Private Sub Cmd_AddWorker_Click()
Dim i As Integer
If Len(txt_NewworkerPwd.Text) < 4 Then
Call MsgBox("您的密码位数必须大于4个,请重新输入密码", vbOKOnly + vbInformation, STRGARAGE)
Exit Sub
End If
Dim UsrNew As User
On Error GoTo EHand
With wksWorker
' Create and append new User.
Set UsrNew = .CreateUser(Txt_NewName.Text)
UsrNew.PID = "KCSWORKER" & CStr(.Users.Count + 1)
UsrNew.Password = txt_NewworkerPwd.Text
.Users.Append UsrNew
End With
LstFresh
Cmd_AddWorker.Enabled = False
Txt_NewName.Text = ""
txt_NewworkerPwd.Text = ""
Exit Sub
For i = 0 To Chk_Groups.Count - 1
If Chk_Groups(i).Caption = "Users" Then
Chk_Groups(i).Value = 1
Else
Chk_Groups(i).Value = 0
End If
Next i
EHand:
If Err.Number = 3033 Then
MsgBox "您无权做此操作!", vbInformation + vbOKOnly, STRGARAGE
Else
MsgBox Err.Description, vbInformation + vbOKOnly, STRGARAGE
End If
End Sub
Private Sub Cmd_Cancel_Click()
Unload Me
End Sub
Private Sub Cmd_CancelPwd_Click()
Unload Me
End Sub
Private Sub Cmd_CountSalary_Click()
Dim rsMySalary As Recordset
Dim strSql As String
Dim strBanZu As String
Dim i As Integer
Dim intLU As Integer
Dim intLQ As Integer
Dim intLP As Integer
Dim intLR As Integer
Dim strField As String
Dim strEach As String
Dim intStart As Integer
Dim intBanZu As Integer
Dim curBanZu As Currency
Dim sngTiCheng As Single
Dim curBonus As Currency
Dim curBase As Currency
Set rsMySalary = dbWorker.OpenRecordset("Select 工组 From 职员表", dbOpenSnapshot)
i = 0
Do Until i = Lst_Salary.ListIndex
rsMySalary.MoveNext
i = i + 1
Loop
strBanZu = rsMySalary.Fields("工组") & ""
rsMySalary.Close
For i = 0 To Txt_SalarySetup.Count - 1
Select Case lbl_SalaryTitle(i).Caption
Case "奖金"
curBonus = CCur(Txt_SalarySetup(i).Text)
Case "班组提成"
sngTiCheng = CSng(Txt_SalarySetup(i).Text) / 100
Case "底薪"
curBase = CCur(Txt_SalarySetup(i).Text)
End Select
Next i
strSql = "Select 人工 from 维修记录表 Where ( 出厂日期时间 between #" & DateBegin & "# and #" & dateEnd & "# )"
Set rsMySalary = dbWorker.OpenRecordset(strSql, dbOpenDynaset, dbReadOnly)
Do
strField = rsMySalary.Fields("人工") & ""
intStart = 1
If Len(strField) > 0 Then
Do
intBanZu = InStr(intStart, strField, strBanZu)
If intBanZu > 0 Then
intLP = InStr(intBanZu, strField, "LP")
intLR = InStr(intBanZu, strField, "LR")
intEnd = InStr(intBanZu, strField, ">")
curBanZu = curBanZu + CCur(Mid(strField, intLP + 2, intLR - intLP - 2))
intStart = intEnd + 1
Else
intStart = Len(strField)
End If
Loop Until intStart >= Len(strField)
End If
rsMySalary.MoveNext
Loop Until rsMySalary.EOF
Txt_MySalary.Text = CStr(curBanZu * sngTiCheng + DateDiff("d", DateValue(DateBegin), DateValue(dateEnd)) / 30.42 * (curBonus + curBase))
End Sub
Private Sub Cmd_DelWorker_Click()
If Lst_Workers.List(Lst_Workers.ListIndex) = "Engine" Then Exit Sub
wksWorker.Users.Delete (Lst_Workers.List(Lst_Workers.ListIndex))
Cmd_DelWorker.Enabled = False
For i = 0 To Chk_Groups.Count - 1
Chk_Groups(i).Value = 0
Next i
LstFresh
End Sub
Private Sub Cmd_OKPWD_Click()
Dim wksPwd As Workspace
On Error GoTo EHand
If txt_Confirm.Text = Txt_NewPWD.Text Then
Set wksPwd = DBEngine.CreateWorkspace("PWD", wksWorker.UserName, Txt_OldPWD.Text, dbUseJet)
wksWorker.Users(wksWorker.UserName).NewPassword Txt_OldPWD.Text, Txt_NewPWD.Text
Call MsgBox("您已经成功修改密码,请记住您的新密码!", vbOKOnly + vbInformation, STRGARAGE)
wksPwd.Close
Else
Call MsgBox("您输入的密码和确认密码不一样,请重新输入", vbOKOnly + vbInformation, STRGARAGE)
End If
Exit Sub
EHand:
If Err.Number = 3029 Then
MsgBox "您输入的旧密码无效", vbInformation + vbOKOnly, STRGARAGE
Else
MsgBox Err.Description, vbInformation + vbOKOnly, STRGARAGE
End If
End Sub
Private Sub Cmd_SalaryEdit_Click()
Dim wksHardWere As Workspace
Dim dbHardWere As Database
On Error GoTo ErrHandle
Set WKSGRG = wksWorker
Set DBSGRG = dbWorker
Set frmDataControl.mrsFormRecordset = DBSGRG.OpenRecordset("职员表", dbOpenTable, dbOpenDynaset)
frmDataControl.Caption = "职员基本情况设置"
frmDataControl.Show
Exit Sub
ErrHandle:
If Err.Number = 3112 Then
MsgBox "您没有操作权限", vbCritical + vbOKOnly, STRGARAGE
Else
MsgBox Err.Description, vbCritical + vbOKOnly, STRGARAGE
End If
End Sub
Private Sub Cmd_SetGroup_Click()
Dim i As Integer
Dim grpTemp As Group
If IsChangeGrp() = True Then
For i = 0 To wksWorker.Groups.Count - 1
If GrpSelected(i) <> GrpChange(i) Then
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -