formemployeechange.frm

本系统可用于医院和专业体检中心的健康体检管理

            rstemp.MoveNext
        Loop
    End If
    '*************************20040530加入完 闻**************************
    
    '加载所有用户
    strSQL = "select EmployeeID,Name,JSID" _
            & " from RY_Employee order by name"
    Set rsEmployee = New ADODB.Recordset
    rsEmployee.Open strSQL, GCon, adOpenStatic, adLockOptimistic
    If Not rsEmployee.EOF Then
        rsEmployee.MoveFirst
        Do
            Set itmTemp = lvwEmployee.ListItems.Add(, "W" & rsEmployee("EmployeeID"), rsEmployee("Name"))
'            itmTemp.SubItems(1) = rsEmployee("ClassifyName")
            '**********************20040531加入 闻***********************
            If IsNull(rsEmployee("JSID")) Or rsEmployee("JSID") = "" Then
                itmTemp.SubItems(1) = ""
            Else
                Set rstemp = New ADODB.Recordset
                strSQL = "select * from SET_JS_Index where JSID=" & rsEmployee("JSID")
                rstemp.Open strSQL, GCon, adOpenStatic, adLockReadOnly
                If rstemp.RecordCount >= 1 Then
                    itmTemp.SubItems(1) = rstemp("JSMC")
                End If
            End If
            '**********************20040531加入完 闻***********************
            
            rsEmployee.MoveNext
        Loop Until rsEmployee.EOF
        rsEmployee.Close
        
        lvwEmployee_Click
    End If
    
'
'    Set rsTemp = New ADODB.Recordset
'    strSQL = "select * from RY_Employee"
'    rsTemp.Open strSQL, GCon, 3, 3
'    rsTemp.MoveFirst
'
'    SaveDirect = "SEE"
'    'MsgBox rs("name")
'    'MsgBox rs("telphonehome")
'    DisplayEmployee
    
    GoTo ExitLab
ErrMsg:
    Status = SetError(Err.Number, Err.Description, Err.Source)
    ErrMsg Status
ExitLab:
    Screen.MousePointer = vbDefault
End Sub

'显示记录
'Private Sub DisplayEmployee()
'    Dim i As Integer
'
'    TextName.Text = rsTemp("Name")
'    If TextName.Text = "管理员" Then
'        CommandDelete.Enabled = False
'    Else
'        CommandDelete.Enabled = True
'    End If
'
'
'    If (rsTemp("Born") <> "") Then
'        DTPBorn.Value = rsTemp("Born")
'    Else
'        DTPBorn.Value = ""
'    End If
'
'    If (rsTemp("ZhiWu") <> "") Then
'        ComboZhiWu.Text = rsTemp("ZhiWu")
''        With ComboZhiWu
''            '检查是那一种级别
''            For i = 0 To .ListCount - 1
''                If LongToString(.ItemData(i), 2) = rsTemp("ZhiWu") Then
''                    .ListIndex = i
''                    Exit For
''                End If
''            Next
''        End With
'    Else
'        ComboZhiWu.Text = ""
'    End If
'
'    '********************************************
'    '设置管理类别
'    '********************************************
'    If Not IsNull(rsTemp("Rank")) Then
'        With cmbClassify
'            For i = 0 To .ListCount - 1
'                If .ItemData(i) = Val(rsTemp("Rank")) Then
'                    .ListIndex = i
'                    Exit For
'                End If
'            Next
'
'            '如果是科室医生，则显示所管理科室
'            If .ItemData(i) = Val(GManager.SystemKSYS) Then
'                fraKeShi.Visible = True
'                '决定选中哪个科室
'                For i = 0 To lstKeShi.ListCount - 1
'                    If lstKeShi.ItemData(i) = Val(rsTemp("KSID")) Then
'                        lstKeShi.Selected(i) = True
'                    Else
'                        lstKeShi.Selected(i) = False
'                    End If
'                Next
'            Else
'                fraKeShi.Visible = False
'            End If
'        End With
'    End If
'    '********************************************
'    '********************************************
'
'    If (rsTemp("Sex") = "男") Then
'        OptionMale.Value = True
'    Else
'        OptionMale.Value = False
'        OptionFemale.Value = True
'    End If
'
'    If rsTemp("ZZSJ") <> "" Then
'        DTPZZSJ.Value = rsTemp("ZZSJ")
'    Else
'        DTPZZSJ.Value = ""
'    End If
'
'    If rsTemp("TelphoneHome") <> "" Then
'        TextTelphoneHome.Text = rsTemp("TelphoneHome")
'    Else
'        TextTelphoneHome.Text = ""
'    End If
'
'    If rsTemp("TelphoneMobile") <> "" Then
'        TextTelphoneMobile.Text = rsTemp("TelphoneMobile")
'    Else
'        TextTelphoneMobile.Text = ""
'    End If
'
'    If (rsTemp("Address") <> "") Then
'        TextAddress.Text = rsTemp("Address")
'    Else
'        TextAddress.Text = ""
'    End If
'
'    If (rsTemp("Password") <> "") Then
'        TextPassword.Text = rsTemp("Password")
'    Else
'        TextPassword.Text = ""
'    End If
'
'End Sub

