frmempselect.frm

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

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
MsgBar LoadResString(356)
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

MsgBar App.ProductName + Trim$(Str(App.Major) + Trim$(".") + Trim$(Str(App.Minor))) + "  " + LoadResString(342)

Exit Sub

FillErr:
 ShowError GlobalCon.Errors, 0
 MsgBar App.ProductName + Trim$(Str(App.Major) + Trim$(".") + Trim$(Str(App.Minor))) + "  " + LoadResString(342)
 
End Sub
Sub GetTitles(NowSelectNode As Node)
Dim SqlStr As String, NowNodeKey As String
Dim TempItem As ListItem

On Error GoTo GetErr

MsgBar LoadResString(357) & NowSelectNode & LoadResString(358)
Set TempRec = New ADODB.Recordset

NowNodeKey = NowSelectNode.Key
SqlStr = "SELECT id,chsname,engname,sex,nation,class,DepartDir,position   FROM  View_EmpBaseInfo WHERE LTRIM(RTRIM(DepartDir))='" & Mid(NowNodeKey, 4, Len(NowNodeKey) - 3) & "' ORDER BY id "
TempRec.Open SqlStr, GlobalCon, adOpenDynamic, adLockReadOnly

If TempRec.EOF Then
  lvwDB.ListItems.Clear
  TempRec.Close
  Set TempRec = Nothing
  MsgBar App.ProductName + Trim$(Str(App.Major) + Trim$(".") + Trim$(Str(App.Minor))) + "  " + LoadResString(342)
  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(780)
            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(1200)
                Else
                    TempItem.SubItems(4) = LoadResString(1201)
                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 TempRec!sex = "M" Then
                TempItem.SmallIcon = "man"
            Else
                TempItem.SmallIcon = "woman"
            End If
            
            TempRec.MoveNext
Loop
UserBm = Trim$(UserBm) + " " + LoadResString(359) + Trim$(Str(TempRec.RecordCount))

TempRec.Close
Set TempRec = Nothing

MsgBar App.ProductName + Trim$(Str(App.Major) + Trim$(".") + Trim$(Str(App.Minor))) + "  " + LoadResString(342)

Exit Sub

GetErr:
 ShowError GlobalCon.Errors, 0
 MsgBar App.ProductName + Trim$(Str(App.Major) + Trim$(".") + Trim$(Str(App.Minor))) + "  " + LoadResString(342)
 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 / 20)
    lvwDB.ColumnHeaders.Clear
    
'SELECT chsname,id,engname,position,sex,nation,class,DepartDir
    
    lvwDB.ColumnHeaders.Add , , LoadResString(343), I * 6, lvwColumnLeft '职员姓名
    
    lvwDB.ColumnHeaders.Add , , LoadResString(344), I * 5, lvwColumnCenter '职员代码
    lvwDB.ColumnHeaders.Add , , LoadResString(347), I * 4, lvwColumnCenter '英文名
    lvwDB.ColumnHeaders.Add , , LoadResString(345), I * 4, lvwColumnLeft '职位
    lvwDB.ColumnHeaders.Add , , LoadResString(346), I * 3, lvwColumnCenter '性别
    lvwDB.ColumnHeaders.Add , , LoadResString(348), I * 3, lvwColumnLeft '省份
    lvwDB.ColumnHeaders.Add , , LoadResString(349), I * 4, lvwColumnLeft '类别
    
    

End Sub

Private Sub CancelCmd_Click()
NowSelectEmpID = ""
NowSelectDepartDir = ""
Unload Me

End Sub

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

Screen.MousePointer = 11

NowSelectDepartDir = ""
MsgBar LoadResString(340)

SSSplitter1.ClipControls = False

LoadRes

If AllowMultiSelect = True Then
   tvTreeView.Checkboxes = True
   lvwDB.Checkboxes = True
End If

tvTreeView.Indentation = 350

MakeColumns
Call NewFillTree

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

MsgBar App.ProductName + Trim$(Str(App.Major) + Trim$(".") + Trim$(Str(App.Minor))) + "  " + LoadResString(342)


Screen.MousePointer = 0
Exit Sub
LoadErr:
Screen.MousePointer = 0
  ShowError Nothing, 0
  MsgBar App.ProductName + Trim$(Str(App.Major) + Trim$(".") + Trim$(Str(App.Minor))) + "  " + LoadResString(342)
 
End Sub


Private Sub lvwDB_ColumnClick(ByVal ColumnHeader As MSComctlLib.ColumnHeader)
   lvwDB.SortKey = ColumnHeader.Index - 1
   
   lvwDB.Sorted = True


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)
NowSelectEmpName = Trim$(Item.Text)
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 OkCmd_Click()

Unload Me

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

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

UserBm = LoadResString(361) & 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
  ShowError Nothing, 0
  
End Sub