📄 frmusermain.frm
字号:
VERSION 5.00
Object = "{F7BA9F11-0A5D-11D0-97C9-0000C09400C4}#2.0#0"; "SPLITTER.OCX"
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Begin VB.Form frmEmpView
Caption = "职员管理窗口"
ClientHeight = 5970
ClientLeft = 60
ClientTop = 345
ClientWidth = 11670
ClipControls = 0 'False
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
HasDC = 0 'False
Icon = "frmUserMain.frx":0000
LockControls = -1 'True
MinButton = 0 'False
ScaleHeight = 5970
ScaleWidth = 11670
ShowInTaskbar = 0 'False
StartUpPosition = 1 '所有者中心
Begin SSSplitter.SSSplitter SSSplitter1
Height = 5970
Left = 0
TabIndex = 0
Top = 0
Width = 11670
_ExtentX = 20585
_ExtentY = 10530
_Version = 131074
AutoSize = 1
SplitterBarWidth= 4
SplitterBarJoinStyle= 0
BorderStyle = 0
ClipControls = 0 'False
PaneTree = "frmUserMain.frx":030A
Begin VB.Frame Frame1
BorderStyle = 0 'None
Height = 390
Left = 0
TabIndex = 3
Top = 0
Width = 11670
Begin VB.CommandButton CmdCancel
Height = 375
Left = 7320
Picture = "frmUserMain.frx":037E
Style = 1 'Graphical
TabIndex = 6
Top = 0
Width = 1335
End
Begin VB.CommandButton CmdOk
Height = 375
Left = 5880
Picture = "frmUserMain.frx":09F8
Style = 1 'Graphical
TabIndex = 5
Top = 0
Width = 1335
End
Begin MSComctlLib.ImageList DrogImage
Left = 3960
Top = 0
_ExtentX = 1005
_ExtentY = 1005
BackColor = -2147483643
ImageWidth = 32
ImageHeight = 32
MaskColor = 12632256
_Version = 393216
BeginProperty Images {2C247F25-8591-11D1-B16A-00C0F0283628}
NumListImages = 4
BeginProperty ListImage1 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmUserMain.frx":1046
Key = "DrogOne"
EndProperty
BeginProperty ListImage2 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmUserMain.frx":1362
Key = "DrogStop"
EndProperty
BeginProperty ListImage3 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmUserMain.frx":1686
Key = "DropOne"
EndProperty
BeginProperty ListImage4 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmUserMain.frx":19A2
Key = ""
EndProperty
EndProperty
End
Begin VB.Label UserBmLabel
AutoSize = -1 'True
Caption = "部门组织结构浏览"
Height = 210
Left = 120
TabIndex = 4
Top = 60
Width = 3240
End
End
Begin MSComctlLib.ImageList ImageList1
Left = 5760
Top = 1320
_ExtentX = 1005
_ExtentY = 1005
BackColor = -2147483643
ImageWidth = 16
ImageHeight = 15
MaskColor = 12632256
_Version = 393216
BeginProperty Images {2C247F25-8591-11D1-B16A-00C0F0283628}
NumListImages = 3
BeginProperty ListImage1 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmUserMain.frx":1CC6
Key = "main"
EndProperty
BeginProperty ListImage2 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmUserMain.frx":1DDA
Key = "closed"
EndProperty
BeginProperty ListImage3 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmUserMain.frx":1F3A
Key = "open"
EndProperty
EndProperty
End
Begin MSComctlLib.ImageList SmallIcon
Left = 4080
Top = 1440
_ExtentX = 1005
_ExtentY = 1005
BackColor = -2147483643
ImageWidth = 16
ImageHeight = 17
MaskColor = 12632256
_Version = 393216
BeginProperty Images {2C247F25-8591-11D1-B16A-00C0F0283628}
NumListImages = 2
BeginProperty ListImage1 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmUserMain.frx":209A
Key = "man"
EndProperty
BeginProperty ListImage2 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmUserMain.frx":21B6
Key = "woman"
EndProperty
EndProperty
End
Begin MSComctlLib.ListView lvwDB
Height = 5505
Left = 3330
TabIndex = 1
Top = 465
Width = 8340
_ExtentX = 14711
_ExtentY = 9710
View = 3
LabelEdit = 1
MultiSelect = -1 'True
LabelWrap = -1 'True
HideSelection = 0 'False
OLEDropMode = 1
FullRowSelect = -1 'True
GridLines = -1 'True
_Version = 393217
SmallIcons = "SmallIcon"
ForeColor = -2147483640
BackColor = -2147483643
Appearance = 0
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
OLEDropMode = 1
NumItems = 0
End
Begin MSComctlLib.TreeView tvTreeView
Height = 5505
Left = 0
TabIndex = 2
Top = 465
Width = 3255
_ExtentX = 5741
_ExtentY = 9710
_Version = 393217
HideSelection = 0 'False
LabelEdit = 1
Style = 7
FullRowSelect = -1 'True
ImageList = "ImageList1"
Appearance = 0
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
End
End
Begin VB.Menu mnuFunc
Caption = "功能管理"
Visible = 0 'False
Begin VB.Menu mnuAddDep
Caption = "增加部门"
End
Begin VB.Menu mnuChangeDep
Caption = "修改部门"
End
Begin VB.Menu mnuDelDep
Caption = "删除部门"
End
Begin VB.Menu mnuFg
Caption = "-"
End
Begin VB.Menu mnuAddEmp
Caption = "增加职员"
End
Begin VB.Menu mnuChangeEmp
Caption = "修改职员"
End
Begin VB.Menu mnuDelEmp
Caption = "删除职员"
End
End
End
Attribute VB_Name = "frmEmpView"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim NowBmRec As Recordset
Dim TempNode As Node
Dim NowBmSelect As Integer, DrogYn As Boolean
Dim InDrog As Boolean, UserBm As String
Dim CtrlYn As Boolean, NowLjStr As String
Dim NowUserBm As String, TempRec As New ADODB.Recordset, SqlStr As String
Dim gnodDBNode As Node
Sub AddUser()
Screen.MousePointer = 0
If NowSelectDepartDir = "" Then
ShowMsgBox LoadResString(218), vbExclamation
Exit Sub
End If
FrmAddEmp.Show 1
GetTitles gnodDBNode
End Sub
Sub ChangeDepCode()
Dim NowLjStr As String
Dim NewLj As String, TempSql As String
Dim TempNode As Node
Dim NewCode As String, OldCode As String
On Error GoTo GetErr
If tvTreeView.SelectedItem Is Nothing Then
ShowMsgBox LoadResString(362), vbInformation
Exit Sub
End If
Screen.MousePointer = 11
Set TempRec = New ADODB.Recordset
NowLjStr = Mid(tvTreeView.SelectedItem.Key, 4, Len(tvTreeView.SelectedItem.Key) - 3)
TempSql = "Select id from department where dir='" & NowLjStr & "' "
TempRec.Open TempSql, GlobalCon
If Not TempRec.EOF Then
If Not IsNull(TempRec!Id) Then
OldCode = Trim$(TempRec!Id)
End If
End If
TempRec.Close
Set TempRec = Nothing
NewCode = Trim$(InputBox(LoadResString(401), App.Title, OldCode))
SqlStr = "update Department set Id='" & NewCode & "' where dir='" & NowLjStr & "' "
GlobalCon.Execute SqlStr
CheckSqlErr GlobalCon
Screen.MousePointer = 0
Exit Sub
GetErr:
ShowMsgBox Err.Description
End Sub
Public Sub DepartChange()
Dim NowLjStr As String
NowLjStr = Mid(tvTreeView.SelectedItem.Key, 4, Len(tvTreeView.SelectedItem.Key) - 3)
If NowLjStr = "000" Then
ShowMsgBox LoadResString(204), vbInformation
Exit Sub
End If
If tvTreeView.SelectedItem.Index <> 0 Then
tvTreeView.StartLabelEdit ' 可以开始编辑。
End If
End Sub
Public Sub DepartDel()
Dim NowLjStr As String, TmPath As String
NowLjStr = Mid(tvTreeView.SelectedItem.Key, 4, Len(tvTreeView.SelectedItem.Key) - 3)
If NowLjStr = "000" Then
ShowMsgBox LoadResString(204), vbInformation
Exit Sub
End If
If ShowMsgBox(LoadResString(205), vbQuestion + vbYesNo + vbDefaultButton2) = vbNo Then
Exit Sub
End If
If NowEmp.DelDepart(NowLjStr) = False Then
Exit Sub
End If
On Error Resume Next
tvTreeView.Nodes.Remove tvTreeView.SelectedItem.Index
lvwDB.ListItems.Clear
End Sub
Public Sub DepartAdd()
Dim TempStr As String, i As Integer
If tvTreeView.SelectedItem Is Nothing Then
ShowMsgBox LoadResString(362), vbInformation
Exit Sub
End If
NowLjStr = Mid(tvTreeView.SelectedItem.Key, 4, Len(tvTreeView.SelectedItem.Key) - 3)
TempStr = NowEmp.AddDep(NowLjStr)
If InStr(1, TempStr, "-") > 0 Then
i = InStr(1, TempStr, "-")
Set TempNode = tvTreeView.Nodes.Add(gnodDBNode.Key, tvwChild, Trim$("KEY" + Trim$(Mid(TempStr, 1, i - 1))), Trim$(Mid(TempStr, i + 1, Len(TempStr) - i - 1)), "closed") ' 创建第一个节点。
End If
End Sub
Sub LoadRes()
Caption = LoadResString(201)
mnuAddDep.Caption = LoadResString(240)
mnuAddEmp.Caption = LoadResString(241)
mnuChangeDep.Caption = LoadResString(242)
mnuChangeEmp.Caption = LoadResString(243)
mnuDelDep.Caption = LoadResString(244)
mnuDelEmp.Caption = LoadResString(245)
End Sub
Sub MoveUser(MoveBmBm As String, MoveBm As String)
Dim NowGhStr As String, Rec As Recordset
On Error GoTo MoveErr
Dim i As Integer, j As Integer, k As Integer
Screen.MousePointer = 11
j = lvwDB.ListItems.Count
For i = 1 To j
If lvwDB.ListItems.Item(i).Selected = True Then
NowGhStr = Mid(lvwDB.ListItems.Item(i).Key, 4, Len(lvwDB.ListItems.Item(i).Key) - 3)
NowEmp.ChangeEmpDep NowGhStr, MoveBmBm
End If
Next
Set Rec = Nothing
For i = 1 To j
For k = 1 To lvwDB.ListItems.Count
If lvwDB.ListItems.Item(k).Selected = True Then
lvwDB.ListItems.Remove lvwDB.ListItems.Item(k).Key
Exit For
End If
Next
Next
Screen.MousePointer = 0
Exit Sub
MoveErr:
ShowMsgBox Err.Description
lvwDB.Refresh
tvTreeView.Refresh
End Sub
Sub NewFillTree()
Dim NowNodeKey As String, NowBmBm As String
Dim TempIncName As String
On Error GoTo FillErr
Set TempRec = New ADODB.Recordset
SqlStr = "select Name from Customer"
TempRec.Open SqlStr, GlobalCon, adOpenForwardOnly, adLockReadOnly
If Not TempRec.EOF Then
If Not IsNull(TempRec!Name) Then
TempIncName = Trim$(TempRec!Name)
Else
TempIncName = LoadResString(202)
End If
Else
TempIncName = LoadResString(202)
End If
TempRec.Close
Set TempRec = Nothing
SqlStr = "SELECT DISTINCT dir,Name FROM Department ORDER BY Dir "
Set NowBmRec = New ADODB.Recordset
NowBmRec.Open SqlStr, GlobalCon, adOpenDynamic, adLockReadOnly
If NowBmRec.EOF Then
tvTreeView.Nodes.Clear
ShowMsgBox LoadResString(203), vbInformation
Set TempNode = tvTreeView.Nodes.Add(, , Trim$("KEY" + "000"), Trim$(TempIncName), "main") ' 创建第一个节点。
NowBmRec.Close
Set NowBmRec = Nothing
Screen.MousePointer = 0
Exit Sub
End If
tvTreeView.Nodes.Clear
Set TempNode = tvTreeView.Nodes.Add(, , Trim$("KEY" + "000"), Trim$(TempIncName), "main") ' 创建第一个节点。
TempNode.Expanded = True
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -