VB开发的ERP系统

                    CL_MakeVoucher.Show
                    CL_MakeVoucherFind.Show 1
                    Security_Log gnsy, Xtczybm, 2, False  '用户退出时写上机日志
                End If
            End If
        Case "Chhs_Qmjz"                             '期末结帐
             '判断用户是否有此功能执行权限,如有则写上机日志(进入)
            If Not Security_Log("Chhs_Qmjz", Xtczybm, 1) Then
                Exit Sub
            End If
            If Xtyear <> PGKjYear Then
                Set Rectemp = Cw_DataEnvi.DataConnect.Execute("select * from gy_kjrlb where kjyear=" & PGKjYear - 1 & " order by period desc")
                If Not Rectemp.EOF Then
                    If Xtmm = Rectemp.Fields("period") Then
                        CL_EndCheckOut.Dyear = PGKjYear - 1
                        CL_EndCheckOut.Dmonth = Xtmm
                        CL_EndCheckOut.Timer1 = True
                        CL_EndCheckOut.Opt_Qmjz.Enabled = False
                        CL_EndCheckOut.Opt_Hfqmjz.Value = True
                        CL_EndCheckOut.Show 1
                        Security_Log gnsy, Xtczybm, 2, False  '用户退出时写上机日志
                    Else
                        Tsxx = "操作日期不在当前会计年度(" + Trim(Str(PGKjYear)) + ")之内,请重新登录!"
                        Call Xtxxts(Tsxx, 0, 1)
                    End If
                Else
                    Tsxx = "操作日期不在当前会计年度(" + Trim(Str(PGKjYear)) + ")之内,请重新登录!"
                    Call Xtxxts(Tsxx, 0, 1)
                End If
            Else
                CL_EndCheckOut.Dyear = PGKjYear
                CL_EndCheckOut.Dmonth = PGNowmon
                CL_EndCheckOut.Timer1 = True
                CL_EndCheckOut.Show 1
                Security_Log gnsy, Xtczybm, 2, False  '用户退出时写上机日志
            End If
        
        '帐簿分析
        Case "Chhs_Mxz"                              '明细帐
            '判断用户是否有此功能执行权限,如有则写上机日志(进入)
            If Not Security_Log("Chhs_Mxz", Xtczybm, 1) Then
                Exit Sub
            End If
            Zbfx_List.Show
            Zbfx_ListCond.Show 1
            Security_Log "Chhs_Mxz", Xtczybm, 2, False  '用户退出时写上机日志
        Case "Chhs_Zz"                               '总帐
            '判断用户是否有此功能执行权限,如有则写上机日志(进入)
            If Not Security_Log("Chhs_Zz", Xtczybm, 1) Then
                Exit Sub
            End If
            Zbfx_Mate.Show
            Zbfx_MateCond.Show 1
            Security_Log "Chhs_Zz", Xtczybm, 2, False  '用户退出时写上机日志
        Case "Chhs_Lsz"                              '流水帐
            '判断用户是否有此功能执行权限,如有则写上机日志(进入)
            If Not Security_Log("Chhs_Lsz", Xtczybm, 1) Then
                Exit Sub
            End If
            Zbfx_InOut.Show
            Zbfx_InOutCond.Show 1
            Security_Log "Chhs_Lsz", Xtczybm, 2, False  '用户退出时写上机日志
        
        
        '统计分析
        Case "Chhs_InbillSum"                        '入库单汇总表
            '判断用户是否有此功能执行权限,如有则写上机日志(进入)
            If Not Security_Log("Chhs_InbillSum", Xtczybm, 1) Then
                Exit Sub
            End If
            Tjfx_InBillSum.Show
            Tjfx_InBillSumCond.Show 1
            Security_Log "Chhs_InbillSum", Xtczybm, 2, False  '用户退出时写上机日志
        Case "Chhs_OutBillSum"                       '出库单汇总表
             '判断用户是否有此功能执行权限,如有则写上机日志(进入)
            If Not Security_Log("Chhs_OutBillSum", Xtczybm, 1) Then
                Exit Sub
            End If
            Tjfx_OutBillSum.Show
            Tjfx_OutBillSumCond.Show 1
            Security_Log "Chhs_OutBillSum", Xtczybm, 2, False  '用户退出时写上机日志
        Case "Chhs_Sfchz"                            '收发存汇总表
            '判断用户是否有此功能执行权限,如有则写上机日志(进入)
            If Not Security_Log("Chhs_Sfchz", Xtczybm, 1) Then
                Exit Sub
            End If
            Tjfx_Sfchz.Show
            Tjfx_SfchzCond.Show 1
            Security_Log "Chhs_Sfchz", Xtczybm, 2, False  '用户退出时写上机日志
        Case "Chhs_InOutClassSum"                    '收发类别汇总表
            '判断用户是否有此功能执行权限,如有则写上机日志(进入)
            If Not Security_Log("Chhs_InOutClassSum", Xtczybm, 1) Then
                Exit Sub
            End If
            Tjfx_InOutClassSum.Show
            Tjfx_InOutClassSumCond.Show 1
            Security_Log "Chhs_InOutClassSum", Xtczybm, 2, False  '用户退出时写上机日志
        Case "Chhs_Cyft"                             '差异分摊
            '判断用户是否有此功能执行权限,如有则写上机日志(进入)
            If Not Security_Log("Chhs_Cyft", Xtczybm, 1) Then
                Exit Sub
            End If
            If Qmclcy Then
                Tjfx_Diff.Show
                Tjfx_DiffCond.Show 1
                Security_Log "Chhs_Cyft", Xtczybm, 2, False  '用户退出时写上机日志
            Else
                Tsxx = "系统期末不处理差异!"
                Call Xtxxts(Tsxx, 0, 4)
            End If
        Case "Chhs_Abcfl"                            'Abc分类
            '判断用户是否有此功能执行权限,如有则写上机日志(进入)
            If Not Security_Log("Chhs_Abcfl", Xtczybm, 1) Then
                Exit Sub
            End If
            Tjfx_AbcFx.Show
            Tjfx_AbcFxCond.Show 1
            Security_Log "Chhs_Abcfl", Xtczybm, 2, False  '用户退出时写上机日志
        Case "Chhs_EvalFx"                           '暂估成本分析
            '判断用户是否有此功能执行权限,如有则写上机日志(进入)
            If Not Security_Log("Chhs_EvalFx", Xtczybm, 1) Then
                Exit Sub
            End If
            If Xtclzg Then
                Tjfx_EvalFx.Show
                Tjfx_EvalFxCond.Show 1
                Security_Log "Chhs_EvalFx", Xtczybm, 2, False  '用户退出时写上机日志
            Else
                Tsxx = "系统不处理暂估!"
                Call Xtxxts(Tsxx, 0, 4)
            End If
        Case "Chhs_InCbfx"                           '入库成本分析
            '判断用户是否有此功能执行权限,如有则写上机日志(进入)
            If Not Security_Log("Chhs_InCbfx", Xtczybm, 1) Then
                Exit Sub
            End If
            Tjfx_IncbFx.Show
            Tjfx_IncbFxCond.Show 1
            Security_Log "Chhs_InCbfx", Xtczybm, 2, False  '用户退出时写上机日志
        Case "Chhs_gnbmkmrl"
            XT_kjrlFrm.Show 1
            
        Case "Chhs_gnbmjsq"
            Shell App.Path & "\calc.exe", vbNormalFocus
            
        Case "Chhs_xtbz"
            Call F1bz
            
        Case "Chhs_gy"
            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