VB开发的ERP系统

                FrmJljy_SDemotionList.HelpContextID = 1503003
                FrmJljy_SDemotionList.Show
            End If
             
            Security_Log gnsy, Xtczybm, 2, False         '用户退出时写上机日志
        
       Case "Qc_StoDemotionQuery"                        '降等使用报告单列表
            If GBln_IfLinkStock = True Then
                FrmJljy_StoDemotionListCg.HelpContextID = 1503004
                FrmJljy_StoDemotionListCg.Show
                FrmJljy_StoDemotionListQueryCg.Show 1
            Else
                FrmJljy_StoDemotionList.HelpContextID = 1503004
                FrmJljy_StoDemotionList.Show
                FrmJljy_StoDemotionListQuery.Show 1
            End If

        '******************************* 成品检验 *******************************
        
        Case "Qc_ProductCheck"                           '成品检验分析单
            
            '判断用户是否有此功能执行权限,如有则写上机日志(进入)
            If Not Security_Log("Qc_ProductCheck_edit", Xtczybm, 1) Then
                Exit Sub
            End If
            
            Xtcdcs = "1"
            FrmCpjy_ProductCheck.HelpContextID = 1504001
            FrmCpjy_ProductCheck.Show 1
            
            Security_Log gnsy, Xtczybm, 2, False         '用户退出时写上机日志
        
        Case "Qc_ProductCheckQuery"                      '成品检验分析单列表
            FrmCpjy_ProductCheckList.HelpContextID = 1504002
            FrmCpjy_ProductCheckList.Show
            FrmCpjy_ProductCheckListQuery.Show 1
        Case "Qc_ProductDemotion"                        '成品质量降等
            
            '判断用户是否有此功能执行权限,如有则写上机日志(进入)
            If Not Security_Log("Qc_ProductDemotion_edit", Xtczybm, 1) Then
                Exit Sub
            End If
            
            FrmCpjy_PDemotionList.HelpContextID = 1504003
            FrmCpjy_PDemotionList.Show
            
            Security_Log gnsy, Xtczybm, 2, False         '用户退出时写上机日志
        
        Case "Qc_ProductDemotionQuery"                   '成品质量降等列表
            FrmCpjy_ProductDemotionList.HelpContextID = 1504004
            FrmCpjy_ProductDemotionList.Show
            FrmCpjy_ProductDemotionListQuery.Show 1
        Case "QC_ProGraphZxt"                            '成品指标折线图
            FrmProGraph_Zxt.HelpContextID = 150400501
            FrmProGraph_Zxt.Show
            FrmProGraph_ZxtQuery.Show 1
        Case "QC_ProGraphZst"                            '成品等级走势图
            FrmProGraph_Zst.HelpContextID = 150400502
            FrmProGraph_Zst.Show
            FrmProGraph_ZstQuery.Show 1
        Case "QC_ProGraphPlt"                            '成品降等排列图
            FrmProGraph_Plt.HelpContextID = 150400503
            FrmProGraph_Plt.Show
            FrmProGraph_PltQuery.Show 1
       
        
        '******************************* 中控检验 *******************************
        
        Case "QC_MidCheck"                               '中控检验分析单
            
            '判断用户是否有此功能执行权限,如有则写上机日志(进入)
            If Not Security_Log("QC_MidCheck_edit", Xtczybm, 1) Then
                Exit Sub
            End If
            
            Xtcdcs = "1"
            Qc_MidAnaBill.HelpContextID = 1505001
            Qc_MidAnaBill.Show 1
             
            Security_Log gnsy, Xtczybm, 2, False         '用户退出时写上机日志
        
       Case "QC_MidCheckQuery"                           '中控检验分析单查询
            Qc_MidAnaBillList.HelpContextID = 1505002
            Qc_MidAnaBillList.Show
            Qc_MidAnaBillListQuery.Show 1
        Case "QC_MidGraphZxt"                            '中控图形分析折线图
            QC_MidGraphZxt.HelpContextID = 150500301
            QC_MidGraphZxt.Show 1
        Case "QC_MidGraphKzt"                            '中控图形分析控制图
            QC_MidGraphKzt.HelpContextID = 150500302
            QC_MidGraphKzt.Show 1
         
         
        '******************************* 工作环境 *******************************
       Case "QC_WaterReport"                             '废水监测报告
             
            '判断用户是否有此功能执行权限,如有则写上机日志(进入)
            If Not Security_Log("QC_StockCheck_edit", Xtczybm, 1) Then
                Exit Sub
            End If
            
           If Not ReportItem(1) Then
                Exit Sub
            End If
            Xtcdcs = "1"
           QC_WaterReport.HelpContextID = 1506001
           QC_WaterReport.Show 1
            
            Security_Log gnsy, Xtczybm, 2, False         '用户退出时写上机日志
        
        Case "QC_GasReport"                              '废气监测报告
            
            '判断用户是否有此功能执行权限,如有则写上机日志(进入)
            If Not Security_Log("QC_StockCheck_edit", Xtczybm, 1) Then
                Exit Sub
            End If
            
            If Not ReportItem(2) Then
                Exit Sub
            End If
            Xtcdcs = "1"
            QC_GasReport.HelpContextID = 1506002
            QC_GasReport.Show 1
            
            Security_Log gnsy, Xtczybm, 2, False         '用户退出时写上机日志
        
        Case "QC_EnvironmentReport"                      '工作环境检测报告
            
            '判断用户是否有此功能执行权限,如有则写上机日志(进入)
            If Not Security_Log("QC_StockCheck_edit", Xtczybm, 1) Then
                Exit Sub
            End If
            
            If Not ReportItem(3) Then
                Exit Sub
            End If
            Xtcdcs = "1"
            Qc_EnviReport.HelpContextID = 1506003
            Qc_EnviReport.Show 1
            
            Security_Log gnsy, Xtczybm, 2, False         '用户退出时写上机日志
        
        
        '******************************* 工 具 *********************************
          
        Case "Qc_jsq"                                    '计算器
            Shell App.Path & "\calc.exe", vbNormalFocus
        Case "Qc_kjrl"                                   '会计日历
            XT_kjrlFrm.HelpContextID = 1507001
            XT_kjrlFrm.Show 1
        
        '******************************* 帮  助 *********************************
          
        Case "Qc_wshxxd"                                 '网上华夏新达
            ShellExecute 0, "open", "www.hxxd.com", "", "", 0
        Case "Qc_xtbz"                                   '系统帮助
            Call F1bz
        Case "Qc_gy"                                     '关于
            XT_frmAbout.Show
        
    End Select
    
    '用户退出时写上机日志
   Security_Log gnsy, Xtczybm, 2, False
   
   
    Exit Sub
