VB开发的ERP系统

            End If
            KF_AlertDzjy.Show
            KF_AlertDzjyQuery.Show 1
            
        Case "Kf_QualityAlart"                   '保质期预警
            If Not Security_Log("Kf_QualityAlart", Xtczybm, 1) Then
                Exit Sub
            End If
            KF_AlertTime.Show
            KF_AlertTimeQuery.Show 1
            
        Case "Kf_AgeAssay"                       '库龄分析
            If Not Security_Log("Kf_AgeAssay", Xtczybm, 1) Then
                Exit Sub
            End If
            KF_AlertWareage.Show
            KF_AlertWareageQuery.Show 1
        
        '统计分析
        Case "Kf_InOutSum"                      '收发存汇总
            If Not Security_Log("Kf_InOutSum", Xtczybm, 1) Then
                Exit Sub
            End If
            KF_SumInout.Show
            KF_SumInoutQuery.Show 1
        Case "Kf_TransactSum"                   '业务类型汇总
            If Not Security_Log("Kf_TransactSum", Xtczybm, 1) Then
                Exit Sub
            End If
            KF_FrmOptypeSum.Show
            KF_FrmOptypeSumQuery.Show 1
        Case "Kf_InOutTypeSum"                  '收发类别汇总
            If Not Security_Log("Kf_InOutTypeSum", Xtczybm, 1) Then
                Exit Sub
            End If
            KF_FrmInoutSum.Show
            KF_FrmInoutSumQuery.Show 1
        Case "Kf_MaterialSum"                   '物料批次汇总表
            If Not Security_Log("Kf_MaterialSum", Xtczybm, 1) Then
                Exit Sub
            End If
            KF_FrmMateBatch.Show
            KF_FrmMateBatchQuery.Show 1
        Case "Kf_BatchSum"                      '批次物料汇总表
            If Not Security_Log("Kf_BatchSum", Xtczybm, 1) Then
                Exit Sub
            End If
            KF_FrmBatchMate.Show
            KF_FrmBatchMateQuery.Show 1
        Case "Kf_InSum"                         '入库汇总表
            If Not Security_Log("Kf_InSum", Xtczybm, 1) Then
                Exit Sub
            End If
            KF_FrmInList.Show
            KF_FrmInListQuery.Show 1
        Case "Kf_OutSum"                        '出库汇总表
            If Not Security_Log("Kf_OutSum", Xtczybm, 1) Then
                Exit Sub
            End If
            KF_FrmOutList.Show
            KF_FrmOutListQuery.Show 1
            
        '其他业务
        Case "KF_IssueApply"                    '领料申请单
            '判断用户是否有此功能执行权限,如有则写上机日志(进入)
            If Not Security_Log("KF_IssueApply_edit", Xtczybm, 1) Then
                Exit Sub
            End If
            Xtcdcs = "1"
            KF_FrmIssueApply.Show 1
            Security_Log gnsy, Xtczybm, 2, False  '用户退出时写上机日志
        Case "Kf_MRList"                        '领料申请单列表
            '判断用户是否有此功能执行权限,如有则写上机日志(进入)
            If Not Security_Log("Kf_MRList", Xtczybm, 1) Then
                Exit Sub
            End If
            KF_FrmIssueApplyCxjg.Show
            KF_FrmIssueApplyCxtj.Show 1
        Case "Kf_DBD"                           '调拨单
            '判断用户是否有此功能执行权限,如有则写上机日志(进入)
            If Not Security_Log("Kf_DBD_edit", Xtczybm, 1) Then
                Exit Sub
            End If
            Xtcdcs = "1"
            KF_FrmDBD.Show 1
            Security_Log gnsy, Xtczybm, 2, False  '用户退出时写上机日志
        Case "Kf_DbbList"                       '调拨单列表
            '判断用户是否有此功能执行权限,如有则写上机日志(进入)
            If Not Security_Log("Kf_DbbList", Xtczybm, 1) Then
                Exit Sub
            End If
            KF_FrmDBDcxjg.Show
            KF_FrmDBDCxtj.Show 1
        Case "Kf_PDD"                           '盘点单
            '判断用户是否有此功能执行权限,如有则写上机日志(进入)
            If Not Security_Log("Kf_PDD_edit", Xtczybm, 1) Then
                Exit Sub
            End If
            Xtcdcs = "1"
            KF_FrmPDD.Show 1
            Security_Log gnsy, Xtczybm, 2, False  '用户退出时写上机日志
        Case "Kf_PddList"                       '盘点单列表
            '判断用户是否有此功能执行权限,如有则写上机日志(进入)
            If Not Security_Log("Kf_PddList", Xtczybm, 1) Then
                Exit Sub
            End If
            Xtcdcs = "2"
            KF_FrmPDDcxjg.Show
            KF_FrmPDDCxtj.Show 1
        Case "Kf_AutoBanlance"                  '自动结算
            If Not Security_Log("Kf_AutoBanlance", Xtczybm, 1) Then
                Exit Sub
            End If
            If Judge_NowDate = False Then Exit Sub
                Balance_KF_Autobalance.Show 1
        Case "Kf_HandBalance"                   '手工结算
                If Not Security_Log("Kf_HandBalance", Xtczybm, 1) Then
                    Exit Sub
                End If
                If Judge_NowDate = False Then Exit Sub
                Balance_KF_HandBalance.Show 1
        Case "Kf_BanlanceList"
            If Not Security_Log("Kf_BanlanceList", Xtczybm, 1) Then
                Exit Sub
            End If
             Balance_KF_BillList.Show
             Balance_KF_BillQuery.Show 1
        Case "Kf_MaterialIn"                    '材料入库单
            If Not Security_Log("Kf_MaterialIn_edit", Xtczybm, 1) Then
                Exit Sub
            End If
            If Judge_NowDate = False Then Exit Sub
            Xtcdcs = "1"
            KF_FrmMateIn.Show 1
            Security_Log gnsy, Xtczybm, 2, False  '用户退出时写上机日志
        Case "Kf_MaterialInList"                '材料入库单列表
            If Not Security_Log("Kf_MaterialInList", Xtczybm, 1) Then
                Exit Sub
            End If
            KF_FrmMateInCxjg.Show
            KF_FrmMateInCxtj.Show 1
        Case "Kf_BalanceMateIn"                 '材料入库单列表
            If Not Security_Log("Kf_BalanceMateIn", Xtczybm, 1) Then
                Exit Sub
            End If
            If Clrkdkfsc = True Then
                Balance_KF_MateInList.Show
                Balance_KF_MateInQuery.Show 1
            Else
                Tsxx = "材料入库单不由库存管理系统生成,不允许查看!"
                Call Xtxxts(Tsxx, 0, 1)
                Exit Sub
            End If
        '月末处理
        Case "Kf_MonthCheck"                    '月末结帐
            If Not Security_Log("Kf_MonthCheck", Xtczybm, 1) Then
                Exit Sub
            End If
            '判断是否已经完成初始化
            If CheckStartFinish = False Then
                Tsxx = "系统未完成初始化操作,不允许进行月末结帐操作!"
                Call Xtxxts(Tsxx, 0, 1)
                Exit Sub
            Else
                KF_FrmCheck.Show 1
            End If
            Security_Log gnsy, Xtczybm, 2, False  '用户退出时写上机日志
        Case "Kf_RepariNowQuan"                 '整理现存量
            If Not Security_Log("Kf_RepariNowQuan", Xtczybm, 1) Then
                Exit Sub
            End If
            If CheckStartFinish = False Then
                Tsxx = "系统未完成初始化操作,不允许进行整理现存量!"
                Call Xtxxts(Tsxx, 0, 1)
                Exit Sub
            Else
                Call NowQuanManage
            End If
        Case "Kf_Kjrlb"                         '会计日历表
            KF_FrmKjrlb.Show 1

        '工具
        Case "Kf_Counter"                        '计算器
            Shell App.Path & "\calc.exe", vbNormalFocus
        
        '帐簿分析
        Case "Kf_WaterLedger"                   '库存流水帐
            If Not Security_Log("Kf_WaterLedger", Xtczybm, 1) Then
                Exit Sub
            End If
            KF_FrmGliad.Show
            KF_FrmGliadCxtj.Show 1
       Case "Kf_DeskLedger"                     '库存台帐
            If Not Security_Log("Kf_DeskLedger", Xtczybm, 1) Then
                Exit Sub
            End If
            KF_FrmStockAcc.Show
            KF_FrmStockAccCxtj.Show 1
       Case "Kf_BatchLedger"                    '批次台帐
            If Not Security_Log("Kf_BatchLedger", Xtczybm, 1) Then
                Exit Sub
            End If
            KF_FrmBatchAcc.Show
            KF_FrmBatchAccCxtj.Show 1
       Case "Kf_MaterialLedger"                 '材料台帐
            If Not Security_Log("Kf_MaterialLedger", Xtczybm, 1) Then
                Exit Sub
            End If
            KF_FrmMateAcc.Show
            KF_FrmMateAccCxtj.Show 1
       Case "Kf_Collate"                         '库存对帐表
            If Not Security_Log("Kf_Collate", Xtczybm, 1) Then
                Exit Sub
            End If
            KF_FrmCollate.Show
            KF_FrmCollateCxtj.Show 1
       
       Case "KF_DayReport"                      '库存日报表
            If Not Security_Log("KF_DayReport", Xtczybm, 1) Then
                Exit Sub
            End If
            KF_FrmDayReport.Show
            KF_FrmDayReportCxtj.Show 1
        
        '帮助
        Case "Kf_SysHelp"                           '系统帮助
            Call F1bz
        Case "Kf_About"                             '关于
            XT_frmAbout.Show
    End Select
      
    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