企业管理

开发平台：
Visual Basic

：源码内容
							VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX"
Begin VB.Form Xt_Control 
   Caption         =   "桌面"
   ClientHeight    =   5850
   ClientLeft      =   60
   ClientTop       =   1665
   ClientWidth     =   9240
   Icon            =   "系统_主操作桌面.frx":0000
   LinkTopic       =   "Form1"
   MDIChild        =   -1  'True
   ScaleHeight     =   5850
   ScaleWidth      =   9240
   WindowState     =   2  'Maximized
   Begin VB.PictureBox picTitles 
      Align           =   1  'Align Top
      Appearance      =   0  'Flat
      BorderStyle     =   0  'None
      ForeColor       =   &H80000008&
      Height          =   300
      Left            =   0
      ScaleHeight     =   300
      ScaleWidth      =   9240
      TabIndex        =   2
      TabStop         =   0   'False
      Top             =   420
      Width           =   9240
      Begin VB.Label lblTitle 
         BorderStyle     =   1  'Fixed Single
         Caption         =   " 列表视图:"
         Height          =   270
         Index           =   1
         Left            =   2078
         TabIndex        =   4
         Tag             =   " 列表视图:"
         Top             =   12
         Width           =   3216
      End
      Begin VB.Label lblTitle 
         BorderStyle     =   1  'Fixed Single
         Caption         =   "百利/ERP5.0"
         Height          =   270
         Index           =   0
         Left            =   0
         TabIndex        =   3
         Tag             =   " 树形视图:"
         Top             =   12
         Width           =   2016
      End
   End
   Begin VB.PictureBox picSplitter 
      BackColor       =   &H00808080&
      BorderStyle     =   0  'None
      FillColor       =   &H00808080&
      Height          =   4800
      Left            =   4740
      ScaleHeight     =   2090.126
      ScaleMode       =   0  'User
      ScaleWidth      =   780
      TabIndex        =   0
      Top             =   780
      Visible         =   0   'False
      Width           =   72
   End
   Begin MSComctlLib.ImageList ImageList1 
      Left            =   5220
      Top             =   2340
      _ExtentX        =   1005
      _ExtentY        =   1005
      BackColor       =   -2147483643
      ImageWidth      =   16
      ImageHeight     =   16
      MaskColor       =   12632256
      _Version        =   393216
      BeginProperty Images {2C247F25-8591-11D1-B16A-00C0F0283628} 
         NumListImages   =   8
         BeginProperty ListImage1 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "系统_主操作桌面.frx":1042
            Key             =   "stb"
         EndProperty
         BeginProperty ListImage2 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "系统_主操作桌面.frx":2094
            Key             =   "xttb"
         EndProperty
         BeginProperty ListImage3 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "系统_主操作桌面.frx":30E6
            Key             =   "szk"
         EndProperty
         BeginProperty ListImage4 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "系统_主操作桌面.frx":3480
            Key             =   "gnqx1"
         EndProperty
         BeginProperty ListImage5 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "系统_主操作桌面.frx":38D2
            Key             =   "kpgl"
         EndProperty
         BeginProperty ListImage6 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "系统_主操作桌面.frx":41AC
            Key             =   "kftb"
         EndProperty
         BeginProperty ListImage7 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "系统_主操作桌面.frx":51FE
            Key             =   "gnqx"
         EndProperty
         BeginProperty ListImage8 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "系统_主操作桌面.frx":5598
            Key             =   "chhs"
         EndProperty
      EndProperty
   End
   Begin MSComctlLib.ListView lvListView 
      Height          =   3375
      Left            =   2160
      TabIndex        =   1
      Top             =   705
      Width           =   2295
      _ExtentX        =   4048
      _ExtentY        =   5953
      Arrange         =   2
      LabelEdit       =   1
      LabelWrap       =   -1  'True
      HideSelection   =   -1  'True
      OLEDragMode     =   1
      OLEDropMode     =   1
      PictureAlignment=   1
      _Version        =   393217
      Icons           =   "ImageList2"
      SmallIcons      =   "ImageList1"
      ColHdrIcons     =   "ImageList1"
      ForeColor       =   -2147483640
      BackColor       =   -2147483643
      BorderStyle     =   1
      Appearance      =   1
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "宋体"
         Size            =   9
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      OLEDragMode     =   1
      OLEDropMode     =   1
      NumItems        =   0
   End
   Begin MSComDlg.CommonDialog dlgCommonDialog 
      Left            =   3360
      Top             =   2160
      _ExtentX        =   847
      _ExtentY        =   847
      _Version        =   393216
   End
   Begin MSComctlLib.TreeView tvTreeView 
      Height          =   4800
      Left            =   0
      TabIndex        =   5
      Top             =   705
      Width           =   2010
      _ExtentX        =   3545
      _ExtentY        =   8467
      _Version        =   393217
      Indentation     =   564
      Style           =   7
      ImageList       =   "ImageList1"
      Appearance      =   1
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "宋体"
         Size            =   9
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
   End
   Begin MSComctlLib.Toolbar tbToolBar 
      Align           =   1  'Align Top
      Height          =   420
      Left            =   0
      TabIndex        =   6
      Top             =   0
      Width           =   9240
      _ExtentX        =   16298
      _ExtentY        =   741
      ButtonWidth     =   609
      ButtonHeight    =   582
      AllowCustomize  =   0   'False
      Appearance      =   1
      ImageList       =   "imlToolbarIcons"
      _Version        =   393216
      BeginProperty Buttons {66833FE8-8583-11D1-B16A-00C0F0283628} 
         NumButtons      =   10
         BeginProperty Button1 {66833FEA-8583-11D1-B16A-00C0F0283628} 
            Style           =   3
         EndProperty
         BeginProperty Button2 {66833FEA-8583-11D1-B16A-00C0F0283628} 
            Key             =   "返回"
            Object.ToolTipText     =   "返回"
            ImageKey        =   "xq"
         EndProperty
         BeginProperty Button3 {66833FEA-8583-11D1-B16A-00C0F0283628} 
            Key             =   "向前"
            Object.ToolTipText     =   "向前"
            ImageKey        =   "xh"
         EndProperty
         BeginProperty Button4 {66833FEA-8583-11D1-B16A-00C0F0283628} 
            Style           =   3
         EndProperty
         BeginProperty Button5 {66833FEA-8583-11D1-B16A-00C0F0283628} 
            Style           =   3
         EndProperty
         BeginProperty Button6 {66833FEA-8583-11D1-B16A-00C0F0283628} 
            Style           =   3
         EndProperty
         BeginProperty Button7 {66833FEA-8583-11D1-B16A-00C0F0283628} 
            Key             =   "大图标"
            Object.ToolTipText     =   "大图标"
            ImageKey        =   "dtb"
            Style           =   2
            Value           =   1
         EndProperty
         BeginProperty Button8 {66833FEA-8583-11D1-B16A-00C0F0283628} 
            Key             =   "小图标"
            Object.ToolTipText     =   "小图标"
            ImageKey        =   "xtb"
            Style           =   2
         EndProperty
         BeginProperty Button9 {66833FEA-8583-11D1-B16A-00C0F0283628} 
            Key             =   "列表"
            Object.ToolTipText     =   "列表"
            ImageKey        =   "lb"
            Style           =   2
         EndProperty
         BeginProperty Button10 {66833FEA-8583-11D1-B16A-00C0F0283628} 
            Key             =   "详细资料"
            Object.ToolTipText     =   "详细资料"
            ImageKey        =   "xxzl"
            Style           =   2
         EndProperty
      EndProperty
   End
   Begin MSComctlLib.ImageList imlToolbarIcons 
      Left            =   5220
      Top             =   930
      _ExtentX        =   1005
      _ExtentY        =   1005
      BackColor       =   -2147483643
      ImageWidth      =   16
      ImageHeight     =   16
      MaskColor       =   12632256
      _Version        =   393216
      BeginProperty Images {2C247F25-8591-11D1-B16A-00C0F0283628} 
         NumListImages   =   6
         BeginProperty ListImage1 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "系统_主操作桌面.frx":65EA
            Key             =   "xq"
         EndProperty
         BeginProperty ListImage2 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "系统_主操作桌面.frx":6984
            Key             =   "xh"
         EndProperty
         BeginProperty ListImage3 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "系统_主操作桌面.frx":6D1E
            Key             =   "dtb"
         EndProperty
         BeginProperty ListImage4 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "系统_主操作桌面.frx":70B8
            Key             =   "xtb"
         EndProperty
         BeginProperty ListImage5 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "系统_主操作桌面.frx":7452
            Key             =   "lb"
         EndProperty
         BeginProperty ListImage6 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "系统_主操作桌面.frx":77EC
            Key             =   "xxzl"
         EndProperty
      EndProperty
   End
   Begin MSComctlLib.ImageList ImageList2 
      Left            =   6750
      Top             =   2940
      _ExtentX        =   1005
      _ExtentY        =   1005
      BackColor       =   -2147483643
      ImageWidth      =   32
      ImageHeight     =   32
      MaskColor       =   12632256
      _Version        =   393216
      BeginProperty Images {2C247F25-8591-11D1-B16A-00C0F0283628} 
         NumListImages   =   4
         BeginProperty ListImage1 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "系统_主操作桌面.frx":7B86
            Key             =   "y1"
         EndProperty
         BeginProperty ListImage2 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "系统_主操作桌面.frx":7FDA
            Key             =   ""
         EndProperty
         BeginProperty ListImage3 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "系统_主操作桌面.frx":82FA
            Key             =   "i"
         EndProperty
         BeginProperty ListImage4 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "系统_主操作桌面.frx":934C
            Key             =   "y"
         EndProperty
      EndProperty
   End
   Begin VB.Image imgSplitter 
      Height          =   4785
      Left            =   4230
      MousePointer    =   9  'Size W E
      Top             =   750
      Width           =   150
   End
