开通博客赚积分
发布资源赚积分
分类

源码开发语言/平台
当前位置：首页 > 源码/资料 > 行业应用 > 企业管理 > 查看源码
+
资源名称：ERPSYS.zip　[点击查看]
上传用户：zhpu1995
上传日期：2013-09-06
资源大小：61151k
文件大小：54k
源码类别：

企业管理

开发平台：

Visual Basic

+：源码内容
  1. VERSION 5.00
  2. Object = "{65A39231-6133-11D1-BAA2-444553540000}#1.0#0"; "vslight6.OCX"
  3. Object = "{D76D7128-4A96-11D3-BD95-D296DC2DD072}#1.0#0"; "VSOCX7.OCX"
  4. Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "mscomctl.ocx"
  5. Object = "{BDC217C8-ED16-11CD-956C-0000C04E4C0A}#1.1#0"; "Tabctl32.ocx"
  6. Begin VB.Form Set_QrtFrm 
  7.    Caption         =   "定员设置"
  8.    ClientHeight    =   7110
  9.    ClientLeft      =   60
  10.    ClientTop       =   345
  11.    ClientWidth     =   10380
  12.    HelpContextID   =   2001
  13.    Icon            =   "设置_定员设置.frx":0000
  14.    KeyPreview      =   -1  'True
  15.    LinkTopic       =   "Form2"
  16.    ScaleHeight     =   7110
  17.    ScaleWidth      =   10380
  18.    StartUpPosition =   2  '屏幕中心
  19.    Begin MSComctlLib.Toolbar SzToolbar 
  20.       Align           =   1  'Align Top
  21.       Height          =   570
  22.       Left            =   0
  23.       TabIndex        =   4
  24.       Top             =   0
  25.       Width           =   10380
  26.       _ExtentX        =   18309
  27.       _ExtentY        =   1005
  28.       ButtonWidth     =   820
  29.       ButtonHeight    =   953
  30.       AllowCustomize  =   0   'False
  31.       Appearance      =   1
  32.       Style           =   1
  33.       ImageList       =   "ImageList1"
  34.       _Version        =   393216
  35.       BeginProperty Buttons {66833FE8-8583-11D1-B16A-00C0F0283628} 
  36.          NumButtons      =   14
  37.          BeginProperty Button1 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  38.             Caption         =   "设置"
  39.             Key             =   "ymsz"
  40.             ImageKey        =   "sz"
  41.          EndProperty
  42.          BeginProperty Button2 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  43.             Caption         =   "打印"
  44.             Key             =   "dy"
  45.             Object.ToolTipText     =   "点击或按Ctrl+P打印表格"
  46.             ImageKey        =   "dy"
  47.          EndProperty
  48.          BeginProperty Button3 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  49.             Caption         =   "预览"
  50.             Key             =   "yl"
  51.             ImageKey        =   "yl"
  52.          EndProperty
  53.          BeginProperty Button4 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  54.             Style           =   3
  55.          EndProperty
  56.          BeginProperty Button5 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  57.             Object.Visible         =   0   'False
  58.             Caption         =   "增加"
  59.             Key             =   "zj"
  60.             Object.ToolTipText     =   "点击或按Ctrl+A增加记录"
  61.             ImageKey        =   "xz"
  62.          EndProperty
  63.          BeginProperty Button6 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  64.             Caption         =   "设定"
  65.             Key             =   "xg"
  66.             ImageKey        =   "xg"
  67.          EndProperty
  68.          BeginProperty Button7 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  69.             Object.Visible         =   0   'False
  70.             Caption         =   "删除"
  71.             Key             =   "sc"
  72.             Object.ToolTipText     =   "点击或按Ctrl+D删除当前记录"
  73.             ImageKey        =   "sc"
  74.          EndProperty
  75.          BeginProperty Button8 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  76.             Style           =   3
  77.          EndProperty
  78.          BeginProperty Button9 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  79.             Object.Visible         =   0   'False
  80.             Caption         =   "刷新"
  81.             Key             =   "sx"
  82.             ImageKey        =   "sx"
  83.          EndProperty
  84.          BeginProperty Button10 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  85.             Object.Visible         =   0   'False
  86.             Style           =   3
  87.          EndProperty
  88.          BeginProperty Button11 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  89.             Object.Visible         =   0   'False
  90.             Caption         =   "分配"
  91.             Key             =   "fp"
  92.             Object.ToolTipText     =   "分配部门"
  93.             ImageKey        =   "dz"
  94.          EndProperty
  95.          BeginProperty Button12 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  96.             Object.Visible         =   0   'False
  97.             Style           =   3
  98.          EndProperty
  99.          BeginProperty Button13 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  100.             Caption         =   "帮助"
  101.             Key             =   "bz"
  102.             ImageKey        =   "bz"
  103.          EndProperty
  104.          BeginProperty Button14 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  105.             Caption         =   "退出"
  106.             Key             =   "fh"
  107.             ImageKey        =   "tc"
  108.          EndProperty
  109.       EndProperty
  110.       BorderStyle     =   1
  111.       Begin MSComctlLib.Toolbar GsToolbar 
  112.          Height          =   540
  113.          Left            =   7830
  114.          TabIndex        =   5
  115.          Top             =   0
  116.          Width           =   2520
  117.          _ExtentX        =   4445
  118.          _ExtentY        =   953
  119.          ButtonWidth     =   1455
  120.          ButtonHeight    =   953
  121.          AllowCustomize  =   0   'False
  122.          Appearance      =   1
  123.          Style           =   1
  124.          ImageList       =   "ImageList1"
  125.          _Version        =   393216
  126.          BeginProperty Buttons {66833FE8-8583-11D1-B16A-00C0F0283628} 
  127.             NumButtons      =   3
  128.             BeginProperty Button1 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  129.                Caption         =   "保存格式"
  130.                Key             =   "bcgs"
  131.                ImageKey        =   "bcgs"
  132.             EndProperty
  133.             BeginProperty Button2 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  134.                Caption         =   "默认列宽"
  135.                Key             =   "hfmrgs"
  136.                ImageKey        =   "mrlk"
  137.             EndProperty
  138.             BeginProperty Button3 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  139.                Caption         =   "显示项目"
  140.                Key             =   "szxsxm"
  141.                ImageKey        =   "xsxm"
  142.             EndProperty
  143.          EndProperty
  144.       End
  145.    End
  146.    Begin MSComctlLib.ImageList ImageList2 
  147.       Left            =   855
  148.       Top             =   270
  149.       _ExtentX        =   1005
  150.       _ExtentY        =   1005
  151.       BackColor       =   -2147483643
  152.       ImageWidth      =   16
  153.       ImageHeight     =   16
  154.       MaskColor       =   12632256
  155.       _Version        =   393216
  156.       BeginProperty Images {2C247F25-8591-11D1-B16A-00C0F0283628} 
  157.          NumListImages   =   4
  158.          BeginProperty ListImage1 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  159.             Picture         =   "设置_定员设置.frx":1042
  160.             Key             =   "T"
  161.          EndProperty
  162.          BeginProperty ListImage2 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  163.             Picture         =   "设置_定员设置.frx":191C
  164.             Key             =   "C"
  165.          EndProperty
  166.          BeginProperty ListImage3 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  167.             Picture         =   "设置_定员设置.frx":21F6
  168.             Key             =   "Cl"
  169.          EndProperty
  170.          BeginProperty ListImage4 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  171.             Picture         =   "设置_定员设置.frx":3248
  172.             Key             =   "O"
  173.          EndProperty
  174.       EndProperty
  175.    End
  176.    Begin VB.PictureBox picSplitter 
  177.       BackColor       =   &H00E0E0E0&
  178.       BorderStyle     =   0  'None
  179.       FillColor       =   &H00808080&
  180.       Height          =   6360
  181.       Left            =   2831
  182.       ScaleHeight     =   2769.417
  183.       ScaleMode       =   0  'User
  184.       ScaleWidth      =   468
  185.       TabIndex        =   7
  186.       Top             =   675
  187.       Visible         =   0   'False
  188.       Width           =   39
  189.    End
  190.    Begin MSComctlLib.TreeView TrV_Depart 
  191.       Height          =   6435
  192.       Left            =   26
  193.       TabIndex        =   6
  194.       Top             =   660
  195.       Width           =   2739
  196.       _ExtentX        =   4815
  197.       _ExtentY        =   11351
  198.       _Version        =   393217
  199.       Indentation     =   617
  200.       LabelEdit       =   1
  201.       Style           =   7
  202.       ImageList       =   "ImageList2"
  203.       Appearance      =   1
  204.       BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
  205.          Name            =   "宋体"
  206.          Size            =   9
  207.          Charset         =   134
  208.          Weight          =   400
  209.          Underline       =   0   'False
  210.          Italic          =   0   'False
  211.          Strikethrough   =   0   'False
  212.       EndProperty
  213.    End
  214.    Begin TabDlg.SSTab StTab 
  215.       Height          =   6435
  216.       Left            =   2910
  217.       TabIndex        =   3
  218.       Top             =   630
  219.       Width           =   7440
  220.       _ExtentX        =   13123
  221.       _ExtentY        =   11351
  222.       _Version        =   393216
  223.       Style           =   1
  224.       Tabs            =   2
  225.       TabHeight       =   520
  226.       TabCaption(0)   =   "列表视图"
  227.       TabPicture(0)   =   "设置_定员设置.frx":35E2
  228.       Tab(0).ControlEnabled=   -1  'True
  229.       Tab(0).Control(0)=   "CzxsGrid"
  230.       Tab(0).Control(0).Enabled=   0   'False
  231.       Tab(0).ControlCount=   1
  232.       TabCaption(1)   =   "单张视图"
  233.       TabPicture(1)   =   "设置_定员设置.frx":35FE
  234.       Tab(1).ControlEnabled=   0   'False
  235.       Tab(1).Control(0)=   "Frame1"
  236.       Tab(1).Control(0).Enabled=   0   'False
  237.       Tab(1).ControlCount=   1
  238.       Begin VB.Frame Frame1 
  239.          Height          =   5955
  240.          Left            =   -74882
  241.          TabIndex        =   8
  242.          Top             =   360
  243.          Width           =   7215
  244.          Begin VB.TextBox LrText 
  245.             Height          =   300
  246.             Index           =   0
  247.             Left            =   1575
  248.             TabIndex        =   0
  249.             Text            =   "0"
  250.             Top             =   1305
  251.             Width           =   1414
  252.          End
  253.          Begin VB.CommandButton QxCommand 
  254.             Cancel          =   -1  'True
  255.             Caption         =   "取消(&C)"
  256.             Height          =   300
  257.             Left            =   2010
  258.             TabIndex        =   10
  259.             Top             =   1830
  260.             Width           =   979
  261.          End
  262.          Begin VB.CommandButton BcCommand 
  263.             Caption         =   "保存(&S)"
  264.             Height          =   300
  265.             Left            =   840
  266.             TabIndex        =   1
  267.             Top             =   1830
  268.             Width           =   979
  269.          End
  270.          Begin VB.CommandButton Ydcommand1 
  271.             Height          =   300
  272.             Index           =   0
  273.             Left            =   5505
  274.             Picture         =   "设置_定员设置.frx":361A
  275.             Style           =   1  'Graphical
  276.             TabIndex        =   9
  277.             Top             =   270
  278.             Visible         =   0   'False
  279.             Width           =   262
  280.          End
  281.          Begin VB.Label Lbl_codescheme 
  282.             AutoSize        =   -1  'True
  283.             Height          =   180
  284.             Left            =   1048
  285.             TabIndex        =   14
  286.             Top             =   2820
  287.             Visible         =   0   'False
  288.             Width           =   708
  289.          End
  290.          Begin VB.Label TsLabel 
  291.             AutoSize        =   -1  'True
  292.             Caption         =   "定员人数:"
  293.             Height          =   180
  294.             Index           =   0
  295.             Left            =   511
  296.             TabIndex        =   13
  297.             Top             =   1335
  298.             Width           =   708
  299.          End
  300.          Begin VB.Label Label2 
  301.             AutoSize        =   -1  'True
  302.             Caption         =   "部门名称:"
  303.             BeginProperty Font 
  304.                Name            =   "宋体"
  305.                Size            =   9
  306.                Charset         =   134
  307.                Weight          =   700
  308.                Underline       =   0   'False
  309.                Italic          =   0   'False
  310.                Strikethrough   =   0   'False
  311.             EndProperty
  312.             Height          =   180
  313.             Left            =   511
  314.             TabIndex        =   12
  315.             Top             =   810
  316.             Width           =   885
  317.          End
  318.          Begin VB.Label Lbl_DeptName 
  319.             BeginProperty Font 
  320.                Name            =   "宋体"
  321.                Size            =   9
  322.                Charset         =   134
  323.                Weight          =   700
  324.                Underline       =   0   'False
  325.                Italic          =   0   'False
  326.                Strikethrough   =   0   'False
  327.             EndProperty
  328.             Height          =   180
  329.             Left            =   1515
  330.             TabIndex        =   11
  331.             Top             =   810
  332.             Width           =   1815
  333.          End
  334.       End
  335.       Begin VSFlex8Ctl.VSFlexGrid CzxsGrid 
  336.          Height          =   5955
  337.          Left            =   75
  338.          TabIndex        =   2
  339.          Top             =   405
  340.          Width           =   7290
  341.          _ExtentX        =   12859
  342.          _ExtentY        =   10504
  343.          Appearance      =   1
  344.          BorderStyle     =   1
  345.          Enabled         =   -1  'True
  346.          BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
  347.             Name            =   "宋体"
  348.             Size            =   9
  349.             Charset         =   134
  350.             Weight          =   400
  351.             Underline       =   0   'False
  352.             Italic          =   0   'False
  353.             Strikethrough   =   0   'False
  354.          EndProperty
  355.          MousePointer    =   0
  356.          BackColor       =   -2147483643
  357.          ForeColor       =   -2147483640
  358.          BackColorFixed  =   -2147483633
  359.          ForeColorFixed  =   -2147483630
  360.          BackColorSel    =   -2147483635
  361.          ForeColorSel    =   -2147483634
  362.          BackColorBkg    =   8421504
  363.          BackColorAlternate=   -2147483643
  364.          GridColor       =   -2147483633
  365.          GridColorFixed  =   -2147483632
  366.          TreeColor       =   -2147483632
  367.          FloodColor      =   192
  368.          SheetBorder     =   -2147483642
  369.          FocusRect       =   1
  370.          HighLight       =   1
  371.          AllowSelection  =   -1  'True
  372.          AllowBigSelection=   -1  'True
  373.          AllowUserResizing=   0
  374.          SelectionMode   =   0
  375.          GridLines       =   1
  376.          GridLinesFixed  =   2
  377.          GridLineWidth   =   1
  378.          Rows            =   5000
  379.          Cols            =   10
  380.          FixedRows       =   1
  381.          FixedCols       =   0
  382.          RowHeightMin    =   0
  383.          RowHeightMax    =   0
  384.          ColWidthMin     =   0
  385.          ColWidthMax     =   0
  386.          ExtendLastCol   =   0   'False
  387.          FormatString    =   ""
  388.          ScrollTrack     =   0   'False
  389.          ScrollBars      =   3
  390.          ScrollTips      =   0   'False
  391.          MergeCells      =   0
  392.          MergeCompare    =   0
  393.          AutoResize      =   -1  'True
  394.          AutoSizeMode    =   0
  395.          AutoSearch      =   0
  396.          MultiTotals     =   -1  'True
  397.          SubtotalPosition=   1
  398.          OutlineBar      =   0
  399.          OutlineCol      =   0
  400.          Ellipsis        =   0
  401.          ExplorerBar     =   0
  402.          PicturesOver    =   0   'False
  403.          FillStyle       =   0
  404.          RightToLeft     =   0   'False
  405.          PictureType     =   0
  406.          TabBehavior     =   0
  407.          OwnerDraw       =   0
  408.          Editable        =   0   'False
  409.          ShowComboButton =   -1  'True
  410.          WordWrap        =   0   'False
  411.          TextStyle       =   0
  412.          TextStyleFixed  =   0
  413.          OleDragMode     =   0
  414.          OleDropMode     =   0
  415.          DataMode        =   0
  416.          VirtualData     =   -1  'True
  417.       End
  418.    End
  419.    Begin MSComctlLib.ImageList ImageList1 
  420.       Left            =   2070
  421.       Top             =   480
  422.       _ExtentX        =   1005
  423.       _ExtentY        =   1005
  424.       BackColor       =   -2147483643
  425.       ImageWidth      =   16
  426.       ImageHeight     =   16
  427.       MaskColor       =   12632256
  428.       _Version        =   393216
  429.       BeginProperty Images {2C247F25-8591-11D1-B16A-00C0F0283628} 
  430.          NumListImages   =   29
  431.          BeginProperty ListImage1 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  432.             Picture         =   "设置_定员设置.frx":39A4
  433.             Key             =   "sz"
  434.          EndProperty
  435.          BeginProperty ListImage2 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  436.             Picture         =   "设置_定员设置.frx":3D3E
  437.             Key             =   "dy"
  438.          EndProperty
  439.          BeginProperty ListImage3 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  440.             Picture         =   "设置_定员设置.frx":40D8
  441.             Key             =   "yl"
  442.          EndProperty
  443.          BeginProperty ListImage4 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  444.             Picture         =   "设置_定员设置.frx":4472
  445.             Key             =   "xg"
  446.          EndProperty
  447.          BeginProperty ListImage5 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  448.             Picture         =   "设置_定员设置.frx":480C
  449.             Key             =   "zh"
  450.          EndProperty
  451.          BeginProperty ListImage6 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  452.             Picture         =   "设置_定员设置.frx":4BA6
  453.             Key             =   "sh"
  454.          EndProperty
  455.          BeginProperty ListImage7 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  456.             Picture         =   "设置_定员设置.frx":4F40
  457.             Key             =   "bc"
  458.          EndProperty
  459.          BeginProperty ListImage8 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  460.             Picture         =   "设置_定员设置.frx":52DA
  461.             Key             =   "fq"
  462.          EndProperty
  463.          BeginProperty ListImage9 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  464.             Picture         =   "设置_定员设置.frx":5674
  465.             Key             =   "bz"
  466.          EndProperty
  467.          BeginProperty ListImage10 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  468.             Picture         =   "设置_定员设置.frx":5A0E
  469.             Key             =   "tc"
  470.          EndProperty
  471.          BeginProperty ListImage11 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  472.             Picture         =   "设置_定员设置.frx":5DA8
  473.             Key             =   "bcgs"
  474.          EndProperty
  475.          BeginProperty ListImage12 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  476.             Picture         =   "设置_定员设置.frx":6142
  477.             Key             =   "mrlk"
  478.          EndProperty
  479.          BeginProperty ListImage13 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  480.             Picture         =   "设置_定员设置.frx":64DC
  481.             Key             =   "xsxm"
  482.          EndProperty
  483.          BeginProperty ListImage14 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  484.             Picture         =   "设置_定员设置.frx":6876
  485.             Key             =   "first"
  486.          EndProperty
  487.          BeginProperty ListImage15 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  488.             Picture         =   "设置_定员设置.frx":6C10
  489.             Key             =   "prev"
  490.          EndProperty
  491.          BeginProperty ListImage16 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  492.             Picture         =   "设置_定员设置.frx":6FAA
  493.             Key             =   "next"
  494.          EndProperty
  495.          BeginProperty ListImage17 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  496.             Picture         =   "设置_定员设置.frx":7344
  497.             Key             =   "last"
  498.          EndProperty
  499.          BeginProperty ListImage18 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  500.             Picture         =   "设置_定员设置.frx":76DE
  501.             Key             =   "xx"
  502.          EndProperty
  503.          BeginProperty ListImage19 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  504.             Picture         =   "设置_定员设置.frx":7A78
  505.             Key             =   "define"
  506.          EndProperty
  507.          BeginProperty ListImage20 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  508.             Picture         =   "设置_定员设置.frx":7E12
  509.             Key             =   "exec"
  510.          EndProperty
  511.          BeginProperty ListImage21 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  512.             Picture         =   "设置_定员设置.frx":81AC
  513.             Key             =   "xz"
  514.          EndProperty
  515.          BeginProperty ListImage22 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  516.             Picture         =   "设置_定员设置.frx":8546
  517.             Key             =   "sc"
  518.          EndProperty
  519.          BeginProperty ListImage23 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  520.             Picture         =   "设置_定员设置.frx":88E0
  521.             Key             =   "sx"
  522.          EndProperty
  523.          BeginProperty ListImage24 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  524.             Picture         =   "设置_定员设置.frx":8C7A
  525.             Key             =   "cx"
  526.          EndProperty
  527.          BeginProperty ListImage25 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  528.             Picture         =   "设置_定员设置.frx":9014
  529.             Key             =   "zd"
  530.          EndProperty
  531.          BeginProperty ListImage26 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  532.             Picture         =   "设置_定员设置.frx":93AE
  533.             Key             =   "dz"
  534.          EndProperty
  535.          BeginProperty ListImage27 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  536.             Picture         =   "设置_定员设置.frx":9748
  537.             Key             =   "ph"
  538.          EndProperty
  539.          BeginProperty ListImage28 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  540.             Picture         =   "设置_定员设置.frx":9AE2
  541.             Key             =   "fz"
  542.          EndProperty
  543.          BeginProperty ListImage29 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  544.             Picture         =   "设置_定员设置.frx":9E7C
  545.             Key             =   "dw"
  546.          EndProperty
  547.       EndProperty
  548.    End
  549.    Begin VB.Image imgSplitter 
  550.       Height          =   6435
  551.       Left            =   2831
  552.       MousePointer    =   9  'Size W E
  553.       Top             =   630
  554.       Width           =   79
  555.    End
  556. End
  557. Attribute VB_Name = "Set_QrtFrm"
  558. Attribute VB_GlobalNameSpace = False
  559. Attribute VB_Creatable = False
  560. Attribute VB_PredeclaredId = True
  561. Attribute VB_Exposed = False
  562. '*******************************************************
  563. '*    模 块 名 称 :定员设置
  564. '*    功 能 描 述 :设定各部门的人数
  565. '*    程序员姓名  :刘刚
  566. '*    最后修改人  :刘刚
  567. '*    最后修改时间:2001/12/07
  568. '*    备        注:经过自己测试
  569. '*******************************************************
  570. Dim mbMoving As Boolean
  571. Const sglSplitLimit = 1000
  573. Dim Rec_CodeSet As New ADODB.Recordset   '编码设置表
  574. Dim jdzygs As Integer                    '控件焦点转移个数
  575. Dim Lrzt As Integer                      '录入状态标志(0-非录入状态 1-增加 2-修改)
  576. Dim ReportTitle As String                '报表主标题
  577. Dim Str_RightEdit As String             '编辑(新增、修改、删除)权限索引
  579. '以下为固定使用变量(网格)
  580. Dim Cxnrrec As New ADODB.Recordset       '显示查询内容动态集
  581. Dim Dyymctbl As New DY_Dyymsz            '打印页面窗体变量
  582. Dim GridCode As String                   '显示网格网格代码
  583. Dim GridInf() As Variant                 '整个网格设置信息
  584. Dim Tsxx As String                       '系统提示信息
  585. Dim Qslz As Long                         '网格隐藏(非操作显示)列数
  586. Dim Sjhgd As Double                      '网格数据行高度
  587. Dim GridBoolean() As Boolean             '网格列信息(布尔型)
  588. Dim GridStr()  As String                 '网格列信息(字符型)
  589. Dim GridInt() As Integer                 '网格列信息(整型)
  590. Dim Szzls As Integer                     '数组总列数(网格列数-1)
  592. '以下为固定使用变量(文本框)
  593. Dim Textvar() As Variant                 '存储变体型文本框信息
  594. Dim Textboolean() As Boolean             '存储布尔型文本框信息
  595. Dim Textint() As Integer                 '存储整型文本框信息
  596. Dim Textstr() As String                  '存储字符型文本框信息
  597. Dim Max_Text_Index As Integer            '最大录入文本框索引值
  598. Dim TextGroupCode As String              '文本框录入分组编码
  599. Dim TextValiLock As Boolean              '文本框失去焦点是否进行有效性控制判断
  600. Dim TextValiJudgeLock() As Boolean       '文本框录入有效性判断控制锁
  601. Dim CurTextIndex As Integer              '当前文本框索引值
  602. Dim TextChangeLock As Boolean            '文本框内容变换控制锁
  603. Dim Bln_Cancel As Boolean                '取消按钮信息传递
  605. Dim nodX As Node
  606. Dim CodSchemeIndex As String             '编码方案编码
  607. Dim CodScheme As String                  '编码方案
  608. Dim ParentCode As String                 '上级编码
  609. Dim CodeLevel As Integer                 '编码级次
  610. Dim DptAmount As Integer                 '暂存当前节点的人数
  612. Private Sub CzxsGrid_Click()
  613.     
  614.     Dim count As Integer
  615.     With CzxsGrid
  616.         If Trim(.TextMatrix(.Row, Sydz("001", GridStr(), Szzls))) <> "" And .Rows <> .FixedRows Then
  617.             TrV_Depart.Nodes("T" & Trim(.TextMatrix(.Row, 0))).Selected = True
  618.             TrV_Depart.SetFocus
  619.         End If
  620.     End With
  622. End Sub
  624. Private Sub Form_KeyPress(KeyAscii As Integer)   '控 制 焦 点 转 移
  625.    
  626.     jdzygs = 10
  627.     Select Case KeyAscii
  628.         Case vbKeyReturn
  629.             If Kjjdzy(jdzygs) Then
  630.                 KeyAscii = 0
  631.             End If
  632.         Case 39           '屏蔽"'"
  633.             KeyAscii = 0
  634.     End Select
  636. End Sub
  638. Private Sub Form_Load()
  639.     
  640.     SizeControls imgSplitter.Left
  641.     CodSchemeIndex = "Gy_Depar"
  642.     Add_Tree
  643.     Text_CodScheme
  644.   
  645.     '打印报表标题信息
  646.     ReportTitle = "定 员 设 置"
  647.    
  648.     '调入打印页面设置窗体
  649.     XtReportCode = "Rs_SetQrt"
  650.     Load Dyymctbl
  651.   
  652.     '以下为文本框处理程序(读入文本框录入信息)
  653.     TextGroupCode = "Rs_SetQrt"
  654.     
  655.     Call Drwbkxx(TextGroupCode, Textvar(), Textboolean(), Textint(), Textstr())
  656.     Call Wbkcsh
  657.     '调入网格设置信息
  658.     GridCode = "Rs_SetQrt"
  659.     Call BzWgcsh(CzxsGrid, GridCode, GridInf(), GridBoolean(), GridInt(), GridStr())
  660.     Qslz = GridInf(1)
  661.     Sjhgd = GridInf(2)
  662.     Szzls = CzxsGrid.Cols - 1
  663.        
  664.     '初始化toolbar,tab卡状态
  665.     StTab.Tab = 0
  666.     StTab.TabEnabled(0) = True
  667.     StTab.TabEnabled(1) = False
  668.    
  669.     '设置为非录入状态
  670.     Lrzt = 0
  671.     
  672.     '编辑(新增、修改、删除)权限索引
  673.     Str_RightEdit = "Rs_Set_Qrt_Edit"
  674.  
  675. End Sub
  677. Private Sub Cxnrtcwg()                               '查询内容填充网格
  678.   
  679.     Dim Sqlstr As String              '查询连接串
  680.     Dim jsqte As Long                 '查询临时使用变量
  681.     Dim tmpRs As New ADODB.Recordset
  682.     Dim aStr As String
  683.   
  684.     '为加快显示速度,将网格刷新动作冻结
  685.     CzxsGrid.Redraw = False
  686.       
  687.     '[>>查询连接串
  688.     
  689.     Sqlstr = "SELECT DeptCode,DeptName,Amount FROM Gy_Department WHERE DeptCode LIKE '" & Mid(Trim(TrV_Depart.SelectedItem.Key), 2, Len(Trim(TrV_Depart.SelectedItem.Key)) - 1) & "%' order by DeptCode"
  690.   
  691.     '<<]
  692.       
  693.     Set Cxnrrec = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
  694.     With Cxnrrec
  695.         CzxsGrid.Rows = CzxsGrid.FixedRows
  696.         If .EOF And .BOF Then
  697.             CzxsGrid.Redraw = True
  698.             Exit Sub
  699.         End If
  700.         jsqte = CzxsGrid.FixedRows
  701.         Do While Not .EOF
  702.             aStr = Trim(.Fields("DeptCode"))
  703.             Set tmpRs = Cw_DataEnvi.DataConnect.Execute("SELECT * FROM gY_Department WHERE DeptCode LIKE '" & aStr & "%'")
  704.             
  705.             CzxsGrid.AddItem ""
  706.             If tmpRs.RecordCount > 1 Then
  707.                 Call Jltcwg(Cxnrrec, jsqte, 1)                             '调入填充网格子过程
  708.             Else
  709.                 Call Jltcwg(Cxnrrec, jsqte, 0)
  710.             End If
  711.             CzxsGrid.RowHeight(jsqte) = Sjhgd                           '设置网格高度
  712.             .MoveNext
  713.             jsqte = jsqte + 1
  714.         Loop
  715.     End With
  716.   
  717.     '将网格刷新动作解冻
  718.     CzxsGrid.Redraw = True
  720. End Sub
  722. Private Sub Jltcwg(Jlbrec As ADODB.Recordset, Rowjsq As Long, aa As Integer)           '记录内容填充网格
  723.     
  724.     '[>>以下为自定义部分
  725.     
  726.     With Jlbrec
  727.         CzxsGrid.TextMatrix(Rowjsq, 0) = Trim(.Fields("DeptCode") & "")             '部门编码
  728.         CzxsGrid.TextMatrix(Rowjsq, Sydz("001", GridStr(), Szzls)) = Trim(.Fields("DeptName") & "")             '部门名称
  729.         If aa = 1 Then
  730.             CzxsGrid.Cell(flexcpBackColor, Rowjsq, 0, Rowjsq, 3) = &HFFC0C0
  731.             
  732.         Else
  733.             CzxsGrid.Cell(flexcpBackColor, Rowjsq, 0, Rowjsq, 3) = &HFFFFFF
  734.                         '定员人数
  735.         End If
  736.         CzxsGrid.TextMatrix(Rowjsq, Sydz("002", GridStr(), Szzls)) = Trim(.Fields("Amount") & "")
  737.         
  738.     End With
  739.     '以上为自定义部分<<]
  741. End Sub
  743. Private Sub Form_Resize()
  744.     
  745.     On Error Resume Next
  746.     
  747.     Dim St_tab As Integer
  748.     If Me.Height < 7000 Then Me.Height = 7000
  749.     If Me.Width < 10000 Then Me.Width = 10000
  751.     StTab.Width = Me.Width - (TrV_Depart.Width + 300)
  752.     StTab.Height = Me.Height - (StTab.Top + 400)
  753.     TrV_Depart.Height = Me.Height - (TrV_Depart.Top + 400)
  754.     imgSplitter.Height = TrV_Depart.Height
  756.     St_tab = StTab.Tab
  757.     StTab.Tab = 0
  758.     CzxsGrid.Width = StTab.Width - CzxsGrid.Left * 2
  759.     CzxsGrid.Height = StTab.Height - 500
  760.     StTab.Tab = St_tab
  761.     GsToolbar.Left = Me.Width - 2580
  763. End Sub
  765. Private Sub Form_Unload(Cancel As Integer)             '窗体卸载
  766.     
  767.     Set Cxnrrec = Nothing
  768.     Set Rec_CodeSet = Nothing
  769.     Unload Dyymctbl
  770.     
  771. End Sub
  773. Private Function Bclrsj() As Boolean                   '判断录入数据有效性,并保存数据
  774.   
  775.     Dim jsqte As Integer
  776.     Dim sSql As String
  777.     '对文本框录入内容进行为零和为空判断(固定不变)
  778.     With Rec_CodeSet
  779.         For jsqte = 0 To Max_Text_Index
  780.             If Textint(jsqte, 8) = 1 Then     '字段不能为空
  781.                 If Len(Trim(LrText(jsqte).Text)) = 0 Then
  782.                     Tsxx = Textstr(jsqte, 7) & "不能为空!"
  783.                     Call Xtxxts(Tsxx, 0, 1)
  784.                     LrText(jsqte).SetFocus
  785.                     Bclrsj = False
  786.                     Exit Function
  787.                 End If
  788.             Else
  789.                 If Textint(jsqte, 8) = 2 Then   '字段不能为零
  790.                     If Val(Trim(LrText(jsqte).Text)) = 0 Then
  791.                         Tsxx = Textstr(jsqte, 7) & "不能为零!"
  792.                         Call Xtxxts(Tsxx, 0, 1)
  793.                         LrText(jsqte).SetFocus
  794.                         Bclrsj = False
  795.                         Exit Function
  796.                     End If
  797.                 End If
  798.             End If
  799.         Next jsqte
  800.         
  801.         '对需要进行事后判断的文本框录入内容进行有效性判断 (固定不变)
  802.         For jsqte = 0 To Max_Text_Index
  803.             If Textint(jsqte, 9) = 0 Or Textint(jsqte, 9) = 2 Then
  804.                 If Not TextYxxpd(jsqte) Then
  805.                     Exit Function
  806.                 End If
  807.             End If
  808.         Next jsqte
  809.    
  810.         If Lrzt = 1 Then  '增 加
  811.             
  812.         Else  '否则为修改记录
  813.  
  814.             On Error GoTo Swcwcl
  815.             DptAmount = Val(Trim(LrText(0).Text)) - DptAmount
  816.             
  817.             Cw_DataEnvi.DataConnect.BeginTrans
  818.             sSql = "UPDATE Gy_department SET amount = amount + " & DptAmount & " WHERE  deptcode= LEFT('" & Trim(CzxsGrid.TextMatrix(CzxsGrid.Row, 0)) & "',len(rtrim(deptcode)))"
  819.             Cw_DataEnvi.DataConnect.Execute (sSql)
  821.             Cw_DataEnvi.DataConnect.CommitTrans
  822.        
  823.             '刷新当前网格
  824.             Call Cxnrtcwg
  825.             Call Xtxxts("保存成功!", 0, 4)
  826.    
  827.         End If
  828.      
  829.         '保存记录成功,函数返回真值
  830.         Bclrsj = True
  831.         Exit Function
  832.     End With
  833.  
  834. Swcwcl:
  835.     Cw_DataEnvi.DataConnect.RollbackTrans
  836.     Tsxx = "存盘过程中出现错误,程序自动恢复保存前状态!"
  837.     Call Xtxxts(Tsxx, 0, 1)
  838.     Exit Function
  840. End Function
  842. Private Function Cshlrxx(lrztxx As Integer) As Boolean              '初始化录入字段信息
  843.  
  844.     TextChangeLock = True       '关闭文本框Chang事件
  845.     
  846.     If lrztxx = 1 Then
  847.         
  848.         '增加新记录时将文本框清空
  849.         For jsqte = 0 To Max_Text_Index
  850.             If Len(Trim(Textstr(jsqte, 1))) <> 0 Then
  851.                 LrText(jsqte).Text = ""
  852.                 LrText(jsqte).Tag = ""
  853.             End If
  854.             TextValiJudgeLock(jsqte) = True
  855.         Next jsqte
  856.        
  857.         '[>>
  858.         '在此处可添加新增记录时初始化设置
  859.         '<<]
  860.     Else
  861.         '修改记录时根据记录关键字(编码)从数据表中读入其他字段内容
  862.         With RecTemp
  863.             Sqlstr = "SELECT * FROM Gy_Department Where DeptCode='" & Trim(CzxsGrid.TextMatrix(CzxsGrid.Row, 0)) & "'"
  864.             Set RecTemp = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
  865.             '记录如存在则读入其内容,否则提示记录已被其他人删除
  866.             If Not RecTemp.EOF Then
  867.                 Lbl_DeptName.Caption = Trim(CzxsGrid.TextMatrix(CzxsGrid.Row, Sydz("001", GridStr(), Szzls)))
  868.                 LrText(0).Text = Trim(CzxsGrid.TextMatrix(CzxsGrid.Row, Sydz("002", GridStr(), Szzls)))           '部门编码
  869.                 DptAmount = LrText(0).Text
  870.                 LrText(0).Tag = Trim(CzxsGrid.TextMatrix(CzxsGrid.Row, 0))
  872.             Else
  873.                 Tsxx = "该记录已经被其他人删除,请刷新当前数据!"
  874.                 Call Xtxxts(Tsxx, 0, 4)
  875.                 Call Cancel
  876.                 TextChangeLock = False
  877.                 Exit Function
  878.             End If
  879.         End With
  880.     End If
  881.     Cshlrxx = True
  882.     TextChangeLock = False
  884. End Function
  886. Private Sub Scdqjl()                 '删 除 当 前 记 录
  887.     
  888.     Dim Yhanswer As Integer
  889.     Dim aDo_Rec As New Recordset
  890.     '非数据行不能删除
  891.     If CzxsGrid.Row < CzxsGrid.FixedRows Then
  892.         Exit Sub
  893.     End If
  894.   
  895.     '用户确认是否删除记录
  896.     Tsxx = "请确认是否删除当前记录?"
  897.     Yhanswer = Xtxxts(Tsxx, 2, 2)
  898.     If Yhanswer = 2 Then
  899.         Exit Sub
  900.     End If
  902.     Set aDo_Rec = Cw_DataEnvi.DataConnect.Execute("select * from Gy_Department where ParentCode='" & Trim(CzxsGrid.TextMatrix(CzxsGrid.Row, Sydz("001", GridStr(), Szzls))) & "'")
  903.     If aDo_Rec.RecordCount > 0 Then
  904.         aDo_Rec.Close
  905.         Tsxx = "该项有下级,不能删除!"
  906.         Call Xtxxts(Tsxx, 0, 1)
  907.         Exit Sub
  908.     End If
  909.     aDo_Rec.Close
  910.   
  911.   On Error GoTo Cwcl
  912.       
  913.     Cw_DataEnvi.DataConnect.BeginTrans
  914.  
  915.     '[>>以下需自定义部分
  916.     Cw_DataEnvi.DataConnect.Execute "delete Gy_Department where DeptCode = '" + Trim(CzxsGrid.TextMatrix(CzxsGrid.Row, Sydz("001", GridStr(), Szzls))) + "'"
  917.  
  918.   
  919.     Add_Tree
  920.     '以上为自定义部分<<]
  921.   
  922.     Cw_DataEnvi.DataConnect.CommitTrans
  923.   
  924.     '将记录加入网格
  925.     '  Call Cxnrtcwg
  926.     CzxsGrid.RemoveItem CzxsGrid.Row
  927.     Exit Sub
  928. Cwcl:
  929.     Cw_DataEnvi.DataConnect.RollbackTrans
  930.     If Err.Number = -2147217873 Then                '(-2147217873 为SQL Server 2000通过建立外键产生的错误号)
  931.         Tsxx = "该编码已经被使用,不能删除!"
  932.         Call Xtxxts(Tsxx, 0, 1)
  933.         Exit Sub
  934.     Else
  935.         Tsxx = "出现未知情况,该编码不能被删除!"
  936.         Call Xtxxts(Tsxx, 0, 1)
  937.         Exit Sub
  938.     End If
  940. End Sub
  942. '*******************以下区域为编写自定义过程区域**********************
  944. Private Function DBIni() As Boolean
  945. '每次使用定员设置首先保证定员设置表中的部门与公用部门表里的同步
  946. Dim tmpRs As New ADODB.Recordset
  947. Dim sSql As String
  950.     
  951. End Function
  957. '*******************以上区域为编写自定义过程区域**********************
  959. '******************以下为基本处理程序(固定不变)************************'
  960. Private Sub Form_KeyUp(KeyCode As Integer, Shift As Integer)        '支持热键操作
  961.     
  962.     If Shift = 2 Then
  963.         Select Case UCase(Chr(KeyCode))
  964.             Case "P"                                                                          'Ctrl+P 打印
  965.                 If SzToolbar.Buttons("dy").Visible And SzToolbar.Buttons("dy").Enabled Then
  966.                     Call bbyl(False)
  967.                 End If
  968.             Case "A"                                                                          'Ctrl+A 增加
  969.                 If SzToolbar.Buttons("zj").Visible And SzToolbar.Buttons("zj").Enabled Then
  970.                     Call Toolbjzt
  971.                     Lrzt = 1
  972.                     Call Cshlrxx(Lrzt)
  973.                     LrText(0).Enabled = True
  974.                     LrText(0).SetFocus
  975.                    
  976.                 End If
  977.             Case "D"                                                                          'Ctrl+D 删除
  978.                 If SzToolbar.Buttons("sc").Visible And SzToolbar.Buttons("sc").Enabled Then
  979.                     Call Scdqjl
  980.                 End If
  981.         End Select
  982.     End If
  984. End Sub
  986. Private Sub imgSplitter_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
  987.     
  988.     With imgSplitter
  989.         picSplitter.Move .Left, .Top, .Width  2, .Height - 20
  990.     End With
  991.     picSplitter.Visible = True
  992.     mbMoving = True
  994. End Sub
  996. Private Sub imgSplitter_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
  997.     
  998.     Dim sglPos As Single
  999.     If mbMoving Then
  1000.         sglPos = x + imgSplitter.Left
  1001.         If sglPos < sglSplitLimit Then
  1002.             picSplitter.Left = sglSplitLimit
  1003.         ElseIf sglPos > Me.Width - sglSplitLimit Then
  1004.             picSplitter.Left = Me.Width - sglSplitLimit
  1005.         Else
  1006.             picSplitter.Left = sglPos
  1007.         End If
  1008.     End If
  1010. End Sub
  1012. Private Sub imgSplitter_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
  1013.     
  1014.     SizeControls picSplitter.Left
  1015.     picSplitter.Visible = False
  1016.     mbMoving = False
  1017.    ' StTab.Refresh
  1019. End Sub
  1021. Sub SizeControls(x As Single)
  1022.     
  1023.     On Error Resume Next
  1025.     '设置 Width 属性
  1026.     If x < 2000 Then x = 2000
  1027.     If x > (Me.Width - 5000) Then x = Me.Width - 5000
  1028.     TrV_Depart.Width = x - 100
  1029.     imgSplitter.Left = x
  1030.     StTab.Left = x + 40
  1031.     StTab.Width = Me.Width - (TrV_Depart.Width + 300)
  1032.     '设置 Top 属性
  1033.     TrV_Depart.Top = tbToolBar.Height + picTitles.Height
  1034.     StTab.Top = TrV_Depart.Top
  1035.     Dim St_tab As Integer
  1036.     St_tab = StTab.Tab
  1037.     StTab.Tab = 0
  1038.     CzxsGrid.Width = StTab.Width - CzxsGrid.Left * 2
  1039.     StTab.Tab = St_tab
  1040.     imgSplitter.Top = TrV_Depart.Top
  1041.     imgSplitter.Height = TrV_Depart.Height
  1043. End Sub
  1045. Private Sub SzToolbar_ButtonClick(ByVal Button As MSComctlLib.Button)
  1046.     
  1047.     Select Case Button.Key
  1048.         Case "ymsz"                                          '页面设置
  1049.             Dyymctbl.Show 1
  1050.         Case "yl"                                            '预 览
  1051.             Call bbyl(True)
  1052.         Case "dy"                                            '打 印
  1053.             Call bbyl(False)
  1054.         Case "xg"                                            '修 改
  1055.             Call Xgdqjl
  1056.         Case "sx"                                            '刷 新
  1057.             Call Cxnrtcwg
  1058.             Add_Tree
  1059.         Case "bz"                                            '帮 助
  1060.             Call F1bz
  1061.         Case "fh"                                            '退 出
  1062.             Unload Me
  1063.     End Select
  1065. End Sub
  1067. Private Sub CzxsGrid_DblClick()                            '修改当前编码记录
  1068.     Call Xgdqjl
  1069. End Sub
  1071. Private Sub Xgdqjl()                                       '修改当前编码记录
  1072.     
  1073.     '判断用户是否有此功能执行权限,如有则写上机日志(进入)
  1074.     If Not Security_Log(Str_RightEdit, Xtczybm, 1, True, False) Then
  1075.         BcCommand.Enabled = False
  1076.     End If
  1077.     
  1078.     If CzxsGrid.Row < CzxsGrid.FixedRows Then
  1079.         Exit Sub
  1080.     End If
  1081.     If CzxsGrid.CellBackColor = &HFFC0C0 Then Call Xtxxts("不是末级部门，不能修改!", 0, 1): Exit Sub
  1082.     Call Toolbjzt
  1083.     Lrzt = 2
  1084.     If Cshlrxx(Lrzt) Then
  1085.         LrText(0).Enabled = True
  1086.         LrText(0).SetFocus
  1087.         If LrText(0).Text = 0 Then
  1088.            LrText(0).Text = ""
  1089.         End If
  1090.     End If
  1092. End Sub
  1094. Private Sub Toolbjzt()                                     'Toolbar状态(编辑状态)
  1095.     
  1096.     StTab.TabEnabled(1) = True
  1097.     StTab.Tab = 1
  1098.     StTab.TabEnabled(0) = False
  1099.     CzxsGrid.Enabled = False
  1100.     With SzToolbar
  1101.         .Buttons("ymsz").Enabled = False
  1102.         .Buttons("dy").Enabled = False
  1103.         .Buttons("yl").Enabled = False
  1104.         .Buttons("zj").Enabled = False
  1105.         .Buttons("xg").Enabled = False
  1106.         .Buttons("sc").Enabled = False
  1107.         .Buttons("sx").Enabled = False
  1108.         .Buttons("fp").Enabled = False
  1109.     End With
  1110.     TrV_Depart.Enabled = False
  1112. End Sub
  1114. Private Sub Toolfbjzt()                                    'Toolbar状态(非编辑状态)
  1115.     
  1116.     StTab.TabEnabled(0) = True
  1117.     StTab.Tab = 0
  1118.     CzxsGrid.Enabled = True
  1119.     StTab.TabEnabled(1) = False
  1120.     Lrzt = 0
  1121.     With SzToolbar
  1122.         .Buttons("ymsz").Enabled = True
  1123.         .Buttons("dy").Enabled = True
  1124.         .Buttons("yl").Enabled = True
  1125.         .Buttons("zj").Enabled = True
  1126.         .Buttons("xg").Enabled = True
  1127.         .Buttons("sc").Enabled = True
  1128.         .Buttons("sx").Enabled = True
  1129.         .Buttons("fp").Enabled = True
  1130.     End With
  1131.     TrV_Depart.Enabled = True
  1133. End Sub
  1135. Private Sub BcCommand_Click()                                           '保 存
  1136.   
  1137.     If Not Bclrsj Then
  1138.         Exit Sub
  1139.     End If
  1140.     If Lrzt = 2 Then
  1141.         Call Toolfbjzt
  1142.     End If
  1143. End Sub
  1145. Private Sub QxCommand_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)       '取消
  1146.     
  1147.     '避免执行Click程序
  1148.     Bln_Cancel = True
  1149.   
  1150.     Call Cancel
  1152. End Sub
  1154. Private Sub QxCommand_Click()                                                                         '取消
  1155.     
  1156.     If Bln_Cancel Then
  1157.         Bln_Cancel = False
  1158.         Exit Sub
  1159.     End If
  1160.  
  1161.     Call Cancel
  1163. End Sub
  1165. Private Sub Cancel()                                                                                  '取消
  1166.     
  1167.     '文本框加锁
  1168.     For jsqte = 0 To Max_Text_Index
  1169.         TextValiJudgeLock(jsqte) = True
  1170.     Next jsqte
  1171.   
  1172.     Call Toolfbjzt
  1174. End Sub
  1176. Private Sub CzxsGrid_AfterMoveColumn(ByVal Col As Long, Position As Long)           '网格列发生移动时自动交换网格索引信息
  1177.     FnBln_RefreshArray Col, Position, GridStr(), GridInf()
  1178. End Sub
  1180. Private Sub GsToolbar_ButtonClick(ByVal Button As MSComctlLib.Button)   '表格格式设置(通用)
  1181.     
  1182.     Select Case Button.Key
  1183.         Case "bcgs"                                       '保存表格格式
  1184.             Call Bcwggs(CzxsGrid, GridCode, GridStr())
  1185.         Case "hfmrgs"                                     '恢复默认格式
  1186.             Call Hfmrgs(CzxsGrid, GridCode, GridStr())
  1187.         Case "szxsxm"                                     '设置显示项目
  1188.             Call Szxsxm(CzxsGrid, GridCode)
  1189.     End Select
  1191. End Sub
  1193. Private Sub bbyl(bbylte As Boolean)                    '报表打印预览
  1194.   
  1195.     Dim Bbzbt$, Bbxbt() As String, bbxbtzzxs() As Integer, Bbxbtgs As Integer
  1196.     Dim Bbbwh() As String, Bbbwhzzxs() As Integer, Bbbwhgs As Integer
  1197.     Bbxbtgs = 1                                          '报 表 小 标 题 行 数
  1198.     Bbbwhgs = 0                                          '报 表 表 尾 行 数
  1199.     ReDim Bbxbt(1 To Bbxbtgs)
  1200.     ReDim bbxbtzzxs(1 To Bbxbtgs)
  1201.     If Bbbwhgs <> 0 Then
  1202.         ReDim Bbbwh(1 To Bbbwhgs)
  1203.         ReDim Bbbwhzzxs(1 To Bbbwhgs)
  1204.     End If
  1205.     Bbzbt = ReportTitle
  1206.     Bbxbt(1) = " "
  1207.     bbxbtzzxs(1) = 0                                     '报表行组织形式(0-居左 1-居中 2-居右)
  1208.     Call Scyxsjb(CzxsGrid)                               '生成报表数据
  1209.     Call Scdybb(Dyymctbl, Bbzbt, Bbxbt(), bbxbtzzxs(), Bbxbtgs, Bbbwh(), Bbbwhzzxs(), Bbbwhgs, bbylte)
  1210.     If Not bbylte Then
  1211.         Unload DY_Tybbyldy
  1212.     End If
  1214. End Sub
  1216. '************以下为文本框录入处理程序(固定不变部分)*************'
  1217. Private Sub Wbklrwbcl(Index As Integer)    '文本框录入事后处理程序
  1218.     
  1219.     '以下为依据实际情况自定义部分[
  1220.     
  1221.     '在此填写文本框录入事后处理程序
  1222.     
  1223.     ']以上为依据实际情况自定义部分
  1225. End Sub
  1227. Private Sub LrText_Change(Index As Integer)
  1229.     '屏蔽程序改变控制
  1230.     If TextChangeLock Then
  1231.         Exit Sub
  1232.     End If
  1233.     
  1234.     TextValiJudgeLock(Index) = False    '打开有效性判断锁
  1235.     
  1236.     '限制字段录入长度
  1237.     TextChangeLock = True  '加锁(防止执行Lrtext_Change)
  1238.     Select Case Textint(Index, 1)
  1239.         Case 8, 11      '金额型
  1240.             Call Sjgskz(LrText(Index), Xtjezws - Xtjexsws - 1, Xtjexsws)
  1241.         Case 9, 12      '数量型
  1242.             Call Sjgskz(LrText(Index), Xtslzws - Xtslxsws - 1, Xtslxsws)
  1243.         Case 10          '单价型
  1244.             Call Sjgskz(LrText(Index), Xtdjzws - Xtdjxsws - 1, Xtdjxsws)
  1245.         Case Else        '其他小数类型控制
  1246.             If Textint(Index, 6) <> 0 Or Textint(Index, 7) <> 0 Then
  1247.                 Call Sjgskz(LrText(Index), Textint(Index, 6), Textint(Index, 7))
  1248.             End If
  1249.     End Select
  1250.         
  1251.     TextChangeLock = False '解锁
  1253. End Sub
  1255. Private Sub LrText_GotFocus(Index As Integer)                                                 '文本框得到焦点,显示相应信息
  1256.     
  1257.     Call TextShow(Index)
  1258.     CurTextIndex = Index
  1259.     LrText(Index).SelStart = Len(LrText(Index))
  1261. End Sub
  1263. Private Sub LrText_KeyDown(Index As Integer, KeyCode As Integer, Shift As Integer)            '字段按F2键提供帮助
  1264.     
  1265.     Select Case KeyCode
  1266.         Case vbKeyF2
  1267.             Call Text_Help(Index)
  1268.     End Select
  1270. End Sub
  1272. Private Sub LrText_KeyPress(Index As Integer, KeyAscii As Integer)                            '文本框录入事中控制
  1273.     Call InputFieldLimit(LrText(Index), Textint(Index, 1), KeyAscii)
  1274. End Sub
  1276. Private Sub LrText_LostFocus(Index As Integer)                                                '文本框失去焦点
  1278.     '显示相应信息但不能进行有效性判断
  1279.   
  1280. End Sub
  1282. Private Sub TrV_Depart_Collapse(ByVal Node As MSComctlLib.Node)
  1283.     
  1284.     If Node.Index <> 1 And Node.Key <> "T" Then
  1285.         Node.Image = "Cl"
  1286.     End If
  1288. End Sub
  1290. Private Sub TrV_Depart_Expand(ByVal Node As MSComctlLib.Node)
  1291.     
  1292.     If Node.Index <> 1 And Node.Key <> "T" Then
  1293.         Node.Image = "O"
  1294.     End If
  1296. End Sub
  1298. Private Sub TrV_Depart_NodeClick(ByVal Node As MSComctlLib.Node)
  1299.     
  1300.     Dim code_row As Integer
  1301.     With CzxsGrid
  1302. '        code_row = .FindRow(Trim(Mid(TrV_Depart.SelectedItem.Key, 2)), , Sydz("001", GridStr(), Szzls))
  1303. '        If code_row <> -1 Then
  1304. '            .Select code_row, 0
  1305. '        End If
  1306. '        MsgBox Node.Key
  1307.         Call Cxnrtcwg
  1308.     End With
  1310. End Sub
  1312. Private Sub Ydcommand1_MouseDown(Index As Integer, Button As Integer, Shift As Integer, x As Single, y As Single)     '按钮提供帮助
  1313.     Call Text_Help(Index)
  1314. End Sub
  1316. Private Sub Text_Help(Index As Integer)                                                       '录入字段帮助
  1317.     
  1318.     If Not Textboolean(Index, 1) Then
  1319.         Exit Sub
  1320.     End If
  1321.    
  1322.     '调用帮助
  1323.     Call Drbmhelp(Textint(Index, 2), Textstr(Index, 4), Trim(LrText(Index).Text))
  1324.   
  1325.     '根据设置选择显示编码和名称,并进行存储
  1326.     If Len(Xtfhcs) <> 0 Then
  1327.         If Textint(Index, 3) = 1 Then
  1328.             LrText(Index).Text = Xtfhcsfz
  1329.             LrText(Index).Tag = Xtfhcs
  1330.         Else
  1331.             LrText(Index).Text = Xtfhcs
  1332.             LrText(Index).Tag = Xtfhcsfz
  1333.         End If
  1334.     End If
  1335.    
  1336.     LrText(Index).SetFocus
  1338. End Sub
  1340. Private Sub TextShow(Index As Integer)        '文本框得到焦点,显示相应信息
  1341.     
  1342.     '填写文本框得到焦点,进行相应信息处理程序
  1343.    
  1344. End Sub
  1346. Private Sub Wbkcsh()                          '录入文本框初始化
  1347.     
  1348.     Dim jsqte As Integer
  1349.   
  1350.     '最大录入文本框索引值
  1351.     Max_Text_Index = Textvar(1)
  1352.   
  1353.     ReDim TextValiJudgeLock(Max_Text_Index)
  1354.     For jsqte = 0 To Max_Text_Index
  1355.         If Len(Trim(Textstr(jsqte, 1))) <> 0 Then
  1356.             If Textboolean(jsqte, 1) Then
  1357.                 If jsqte <> 0 And Not Textboolean(jsqte, 3) Then
  1358.                     Load Ydcommand1(jsqte)
  1359.                 End If
  1360.                 Ydcommand1(jsqte).Visible = True
  1361.                 Ydcommand1(jsqte).Move LrText(jsqte).Left + LrText(jsqte).Width, LrText(jsqte).Top
  1362.             End If
  1363.             TextChangeLock = True
  1364.             LrText(jsqte).Text = ""
  1365.             LrText(jsqte).Tag = ""
  1366.             If Textint(jsqte, 5) <> 0 Then
  1367.                 LrText(jsqte).MaxLength = Textint(jsqte, 5)
  1368.             End If
  1369.             TextChangeLock = False
  1370.         End If
  1371.         TextValiJudgeLock(jsqte) = True
  1372.     Next jsqte
  1374. End Sub
  1376. Private Function TextYxxpd(Index As Integer) As Boolean           '文本框有效性判断
  1377.   
  1378.     Dim Sqlstr As String
  1379.     Dim Findrec As ADODB.Recordset
  1380.   
  1381.     '文本框内容未曾改变不进行有效性判断
  1382.     If TextValiJudgeLock(Index) Then
  1383.         TextYxxpd = True
  1384.         Exit Function
  1385.     End If
  1386.   
  1387.     '文本框内容为空认为有效,并清空其Tag值
  1388.     If Trim(LrText(Index)) = "" Then
  1389.         LrText(Index).Tag = ""
  1390.         Call Wbklrwbcl(Index)
  1391.         TextValiJudgeLock(Index) = True
  1392.         TextYxxpd = True
  1393.         Exit Function
  1394.     End If
  1395.   
  1396.     '可在此加入不做有效性判断的理由
  1397.     Select Case Textint(Index, 4)
  1398.         Case 1      '编码型
  1399.             Sqlstr = Trim(Textstr(Index, 5))
  1400.             Sqlstr = Replace(Sqlstr, "@", "'" + Trim(LrText(Index).Text) + "'")
  1401.             Set Findrec = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
  1402.             If Findrec.EOF Then
  1403.                 Call Xtxxts(Trim(Textstr(Index, 6)), 0, 1)
  1404.                 LrText(Index).SetFocus
  1405.                 Exit Function
  1406.             Else
  1407.                 Select Case Textint(Index, 3)
  1408.                     Case 0
  1409.                         If Len(Trim(Textstr(Index, 2))) <> 0 Then
  1410.                             LrText(Index).Text = Trim(Findrec.Fields(Trim(Textstr(Index, 2))))
  1411.                         End If
  1412.                         If Len(Trim(Textstr(Index, 3) & "")) <> 0 Then
  1413.                             LrText(Index).Tag = Trim(Findrec.Fields(Trim(Textstr(Index, 3))))
  1414.                         End If
  1415.                     Case 1
  1416.                         If Len(Trim(Textstr(Index, 3) & "")) <> 0 Then
  1417.                             LrText(Index).Text = Trim(Findrec.Fields(Trim(Textstr(Index, 3))))
  1418.                         End If
  1419.                         If Len(Trim(Textstr(Index, 2))) <> 0 Then
  1420.                             LrText(Index).Tag = Trim(Findrec.Fields(Trim(Textstr(Index, 2))))
  1421.                         End If
  1422.                 End Select
  1423.             End If
  1424.         Case 2      '日期型
  1425.             If IsDate(LrText(Index).Text) Then
  1426.                 LrText(Index).Text = Format(LrText(Index).Text, "yyyy-mm-dd")
  1427.                 If Val(Mid(LrText(Index), 1, 4)) < 1900 Then
  1428.                     LrText(Index).Text = "1900" + Mid(LrText(Index), 5, 6)
  1429.                 End If
  1430.             Else
  1431.                 Tsxx = "非法公历日期!(格式:" + Format(Date, "yyyy-mm-dd") + ")"
  1432.                 Call Xtxxts(Tsxx, 0, 1)
  1433.                 LrText(Index).SetFocus
  1434.                 Exit Function
  1435.             End If
  1436.         Case 3      '其他类型
  1437.             If Index = 0 Then
  1438.                 Dim i As Integer, LevelLeng As Integer, tf As Boolean
  1439.                 For i = 1 To Len(CodScheme)
  1440.                     LevelLeng = LevelLeng + Val(Mid(CodScheme, i, 1))
  1441.                     If Len(Trim(LrText(0))) = LevelLeng Then
  1442.                         tf = True: Exit For
  1443.                     Else
  1444.                         tf = False
  1445.                     End If
  1446.                 Next i
  1447.                 '--------------
  1448.                 If tf = False Then
  1449.                     Tsxx = "非法编码方式！  "
  1450.                     Call Xtxxts(Tsxx, 0, 1)
  1451.                     LrText(Index).SetFocus
  1452.                     Exit Function
  1453.                 End If
  1454.                 '---------------
  1455.                 If Len(Trim(LrText(0))) <> Val(Mid(CodScheme, 1, 1)) Then
  1456.                     With CzxsGrid
  1457.                         ParentCode = Mid(Trim(LrText(0)), 1, LevelLeng - Val(Mid(CodScheme, i, 1)))
  1458.                         code_row = .FindRow(ParentCode, , Sydz("001", GridStr(), Szzls))
  1459.                         If code_row = -1 Then
  1460.                             ParentCode = ""
  1461.                             Tsxx = "没有上级编码！  "
  1462.                             Call Xtxxts(Tsxx, 0, 1)
  1463.                             LrText(Index).SetFocus
  1464.                             Exit Function
  1465.                         End If
  1466.                     End With
  1467.                 End If
  1468.                 CodeLevel = i
  1469.             End If
  1470.     End Select
  1471.     '如果有效则加锁,用户不改变内容则不再进行有效性判断
  1472.     TextValiJudgeLock(Index) = True
  1473.     
  1474.     '调用文本框事后处理程序
  1475.     Call Wbklrwbcl(Index)
  1476.     
  1477.     '有效性判断通过则返回True
  1478.     TextYxxpd = True
  1479.    
  1480. End Function
  1482. Sub Add_Tree() '添加树项
  1483.     Dim aDo_Sort As New Recordset
  1484.     TrV_Depart.Nodes.Clear
  1485.     TrV_Depart.Nodes.Add , 4, "T", "部门", "T"
  1486.     
  1487.     Set aDo_Sort = Cw_DataEnvi.DataConnect.Execute("select a.*,mj=(select count(*) from Gy_Department where Gy_Department.ParentCode=a.deptCode) from Gy_Department a order by a.deptCode")
  1488.     With aDo_Sort
  1489.         Do While Not .EOF
  1490.             If Trim("" & aDo_Sort!ParentCode) = "" Then
  1491.                 If !mj < 1 Then
  1492.                     Set nodX = TrV_Depart.Nodes.Add("T", 4, "T" & Trim(.Fields("deptcode")), "(" & Trim(.Fields("deptcode")) & ")" & Trim(.Fields("deptname")), "C")
  1493.                 Else
  1494.                     Set nodX = TrV_Depart.Nodes.Add("T", 4, "T" & Trim(.Fields("deptcode")), "(" & Trim(.Fields("deptcode")) & ")" & Trim(.Fields("deptname")), "Cl")
  1495.                 End If
  1496.                 nodX.EnsureVisible
  1497.             Else
  1498.                 If !mj < 1 Then
  1499.                     Set nodX = TrV_Depart.Nodes.Add("T" & Trim(!ParentCode), 4, "T" & Trim(.Fields("deptcode")), "(" & Trim(.Fields("deptcode")) & ")" & Trim(.Fields("deptname")), "C")
  1500.                 Else
  1501.                     Set nodX = TrV_Depart.Nodes.Add("T" & Trim(!ParentCode), 4, "T" & Trim(.Fields("deptcode")), "(" & Trim(.Fields("deptcode")) & ")" & Trim(.Fields("deptname")), "Cl")
  1502.                 End If
  1503.             End If
  1504.             .MoveNext
  1505.         Loop
  1506.     End With
  1508. End Sub
  1509.  
  1510. '编码方案
  1511. Sub Text_CodScheme()
  1512.     
  1513.     Dim aDo_Sort As New Recordset
  1514.     Dim i As Integer, h As Integer
  1515.     Set aDo_Sort = Cw_DataEnvi.DataConnect.Execute("select * from Gy_CodeScheme where ItemCode='" & Trim(CodSchemeIndex) & "'")
  1516.     CodScheme = Trim(aDo_Sort!CodeScheme)
  1517.     aDo_Sort.Close
  1518.     '-------------
  1519.     StTab.Tab = 1
  1520.     Lbl_codescheme.Caption = ""
  1521.     For i = 1 To Len(CodScheme)
  1522.         For h = 1 To Val(Mid(CodScheme, i, 1))
  1523.             Lbl_codescheme = Lbl_codescheme & "*"
  1524.         Next
  1525.         Lbl_codescheme = Lbl_codescheme & " "
  1526.     Next i
  1527.     Lbl_codescheme = Trim(Lbl_codescheme)
  1529. End Sub