frmsetrole.frm

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

VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Begin VB.Form frmSetRole 
   Caption         =   "SetRole"
   ClientHeight    =   4620
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   6570
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   4620
   ScaleWidth      =   6570
   StartUpPosition =   1  'CenterOwner
   Begin VB.Frame frmRole 
      BeginProperty Font 
         Name            =   "Arial"
         Size            =   9
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   3615
      Left            =   0
      TabIndex        =   7
      Top             =   600
      Width           =   3135
      Begin MSComctlLib.ListView lsvRole 
         Height          =   3255
         Left            =   120
         TabIndex        =   0
         Top             =   240
         Width           =   2895
         _ExtentX        =   5106
         _ExtentY        =   5741
         LabelWrap       =   -1  'True
         HideSelection   =   -1  'True
         _Version        =   393217
         ForeColor       =   -2147483640
         BackColor       =   -2147483643
         BorderStyle     =   1
         Appearance      =   1
         BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
            Name            =   "宋体"
            Size            =   9
            Charset         =   134
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         NumItems        =   0
      End
   End
   Begin VB.Frame frmRoleDetail 
      Height          =   3615
      Left            =   3240
      TabIndex        =   4
      Top             =   600
      Width           =   3135
      Begin VB.TextBox txtCode 
         BeginProperty Font 
            Name            =   "宋体"
            Size            =   9
            Charset         =   134
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   270
         Left            =   1080
         MaxLength       =   3
         TabIndex        =   1
         Top             =   465
         Width           =   660
      End
      Begin VB.TextBox txtName 
         BeginProperty Font 
            Name            =   "宋体"
            Size            =   9
            Charset         =   134
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   270
         Left            =   1080
         MaxLength       =   20
         TabIndex        =   2
         Top             =   1305
         Width           =   1935
      End
      Begin VB.Label Label1 
         Caption         =   "RoleCode"
         BeginProperty Font 
            Name            =   "宋体"
            Size            =   9
            Charset         =   134
            Weight          =   700
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   255
         Left            =   120
         TabIndex        =   6
         Top             =   480
         Width           =   1095
      End
      Begin VB.Label Label2 
         Caption         =   "RoleName"
         BeginProperty Font 
            Name            =   "宋体"
            Size            =   9
            Charset         =   134
            Weight          =   700
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   255
         Left            =   120
         TabIndex        =   5
         Top             =   1320
         Width           =   975
      End
   End
   Begin PrjLDS.UserControl1 UserControl1 
      Height          =   615
      Left            =   -120
      TabIndex        =   3
      Top             =   0
      Width           =   9255
      _ExtentX        =   11800
      _ExtentY        =   1085
   End
   Begin VB.Label lblStatus 
      Caption         =   "Status"
      Height          =   375
      Left            =   2640
      TabIndex        =   8
      Top             =   4200
      Visible         =   0   'False
      Width           =   855
   End
End
Attribute VB_Name = "frmSetRole"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False

Private Sub Form_Load()
    
    Call InitToolBar
    Call Initialize
    Call ShowRoles
    
    frmRoleDetail.Enabled = False
    
End Sub

Private Sub InitToolBar()
    With UserControl1
        .DisplayButton "new", "new", True, , "New"
        .DisplayButton "Save", "Save", True, , "Save"
'        .DisplayButton "Open", "Open", True, , "Open"
        .DisplayButton "Cancel", "Cancel", True, , "Cancel"
'        .DisplayButton "Redo", "Redo", True, , "Redo"
        .DisplayButton "Modify", "Modify", True, , "Modify"
        .DisplayButton "Delete", "Delete", True, , "Delete"
'        .DisplayButton "Cut", "Cut", True, , "Cut"
'        .DisplayButton "Print", "Print", True, , "Print"
        .DisplayButton "Close", "Close", True, , "Close"
    End With
    
    Call EnableDelete(gsRoleCode, UserControl1)
End Sub

Private Sub Initialize()
On Error GoTo Fail
    With lsvRole
        .ColumnHeaders.Add , , "RoleCode", 1000
        .ColumnHeaders.Add , , "RoleName", .Width - 1100
        .LabelEdit = lvwManual
        .FullRowSelect = True
        .HideSelection = False
        .View = lvwReport
    End With
    Me.KeyPreview = True
    Exit Sub
Fail:
    err.Raise err.Number, , err.Description
End Sub

Private Sub ShowRoles()
Dim rstRole As Recordset
Dim cListItem As ListItem
Dim sSQL As String
Dim sRoleCode As String
Dim sRoleName As String
Dim iCount As Long


sSQL = "select * from sysrol order by rolcode"
Set rstRole = Acs_cnt.Execute(sSQL)

iCount = 1
With rstRole
Do While Not .EOF
    Set cListItem = lsvRole.ListItems.Add(iCount, TREEKEY & rstRole!RolCode, rstRole!RolCode)
    cListItem.SubItems(1) = rstRole!RolName
    iCount = iCount + 1
    .MoveNext
Loop
End With

With lsvRole
    If .ListItems.Count > 0 Then
       .ListItems(1).Selected = True
       ScanRole (.SelectedItem.Text)
    End If
End With

rstRole.Close
Set rstRole = Nothing
End Sub

Private Sub lsvRole_ItemClick(ByVal Item As MSComctlLib.ListItem)
Dim RoleCode As String

RoleCode = Right(lsvRole.SelectedItem.Key, Len(lsvRole.SelectedItem.Key) - 1)
Call ScanRole(RoleCode)

End Sub


Private Sub ScanRole(ByVal RoleCode As String)
Dim sSQL As String
Dim rstRole As Recordset

    sSQL = "select * from sysRol where Rolcode='" & RoleCode & "'"
    Set rstRole = Acs_cnt.Execute(sSQL)
    
    With rstRole
    Do While Not .EOF
        txtCode = rstRole!RolCode
        txtName = rstRole!RolName
        .MoveNext
    Loop
    End With
    
    rstRole.Close
    Set rstRole = Nothing
    
    Exit Sub
Fail:
   
End Sub

Private Sub SetToolBar(ByVal mkey As String)
        
        Select Case mkey
        Case "new"
            With UserControl1
                .DisplayButton "New", "New", False, , "New"
                .DisplayButton "Delete", "Delete", False, , "Delete"
'                .DisplayButton "Print", "Print", True, , "Print"