End
Attribute VB_Name = "Xt_Control"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'***********************************************
'*    模 块 名 称 :系统主操作桌面
'*    功 能 描 述 :
'*    程序员姓名  :白凤英
'*    最后修改人  :白凤英
'*    最后修改时间:2001/12/21
'*    备        注:
'***********************************************
Const NAME_COLUMN = 0
Const TYPE_COLUMN = 1
Const SIZE_COLUMN = 2
Const DATE_COLUMN = 3
Private Declare Function OSWinHelp% Lib "user32" Alias "WinHelpA" (ByVal hwnd&, ByVal HelpFile$, ByVal wCommand%, dwData As Any)
  
Dim sjgnbmStr As String                      '上级编码
Dim mbMoving As Boolean
Const sglSplitLimit = 1000
Dim nodX As Node
Dim mitem As ListItem
Dim Ztxxrec As New ADODB.Recordset           '帐套信息动态集
Dim Xtgnbrec As New ADODB.Recordset          '系统功能表
Dim Xtqxxzrec As New ADODB.Recordset         '系统权限限制动态集
Dim Tsxx As String                           '系统提示信息
Dim gnsyte As String                         '系统功能项索引
Dim Xtrlrec As New ADODB.Recordset           '系统日历动态集
Dim Ctsfscdr As Boolean                      '窗体是否首次读入
Private Sub lvListView_DblClick()            '点击ListView执行相应功能
    If lvListView.ListItems.count > 0 Then
        Set Xtgnbrec = Cw_DataEnvi.DataConnect.Execute("SELECT * FROM xt_xtgnb where gnbm='" + Mid(Trim(lvListView.SelectedItem.Key), 2, Len(Trim(lvListView.SelectedItem.Key)) - 1) + "'")
        If Not Xtgnbrec.EOF Then
            If Xtgnbrec.Fields("mjbz") = True Then
                gnsyte = Trim(Xtgnbrec.Fields("gnsy"))
                Call Zxxymk(gnsyte)
            Else
                '---------------
                Dim Ssql As String
                sjgnbmStr = ""
                lvListView.ColumnHeaders.Clear
                lvListView.ListItems.Clear
                Ssql = "SELECT * FROM xt_xtgnb where sjgnbm='" + Xtgnbrec.Fields("gnbm") + "' and MenuList=1 order by gnbm"
                Set Xtgnbrec = Cw_DataEnvi.DataConnect.Execute(Ssql)
                lvListView.ColumnHeaders.Add 1, "rcsw", tvTreeView.SelectedItem.Text, 3000, , "stb"
                Do While Not Xtgnbrec.EOF
                    Set mitem = lvListView.ListItems.Add()
                    mitem.Text = Trim(Xtgnbrec!gnmc)
                    If Xtgnbrec.Fields("mjbz") Then
                        mitem.SmallIcon = "gnqx"
                        mitem.Icon = "y"
                    Else
                        mitem.Icon = "i"
                        mitem.SmallIcon = "stb"
                    End If
                    mitem.Key = "T" & Trim(Xtgnbrec!gnbm)
                    Xtgnbrec.MoveNext
                Loop
                '---------------
            End If
        End If
    End If