Private Sub ClearAllInput()
    TextName.Text = ""
    TextPassword.Text = ""
'    TextBorn.Text = ""
    TextAddress.Text = ""
    TextTelphoneHome.Text = ""
    TextTelphoneMobile.Text = ""
'    TextZZSJ.Text = ""
    ComboZhiWu.Text = ""
    OptionMale.Value = True
'    OptionFemale.Value = False
End Sub

Private Sub Form_Unload(Cancel As Integer)
    Set FormEmployeeChange = Nothing
End Sub

Private Sub lstKeShi_Click()
On Error Resume Next
    Dim i As Integer
    If fraKeShi.Tag <> "CJYS" Then
    '保证只选中一个
        With lstKeShi
            If .Selected(.ListIndex) = True Then
                For i = 0 To .ListCount - 1
                    If i <> .ListIndex Then
                        .Selected(i) = False
                    End If
                Next
            End If
        End With
    End If
End Sub

Private Sub lstKeShi_KeyPress(KeyAscii As Integer)
    EnterToTab KeyAscii
End Sub

Private Sub lvwEmployee_Click()
On Error GoTo ErrMsg
    Dim Status
    Dim strSQL As String
    Dim rstemp As ADODB.Recordset
    Dim i As Integer
    Dim strTempFile As String
    
    Me.MousePointer = vbHourglass
    For i = 0 To lstKeShi.ListCount - 1
        lstKeShi.Selected(i) = False
    Next
    '是否有记录
    If lvwEmployee.ListItems.Count < 1 Then GoTo ExitLab
    If lvwEmployee.SelectedItem Is Nothing Then
        ClearAllInput '清空所有输入
        
        GoTo ExitLab
    End If
    
    '获取当前用户的具体信息
    strSQL = "select * from RY_Employee" _
            & " where EmployeeID=" & Val(Mid(lvwEmployee.SelectedItem.Key, 2))
    Set rstemp = New ADODB.Recordset
    rstemp.Open strSQL, GCon, adOpenStatic, adLockOptimistic
    If rstemp.EOF Then
        MsgBox "当前用户的详细信息被损坏，请联系系统管理员！", vbExclamation, "提示"
        GoTo ExitLab
    Else
        TextName.Text = rstemp("Name")
        TextPassword.Text = rstemp("Password")
        If rstemp("Sex") = "男" Then
            OptionMale.Value = True
        Else
            OptionFemale.Value = True
        End If
        DTPBorn.Value = rstemp("Born")
        
        DTPZZSJ.Value = rstemp("ZZSJ")
        ComboZhiWu.Text = rstemp("ZhiWu")
        If IsNull(rstemp("TelphoneHome")) Then
            TextTelphoneHome.Text = ""
        Else
            TextTelphoneHome.Text = rstemp("TelphoneHome")
        End If
        If IsNull(rstemp("TelphoneMobile")) Then
            TextTelphoneMobile.Text = ""
        Else
            TextTelphoneMobile.Text = rstemp("TelphoneMobile")
        End If
        If IsNull(rstemp("Address")) Then
            TextAddress.Text = ""
        Else
            TextAddress.Text = rstemp("Address")
        End If
        
        '管理类别
        For i = 0 To cmbClassify.ListCount - 1
            If LongToString(cmbClassify.ItemData(i), 2) = rstemp("Rank") Then
                cmbClassify.ListIndex = i
                Exit For
            End If
        Next
        
        '角色
        For i = 0 To CmbJS.ListCount - 1
            If CmbJS.ItemData(i) = rstemp("JSID") Then
                CmbJS.ListIndex = i
                Exit For
            End If
        Next
        
        '如果是科室医生，需要显示科室
        If rstemp("Rank") = GManager.SystemKSYS Then
            For i = 0 To lstKeShi.ListCount - 1
                If LongToString(lstKeShi.ItemData(i), 2) = rstemp("KSID") Then
                    lstKeShi.Selected(i) = True
                End If
            Next
        ElseIf rstemp("Rank") = GManager.SysTemCJYS Then
            Dim strT() As String, j As Integer
            strT = Split(rstemp("KSID"), ",")
            For i = 0 To lstKeShi.ListCount - 1
                For j = 0 To UBound(strT)
                    If LongToString(lstKeShi.ItemData(i), 2) = strT(j) Then
                        lstKeShi.Selected(i) = True
                    End If
                Next
            Next
        End If
        
        '检查有无签名
        If Not IsNull(rstemp("Sign")) Then
            strTempFile = GetTempPathW & "Sign.jpg"
            If ColumnToFile(rstemp("Sign"), strTempFile, rstemp) = True Then
                imgSign.PICTURE = LoadPicture(strTempFile)
            Else
                imgSign.PICTURE = LoadPicture() '清除签名
            End If
        Else
            imgSign.PICTURE = LoadPicture() '清除签名
        End If
    End If
    
    EnableInput False
    CommandAdd.Enabled = True
    cmdModify.Enabled = True
    CommandOK.Enabled = False
    CommandDelete.Enabled = True
    
    GoTo ExitLab
