frmusermain.frm

本代码适合初学数据库者学习借鉴

NowNodeKey = Trim$(TempNode.Key)

Do Until NowBmRec.EOF
  If Len(Trim$(NowBmRec!Dir)) = 3 Then
   Set TempNode = tvTreeView.Nodes.Add(NowNodeKey, tvwChild, Trim$("KEY" + Trim$(NowBmRec!Dir)), Trim$(NowBmRec!Name), "closed") ' 创建第一个节点。
  End If
'''  If Not IsNull(NowBmRec!Dir) Then
'''    If NowUser.DepartDir = Trim$(NowBmRec!Dir) Then
'''      NowBmSelect = tvTreeView.Nodes.Count
'''    End If
'''  End If
  NowBmRec.MoveNext
Loop

Exit Sub
FillErr:
    ShowMsgBox Err.Description, vbExclamation
    
End Sub



Sub FillNodeTree(NowSelectNode As Node)
On Error GoTo FillErr
Dim NowNodeKey As String, NowNodeNull As Boolean

NowNodeNull = False

If NowBmRec Is Nothing Then
  Exit Sub
End If

NowBmRec.MoveFirst
NowNodeKey = Trim$(NowSelectNode.Key)

Do Until NowBmRec.EOF
  
  If Mid(Trim$(NowBmRec!Dir), 1, Len(NowNodeKey) - 3) = Mid(NowNodeKey, 4, Len(NowNodeKey) - 3) And Trim$(NowBmRec!Dir) <> Mid(NowNodeKey, 4, Len(NowNodeKey) - 3) Then
    Set TempNode = tvTreeView.Nodes.Add(NowNodeKey, tvwChild, Trim$("KEY" + Trim$(NowBmRec!Dir)), Trim$(NowBmRec!Name), "closed") ' 创建第一个节点。
    NowNodeNull = True
  End If
  NowBmRec.MoveNext
  
Loop

Set tvTreeView.SelectedItem = NowSelectNode
If NowNodeNull = False Then
  NowSelectNode.Tag = "NULL"
  NowSelectNode.Image = "closed"
Else
  NowSelectNode.Tag = ""
  NowSelectNode.Image = "open"
End If

NowSelectNode.Expanded = True

Exit Sub

FillErr:
  ShowMsgBox Err.Description, vbExclamation

End Sub
Sub GetTitles(NowSelectNode As Node)
Dim SqlStr As String, NowNodeKey As String
Dim TempItem As ListItem

On Error GoTo GetErr

Set TempRec = New ADODB.Recordset

NowNodeKey = NowSelectNode.Key
SqlStr = "SELECT id,chsname,engname,sex,nationality as nation ,class,Department as departdir,position,status   FROM  Employee WHERE LTRIM(RTRIM(Department))='" & Mid(NowNodeKey, 4, Len(NowNodeKey) - 3) & "' and  status<>'离职' ORDER BY id  "
TempRec.Open SqlStr, GlobalCon, adOpenDynamic, adLockReadOnly

If TempRec.EOF Then
  lvwDB.ListItems.Clear
  TempRec.Close
  Set TempRec = Nothing
  Exit Sub
End If

lvwDB.ListItems.Clear
'SELECT chsname,id,engname,position,sex,nation,class,DepartDir

Do Until TempRec.EOF
    '添加 ListItem。
            Set TempItem = lvwDB.ListItems.Add()
            If Not IsNull(TempRec!chsname) Then
              TempItem.Text = TempRec!chsname
            Else
              TempItem.Text = LoadResString(206)
            End If
            TempItem.SmallIcon = "man"
            
            TempItem.Key = "KEY" & Trim$(TempRec!Id)
            TempItem.SubItems(1) = Trim$(TempRec!Id)
            
            If Not IsNull(TempRec!engname) Then
                TempItem.SubItems(2) = _
                Trim$(TempRec!engname)
            End If
            
            If Not IsNull(TempRec!Position) Then
                TempItem.SubItems(3) = _
                Trim$(TempRec!Position)
            End If
            
            If Not IsNull(TempRec!sex) Then
                If TempRec!sex = "M" Then
                    TempItem.SubItems(4) = LoadResString(207)
                Else
                    TempItem.SubItems(4) = LoadResString(208)
                End If
            End If
            If Not IsNull(TempRec!nation) Then
                TempItem.SubItems(5) = _
                Trim$(TempRec!nation)
            End If
            
            If Not IsNull(TempRec!Class) Then
                TempItem.SubItems(6) = _
                Trim$(TempRec!Class)
            End If
            
            If Not IsNull(TempRec!Status) Then
                TempItem.SubItems(7) = _
                Trim$(TempRec!Status)
            End If
                       
            If TempRec!sex = "M" Then
                TempItem.SmallIcon = "man"
            Else
                TempItem.SmallIcon = "woman"
            End If
            
            TempRec.MoveNext
Loop
UserBmLabel = Trim$(NowUserBm) + " " + LoadResString(209) + Trim$(Str(TempRec.RecordCount))

TempRec.Close
Set TempRec = Nothing

Exit Sub

GetErr:
 ShowMsgBox Err.Description, 48
 Resume Next
 
End Sub



Sub LoadUser(NowSelectN As Node)
 'MakeColumns
 GetTitles NowSelectN

End Sub


Private Sub MakeColumns()
Dim i As Integer
i = CInt(lvwDB.Width / 25) - 15
lvwDB.ColumnHeaders.Clear


lvwDB.ColumnHeaders.Add , , LoadResString(210), i * 6, lvwColumnLeft '职员姓名

lvwDB.ColumnHeaders.Add , , LoadResString(211), i * 5, lvwColumnCenter '职员代码
lvwDB.ColumnHeaders.Add , , LoadResString(212), i * 4, lvwColumnCenter '英文名
lvwDB.ColumnHeaders.Add , , LoadResString(213), i * 4, lvwColumnLeft '职位
lvwDB.ColumnHeaders.Add , , LoadResString(214), i * 3, lvwColumnCenter '性别
lvwDB.ColumnHeaders.Add , , LoadResString(215), i * 3, lvwColumnLeft '省份
lvwDB.ColumnHeaders.Add , , LoadResString(216), i * 4, lvwColumnLeft '类别
lvwDB.ColumnHeaders.Add , , LoadResString(217), i * 8, lvwColumnLeft '状态
    
End Sub

Private Sub CmdCancel_Click()

NowSelectDepartDir = ""
NowSelectDepartName = ""
NowSelectEmpID = ""

Unload Me

End Sub

Private Sub CmdOk_Click()
Unload Me
End Sub

Private Sub Form_Load()
On Error GoTo LoadErr
Dim SqlStr As String, Rec As Recordset

Screen.MousePointer = 11

SSSplitter1.ClipControls = False

NowSelectDepartDir = ""
LoadRes

tvTreeView.Indentation = 350

MakeColumns
Call NewFillTree

If NowBmSelect <> 0 Then
    Set tvTreeView.SelectedItem = tvTreeView.Nodes(NowBmSelect)
    
    tvTreeView_NodeClick tvTreeView.Nodes.Item(NowBmSelect)
End If

Screen.MousePointer = 0
Exit Sub
LoadErr:
  Screen.MousePointer = 0
  ShowMsgBox Err.Description, vbExclamation
 
End Sub


Private Sub lvwDB_ColumnClick(ByVal ColumnHeader As MSComctlLib.ColumnHeader)
lvwDB.SortKey = ColumnHeader.Index - 1
If lvwDB.SortOrder = lvwAscending Then
    lvwDB.SortOrder = lvwDescending
Else
    lvwDB.SortOrder = lvwAscending
End If

lvwDB.Sorted = True


End Sub

Private Sub lvwDB_DragDrop(Source As Control, X As Single, Y As Single)
If UCase(NowUserRunMode) <> "EDIT" Then Exit Sub
If lvwDB.ListItems.Count = 0 Then Exit Sub
On Error Resume Next
lvwDB.SelectedItem.Left = X
lvwDB.SelectedItem.Top = Y

End Sub



Private Sub lvwDB_ItemClick(ByVal Item As MSComctlLib.ListItem)

If Item Is Nothing Then
    NowSelectEmpID = ""
    Exit Sub
End If
NowSelectEmpID = Mid(Item.Key, 4, Len(Item.Key) - 3)

End Sub

Private Sub LvwDb_KeyDown(KeyCode As Integer, Shift As Integer)
 If KeyCode = vbKeyControl And InDrog = True Then
   CtrlYn = True
 End If
End Sub

Private Sub lvwDB_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If UCase(NowUserRunMode) <> "EDIT" Then Exit Sub
If lvwDB.SelectedItem Is Nothing Then Exit Sub

If Button = vbLeftButton Then '指示一个拖动操作。
     InDrog = True
    '使用CreateDragImage方法设置拖动图标。
     Set lvwDB.DragIcon = DrogImage.ListImages("DrogOne").Picture
     lvwDB.Drag vbBeginDrag            '拖动操作。
End If

End Sub

Private Sub lvwDB_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)

If Button = 2 Then
   If NowSelectDepartDir <> "" Then
        mnuChangeEmp.Enabled = True
        mnuAddEmp.Enabled = True
        mnuDelEmp.Enabled = True
        
        mnuAddDep.Enabled = False
        mnuChangeDep.Enabled = False
        mnuDelDep.Enabled = False
        
        PopupMenu Me.mnuFunc
   End If
End If

End Sub

Sub ChangeEmp()
End Sub

Private Sub mnuAddDep_Click()
DepartAdd
End Sub

Private Sub mnuAddEmp_Click()
AddUser
End Sub

Private Sub mnuChangeDep_Click()
DepartChange
End Sub

Private Sub mnuDelDep_Click()
DepartDel
End Sub

Private Sub tvTreeView_AfterLabelEdit(Cancel As Integer, NewString As String)

On Error GoTo SHWOERR
If UCase(NowUserRunMode) = "EDIT" Then
    If ShowMsgBox(LoadResString(237), vbQuestion + vbYesNo + vbDefaultButton2) = vbYes Then
        SqlStr = "UPDATE Department SET Departname='" & NewString & "' WHERE DepartDir='" & Mid(Trim$(tvTreeView.SelectedItem.Key), 4, Len(Trim$(tvTreeView.SelectedItem.Key)) - 3) & "' "
        GlobalCon.Execute SqlStr
        CheckSqlErr GlobalCon
    Else
        Cancel = 1
    End If
Else
    Cancel = 1
End If
Exit Sub

SHWOERR:
 Cancel = 1
 ShowMsgBox Err.Description

End Sub

Private Sub tvTreeView_DragDrop(Source As Control, X As Single, Y As Single)
'测试拖放
'DropHighlight 返回对其上发生放下的对象的引用。
If UCase(NowUserRunMode) <> "EDIT" Then Exit Sub

If tvTreeView.DropHighlight Is Nothing Then
    Set tvTreeView.DropHighlight = Nothing
    InDrog = False
    Exit Sub
Else
    '执行拷贝动作
    DrogYn = True
    
    
    If ShowMsgBox(LoadResString(233) & tvTreeView.SelectedItem.Text & LoadResString(234) & tvTreeView.DropHighlight.Text & LoadResString(235) & Chr(10) & Chr(13) & LoadResString(236), vbYesNo + vbQuestion + vbDefaultButton2) = vbYes Then
      Call MoveUser(Mid(tvTreeView.DropHighlight.Key, 4, Len(tvTreeView.DropHighlight.Key) - 3), Trim$(tvTreeView.DropHighlight.Text))
    End If
    
    DrogYn = False
    
    Set tvTreeView.DropHighlight = Nothing
    InDrog = False
End If

End Sub

Private Sub tvTreeView_DragOver(Source As Control, X As Single, Y As Single, State As Integer)
If UCase(NowUserRunMode) <> "EDIT" Then Exit Sub
If InDrog = True Then
  Set tvTreeView.DropHighlight = tvTreeView.HitTest(X, Y)
End If
Select Case State
    Case vbEnter
    ' 装载图标。
            Source.DragIcon = DrogImage.ListImages("DropOne").Picture
        Case vbLeave
            Source.DragIcon = DrogImage.ListImages("DrogOne").Picture
End Select

End Sub

Private Sub tvTreeView_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)

If Button = 2 Then
    mnuChangeEmp.Enabled = False
    mnuAddEmp.Enabled = False
    mnuDelEmp.Enabled = False
    
    mnuAddDep.Enabled = True
    mnuChangeDep.Enabled = True
    mnuDelDep.Enabled = True
    
    PopupMenu Me.mnuFunc
End If

End Sub



Public Sub tvTreeView_NodeClick(ByVal Node As MSComctlLib.Node)
On Error GoTo tvTreeView_NodeClickErr
If Node Is Nothing Then Exit Sub
Set gnodDBNode = Node

If Node.Children > 0 And Trim$(NowUserBm) = Trim$(Node.Text) Then
  Screen.MousePointer = 0
  Exit Sub
End If
If Trim$(NowUserBm) = Trim$(Node.Text) Then
  Screen.MousePointer = 0
  Exit Sub
End If
If Node.Key <> "KEY000" Then
    NowSelectDepartDir = Mid(Node.Key, 4, Len(Node.Key) - 3)
    NowSelectDepartName = Node.Text
Else
    NowSelectDepartDir = ""
    NowSelectDepartName = ""
End If
If NowSelectDepartDir <> "" Then
    mnuAddEmp.Enabled = True
Else
    mnuAddEmp.Enabled = False
End If

Screen.MousePointer = 11

If Node.Children = 0 Then
    If Trim$(Node.Tag) <> "NULL" Then
       Call FillNodeTree(Node)
    End If
    If Node.Key = "KEY000" Then
      Call NewFillTree
      Screen.MousePointer = 0
      tvTreeView.SetFocus
      Exit Sub
    End If
End If

UserBmLabel = LoadResString(238) & Node.Text
NowUserBm = Trim$(Node.Text)

LoadUser Node

Screen.MousePointer = 0

Exit Sub

tvTreeView_NodeClickErr:
  If Err.Number = 35602 Then Resume Next
  If Err.Number = 35605 Then
     Resume Next
  End If
  ShowMsgBox Err.Description
  
End Sub