End Sub
Private Sub lvListView_KeyPress(KeyAscii As Integer)
    If KeyAscii = vbKeyReturn Then
        Call lvListView_DblClick
    End If
End Sub
Private Sub tvTreeView_NodeClick(ByVal Node As MSComctlLib.Node)
    Dim Ssql As String
    If Node.Tag <> "" Then
        If Node.Tag = False Then
            Ssql = "SELECT * FROM xt_xtgnb where sjgnbm='" + Mid(Trim(tvTreeView.SelectedItem.Key), 2, Len(Trim(tvTreeView.SelectedItem.Key)) - 1) + "' and MenuList=1 order by gnbm"
            If sjgnbmStr = Mid(Trim(tvTreeView.SelectedItem.Key), 2, Len(Trim(tvTreeView.SelectedItem.Key)) - 1) Then
                Exit Sub
            Else
                sjgnbmStr = Mid(Trim(tvTreeView.SelectedItem.Key), 2, Len(Trim(tvTreeView.SelectedItem.Key)) - 1)
            End If
        Else
            Ssql = "SELECT * FROM xt_xtgnb a," _
                    & "(SELECT sjgnbm FROM xt_xtgnb where gnbm='" + Mid(Trim(tvTreeView.SelectedItem.Key), 2, Len(Trim(tvTreeView.SelectedItem.Key)) - 1) + "')b" & " where a.sjgnbm=b.sjgnbm and MenuList=1 order by gnbm"
        End If
        
        Set Xtgnbrec = Cw_DataEnvi.DataConnect.Execute(Ssql)
        If Node.Tag = True Then
            If sjgnbmStr = Trim(Xtgnbrec!sjgnbm) Then
                Exit Sub
            Else
                sjgnbmStr = Trim(Xtgnbrec!sjgnbm)
            End If
        End If
        lvListView.ColumnHeaders.Clear
        lvListView.ListItems.Clear
        lvListView.ColumnHeaders.Add 1, "rcsw", "明细", 3000, , "stb"
        Do While Not Xtgnbrec.EOF
            Set mitem = lvListView.ListItems.Add()
            mitem.Text = Trim(Xtgnbrec!gnmc)
            If Xtgnbrec.Fields("mjbz") Then
                mitem.SmallIcon = "gnqx"
                mitem.Icon = "y"
            Else
                mitem.Icon = "i"
                mitem.SmallIcon = "stb"
            End If
            mitem.Key = "T" & Trim(Xtgnbrec!gnbm)
            Xtgnbrec.MoveNext
        Loop
    End If
