VB开发的ERP系统

            Security_Log "Rs_Set_ArItems", Xtczybm, 2, False
        Case "Rs_Set_HlpSort"                   '帮助类别设置
            If Not Security_Log("Rs_Set_HlpSort", Xtczybm, 1, True) Then
                Exit Sub
            End If
            Set_HlpSortFrm.HelpContextID = 211200201
            Set_HlpSortFrm.Show 1
            Security_Log "Rs_Set_HlpSort", Xtczybm, 2, False
        Case "Rs_Set_HlpList"                   '帮助明细设置
            If Not Security_Log("Rs_Set_HlpList", Xtczybm, 1, True) Then
                Exit Sub
            End If
            Set_HlpListFrm.HelpContextID = 211200202
            Set_HlpListFrm.Show 1
            Security_Log "Rs_Set_HlpList", Xtczybm, 2, False
        Case "Rs_Set_Qrt"                       '定员设置
            If Not Security_Log("Rs_Set_Qrt", Xtczybm, 1, True) Then
                Exit Sub
            End If
            Set_QrtFrm.HelpContextID = 2112003
            Set_QrtFrm.Show 1
            Security_Log "Rs_Set_Qrt", Xtczybm, 2, False
            
        Case "Rs_PmItem"                          '外部接口
            If Not Security_Log("Rs_PmItem", Xtczybm, 1, True) Then
                Exit Sub
            End If
            Set_PmItemFrm.HelpContextID = 2112004
            Set_PmItemFrm.Show 1
            
'        '日常处理
        Case "Rs_Ed_EmpArInfo"                     '个人档案维护
            If Not Security_Log("Rs_Ed_EmpArInfo", Xtczybm, 1, True) Then
                Exit Sub
            End If
            AddExit_TF = True
            Ed_EmpArInfoFrm.FormOwner = "Self"
            Ed_EmpArInfoFrm.SysOwner = 0
            Ed_EmpArInfoFrm.HelpContextID = 2113001
            Ed_EmpArInfoFrm.Show 1
            Security_Log "Rs_Ed_EmpArInfo", Xtczybm, 2, False
        Case "Rs_Ed_EmpCorAr"                      '相关档案维护
            If Not Security_Log("Rs_Ed_EmpCorAr", Xtczybm, 1, True) Then
                Exit Sub
            End If
            Ed_EmpCorArFrm.int_if = 1
            Ed_EmpCorArFrm.HelpContextID = 2113002
            Ed_EmpCorArFrm.Show 1
            Security_Log "Rs_Ed_EmpCorAr", Xtczybm, 2, False
        Case "Rs_Ed_EmpChg"                        '人事变动处理
            If Not Security_Log("Rs_Ed_EmpChg", Xtczybm, 1, True) Then
                Exit Sub
            End If
            Xtcdcs = "1"
            Ed_EmpChgFrm.HelpContextID = 2113003
            Ed_EmpChgFrm.Show 1
            Security_Log "Rs_Ed_EmpChg", Xtczybm, 2, False
        '信息查询
        Case "Rs_Qr_RsBasic"                       '人事信息查询
            If Not Security_Log("Rs_Qr_RsBasic", Xtczybm, 1, True) Then
                Exit Sub
            End If
            Qr_RsBasicFrm.HelpContextID = 2114001
            Qr_RsBasicFrm.Show
            Qr_RsBscCndFrm.Show 1
        Case "Rs_Qr_RsAr"                          '相关档案查询
            If Not Security_Log("Rs_Qr_RsAr", Xtczybm, 1, True) Then
                Exit Sub
            End If
            Qr_RsArFrm.HelpContextID = 2114002
            Qr_RsArFrm.Show
            Qr_RsArCndFrm.Show 1
        Case "Rs_Qr_RsChange"                      '人事变动查询
            If Not Security_Log("Rs_Qr_RsChange", Xtczybm, 1, True) Then
                Exit Sub
            End If
            Qr_RsChgFrm.HelpContextID = 2114003
            Qr_RsChgFrm.Show
            Qr_RsChgCndFrm.Show 1
        Case "Rs_Qr_RsQrt"                         '定员情况查询
            If Not Security_Log("Rs_Qr_RsQrt", Xtczybm, 1, True) Then
                Exit Sub
            End If
            Qr_RsQrtFrm.HelpContextID = 2114004
            Qr_RsQrtFrm.Show
            Qr_RsQrtCndFrm.Show 1
            
        '统计分析
        Case "Rs_An_RsRelation"                    '相关分析
            If Not Security_Log("Rs_An_RsRelation", Xtczybm, 1, True) Then
                Exit Sub
            End If
            An_RsRelationFrm.HelpContextID = 2115001
            An_RsRelationFrm.Show
            An_RsRelationCndFrm.Show 1
        Case "Rs_An_RsAge"                         '年龄分析
            If Not Security_Log("Rs_An_RsAge", Xtczybm, 1, True) Then
                Exit Sub
            End If
            An_RsAgeFrm.HelpContextID = 2115002
            An_RsAgeFrm.Show
            An_RsAgeFrmQuery.Show 1
        Case "Rs_An_RsAgeLong"                     '年资分析
            If Not Security_Log("Rs_An_RsAgeLong", Xtczybm, 1, True) Then
                Exit Sub
            End If
            An_RsAgeLongFrm.HelpContextID = 2115003
            An_RsAgeLongFrm.Show
            An_RsAgeLongFrmQuery.Show 1
            
            
        '工具
        Case "Rs_Cal"                        '计算器
            Shell App.Path & "\calc.exe", vbNormalFocus
'        Case "Rs_kmrl"                        '日历
'            XT_kjrlFrm.Show 1
        '帮助
        Case "Rs_Comment"                           '系统帮助
            Call F1bz
'        Case "Rs_HxxdOnline"                        '网上新达
'            Shell ("explorer http://www.hxxd.com"), vbNormalFocus

        Case "Rs_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