mdlmain.frm

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

         ForeColor       =   -2147483640
         BackColor       =   -2147483628
         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
         OLEDragMode     =   1
         NumItems        =   0
      End
   End
   Begin VB.Menu m_file 
      Caption         =   "File"
      Begin VB.Menu m_about 
         Caption         =   "About ..."
      End
      Begin VB.Menu kk 
         Caption         =   "-"
      End
      Begin VB.Menu m_relogin 
         Caption         =   "Relogin"
      End
      Begin VB.Menu m_exit 
         Caption         =   "Exit"
      End
   End
   Begin VB.Menu m_window 
      Caption         =   "Window"
      WindowList      =   -1  'True
      Begin VB.Menu m_layer 
         Caption         =   "Layer"
      End
      Begin VB.Menu m_cascade 
         Caption         =   "Cascade"
      End
      Begin VB.Menu m_arrange 
         Caption         =   "Arrange"
         Visible         =   0   'False
      End
      Begin VB.Menu pause6 
         Caption         =   "-"
      End
      Begin VB.Menu m_toolbars 
         Caption         =   "Toolbars"
         Checked         =   -1  'True
      End
      Begin VB.Menu m_status 
         Caption         =   "Status"
         Checked         =   -1  'True
      End
      Begin VB.Menu m_desktop 
         Caption         =   "Desktop"
         Checked         =   -1  'True
      End
   End
End
Attribute VB_Name = "mdlMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Const cmdWidth = 2565
Const cmdHeight = 500


Private Sub cmdModule_Click(Index As Integer)
Dim i As Long
    
    For i = 0 To Index
        cmdModule(i).Top = cmdHeight * i
        lsvModule.Top = cmdHeight * (i + 1)
    Next i
    
    For i = Index + 1 To cmdModule.UBound
        cmdModule(i).Top = cmdHeight * i + lsvModule.Height
    Next i

    Call GetOperatorInfo(gsRoleCode, Index + 1)

End Sub


Private Sub lsvModule_DblClick()
Dim funcode As String

    funcode = Right(lsvModule.SelectedItem.Key, Len(lsvModule.SelectedItem.Key) - 1)
    
    Select Case funcode
        Case "10001001"
        '    frmComm.Show
          '   frmdown.Show
        Case "10001002"
            frmCmp.Show
        Case "10001003"
            frmEnt.Show
        Case "10001004"
            frmSal.Show
        Case "10001005"
            frmSta.Show
        Case "10001006"
            frmRea.Show
        Case "20001001"
            frmSetRole.Show vbModal
        Case "20001002"
            frmSetClerk.Show vbModal
        Case "20001003"
            frmClerkRight.Show vbModal
        Case "20001004"
            frmPassWord.Show vbModal
        Case "30001002"
            frmimport2.Show
        Case "30001001"
            Frmexport.Show
        Case "30001003"
            frmUnite.Show
        Case "40001001"
            frmcus.Show
        Case "40001002"
            frmIte.Show
        Case "40001003"
            frmBus.Show
        Case "40001004"
            frmTru.Show
        Case "40001005"
            frmtcd.Show
        Case "40001006"
            frmDrv.Show
        Case "40001007"
            frmDcd.Show
        Case "40001008"
            frmCut.Show
        Case "50001001"
            frmiltank.Show
        Case "60001001"
             frmSugOrder.Show
        Case "60001003"
            frmDownOrder.Show
        Case "70001001"
            frmArrange.Show
        Case "70001002"
            frmCosting.Show
        Case "70001003"
            frmDownList.Show
        Case "70001004"
            frmTripCosting.Show
        Case "80001001"
            frmRepDrvCanl.Show
        Case "80001002"
            frmRepTruCanl.Show
        Case "80001003"
            frmRepExcept.Show
        Case "80001004"
            FrmRepInventory.Show
        Case "80001005"
            frmRepReplenish.Show
        Case "80001006"
            frmRepSales.Show
        Case "80001007"
            frmRepCost.Show
        Case "80001008"
            frmRepSumCost.Show
        Case "80001009"
            frmchart.Show
        Case "80001010"
            frmdailyreport.Show
        
        Case Else
    
    End Select

End Sub


Private Sub m_about_Click()
    frmver.Show

End Sub

Private Sub m_cascade_Click()
    mdlMain.Arrange vbCascade
End Sub

Private Sub m_exit_Click()
    Unload Me
End Sub

Private Sub m_helpcontents_Click()
'frmCusHelp.Show

End Sub

Private Sub m_layer_Click()
    mdlMain.Arrange vbTileHorizontal
End Sub

Private Sub m_relogin_Click()
    Unload Me
    frmLogin.Show
End Sub


Private Sub MDIForm_Load()

    Call InitForm
    Call iniStatusBar
    Call GetOperatorInfo(gsRoleCode, 1)

End Sub

Private Sub iniStatusBar()
Dim company, entity As String
Dim sSQL As String
Dim rstcmp As Recordset

sSQL = "select cmpdesc from syscmp"
Set rstcmp = Acs_cnt.Execute(sSQL)
company = rstcmp!cmpdesc
sSQL = "select entdesc from sysent"
Set rstcmp = Acs_cnt.Execute(sSQL)
entity = rstcmp!entdesc

    With StatusBar
        .Panels(2).Text = gsUserCode
        .Panels(4).Text = gsUserName
        .Panels(5).Text = company
        .Panels(6).Text = entity
    End With
rstcmp.Close
Set rstcmp = Nothing
End Sub

Private Sub InitForm()
Dim iCount As Long

    lsvModule.Top = cmdModule(0).Top + cmdModule(0).Height
    cmdModule(1).Top = lsvModule.Top + lsvModule.Height
    
    For iCount = 2 To cmdModule.UBound
        cmdModule(iCount).Top = cmdModule(iCount - 1).Top + cmdHeight
    Next iCount

End Sub

Public Sub GetOperatorInfo(ByVal sCode As String, ByVal iCount As Long)
Dim i As Long
Dim sSQL As String
Dim ItemX As ListItem
Dim rstFun As Recordset
Dim sParentc As String

    sParentc = iCount & "0000000"
    sSQL = "select a.empower,b.* from sysacc a,sysfun b where a.funcode=b.funcode and a.rolcode='" & sCode & "' and b.parentc='" & sParentc & "' and b.parentc <> 'F' order by b.funcode"
    
    Set rstFun = Acs_cnt.Execute(sSQL)
    
    i = 0
    lsvModule.ListItems.Clear
    
    With rstFun
    Do While Not .EOF
      If LCase(sCode) = "100" Then
            i = i + 1
            Set ItemX = lsvModule.ListItems.Add(i, TREEKEY & rstFun!funcode, rstFun!shodesc, i)
      ElseIf LCase(sCode) <> "100" And rstFun!empower = "1" Then
            i = i + 1
            Set ItemX = lsvModule.ListItems.Add(i, TREEKEY & rstFun!funcode, rstFun!shodesc, i)
      End If
      .MoveNext
    Loop
    End With
    
    
    rstFun.Close
    Set rstFun = Nothing

End Sub

Private Sub MDIForm_Resize()
   If mdlMain.WindowState = 2 Then
'    mdlMain.Height = 9000
'    mdlMain.Width = 10245
    Else
    End If

End Sub

Private Sub Relogin_Click()

End Sub