End Sub
Public Sub Cshgns()                                                    '初始化系统功能树
  
    Set Xtgnbrec = Cw_DataEnvi.DataConnect.Execute("SELECT * FROM xt_xtgnb where gnbm like '13%' and MenuList=1 order by gnbm")
    tvTreeView.Nodes.Add , 4, "T", "百利/ERP5.0", "xttb"
    With Xtgnbrec
        Do While Not .EOF
            If .Fields("mjbz") Then
                Set nodX = tvTreeView.Nodes.Add("T" + Trim(.Fields("sjgnbm")), 4, "T" + Trim(.Fields("gnbm")), Trim(.Fields("gnmc")), "gnqx")
            Else
                If Trim(.Fields("sjgnbm")) = "" Then
                    Set nodX = tvTreeView.Nodes.Add("T" + Trim(.Fields("sjgnbm")), 4, "T" + Trim(.Fields("gnbm")), Trim(.Fields("gnmc")), "chhs")
                Else
                    Set nodX = tvTreeView.Nodes.Add("T" + Trim(.Fields("sjgnbm")), 4, "T" + Trim(.Fields("gnbm")), Trim(.Fields("gnmc")), "stb")
                End If
            End If
            nodX.Tag = Xtgnbrec!mjbz
            If Len(Trim(.Fields("sjgnbm"))) <= 2 Then
                nodX.EnsureVisible
            End If
            .MoveNext
        Loop
    End With
End Sub
'系统功能树操作
Private Sub tvTreeView_BeforeLabelEdit(Cancel As Integer)                     '屏蔽编辑
  Cancel = 1
End Sub
Private Sub tvTreeView_Collapse(ByVal Node As MSComctlLib.Node)               '功能树收缩
    
    If Node.Index <> 1 And Node.Key <> "T13" Then
        Node.Image = "stb"
    End If
 
End Sub
Private Sub tvTreeView_Expand(ByVal Node As MSComctlLib.Node)                 '功能树展开
    
    If Node.Index <> 1 And Node.Key <> "T13" Then
        Node.Image = "szk"
    End If
End Sub
Private Sub tvTreeView_KeyPress(KeyAscii As Integer)                          '用户按回车键执行相应功能
    
    If KeyAscii = vbKeyReturn Then
        Call tvTreeView_DblClick
    End If
End Sub
Private Sub tvTreeView_DblClick()                                             '选择功能
    If tvTreeView.SelectedItem.Children = 0 Then
        Set Xtgnbrec = Cw_DataEnvi.DataConnect.Execute("SELECT * FROM xt_xtgnb where gnbm='" + Mid(Trim(tvTreeView.SelectedItem.Key), 2, Len(Trim(tvTreeView.SelectedItem.Key)) - 1) + "'")
        If Not Xtgnbrec.EOF Then
            gnsyte = Trim(Xtgnbrec.Fields("gnsy"))
            Call Zxxymk(gnsyte)
        End If
    End If
