frmsetrole.frm

用VB6.0编写的关于车辆运输调度的系统

                .DisplayButton "Modify", "Modify", False, , "Modify"
                .DisplayButton "Save", "Save", True, , "Save"
                .DisplayButton "Cancel", "Cancel", True, , "Cancel"
'                .DisplayButton "Redo", "Redo", True, , "Redo"
                .DisplayButton "Close", "Close", False, , "Close"
            End With
            frmRole.Enabled = False
            frmRoleDetail.Enabled = True
            txtCode.SetFocus
        Case "modify"
            With UserControl1
                .DisplayButton "New", "New", False, , "New"
                .DisplayButton "Delete", "Delete", False, , "Delete"
'                .DisplayButton "Print", "Print", False, , "Print"
                .DisplayButton "Modify", "Modify", False, , "Modify"
                .DisplayButton "Save", "Save", True, , "Save"
                .DisplayButton "Cancel", "Cancel", True, , "Cancel"
'                .DisplayButton "Redo", "Redo", True, , "Redo"
                .DisplayButton "Close", "Close", False, , "Close"
            End With
            frmRole.Enabled = False
            frmRoleDetail.Enabled = True
        Case "cancel"
            With UserControl1
                .DisplayButton "New", "New", True, , "New"
                .DisplayButton "Delete", "Delete", True, , "Delete"
'                .DisplayButton "Print", "Print", True, , "Print"
                .DisplayButton "Modify", "Modify", True, , "Modify"
                .DisplayButton "Save", "Save", False, , "Save"
                .DisplayButton "Cancel", "Cancel", False, , "Cancel"
'                .DisplayButton "Redo", "Redo", False, , "Redo"
                .DisplayButton "Close", "Close", True, , "Close"
            End With
            frmRole.Enabled = True
            frmRoleDetail.Enabled = False
        Case "delete"
            With UserControl1
                .DisplayButton "New", "New", True, , "New"
                .DisplayButton "Delete", "Delete", True, , "Delete"
'                .DisplayButton "Print", "Print", True, , "Print"
                .DisplayButton "Save", "Save", False, , "Save"
                .DisplayButton "Modify", "Modify", True, , "Modify"
                .DisplayButton "Cancel", "Cancel", False, , "Cancel"
'                .DisplayButton "Redo", "Redo", False, , "Redo"
                .DisplayButton "Close", "Close", True, , "Close"
            End With
            frmRole.Enabled = True
            frmRoleDetail.Enabled = False
        Case "save"
            With UserControl1
                .DisplayButton "New", "New", True, , "New"
                .DisplayButton "Delete", "Delete", True, , "Delete"
'                .DisplayButton "Print", "Print", True, , "Print"
                .DisplayButton "Save", "Save", False, , "Save"
                .DisplayButton "Modify", "Modify", True, , "Modify"
                .DisplayButton "Cancel", "Cancel", False, , "Cancel"
'                .DisplayButton "Redo", "Redo", False, , "Redo"
                .DisplayButton "Close", "Close", True, , "Close"
            End With
            frmRole.Enabled = True
            frmRoleDetail.Enabled = False
        Case Else
            With UserControl1
                .DisplayButton "New", "New", True, , "New"
                .DisplayButton "Delete", "Delete", True, , "Delete"
'                .DisplayButton "Print", "Print", True, , "Print"
                .DisplayButton "Save", "Save", False, , "Save"
                .DisplayButton "Modify", "Modify", True, , "Modify"
                .DisplayButton "Cancel", "Cancel", False, , "Cancel"
'                .DisplayButton "Redo", "Redo", False, , "Redo"
                .DisplayButton "Close", "Close", True, , "Close"
            End With
            frmRole.Enabled = True
            frmRoleDetail.Enabled = False
        End Select
        Call EnableDelete(gsRoleCode, UserControl1)
End Sub

Private Sub IniRoleDetail()
    
    txtCode.Text = ""
    txtName.Text = ""
    txtCode.Locked = False

End Sub

Private Sub txtcode_KeyUp(KeyCode As Integer, Shift As Integer)

    If KeyCode = vbKeyReturn Then
         SendKeys "{tab}"
    End If
    
End Sub