ErrMsg:
    Status = SetError(Err.Number, Err.Description, Err.Source)
    ErrMsg Status
ExitLab:
    Me.MousePointer = vbDefault
End Sub

Private Sub OptionFemale_Click()
  If (OptionFemale.Value = True) And (OptionMale.Value = True) Then
    OptionMale.Value = False
  End If
End Sub

Private Sub OptionFemale_KeyPress(KeyAscii As Integer)
    EnterToTab KeyAscii
End Sub

Private Sub OptionMale_Click()
  If (OptionFemale.Value = True) And (OptionMale.Value = True) Then
    OptionFemale.Value = False
  End If

End Sub

Private Sub OptionMale_KeyPress(KeyAscii As Integer)
    EnterToTab KeyAscii
End Sub

Private Sub TextName_KeyPress(KeyAscii As Integer)
    EnterToTab KeyAscii
End Sub

Private Sub TextName_LostFocus()
    TextName.Text = CheckString(Trim(TextName.Text))
End Sub

Private Sub TextPassword_KeyPress(KeyAscii As Integer)
    EnterToTab KeyAscii
End Sub

'Private Sub TextBorn_KeyPress(KeyAscii As Integer)
'    EnterToTab KeyAscii
'End Sub

Private Sub ComboZhiWu_KeyPress(KeyAscii As Integer)
    EnterToTab KeyAscii
End Sub

Private Sub TextPassword_LostFocus()
    TextPassword.Text = CheckString(Trim(TextPassword.Text))
End Sub

'Private Sub TextZZSJ_KeyPress(KeyAscii As Integer)
'    EnterToTab KeyAscii
'End Sub

Private Sub TextTelphoneHome_KeyPress(KeyAscii As Integer)
    EnterToTab KeyAscii
End Sub

Private Sub TextTelphoneMobile_KeyPress(KeyAscii As Integer)
    EnterToTab KeyAscii
End Sub

Private Sub TextAddress_KeyPress(KeyAscii As Integer)
    EnterToTab KeyAscii
End Sub

'启用/禁用输入框
Private Sub EnableInput(ByVal blnFlag As Boolean)
    TextName.Enabled = blnFlag
    TextPassword.Enabled = blnFlag
    Frame1.Enabled = blnFlag
    DTPBorn.Enabled = blnFlag
    DTPZZSJ.Enabled = blnFlag
    ComboZhiWu.Enabled = blnFlag
    cmbClassify.Enabled = blnFlag
    CmbJS.Enabled = blnFlag
    TextTelphoneHome.Enabled = blnFlag
    TextTelphoneMobile.Enabled = blnFlag
    TextAddress.Enabled = blnFlag
    cmdBrowser.Enabled = blnFlag
End Sub