End Sub
Public Sub Zxxymk(gnsy As String)                                            '根据用户选择执行相应程序
  
    Dim Rectemp As New ADODB.Recordset     '临时使用动态集
    Dim SqlStr As String                   '临时查询字符串
  
    If Len(Trim(gnsy)) = 0 Then
        Exit Sub
    End If
    
    On Error GoTo Cwcl:
    Select Case gnsy
        
        '基础设置
        Case "Chhs_Ywfw"                        '业务范围
            Jcsz_Ywfw.Show 1
        Case "Chhs_Macc"                        '存货科目
            Jcsz_Macc.Show 1
        Case "Chhs_Dfacc"                       '对方科目
            Jcsz_Dfacc.Show 1
        Case "Chhs_EvalCond"                    '暂估存货设置
            If Xtclzg Then
                Jcsz_InterimMaterial.Show 1
            Else
                Tsxx = "系统不处理暂估!"
                Call Xtxxts(Tsxx, 0, 4)
            End If
        Case "Chhs_StartBill"                   '期初单据录入
            
            '判断用户是否有此功能执行权限,如有则写上机日志(进入)
            If Not Security_Log("Chhs_StartBillEdit", Xtczybm, 1) Then
                Exit Sub
            End If
            
            If Xtyear <> PGKjYear() Then
                Tsxx = "操作日期不在当前会计年度(" + Trim(Str(PGKjYear)) + "),请重新登录!"
                Call Xtxxts(Tsxx, 0, 1)
                Exit Sub
            End If
            
            Set Rectemp = Cw_DataEnvi.DataConnect.Execute("select * from gy_kjrlb where beginflag=1")
            If Rectemp.Fields("chhsjzbz") Then
                Tsxx = "期初月份已结帐,不允许期初单据录入!"
                Call Xtxxts(Tsxx, 0, 1)
                Exit Sub
            End If
            
            Set Rectemp = Cw_DataEnvi.DataConnect.Execute("select Gy_WareHouse.whcode from Gy_WareHouse left outer join Gy_Whlimit on Gy_WareHouse.whcode=Gy_Whlimit.whcode where Gy_Whlimit.czybm='" & Xtczybm & "'")
            If Rectemp.EOF Then
                Tsxx = "没有进行仓库设置!"
                Call Xtxxts(Tsxx, 0, 4)
                Exit Sub
            Else
                Set Rectemp = Cw_DataEnvi.DataConnect.Execute("select Gy_WareHouse.whcode from Gy_WareHouse left outer join Gy_Whlimit on Gy_WareHouse.whcode=Gy_Whlimit.whcode where Gy_Whlimit.czybm='" & Xtczybm & "' and Gy_WareHouse.EndDealFlagChhs=0")
                If Rectemp.EOF Then
                    Tsxx = "仓库已全部期末处理,不允许期初单据录入!"
                    Call Xtxxts(Tsxx, 0, 4)
                    Exit Sub
                End If
            End If
            Set Rectemp = Nothing
            
            Xtcdcs = "1"
            Start_BillInput.Show 1
            Security_Log "Chhs_StartBillEdit", Xtczybm, 2, False  '用户退出时写上机日志
        Case "Chhs_StartBillList"               '期初单据列表
            '判断用户是否有此功能执行权限,如有则写上机日志(进入)
            If Not Security_Log("Chhs_StartBillList", Xtczybm, 1) Then
                Exit Sub
            End If
            Start_BillInputList.Show
            Start_BillListCond.Show 1
            Security_Log "Chhs_StartBillList", Xtczybm, 2, False  '用户退出时写上机日志
        Case "Chhs_Qcjz"                        '期初单据记帐
            
            '判断用户是否有此功能执行权限,如有则写上机日志(进入)
            If Not Security_Log("Chhs_Qcjz", Xtczybm, 1) Then
                Exit Sub
            End If
            
            If Xtyear <> PGKjYear Then
                Tsxx = "操作日期不在当前会计年度(" + Trim(Str(PGKjYear)) + "),请重新登录!"
                Call Xtxxts(Tsxx, 0, 1)
                Exit Sub
            End If
            
            Set Rectemp = Cw_DataEnvi.DataConnect.Execute("select * from gy_kjrlb where beginflag=1")
            If Rectemp.Fields("chhsjzbz") Then
                Tsxx = "期初月份已结帐,不允许期初记帐或恢复记帐操作!"
                Call Xtxxts(Tsxx, 0, 1)
                Exit Sub
            End If
            
            Set Rectemp = Cw_DataEnvi.DataConnect.Execute("select Gy_WareHouse.whcode from Gy_WareHouse left outer join Gy_Whlimit on Gy_WareHouse.whcode=Gy_Whlimit.whcode where Gy_Whlimit.czybm='" & Xtczybm & "' ")
            If Rectemp.EOF Then
                Tsxx = "没有进行仓库设置!"
                Call Xtxxts(Tsxx, 0, 4)
                Exit Sub
            Else
                Set Rectemp = Cw_DataEnvi.DataConnect.Execute("select Gy_WareHouse.whcode from Gy_WareHouse left outer join Gy_Whlimit on Gy_WareHouse.whcode=Gy_Whlimit.whcode where Gy_Whlimit.czybm='" & Xtczybm & "' and Gy_WareHouse.EndDealFlagChhs=0")
                If Rectemp.EOF Then
                    Tsxx = "仓库已全部期末处理,不允许进行记帐或恢复记帐操作!"
                    Call Xtxxts(Tsxx, 0, 4)
                    Exit Sub
                End If
            End If
            Set Rectemp = Nothing
            
            Start_BillChalkitup.Show
            Start_BillChalkitupCond.Show 1
            Security_Log gnsy, Xtczybm, 2, False  '用户退出时写上机日志
        
        
        '日常单据
        Case "Chhs_MateBill"                        '材料入库单
            '判断用户是否有此功能执行权限,如有则写上机日志(进入)
            If Not Security_Log("Chhs_MateInEdit", Xtczybm, 1) Then
                Exit Sub
            End If
            
            If ClrkdKfsc Then
                If Not Sub_Records(Xtrq, "Chhs_V_MateInBill") Then
                    Tsxx = CStr(Format(Xtrq, "yyyy-mm-dd")) + " 无单据!"
                    Call Xtxxts(Tsxx, 0, 4)
                Else
                    Xtcdcs = "1"
                    DJ_MateInBill.Show 1
                    Security_Log "Chhs_MateInEdit", Xtczybm, 2, False  '用户退出时写上机日志
                End If
            Else
                Xtcdcs = "1"
                DJ_MateInBill.Show 1
                Security_Log "Chhs_MateInEdit", Xtczybm, 2, False  '用户退出时写上机日志
            End If
        Case "Chhs_ProdInBill"                      '产品入库单
            '判断用户是否有此功能执行权限,如有则写上机日志(进入)
            If Not Security_Log("Chhs_ProdInEdit", Xtczybm, 1) Then
                Exit Sub
            End If
            
            If Xt_XtJc Then
                If Not Sub_Records(Xtrq, "chhs_V_ProductInBill") Then
                    Tsxx = CStr(Format(Xtrq, "yyyy-mm-dd")) + " 无单据!"
                    Call Xtxxts(Tsxx, 0, 4)
                Else
                    Xtcdcs = "1"
                    DJ_ProdInBill.Show 1
                    Security_Log "Chhs_ProdInEdit", Xtczybm, 2, False  '用户退出时写上机日志
                End If
            Else
                Xtcdcs = "1"
                DJ_ProdInBill.Show 1
                Security_Log "Chhs_ProdInEdit", Xtczybm, 2, False  '用户退出时写上机日志
            End If
        Case "Chhs_OtherInBill"                     '其它入库单
            '判断用户是否有此功能执行权限,如有则写上机日志(进入)
            If Not Security_Log("Chhs_OtherInEdit", Xtczybm, 1) Then
                Exit Sub
            End If
            If Xt_XtJc Then
                If Not Sub_Records(Xtrq, "Chhs_V_OtherInBill") Then
                    Tsxx = CStr(Format(Xtrq, "yyyy-mm-dd")) + " 无单据!"
                    Call Xtxxts(Tsxx, 0, 4)
                Else
                    Xtcdcs = "1"
                    DJ_OtherInBill.Show 1
                    Security_Log "Chhs_OtherInEdit", Xtczybm, 2, False  '用户退出时写上机日志
                End If
            Else
                Xtcdcs = "1"
                DJ_OtherInBill.Show 1
                Security_Log "Chhs_OtherInEdit", Xtczybm, 2, False  '用户退出时写上机日志
            End If
        Case "Chhs_MateOutBill"                     '材料出库单
            '判断用户是否有此功能执行权限,如有则写上机日志(进入)
            If Not Security_Log("Chhs_MateOutEdit", Xtczybm, 1) Then
                Exit Sub
            End If
            
            If Xt_XtJc Then
                If Not Sub_Records(Xtrq, "Chhs_V_MateOutBill") Then
                    Tsxx = CStr(Format(Xtrq, "yyyy-mm-dd")) + " 无单据!"
                    Call Xtxxts(Tsxx, 0, 4)
                Else
                    Xtcdcs = "1"
                    DJ_MateOutBill.Show 1
                    Security_Log "Chhs_MateOutEdit", Xtczybm, 2, False  '用户退出时写上机日志
                End If
            Else
                Xtcdcs = "1"
                DJ_MateOutBill.Show 1
                Security_Log "Chhs_MateOutEdit", Xtczybm, 2, False  '用户退出时写上机日志
            End If
        Case "Chhs_SellOutBill"                     '销售出库单
            '判断用户是否有此功能执行权限,如有则写上机日志(进入)
            If Not Security_Log("Chhs_SellOutEdit", Xtczybm, 1) Then
                Exit Sub
            End If
            
            If Xt_XtJc Then
               If Not Sub_Records(Xtrq, "Chhs_V_SellOutBill") Then
                   Tsxx = CStr(Format(Xtrq, "yyyy-mm-dd")) + " 无单据!"
                   Call Xtxxts(Tsxx, 0, 4)
               Else
                   Xtcdcs = "1"
                   DJ_SellOutBill.Show 1
                   Security_Log "Chhs_SellOutEdit", Xtczybm, 2, False  '用户退出时写上机日志
               End If
            Else
               Xtcdcs = "1"
               DJ_SellOutBill.Show 1
               Security_Log "Chhs_SellOutEdit", Xtczybm, 2, False  '用户退出时写上机日志
            End If
        Case "Chhs_OtherOutBill"                    '其它出库单
            '判断用户是否有此功能执行权限,如有则写上机日志(进入)
            If Not Security_Log("Chhs_OtherOutEdit", Xtczybm, 1) Then
                Exit Sub
            End If
            If Xt_XtJc Then
                If Not Sub_Records(Xtrq, "Chhs_V_OtherOutBill") Then
                    Tsxx = CStr(Format(Xtrq, "yyyy-mm-dd")) + " 无单据!"
                    Call Xtxxts(Tsxx, 0, 4)
                Else
                    Xtcdcs = "1"
                    DJ_OtherOutBill.Show 1
                    Security_Log "Chhs_OtherOutEdit", Xtczybm, 2, False  '用户退出时写上机日志
                End If
            Else
                Xtcdcs = "1"
                DJ_OtherOutBill.Show 1
                Security_Log "Chhs_OtherOutEdit", Xtczybm, 2, False  '用户退出时写上机日志
            End If
            
            
        '单据列表
        Case "Chhs_MateInBillList"                  '材料入库单列表
            '判断用户是否有此功能执行权限,如有则写上机日志(进入)
            If Not Security_Log("Chhs_MateInBillList", Xtczybm, 1) Then
                Exit Sub
            End If
            LB_MateInBillList.Show
            LBCX_MateInBillListFind.Show 1
            Security_Log "Chhs_MateInBillList", Xtczybm, 2, False  '用户退出时写上机日志
        Case "Chhs_ProdInBillList"                  '产品入库单列表
            '判断用户是否有此功能执行权限,如有则写上机日志(进入)
            If Not Security_Log("Chhs_ProdInBillList", Xtczybm, 1) Then
                Exit Sub
            End If
            LB_ProdInBillList.Show
            LBCX_ProdInBillListFind.Show 1
            Security_Log "Chhs_ProdInBillList", Xtczybm, 2, False  '用户退出时写上机日志
        Case "Chhs_OtherInBillList"                 '其它入库单列表
            '判断用户是否有此功能执行权限,如有则写上机日志(进入)
            If Not Security_Log("Chhs_OtherInBillList", Xtczybm, 1) Then
                Exit Sub
            End If
            LB_OtherInBillList.Show
            LBCX_OtherInBillListFind.Show 1
            Security_Log "Chhs_OtherInBillList", Xtczybm, 2, False  '用户退出时写上机日志
        Case "Chhs_MateOutBillList"                 '材料出库单列表
            '判断用户是否有此功能执行权限,如有则写上机日志(进入)
            If Not Security_Log("Chhs_MateOutBillList", Xtczybm, 1) Then
                Exit Sub
            End If
            LB_MateOutBillList.Show
            LBCX_MateOutBillListFind.Show 1
            Security_Log "Chhs_MateOutBillList", Xtczybm, 2, False  '用户退出时写上机日志
        Case "Chhs_SellOutBillList"                 '销售出库单列表
            '判断用户是否有此功能执行权限,如有则写上机日志(进入)
            If Not Security_Log("Chhs_SellOutBillList", Xtczybm, 1) Then
                Exit Sub
            End If
            LB_SellOutBillList.Show
            LBCX_SellOutBillListFind.Show 1
            Security_Log "Chhs_SellOutBillList", Xtczybm, 2, False  '用户退出时写上机日志
        Case "Chhs_OtheOutBillList"                '其它出库单列表
            '判断用户是否有此功能执行权限,如有则写上机日志(进入)
            If Not Security_Log("Chhs_OtheOutBillList", Xtczybm, 1) Then
                Exit Sub
            End If
            LB_OtherOutBillList.Show
            LBCX_OtherOutBillListFind.Show 1
            Security_Log "Chhs_OtheOutBillList", Xtczybm, 2, False  '用户退出时写上机日志
        Case "Chhs_AdjustInBill"                     '入库单调整
            '判断用户是否有此功能执行权限,如有则写上机日志(进入)
            If Not Security_Log("Chhs_AdjustInEdit", Xtczybm, 1) Then
                Exit Sub
            End If
            If Xtyear <> PGKjYear Then
                Tsxx = "操作日期不在当前会计年度(" + Trim(Str(PGKjYear)) + ")之内,请重新登录!"
                Call Xtxxts(Tsxx, 0, 1)
            Else
                If Xtmm <> PGNowmon Then
                    Tsxx = "操作日期不在当前会计期间(" + Trim(Str(Xtyear)) + "." + Trim(Str(PGNowmon)) + ")之内,请重新登录!"
                    Call Xtxxts(Tsxx, 0, 1)
                Else
                    Xtcdcs = "1"
                    DJ_AdjustInbill.Show 1
                    Security_Log "Chhs_AdjustInEdit", Xtczybm, 2, False  '用户退出时写上机日志
                End If
            End If
        Case "Chhs_AdjustOutBill"                    '出库单调整
            '判断用户是否有此功能执行权限,如有则写上机日志(进入)
            If Not Security_Log("Chhs_AdjustInEdit", Xtczybm, 1) Then
                Exit Sub
            End If
            If Xtyear <> PGKjYear Then
                Tsxx = "操作日期不在当前会计年度(" + Trim(Str(PGKjYear)) + ")之内,请重新登录!"
                Call Xtxxts(Tsxx, 0, 1)
            Else
                If Xtmm <> PGNowmon Then
                    Tsxx = "操作日期不在当前会计期间(" + Trim(Str(Xtyear)) + "." + Trim(Str(PGNowmon)) + ")之内,请重新登录!"
                    Call Xtxxts(Tsxx, 0, 1)
                Else
                    Xtcdcs = "1"
                    DJ_AdjustOutBill.Show 1
                    Security_Log "Chhs_AdjustInEdit", Xtczybm, 2, False  '用户退出时写上机日志
                End If
            End If
        Case "Chhs_AdjustPlan"                       '计划价调整
            '判断用户是否有此功能执行权限,如有则写上机日志(进入)
            If Not Security_Log("Chhs_AdjustPlan", Xtczybm, 1) Then
                Exit Sub
            End If
            Xtcdcs = "1"
            DJ_AdjustPlan.Show 1
            Security_Log "Chhs_AdjustPlan", Xtczybm, 2, False  '用户退出时写上机日志
        Case "Chhs_AdjustInList"                     '入库单调整列表
            '判断用户是否有此功能执行权限,如有则写上机日志(进入)
            If Not Security_Log("Chhs_AdjustInList", Xtczybm, 1) Then
                Exit Sub
            End If
            LB_AdjustInBillList.Show
            LB_AdjustInBillCond.Show 1
            Security_Log "Chhs_AdjustInList", Xtczybm, 2, False  '用户退出时写上机日志
        Case "Chhs_AdjustOutList"                    '出库单调整列表
            '判断用户是否有此功能执行权限,如有则写上机日志(进入)
            If Not Security_Log("Chhs_AdjustOutList", Xtczybm, 1) Then
                Exit Sub
            End If
            LB_AdjustOutBillList.Show
            LB_AdjustOutBillCond.Show 1
            Security_Log "Chhs_AdjustOutList", Xtczybm, 2, False  '用户退出时写上机日志
        
        '处理
        Case "Chhs_Djjz"                             '单据记帐
            '判断用户是否有此功能执行权限,如有则写上机日志(进入)
            If Not Security_Log("Chhs_Djjz", Xtczybm, 1) Then
                Exit Sub
            End If
            If Xtyear <> PGKjYear Then
                Tsxx = "操作日期不在当前会计年度(" + Trim(Str(PGKjYear)) + ")之内,请重新登录!"
                Call Xtxxts(Tsxx, 0, 1)
            Else
                If Xtmm <> PGNowmon Then
                    Tsxx = "操作日期不在当前会计期间(" + Trim(Str(Xtyear)) + "." + Trim(Str(PGNowmon)) + ")之内,请重新登录!"
                    Call Xtxxts(Tsxx, 0, 1)
                Else
                    Set Rectemp = Cw_DataEnvi.DataConnect.Execute("select Gy_WareHouse.whcode from Gy_WareHouse left outer join Gy_Whlimit on Gy_WareHouse.whcode=Gy_Whlimit.whcode where Gy_Whlimit.czybm='" & Xtczybm & "' ")
                    If Rectemp.EOF Then
                        Tsxx = "没有进行仓库设置!"
                        Call Xtxxts(Tsxx, 0, 4)
                        Exit Sub
                    Else
                        Set Rectemp = Cw_DataEnvi.DataConnect.Execute("select Gy_WareHouse.whcode from Gy_WareHouse left outer join Gy_Whlimit on Gy_WareHouse.whcode=Gy_Whlimit.whcode where Gy_Whlimit.czybm='" & Xtczybm & "' and Gy_WareHouse.EndDealFlagChhs=0")
                        If Rectemp.EOF Then
                            Tsxx = "仓库已全部期末处理,不允许进行记帐或恢复记帐操作!"
                            Call Xtxxts(Tsxx, 0, 4)
                            Exit Sub
                        End If
                    End If
                    Set Rectemp = Nothing
                    CL_BillChalkitup.Show
                    CL_BillChalkitupCond.Show 1
                    Security_Log gnsy, Xtczybm, 2, False  '用户退出时写上机日志
                End If
            End If
        Case "Chhs_Cyl"                              '差异率列表
            '判断用户是否有此功能执行权限,如有则写上机日志(进入)
            If Not Security_Log("Chhs_Cyl", Xtczybm, 1) Then
                Exit Sub
            End If
            If Qmclcy Then
                CL_Discrepancy.Show
                CL_DiscrepancyFind.Show 1
                Security_Log "Chhs_Cyl", Xtczybm, 2, False  '用户退出时写上机日志
            Else
                Tsxx = "系统期末不处理差异!"
                Call Xtxxts(Tsxx, 0, 4)
            End If
        Case "Chhs_AvgPrice"                         '平均单价列表
            '判断用户是否有此功能执行权限,如有则写上机日志(进入)
            If Not Security_Log("Chhs_AvgPrice", Xtczybm, 1) Then
                Exit Sub
            End If
            CL_AveragePrice.Show
            CL_AveragePriceFind.Show 1
            Security_Log "Chhs_AvgPrice", Xtczybm, 2, False  '用户退出时写上机日志
        Case "Chhs_ProdPrice"                        '产品成本调整
            '判断用户是否有此功能执行权限,如有则写上机日志(进入)
            If Not Security_Log("Chhs_ProdPrice", Xtczybm, 1) Then
                Exit Sub
            End If
            Cl_ProdPrice.Show
            Cl_ProdPriceCond.Show 1
            Security_Log gnsy, Xtczybm, 2, False  '用户退出时写上机日志
        Case "Chhs_EvalPrice"                        '暂估单价处理
            '判断用户是否有此功能执行权限,如有则写上机日志(进入)
            If Not Security_Log("Chhs_EvalPrice", Xtczybm, 1) Then
                Exit Sub
            End If
            CL_InterimMaterialPrice.Show
            CL_InterimMaterialFind.Show 1
            Security_Log gnsy, Xtczybm, 2, False  '用户退出时写上机日志
        Case "Chhs_Qmcl"                             '期末处理
            '判断用户是否有此功能执行权限,如有则写上机日志(进入)
            If Not Security_Log("Chhs_Qmcl", Xtczybm, 1) Then
                Exit Sub
            End If
            If Xtyear <> PGKjYear Then
                Tsxx = "操作日期不在当前会计年度(" + Trim(Str(PGKjYear)) + ")之内,请重新登录!"
                Call Xtxxts(Tsxx, 0, 1)
            Else
                CL_EndDispose.Show 1
                Security_Log gnsy, Xtczybm, 2, False  '用户退出时写上机日志
            End If
        Case "Chhs_Scpz"                             '生成凭证
            '判断用户是否有此功能执行权限,如有则写上机日志(进入)
            If Not Security_Log("Chhs_Scpz", Xtczybm, 1) Then
                Exit Sub
            End If
            If Xtyear <> PGKjYear Then
                Tsxx = "操作日期不在当前会计年度(" + Trim(Str(PGKjYear)) + ")之内,请重新登录!"
                Call Xtxxts(Tsxx, 0, 1)
            Else
                If Xtmm <> PGNowmon Then
                    Tsxx = "操作日期不在当前会计期间(" + Trim(Str(Xtyear)) + "." + Trim(Str(PGNowmon)) + ")之内,请重新登录!"
                    Call Xtxxts(Tsxx, 0, 1)
                Else
                    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

						