Private Sub UserControl1_ButtonClick(ByVal Button As MSComctlLib.Button)
    On Error Resume Next
    mkey = LCase(Button.Key)
    
    Select Case LCase(Button.Key)
        Case "new"
            lblStatus.Caption = mkey
            Call IniRoleDetail
            
        Case "cancel"
            Call RefershRole
            
        Case "save"
            If lblStatus.Caption = "new" Then
                If SaveRoleInfo = True Then
                    Call RefershRole
                Else
                    Exit Sub
                End If
            ElseIf lblStatus.Caption = "modify" Then
                If ModifyRoleInfo = True Then
                    Call RefershRole
                Else
                    Exit Sub
                End If
            End If
        Case "delete"
            If MsgBox("Are you want delete this Role?", vbYesNo + vbQuestion, "Message") = vbYes Then
                Call DeleteRoleInfo
                Call RefershRole
            Else
                Exit Sub
            End If
        Case "modify"
            lblStatus.Caption = mkey
            txtCode.Locked = True
            
        Case "close"
            Unload Me
            Exit Sub
        Case Else
    End Select
    
    Call SetToolBar(mkey)
    
End Sub

Private Sub DeleteRoleInfo()
Dim sSQL As String
Dim sCode As String

    sCode = Right(lsvRole.SelectedItem.Key, Len(lsvRole.SelectedItem.Key) - 1)
    sSQL = "delete from sysRol where Rolcode='" & sCode & "'"

    Acs_cnt.Execute (sSQL)
    
    
    sSQL = "delete from sysacc where rolcode='" & sCode & "'"
    
    Acs_cnt.BeginTrans
    Acs_cnt.Execute (sSQL)
    Acs_cnt.CommitTrans


End Sub


Private Function ModifyRoleInfo() As Boolean
On Error GoTo err
Dim sSQL As String
Dim sCode As String

ModifyRoleInfo = False

sCode = txtCode.Text
sname = txtName.Text
If sname = "" Then
         MsgBox "Role Name can't be null!", vbOKOnly + vbExclamation, "Message"
        Exit Function
End If
    
sSQL = "update sysrol set rolname='" & sname & "' where rolcode='" & sCode & "'"

Acs_cnt.BeginTrans
Acs_cnt.Execute (sSQL)
Acs_cnt.CommitTrans

ModifyRoleInfo = True

Exit Function

err:

End Function


Private Function SaveRoleInfo() As Boolean
On Error GoTo err
Dim sCode As String, sname As String
Dim rstRole As Recordset, rstFun As Recordset
Dim sSQL As String, sFunCode As String
Dim aParentc() As String
Dim iCount As Long
    
    SaveRoleInfo = False
    
    sCode = Trim(txtCode.Text)
    If sCode = "" Then
        MsgBox "Role Code can't be null!", vbOKOnly + vbExclamation, "Message"
        Exit Function
    End If
    sname = Trim(txtName.Text)
    If sname = "" Then
         MsgBox "Role Name can't be null!", vbOKOnly + vbExclamation, "Message"
        Exit Function
    End If
    sSQL = "select * from sysrol where rolcode='" & sCode & "'"
    Set rstRole = Acs_cnt.Execute(sSQL)
    With rstRole
    If Not .EOF Then
        MsgBox "This role code is exist,please change role code!", vbOKOnly + vbExclamation, "Error"
        Exit Function
    End If
    End With
    rstRole.Close
    Set rstRole = Nothing
    
    sSQL = "insert into sysrol(rolcode,rolname)" & _
           " values('" & sCode & "','" & sname & "') "
    
    Acs_cnt.BeginTrans
    Acs_cnt.Execute (sSQL)
    Acs_cnt.CommitTrans
    
    
    sSQL = "select funcode from sysfun"
    Set rstFun = Acs_cnt.Execute(sSQL)
    With rstFun
    Do While Not .EOF
        sFunCode = rstFun!funcode
        Call InsertSysAcc(sCode, sFunCode)
        .MoveNext
    Loop
    End With
    
    rstFun.Close
    Set rstFun = Nothing
    
    SaveRoleInfo = True
    
    Exit Function

err:
    MsgBox err.Description, vbOKOnly + vbExclamation, "Error"
    
End Function

Private Sub InsertSysAcc(ByVal sCode As String, ByVal sFunCode As String)
Dim sSQL As String

sSQL = "insert into sysacc(rolcode,funcode,empower) values('" & sCode & "','" & sFunCode & "','0')"

Acs_cnt.BeginTrans
Acs_cnt.Execute (sSQL)
Acs_cnt.CommitTrans

End Sub

Private Sub RefershRole()
    
    lsvRole.ListItems.Clear
    Call ShowRoles
    
End Sub