VB开发的ERP系统

            Security_Log gnsy, Xtczybm, 2, False  '用户退出时写上机日志
        
        'R 统计报表
        Case "Xs_R_GeneralAccount"            '销售总帐"
            '判断用户是否有此功能执行权限,如有则写上机日志(进入)
            If Not Security_Log("Xs_R_GeneralAccount", Xtczybm, 1, True) Then
                Exit Sub
            End If
            Xs_R_GeneralAccount.HelpContextID = 1413001
            Xs_R_GeneralAccount.Show
            Xs_R_GeneralAccountQuery.Show 1
            Security_Log gnsy, Xtczybm, 2, False  '用户退出时写上机日志
        Case "Xs_R_SaleAccount"               '销售明细帐"
            '判断用户是否有此功能执行权限,如有则写上机日志(进入)
            If Not Security_Log("Xs_R_SaleAccount", Xtczybm, 1, True) Then
                Exit Sub
            End If
            Xs_R_SaleAccount.HelpContextID = 1413002
            Xs_R_SaleAccount.Show
            Xs_R_SaleAccountQuery.Show 1
            Security_Log gnsy, Xtczybm, 2, False  '用户退出时写上机日志
        Case "Xs_R_SaleThing"                 '销售执行情况报表
            '判断用户是否有此功能执行权限,如有则写上机日志(进入)
            If Not Security_Log("Xs_R_SaleThing", Xtczybm, 1, True) Then
                Exit Sub
            End If
            Xs_R_SaleThing.HelpContextID = 1413003
            Xs_R_SaleThing.Show
            Xs_R_SaleThingQuery.Show 1
            Security_Log gnsy, Xtczybm, 2, False  '用户退出时写上机日志
        Case "Xs_R_ConsignThing"              '发货单执行情况"
            '判断用户是否有此功能执行权限,如有则写上机日志(进入)
            If Not Security_Log("Xs_R_ConsignThing", Xtczybm, 1, True) Then
                Exit Sub
            End If
            Xs_R_ConsignThing.HelpContextID = 1413004
            Xs_R_ConsignThing.Show
            Xs_R_ConsignThingQuery.Show 1
            Security_Log gnsy, Xtczybm, 2, False  '用户退出时写上机日志
        Case "Xs_R_consignlist"               '发货明细表"
            '判断用户是否有此功能执行权限,如有则写上机日志(进入)
            If Not Security_Log("Xs_R_consignlist", Xtczybm, 1, True) Then
                Exit Sub
            End If
            Xs_R_consignlist.HelpContextID = 1413005
            Xs_R_consignlist.Show
            Xs_R_ConsignListQuery.Show 1
            Security_Log gnsy, Xtczybm, 2, False  '用户退出时写上机日志
        Case "Xs_R_SaleList"                  '销售明细表"
            '判断用户是否有此功能执行权限,如有则写上机日志(进入)
            If Not Security_Log("Xs_R_SaleList", Xtczybm, 1, True) Then
                Exit Sub
            End If
            Xs_R_SaleList.HelpContextID = 1413006
            Xs_R_SaleList.Show
            Xs_R_SaleListQuery.Show 1
            Security_Log gnsy, Xtczybm, 2, False  '用户退出时写上机日志
        Case "Xs_R_returnlist"                '回款明细表"
            '判断用户是否有此功能执行权限,如有则写上机日志(进入)
            If Not Security_Log("Xs_R_returnlist", Xtczybm, 1, True) Then
                Exit Sub
            End If
            Xs_R_returnlist.HelpContextID = 1413007
            Xs_R_returnlist.Show
            Xs_R_ReturnListQuery.Show 1
            Security_Log gnsy, Xtczybm, 2, False  '用户退出时写上机日志
        
        'A 分析
        Case "Xs_A_FlowAnalysis"              '货物流向分析"
            '判断用户是否有此功能执行权限,如有则写上机日志(进入)
            If Not Security_Log("Xs_A_FlowAnalysis", Xtczybm, 1, True) Then
                Exit Sub
            End If
            Xs_A_FlowAnalysis.HelpContextID = 1414001
            Xs_A_FlowAnalysis.Show
            Xs_A_FlowAnalysisQuery.Show 1
            Security_Log gnsy, Xtczybm, 2, False  '用户退出时写上机日志
        Case "Xs_A_FrameAnalysis"                '销售结构分析"
            '判断用户是否有此功能执行权限,如有则写上机日志(进入)
            If Not Security_Log("Xs_A_FrameAnalysis", Xtczybm, 1, True) Then
                Exit Sub
            End If
            Xs_A_FrameAnalysis.HelpContextID = 1414002
            Xs_A_FrameAnalysis.Show
            Xs_A_FrameAnalysisQuery.Show 1
            Security_Log gnsy, Xtczybm, 2, False  '用户退出时写上机日志
        Case "Xs_A_MarketAnalysis"              '市场分析"
            '判断用户是否有此功能执行权限,如有则写上机日志(进入)
            If Not Security_Log("Xs_A_MarketAnalysis", Xtczybm, 1, True) Then
                Exit Sub
            End If
            Xs_A_MarketAnalysis.HelpContextID = 1414003
            Xs_A_MarketAnalysis.Show
            Xs_A_MarketAnalysisQuery.Show 1
            Security_Log gnsy, Xtczybm, 2, False  '用户退出时写上机日志
        Case "Xs_A_WareAnalysis"                '货龄分析"
            '判断用户是否有此功能执行权限,如有则写上机日志(进入)
            If Not Security_Log("Xs_A_WareAnalysis", Xtczybm, 1, True) Then
                Exit Sub
            End If
            Xs_A_WareAnalysis.HelpContextID = 1414004
            Xs_A_WareAnalysis.Show
            Xs_A_WareAnalysisQuery.Show 1
            Security_Log gnsy, Xtczybm, 2, False  '用户退出时写上机日志
        Case "Xs_A_RiseAnalysis"               '销售增长分析"
            '判断用户是否有此功能执行权限,如有则写上机日志(进入)
            If Not Security_Log("Xs_A_RiseAnalysis", Xtczybm, 1, True) Then
                Exit Sub
            End If
            Xs_A_RiseAnalysis.HelpContextID = 1414005
            Xs_A_RiseAnalysis.Show
            Xs_A_RiseAnalysisQuery.Show 1
            Security_Log gnsy, Xtczybm, 2, False  '用户退出时写上机日志
        
        'D 数据
        Case "Xs_PreDataInput"                '期初数据"
            '判断用户是否有此功能执行权限,如有则写上机日志(进入)
            If Not Security_Log("Xs_PreDataInput", Xtczybm, 1, True) Then
                Exit Sub
            End If
            Xtcdcs = "5"
            Set RecTemp = Cw_DataEnvi.DataConnect.Execute("select consignbillmainid from Xs_ConsignBillMain Where AccountOpt<>''")
            If RecTemp.RecordCount > 0 Then
                Tsxx = "期初已结帐，不能再录入期初数据！"
                Call Xtxxts(Tsxx, 0, 4)
                Exit Sub
            End If
            Xs_C_ConsignBill.HelpContextID = 1403001
            Xs_C_ConsignBill.Show 1
            Security_Log gnsy, Xtczybm, 2, False  '用户退出时写上机日志
        Case "Xs_DataOut"                     '数据导出"
        '工具
        Case "c_gnbmjsq"                        '计算器
            Shell App.Path & "\calc.exe", vbNormalNoFocus
        Case "c_gnbmkmrl"                       '会计日历
            XT_kjrlFrm.HelpContextID = 1416001
            XT_kjrlFrm.Show 1
        '帮助
        Case "c_xtbz"                           '系统帮助
            Call F1bz
        Case "c_gy"                             '关于
            XT_frmAbout.Show 1
    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