上传用户:zhpu1995
上传日期:2013-09-06
资源大小:61151k
文件大小:31k
源码类别:

企业管理

开发平台:

Visual Basic

  1. VERSION 5.00
  2. Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
  3. Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX"
  4. Begin VB.Form Xt_Control 
  5.    Caption         =   "桌面"
  6.    ClientHeight    =   5850
  7.    ClientLeft      =   675
  8.    ClientTop       =   1665
  9.    ClientWidth     =   9240
  10.    Icon            =   "系统_主操作桌面.frx":0000
  11.    LinkTopic       =   "Form1"
  12.    MDIChild        =   -1  'True
  13.    ScaleHeight     =   5850
  14.    ScaleWidth      =   9240
  15.    WindowState     =   2  'Maximized
  16.    Begin VB.PictureBox picSplitter 
  17.       BackColor       =   &H00808080&
  18.       BorderStyle     =   0  'None
  19.       FillColor       =   &H00808080&
  20.       BeginProperty Font 
  21.          Name            =   "MS Sans Serif"
  22.          Size            =   8.25
  23.          Charset         =   0
  24.          Weight          =   400
  25.          Underline       =   0   'False
  26.          Italic          =   0   'False
  27.          Strikethrough   =   0   'False
  28.       EndProperty
  29.       Height          =   4800
  30.       Left            =   4740
  31.       ScaleHeight     =   2090.126
  32.       ScaleMode       =   0  'User
  33.       ScaleWidth      =   780
  34.       TabIndex        =   0
  35.       Top             =   780
  36.       Visible         =   0   'False
  37.       Width           =   72
  38.    End
  39.    Begin MSComctlLib.ImageList ImageList1 
  40.       Left            =   5220
  41.       Top             =   2340
  42.       _ExtentX        =   1005
  43.       _ExtentY        =   1005
  44.       BackColor       =   -2147483643
  45.       ImageWidth      =   16
  46.       ImageHeight     =   16
  47.       MaskColor       =   12632256
  48.       _Version        =   393216
  49.       BeginProperty Images {2C247F25-8591-11D1-B16A-00C0F0283628} 
  50.          NumListImages   =   7
  51.          BeginProperty ListImage1 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  52.             Picture         =   "系统_主操作桌面.frx":08CA
  53.             Key             =   "stb"
  54.          EndProperty
  55.          BeginProperty ListImage2 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  56.             Picture         =   "系统_主操作桌面.frx":191C
  57.             Key             =   "xttb"
  58.          EndProperty
  59.          BeginProperty ListImage3 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  60.             Picture         =   "系统_主操作桌面.frx":296E
  61.             Key             =   "szk"
  62.          EndProperty
  63.          BeginProperty ListImage4 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  64.             Picture         =   "系统_主操作桌面.frx":2D08
  65.             Key             =   "gnqx1"
  66.          EndProperty
  67.          BeginProperty ListImage5 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  68.             Picture         =   "系统_主操作桌面.frx":315A
  69.             Key             =   "kpgl1"
  70.          EndProperty
  71.          BeginProperty ListImage6 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  72.             Picture         =   "系统_主操作桌面.frx":3A34
  73.             Key             =   "kpgl"
  74.          EndProperty
  75.          BeginProperty ListImage7 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  76.             Picture         =   "系统_主操作桌面.frx":430E
  77.             Key             =   "gnqx"
  78.          EndProperty
  79.       EndProperty
  80.    End
  81.    Begin MSComctlLib.ListView lvListView 
  82.       Height          =   3375
  83.       Left            =   2160
  84.       TabIndex        =   5
  85.       Top             =   705
  86.       Width           =   2295
  87.       _ExtentX        =   4048
  88.       _ExtentY        =   5953
  89.       Arrange         =   2
  90.       LabelWrap       =   -1  'True
  91.       HideSelection   =   -1  'True
  92.       OLEDragMode     =   1
  93.       OLEDropMode     =   1
  94.       PictureAlignment=   1
  95.       _Version        =   393217
  96.       Icons           =   "ImageList2"
  97.       SmallIcons      =   "ImageList1"
  98.       ColHdrIcons     =   "ImageList1"
  99.       ForeColor       =   -2147483640
  100.       BackColor       =   -2147483643
  101.       BorderStyle     =   1
  102.       Appearance      =   1
  103.       BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
  104.          Name            =   "宋体"
  105.          Size            =   9
  106.          Charset         =   134
  107.          Weight          =   400
  108.          Underline       =   0   'False
  109.          Italic          =   0   'False
  110.          Strikethrough   =   0   'False
  111.       EndProperty
  112.       OLEDragMode     =   1
  113.       OLEDropMode     =   1
  114.       NumItems        =   0
  115.    End
  116.    Begin VB.PictureBox picTitles 
  117.       Align           =   1  'Align Top
  118.       Appearance      =   0  'Flat
  119.       BorderStyle     =   0  'None
  120.       BeginProperty Font 
  121.          Name            =   "MS Sans Serif"
  122.          Size            =   8.25
  123.          Charset         =   0
  124.          Weight          =   400
  125.          Underline       =   0   'False
  126.          Italic          =   0   'False
  127.          Strikethrough   =   0   'False
  128.       EndProperty
  129.       ForeColor       =   &H80000008&
  130.       Height          =   300
  131.       Left            =   0
  132.       ScaleHeight     =   300
  133.       ScaleWidth      =   9240
  134.       TabIndex        =   1
  135.       TabStop         =   0   'False
  136.       Top             =   420
  137.       Width           =   9240
  138.       Begin VB.Label lblTitle 
  139.          BorderStyle     =   1  'Fixed Single
  140.          Caption         =   "百利/ERP5.0"
  141.          Height          =   270
  142.          Index           =   0
  143.          Left            =   0
  144.          TabIndex        =   3
  145.          Tag             =   " 树形视图:"
  146.          Top             =   12
  147.          Width           =   2016
  148.       End
  149.       Begin VB.Label lblTitle 
  150.          BorderStyle     =   1  'Fixed Single
  151.          Caption         =   " 列表视图:"
  152.          Height          =   270
  153.          Index           =   1
  154.          Left            =   2078
  155.          TabIndex        =   2
  156.          Tag             =   " 列表视图:"
  157.          Top             =   12
  158.          Width           =   3216
  159.       End
  160.    End
  161.    Begin MSComDlg.CommonDialog dlgCommonDialog 
  162.       Left            =   3360
  163.       Top             =   2160
  164.       _ExtentX        =   847
  165.       _ExtentY        =   847
  166.       _Version        =   393216
  167.    End
  168.    Begin MSComctlLib.TreeView tvTreeView 
  169.       Height          =   4800
  170.       Left            =   0
  171.       TabIndex        =   4
  172.       Top             =   705
  173.       Width           =   2010
  174.       _ExtentX        =   3545
  175.       _ExtentY        =   8467
  176.       _Version        =   393217
  177.       Indentation     =   564
  178.       Style           =   7
  179.       ImageList       =   "ImageList1"
  180.       Appearance      =   1
  181.       BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
  182.          Name            =   "宋体"
  183.          Size            =   9
  184.          Charset         =   134
  185.          Weight          =   400
  186.          Underline       =   0   'False
  187.          Italic          =   0   'False
  188.          Strikethrough   =   0   'False
  189.       EndProperty
  190.    End
  191.    Begin MSComctlLib.Toolbar tbToolBar 
  192.       Align           =   1  'Align Top
  193.       Height          =   420
  194.       Left            =   0
  195.       TabIndex        =   6
  196.       Top             =   0
  197.       Width           =   9240
  198.       _ExtentX        =   16298
  199.       _ExtentY        =   741
  200.       ButtonWidth     =   609
  201.       ButtonHeight    =   582
  202.       AllowCustomize  =   0   'False
  203.       Appearance      =   1
  204.       ImageList       =   "imlToolbarIcons"
  205.       _Version        =   393216
  206.       BeginProperty Buttons {66833FE8-8583-11D1-B16A-00C0F0283628} 
  207.          NumButtons      =   10
  208.          BeginProperty Button1 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  209.             Style           =   3
  210.          EndProperty
  211.          BeginProperty Button2 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  212.             Key             =   "返回"
  213.             Object.ToolTipText     =   "返回"
  214.             ImageKey        =   "xq"
  215.          EndProperty
  216.          BeginProperty Button3 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  217.             Key             =   "向前"
  218.             Object.ToolTipText     =   "向前"
  219.             ImageKey        =   "xh"
  220.          EndProperty
  221.          BeginProperty Button4 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  222.             Style           =   3
  223.          EndProperty
  224.          BeginProperty Button5 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  225.             Style           =   3
  226.          EndProperty
  227.          BeginProperty Button6 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  228.             Style           =   3
  229.          EndProperty
  230.          BeginProperty Button7 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  231.             Key             =   "大图标"
  232.             Object.ToolTipText     =   "大图标"
  233.             ImageKey        =   "dtb"
  234.             Style           =   2
  235.             Value           =   1
  236.          EndProperty
  237.          BeginProperty Button8 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  238.             Key             =   "小图标"
  239.             Object.ToolTipText     =   "小图标"
  240.             ImageKey        =   "xtb"
  241.             Style           =   2
  242.          EndProperty
  243.          BeginProperty Button9 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  244.             Key             =   "列表"
  245.             Object.ToolTipText     =   "列表"
  246.             ImageKey        =   "lb"
  247.             Style           =   2
  248.          EndProperty
  249.          BeginProperty Button10 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  250.             Key             =   "详细资料"
  251.             Object.ToolTipText     =   "详细资料"
  252.             ImageKey        =   "xxzl"
  253.             Style           =   2
  254.          EndProperty
  255.       EndProperty
  256.    End
  257.    Begin MSComctlLib.ImageList imlToolbarIcons 
  258.       Left            =   4710
  259.       Top             =   840
  260.       _ExtentX        =   1005
  261.       _ExtentY        =   1005
  262.       BackColor       =   -2147483643
  263.       ImageWidth      =   16
  264.       ImageHeight     =   16
  265.       MaskColor       =   12632256
  266.       _Version        =   393216
  267.       BeginProperty Images {2C247F25-8591-11D1-B16A-00C0F0283628} 
  268.          NumListImages   =   6
  269.          BeginProperty ListImage1 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  270.             Picture         =   "系统_主操作桌面.frx":46A8
  271.             Key             =   "xq"
  272.          EndProperty
  273.          BeginProperty ListImage2 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  274.             Picture         =   "系统_主操作桌面.frx":4A42
  275.             Key             =   "xh"
  276.          EndProperty
  277.          BeginProperty ListImage3 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  278.             Picture         =   "系统_主操作桌面.frx":4DDC
  279.             Key             =   "dtb"
  280.          EndProperty
  281.          BeginProperty ListImage4 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  282.             Picture         =   "系统_主操作桌面.frx":5176
  283.             Key             =   "xtb"
  284.          EndProperty
  285.          BeginProperty ListImage5 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  286.             Picture         =   "系统_主操作桌面.frx":5510
  287.             Key             =   "lb"
  288.          EndProperty
  289.          BeginProperty ListImage6 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  290.             Picture         =   "系统_主操作桌面.frx":58AA
  291.             Key             =   "xxzl"
  292.          EndProperty
  293.       EndProperty
  294.    End
  295.    Begin MSComctlLib.ImageList ImageList2 
  296.       Left            =   6210
  297.       Top             =   2370
  298.       _ExtentX        =   1005
  299.       _ExtentY        =   1005
  300.       BackColor       =   -2147483643
  301.       ImageWidth      =   32
  302.       ImageHeight     =   32
  303.       MaskColor       =   12632256
  304.       _Version        =   393216
  305.       BeginProperty Images {2C247F25-8591-11D1-B16A-00C0F0283628} 
  306.          NumListImages   =   4
  307.          BeginProperty ListImage1 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  308.             Picture         =   "系统_主操作桌面.frx":5C44
  309.             Key             =   "y1"
  310.          EndProperty
  311.          BeginProperty ListImage2 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  312.             Picture         =   "系统_主操作桌面.frx":6098
  313.             Key             =   "y"
  314.          EndProperty
  315.          BeginProperty ListImage3 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  316.             Picture         =   "系统_主操作桌面.frx":6D72
  317.             Key             =   ""
  318.          EndProperty
  319.          BeginProperty ListImage4 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  320.             Picture         =   "系统_主操作桌面.frx":7092
  321.             Key             =   "i"
  322.          EndProperty
  323.       EndProperty
  324.    End
  325.    Begin VB.Image imgSplitter 
  326.       Height          =   4785
  327.       Left            =   4230
  328.       MousePointer    =   9  'Size W E
  329.       Top             =   750
  330.       Width           =   150
  331.    End
  332. End
  333. Attribute VB_Name = "Xt_Control"
  334. Attribute VB_GlobalNameSpace = False
  335. Attribute VB_Creatable = False
  336. Attribute VB_PredeclaredId = True
  337. Attribute VB_Exposed = False
  338. '***********************************************
  339. '*    模 块 名 称 :系统主操作桌面
  340. '*    功 能 描 述 :
  341. '*    程序员姓名  :张建忠
  342. '*    最后修改人  :邹力
  343. '*    最后修改时间:2001/12/03
  344. '*    备        注:封版
  345. '***********************************************
  346. Const NAME_COLUMN = 0
  347. Const TYPE_COLUMN = 1
  348. Const SIZE_COLUMN = 2
  349. Const DATE_COLUMN = 3
  350. Private Declare Function OSWinHelp% Lib "user32" Alias "WinHelpA" (ByVal hwnd&, ByVal HelpFile$, ByVal wCommand%, dwData As Any)
  351. Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
  352. Dim mbMoving As Boolean
  353. Const sglSplitLimit = 1000
  354. Dim nodX As Node
  355. Dim mitem As ListItem
  356. Dim Ztxxrec As New ADODB.Recordset           '帐套信息动态集
  357. Dim Xtgnbrec As New ADODB.Recordset          '系统功能表
  358. Dim Xtqxxzrec As New ADODB.Recordset         '系统权限限制动态集
  359. Dim Tsxx As String                           '系统提示信息
  360. Dim gnsyte As String                         '系统功能项索引
  361. Dim Xtrlrec As New ADODB.Recordset           '系统日历动态集
  362. Dim Ctsfscdr As Boolean                      '窗体是否首次读入
  363. Dim sjgnbmStr As String                      '上级编码
  364. Private Sub lvListView_DblClick()            '点击ListView执行相应功能
  365.     If lvListView.ListItems.Count > 0 Then
  366.         Set Xtgnbrec = Cw_DataEnvi.DataConnect.Execute("SELECT * FROM xt_xtgnb where gnbm='" + Mid(Trim(lvListView.SelectedItem.Key), 2, Len(Trim(lvListView.SelectedItem.Key)) - 1) + "'")
  367.         If Not Xtgnbrec.EOF Then
  368.             If Xtgnbrec.Fields("mjbz") = True Then
  369.                 gnsyte = Trim(Xtgnbrec.Fields("gnsy"))
  370.                 Call Zxxymk(gnsyte)
  371.             Else
  372.                 '---------------
  373.                 Dim Ssql As String
  374.                 sjgnbmStr = ""
  375.                 lvListView.ColumnHeaders.Clear
  376.                 lvListView.ListItems.Clear
  377.                 Ssql = "SELECT * FROM xt_xtgnb where sjgnbm='" + Xtgnbrec.Fields("gnbm") + "' and MenuList=1 order by gnbm"
  378.                 Set Xtgnbrec = Cw_DataEnvi.DataConnect.Execute(Ssql)
  379.                 lvListView.ColumnHeaders.Add 1, "rcsw", tvTreeView.SelectedItem.Text, 3000, , "stb"
  380.                 Do While Not Xtgnbrec.EOF
  381.                     Set mitem = lvListView.ListItems.Add()
  382.                     mitem.Text = Trim(Xtgnbrec!gnmc)
  383.                     If Xtgnbrec.Fields("mjbz") Then
  384.                         mitem.SmallIcon = "gnqx"
  385.                         mitem.Icon = "y"
  386.                     Else
  387.                         mitem.Icon = "i"
  388.                         mitem.SmallIcon = "stb"
  389.                     End If
  390.                     mitem.Key = "T" & Trim(Xtgnbrec!gnbm)
  391.                     Xtgnbrec.MoveNext
  392.                 Loop
  393.                 '---------------
  394.             End If
  395.         End If
  396.     End If
  397. End Sub
  398. Private Sub tvTreeView_NodeClick(ByVal Node As MSComctlLib.Node)
  399.     Dim Ssql As String
  400.     If Node.Tag <> "" Then
  401.         If Node.Tag = False Then
  402.             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"
  403.             If sjgnbmStr = Mid(Trim(tvTreeView.SelectedItem.Key), 2, Len(Trim(tvTreeView.SelectedItem.Key)) - 1) Then
  404.                 Exit Sub
  405.             Else
  406.                 sjgnbmStr = Mid(Trim(tvTreeView.SelectedItem.Key), 2, Len(Trim(tvTreeView.SelectedItem.Key)) - 1)
  407.             End If
  408.         Else
  409.             Ssql = "SELECT * FROM xt_xtgnb a," _
  410.                     & "(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"
  411.         End If
  412.         
  413.         Set Xtgnbrec = Cw_DataEnvi.DataConnect.Execute(Ssql)
  414.         If Node.Tag = True Then
  415.             If sjgnbmStr = Trim(Xtgnbrec!sjgnbm) Then
  416.                 Exit Sub
  417.             Else
  418.                 sjgnbmStr = Trim(Xtgnbrec!sjgnbm)
  419.             End If
  420.         End If
  421.         lvListView.ColumnHeaders.Clear
  422.         lvListView.ListItems.Clear
  423.         lvListView.ColumnHeaders.Add 1, "rcsw", "明细", 3000, , "stb"
  424.         Do While Not Xtgnbrec.EOF
  425.             Set mitem = lvListView.ListItems.Add()
  426.             mitem.Text = Trim(Xtgnbrec!gnmc)
  427.             If Xtgnbrec.Fields("mjbz") Then
  428.                 mitem.SmallIcon = "gnqx"
  429.                 mitem.Icon = "y"
  430.             Else
  431.                 mitem.Icon = "i"
  432.                 mitem.SmallIcon = "stb"
  433.             End If
  434.             mitem.Key = "T" & Trim(Xtgnbrec!gnbm)
  435.             Xtgnbrec.MoveNext
  436.         Loop
  437.     End If
  438. End Sub
  439. Private Sub lvListView_KeyPress(KeyAscii As Integer)
  440.     If KeyAscii = vbKeyReturn Then
  441.         Call lvListView_DblClick
  442.     End If
  443. End Sub
  444. Public Sub Cshgns()                                                    '初始化系统功能树
  445.   
  446.     Set Xtgnbrec = Cw_DataEnvi.DataConnect.Execute("SELECT * FROM xt_xtgnb where gnbm like '17%' and MenuList=1 order by gnbm")
  447.     tvTreeView.Nodes.Add , 4, "T", "百利/ERP5.0", "xttb"
  448.     With Xtgnbrec
  449.         Do While Not .EOF
  450.             If .Fields("mjbz") Then
  451.                 Set nodX = tvTreeView.Nodes.Add("T" + Trim(.Fields("sjgnbm")), 4, "T" + Trim(.Fields("gnbm")), Trim(.Fields("gnmc")), "gnqx")
  452.             Else
  453.                 If Trim(.Fields("sjgnbm")) = "" Then
  454.                     Set nodX = tvTreeView.Nodes.Add("T" + Trim(.Fields("sjgnbm")), 4, "T" + Trim(.Fields("gnbm")), Trim(.Fields("gnmc")), "kpgl")
  455.                 Else
  456.                     Set nodX = tvTreeView.Nodes.Add("T" + Trim(.Fields("sjgnbm")), 4, "T" + Trim(.Fields("gnbm")), Trim(.Fields("gnmc")), "stb")
  457.                 End If
  458.             End If
  459.             nodX.Tag = Xtgnbrec!mjbz
  460.             If Len(Trim(.Fields("sjgnbm"))) <= 2 Then
  461.                 nodX.EnsureVisible
  462.             End If
  463.             .MoveNext
  464.         Loop
  465.     End With
  466. End Sub
  467. '系统功能树操作
  468. Private Sub tvTreeView_BeforeLabelEdit(Cancel As Integer)                     '屏蔽编辑
  469.   Cancel = 1
  470. End Sub
  471. Private Sub tvTreeView_Collapse(ByVal Node As MSComctlLib.Node)               '功能树收缩
  472.     
  473.     If Node.Index <> 1 And Node.Key <> "T17" Then
  474.         Node.Image = "stb"
  475.     End If
  476.  
  477. End Sub
  478. Private Sub tvTreeView_Expand(ByVal Node As MSComctlLib.Node)                 '功能树展开
  479.     
  480.     If Node.Index <> 1 And Node.Key <> "T17" Then
  481.         Node.Image = "szk"
  482.     End If
  483. End Sub
  484. Private Sub tvTreeView_KeyPress(KeyAscii As Integer)                          '用户按回车键执行相应功能
  485.     
  486.     If KeyAscii = vbKeyReturn Then
  487.         Call tvTreeView_DblClick
  488.     End If
  489. End Sub
  490. Private Sub tvTreeView_DblClick()                                             '选择功能
  491.     
  492.     If tvTreeView.SelectedItem.Children = 0 Then
  493.         Set Xtgnbrec = Cw_DataEnvi.DataConnect.Execute("SELECT * FROM xt_xtgnb where gnbm='" + Mid(Trim(tvTreeView.SelectedItem.Key), 2, Len(Trim(tvTreeView.SelectedItem.Key)) - 1) + "'")
  494.         If Not Xtgnbrec.EOF Then
  495.             gnsyte = Trim(Xtgnbrec.Fields("gnsy"))
  496.             Call Zxxymk(gnsyte)
  497.         End If
  498.     End If
  499. End Sub
  500. Public Sub Zxxymk(gnsy As String)                                            '根据用户选择执行相应程序
  501.   
  502.     Dim RecTemp As New ADODB.Recordset     '临时使用动态集
  503.     Dim Sqlstr As String                   '临时查询字符串
  504.   
  505.     If Len(Trim(gnsy)) = 0 Then
  506.         Exit Sub
  507.     End If
  508.     
  509.     On Error GoTo Cwcl:
  510.     Select Case gnsy
  511.         '文件
  512.         Case "Cask_Register"                       '用户重新注册
  513.             XT_login.Show 1
  514.         Case "Cask_Exit"
  515.             Unload XT_Main
  516.         
  517.      
  518.             '期初处理
  519.         Case "Cask_StartInput"                     '期初数据录入(单据式)
  520.             '判断用户是否有此功能执行权限,如有则写上机日志(进入)
  521.             If Not Security_Log("Cask_StartInputEdit", Xtczybm, 1) Then
  522.                 Exit Sub
  523.             End If
  524.             Sqlstr = "select * from gy_accinformation where ItemCode='Cask_StartChalk'"
  525.             Set Rec_Query = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
  526.             If Val(Trim(Rec_Query!ItemValue)) Then
  527.                 Tsxx = "期初已结帐!"
  528.                 Call Xtxxts(Tsxx, 0, 1)
  529.                 Exit Sub
  530.             End If
  531.             Xtcdcs = "1"
  532.             Cask_StartInput.Show 1
  533.         Case "Cask_StartInputList"                 '期初数据列表(单据式)
  534.            Cask_StartInputList.Show
  535.            Cask_StartInputListQuery.Show 1
  536.         Case "Cask_StartChalk"                     '期初结帐
  537.             '判断用户是否有此功能执行权限,如有则写上机日志(进入)
  538.             If Not Security_Log("Cask_ComebackChalk", Xtczybm, 1) Then
  539.                 Exit Sub
  540.             End If
  541.             Call Cask_StartChalk
  542.         Case "Cask_ComebackChalk"                  '恢复期初结帐
  543.             '判断用户是否有此功能执行权限,如有则写上机日志(进入)
  544.             If Not Security_Log("Cask_ComebackChalk", Xtczybm, 1) Then
  545.                 Exit Sub
  546.             End If
  547.             Call Cask_ComebackChalk
  548.             
  549.             '基础设置
  550.         Case "Cask_Status"                         '状态设置
  551.             '判断用户是否有此功能执行权限,如有则写上机日志(进入)
  552.             If Not Security_Log("Cask_Status", Xtczybm, 1) Then
  553.                 Exit Sub
  554.             End If
  555.             Cask_Status.Show 1
  556.         Case "Cask_Sort"                           '类别设置
  557.             '判断用户是否有此功能执行权限,如有则写上机日志(进入)
  558.             If Not Security_Log("Cask_Sort", Xtczybm, 1) Then
  559.                 Exit Sub
  560.             End If
  561.             Cask_Sort.Show 1
  562.         Case "Cask_StyleType"                      '业务类型设置
  563.             '判断用户是否有此功能执行权限,如有则写上机日志(进入)
  564.             If Not Security_Log("Cask_StyleType", Xtczybm, 1) Then
  565.                 Exit Sub
  566.             End If
  567.             Cask_StyleType.Show 1
  568.         Case "Cask_Wrappage"                       '包装物档案
  569.             '判断用户是否有此功能执行权限,如有则写上机日志(进入)
  570.             If Not Security_Log("Cask_Wrappage", Xtczybm, 1) Then
  571.                 Exit Sub
  572.             End If
  573.             Cask_Wrappage.Show 1
  574.             
  575.             
  576.             '业务处理
  577.         Case "Cask_Harvest"                        '入库单
  578.             '判断用户是否有此功能执行权限,如有则写上机日志(进入)
  579.             If Not Security_Log("Cask_HarvestEdit", Xtczybm, 1) Then
  580.                 Exit Sub
  581.             End If
  582.             Xtcdcs = "1"
  583.             Cask_Harvest.Show 1
  584.         Case "Cask_Issue"                          '出库单
  585.             '判断用户是否有此功能执行权限,如有则写上机日志(进入)
  586.             If Not Security_Log("Cask_IssueEdit", Xtczybm, 1) Then
  587.                 Exit Sub
  588.             End If
  589.             Xtcdcs = "1"
  590.             Cask_Issue.Show 1
  591.         Case "Cask_AppertainIn"                    '附属物入库单
  592.             '判断用户是否有此功能执行权限,如有则写上机日志(进入)
  593.             If Not Security_Log("Cask_AppertainInEdit", Xtczybm, 1) Then
  594.                 Exit Sub
  595.             End If
  596.             Xtcdcs = "1"
  597.             Cask_AppertainIn.Show 1
  598.         Case "Cask_AppertainOut"                   '附属物出库单
  599.             '判断用户是否有此功能执行权限,如有则写上机日志(进入)
  600.             If Not Security_Log("Cask_AppertainOutEdit", Xtczybm, 1) Then
  601.                 Exit Sub
  602.             End If
  603.             Xtcdcs = "1"
  604.             Cask_AppertainOut.Show 1
  605.  
  606.             '单据列表
  607.         Case "Cask_HarvestList"                    '出库单列表
  608.             Cask_HarvestList.Show
  609.             Cask_HarvestListQuery.Show 1
  610.         Case "Cask_IssueList"                      '出库单列表
  611.             Cask_IssueList.Show
  612.             Cask_IssueListQuery.Show 1
  613.         Case "Cask_AppertainInList"                '附属物入库单列表
  614.             Cask_AppertainInList.Show
  615.             Cask_AppertainInListQuery.Show 1
  616.         Case "Cask_AppertainOuList"                '附属物出库单列表
  617.             Cask_AppertainOuList.Show
  618.             Cask_AppertainOuListQuery.Show 1
  619.             
  620.             '结帐处理
  621.         Case "Cask_CheckOut"                       '月末结帐
  622.             '判断用户是否有此功能执行权限,如有则写上机日志(进入)
  623.             If Not Security_Log("Cask_Comeback", Xtczybm, 1) Then
  624.                 Exit Sub
  625.             End If
  626.             Cask_CheckOut.Show 1
  627.         Case "Cask_Comeback"                       '恢复月末结帐
  628.             '判断用户是否有此功能执行权限,如有则写上机日志(进入)
  629.             If Not Security_Log("Cask_Comeback", Xtczybm, 1) Then
  630.                 Exit Sub
  631.             End If
  632.             Cask_Comeback.Show 1
  633.         '帐簿统计
  634.         Case "Cask_WasteBook"                      '包装物流水帐
  635.             Cask_WasteBook.Show
  636.             Cask_WasteBookQuery.Show 1
  637.         Case "Cask_Estrade"                        '包装物台帐
  638.             Cask_Estrade.Show
  639.             Cask_EstradeQuery.Show 1
  640.         Case "Cask_Ledger"                         '包装物总帐
  641.             Cask_Ledger.Show
  642.             Cask_LedgerQuery.Show 1
  643.         Case "Cask_HarvestStat"                    '入库汇总统计
  644.             Cask_HarvestStat.Show
  645.             Cask_HarvestStatQuery.Show 1
  646.         Case "Cask_IssueStat"                      '出库汇总统计
  647.             Cask_IssueStat.Show
  648.             Cask_IssueStatQuery.Show 1
  649.         Case "Cask_CollectStat"                    '包装物汇总统计
  650.             Cask_CollectStat.Show
  651.             Cask_CollectStatQuery.Show 1
  652.         Case "Cask_StatusCollect"                  '状态汇总统计
  653.             Cask_StatusCollect.Show
  654.             Cask_StatusCollectQuery.Show 1
  655.         Case "Cask_StyleTypCollect"                '业务类型汇总统计
  656.             Cask_StyleTypCollect.Show
  657.             Cask_StyleTypCollectQuery.Show 1
  658.             
  659.         '工具
  660.         Case "Cask_gnbmkmrl"                          '会计日历
  661.             XT_kjrlFrm.Show 1
  662.         Case "Cask_gnbmjsq"                           '计算器
  663.             Shell App.Path & "calc.exe", vbNormalFocus
  664.         
  665.         '帮助
  666.         Case "Cask_xtbz"                              '系统帮助
  667.             Call F1bz
  668.         Case "Cask_wshxxd"                            '网上华夏新达
  669.             ShellExecute 0, "open", "www.hxxd.com", "", "", 0
  670.         Case "Cask_gy"                                '关于
  671.             XT_frmAbout.Show
  672.     End Select
  673.     
  674.     '用户退出时写上机日志
  675.    Security_Log gnsy, Xtczybm, 2, False
  676.    
  677.     Exit Sub
  678. Cwcl:
  679.     Tsxx = "此项系统功能有待完善!"
  680.     Call Xtxxts(Tsxx, 0, 4)
  681.     Exit Sub
  682. End Sub
  683. Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)        '用户关闭窗体
  684.   
  685.     If Unload_TF = False Then
  686.         Cancel = 1
  687.         Me.WindowState = 1
  688.     End If
  689. End Sub
  690. Private Sub Form_Load()
  691.     
  692.     '设置窗体图标
  693.     Me.Icon = XT_Main.Icon
  694.     
  695.     '设置窗体位置大小,并调入系统功能树
  696.     Me.Left = 0
  697.     Me.Top = 0
  698.     Me.Width = XT_Main.Width - 60
  699.     Me.Height = XT_Main.Height - 760 - 690
  700.     Call Cshgns
  701.     
  702.     '启动调入数据等待提示
  703.     Load Xt_Wait
  704.     
  705. End Sub
  706. Private Sub Form_Unload(Cancel As Integer)
  707.     
  708.     On Error Resume Next
  709.     
  710.     Dim i As Integer
  711.     For i = Forms.Count - 1 To 1 Step -1
  712.         Unload Forms(i)
  713.     Next
  714.     If Me.WindowState <> vbMinimized Then
  715.         SaveSetting App.Title, "Settings", "MainLeft", Me.Left
  716.         SaveSetting App.Title, "Settings", "MainTop", Me.Top
  717.         SaveSetting App.Title, "Settings", "MainWidth", Me.Width
  718.         SaveSetting App.Title, "Settings", "MainHeight", Me.Height
  719.     End If
  720.     SaveSetting App.Title, "Settings", "ViewMode", lvListView.View
  721. End Sub
  722. Private Sub Form_Resize()
  723.     
  724.     On Error Resume Next
  725.     If Me.Width < 3000 Then Me.Width = 3000
  726.     SizeControls imgSplitter.Left
  727. End Sub
  728. Private Sub imgSplitter_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
  729.     
  730.     With imgSplitter
  731.         picSplitter.Move .Left, .Top, .Width  2, .Height - 20
  732.     End With
  733.     picSplitter.Visible = True
  734.     mbMoving = True
  735. End Sub
  736. Private Sub imgSplitter_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
  737.     
  738.     Dim sglPos As Single
  739.     If mbMoving Then
  740.         sglPos = x + imgSplitter.Left
  741.         If sglPos < sglSplitLimit Then
  742.             picSplitter.Left = sglSplitLimit
  743.         ElseIf sglPos > Me.Width - sglSplitLimit Then
  744.             picSplitter.Left = Me.Width - sglSplitLimit
  745.         Else
  746.             picSplitter.Left = sglPos
  747.         End If
  748.     End If
  749. End Sub
  750. Private Sub imgSplitter_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
  751.     
  752.     SizeControls picSplitter.Left
  753.     picSplitter.Visible = False
  754.     mbMoving = False
  755.     lvListView.Refresh
  756. End Sub
  757. Private Sub TreeView1_DragDrop(Source As Control, x As Single, y As Single)
  758.     
  759.     If Source = imgSplitter Then
  760.         SizeControls x
  761.     End If
  762. End Sub
  763. Sub SizeControls(x As Single)
  764.     
  765.     On Error Resume Next
  766.     '设置 Width 属性
  767.     If x < 3500 Then x = 3500
  768.     If x > (Me.Width - 1500) Then x = Me.Width - 1500
  769.     tvTreeView.Width = x
  770.     imgSplitter.Left = x
  771.     lvListView.Left = x + 40
  772.     lvListView.Width = Me.Width - (tvTreeView.Width + 140)
  773.     lblTitle(0).Width = tvTreeView.Width
  774.     lblTitle(1).Left = lvListView.Left + 20
  775.     lblTitle(1).Width = lvListView.Width - 40
  776.     '设置 Top 属性
  777.     tvTreeView.Top = tbToolBar.Height + picTitles.Height
  778.     lvListView.Top = tvTreeView.Top
  779.     '设置 height 属性
  780.     tvTreeView.Height = Me.ScaleHeight - (picTitles.Top + picTitles.Height)
  781.     
  782.     lvListView.Height = tvTreeView.Height
  783.     imgSplitter.Top = tvTreeView.Top
  784.     imgSplitter.Height = tvTreeView.Height
  785. End Sub
  786. Private Sub tbToolBar_ButtonClick(ByVal Button As MSComctlLib.Button)
  787.     
  788.     On Error Resume Next
  789.     
  790.     Select Case Button.Key
  791.         Case "返回"
  792.             tvTreeView.SetFocus
  793.               SendKeys "{up}", True
  794.         Case "向前"
  795.              tvTreeView.SetFocus
  796.               SendKeys "{DOWN}", True
  797.         Case "大图标"
  798.             lvListView.View = lvwIcon
  799.         Case "小图标"
  800.             lvListView.View = lvwSmallIcon
  801.         Case "列表"
  802.             lvListView.View = lvwList
  803.         Case "详细资料"
  804.             lvListView.View = lvwReport
  805.     End Select
  806. End Sub