Cwcl:
    Tsxx = "此项系统功能有待完善!"
    Call Xtxxts(Tsxx, 0, 4)
    Exit Sub

End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)        '用户关闭窗体
  
    If Unload_TF = False Then
        Cancel = 1
        Me.WindowState = 1
    End If

End Sub

Private Sub Form_Load()
    
    '设置窗体图标
    Me.Icon = XT_Main.Icon
    
    '设置窗体位置大小,并调入系统功能树
    Me.Left = 0
    Me.Top = 0
    Me.Width = XT_Main.Width - 60
    Me.Height = XT_Main.Height - 760 - 690
    Call Cshgns
    
    '启动调入数据等待提示
    Load Xt_Wait
    
End Sub

Private Sub Form_Unload(Cancel As Integer)
    
    On Error Resume Next
    
    Dim i As Integer
    For i = Forms.Count - 1 To 1 Step -1
        Unload Forms(i)
    Next
    If Me.WindowState <> vbMinimized Then
        SaveSetting App.Title, "Settings", "MainLeft", Me.Left
        SaveSetting App.Title, "Settings", "MainTop", Me.Top
        SaveSetting App.Title, "Settings", "MainWidth", Me.Width
        SaveSetting App.Title, "Settings", "MainHeight", Me.Height
    End If
    SaveSetting App.Title, "Settings", "ViewMode", lvListView.View

End Sub

Private Sub Form_Resize()
    
    On Error Resume Next
    If Me.Width < 3000 Then Me.Width = 3000
    SizeControls imgSplitter.Left

End Sub

Private Sub imgSplitter_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    
    With imgSplitter
        picSplitter.Move .Left, .Top, .Width \ 2, .Height - 20
    End With
    picSplitter.Visible = True
    mbMoving = True

End Sub

Private Sub imgSplitter_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    
    Dim sglPos As Single
    If mbMoving Then
        sglPos = X + imgSplitter.Left
        If sglPos < sglSplitLimit Then
            picSplitter.Left = sglSplitLimit
        ElseIf sglPos > Me.Width - sglSplitLimit Then
            picSplitter.Left = Me.Width - sglSplitLimit
        Else
            picSplitter.Left = sglPos
        End If
    End If

End Sub

Private Sub imgSplitter_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    
    SizeControls picSplitter.Left
    picSplitter.Visible = False
    mbMoving = False
    lvListView.Refresh

End Sub

Private Sub TreeView1_DragDrop(Source As Control, X As Single, Y As Single)
    
    If Source = imgSplitter Then
        SizeControls X
    End If

End Sub

Sub SizeControls(X As Single)
    
    On Error Resume Next

    '设置 Width 属性
    If X < 3500 Then X = 3500
    If X > (Me.Width - 1500) Then X = Me.Width - 1500
    tvTreeView.Width = X
    imgSplitter.Left = X
    lvListView.Left = X + 40
    lvListView.Width = Me.Width - (tvTreeView.Width + 140)
    lblTitle(0).Width = tvTreeView.Width
    lblTitle(1).Left = lvListView.Left + 20
    lblTitle(1).Width = lvListView.Width - 40

    '设置 Top 属性

    tvTreeView.Top = tbToolBar.Height + picTitles.Height

    lvListView.Top = tvTreeView.Top

    '设置 height 属性
    tvTreeView.Height = Me.ScaleHeight - (picTitles.Top + picTitles.Height)
    
    lvListView.Height = tvTreeView.Height
    imgSplitter.Top = tvTreeView.Top
    imgSplitter.Height = tvTreeView.Height

End Sub

Private Sub tbToolBar_ButtonClick(ByVal Button As MSComctlLib.Button)
    
    On Error Resume Next
    
    Select Case Button.Key
        Case "返回"
            tvTreeView.SetFocus
              SendKeys "{up}", True
        Case "向前"
             tvTreeView.SetFocus
              SendKeys "{DOWN}", True
        Case "大图标"
            lvListView.View = lvwIcon
        Case "小图标"
            lvListView.View = lvwSmallIcon
        Case "列表"
            lvListView.View = lvwList
        Case "详细资料"
            lvListView.View = lvwReport
    End Select

End Sub