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

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

企业管理

开发平台：

Visual Basic

+：源码内容
  1. VERSION 5.00
  2. Object = "{C5DE3F80-3376-11D2-BAA4-04F205C10000}#1.0#0"; "Vsflex6d.ocx"
  3. Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
  4. Object = "{BDC217C8-ED16-11CD-956C-0000C04E4C0A}#1.1#0"; "TABCTL32.OCX"
  5. Begin VB.Form JC_KjkmszFrm 
  6.    BorderStyle     =   1  'Fixed Single
  7.    Caption         =   "会计科目设置"
  8.    ClientHeight    =   7095
  9.    ClientLeft      =   45
  10.    ClientTop       =   330
  11.    ClientWidth     =   9375
  12.    HelpContextID   =   2001
  13.    Icon            =   "基础设置_会计科目设置.frx":0000
  14.    KeyPreview      =   -1  'True
  15.    LinkTopic       =   "Form2"
  16.    MaxButton       =   0   'False
  17.    MinButton       =   0   'False
  18.    ScaleHeight     =   7095
  19.    ScaleWidth      =   9375
  20.    StartUpPosition =   2  '屏幕中心
  21.    Begin TabDlg.SSTab StTab 
  22.       Height          =   6375
  23.       Left            =   30
  24.       TabIndex        =   0
  25.       Top             =   690
  26.       Width           =   9330
  27.       _ExtentX        =   16457
  28.       _ExtentY        =   11245
  29.       _Version        =   393216
  30.       Style           =   1
  31.       Tabs            =   2
  32.       TabHeight       =   520
  33.       TabCaption(0)   =   "列表视图"
  34.       TabPicture(0)   =   "基础设置_会计科目设置.frx":1042
  35.       Tab(0).ControlEnabled=   -1  'True
  36.       Tab(0).Control(0)=   "CzxsGrid"
  37.       Tab(0).Control(0).Enabled=   0   'False
  38.       Tab(0).ControlCount=   1
  39.       TabCaption(1)   =   "单张视图"
  40.       TabPicture(1)   =   "基础设置_会计科目设置.frx":105E
  41.       Tab(1).ControlEnabled=   0   'False
  42.       Tab(1).Control(0)=   "Frame1"
  43.       Tab(1).ControlCount=   1
  44.       Begin VB.Frame Frame1 
  45.          Height          =   5955
  46.          Left            =   -74910
  47.          TabIndex        =   26
  48.          Top             =   330
  49.          Width           =   9135
  50.          Begin VB.Frame Frame5 
  51.             Caption         =   "打印"
  52.             ForeColor       =   &H00FF0000&
  53.             Height          =   990
  54.             Left            =   270
  55.             TabIndex        =   44
  56.             Top             =   4860
  57.             Width           =   3600
  58.             Begin VB.TextBox LrText 
  59.                Height          =   300
  60.                Index           =   6
  61.                Left            =   1020
  62.                TabIndex        =   48
  63.                Text            =   "6"
  64.                Top             =   570
  65.                Width           =   2430
  66.             End
  67.             Begin VB.CheckBox Chk_SumPrint 
  68.                Caption         =   "汇总打印"
  69.                Height          =   240
  70.                Left            =   180
  71.                TabIndex        =   11
  72.                Top             =   255
  73.                Width           =   1185
  74.             End
  75.             Begin VB.Label Label1 
  76.                AutoSize        =   -1  'True
  77.                Caption         =   "汇总科目:"
  78.                Height          =   180
  79.                Left            =   195
  80.                TabIndex        =   45
  81.                Top             =   630
  82.                Width           =   810
  83.             End
  84.          End
  85.          Begin VB.CheckBox Chk_DayBookFlag 
  86.             Caption         =   "日记帐"
  87.             Height          =   225
  88.             Left            =   4410
  89.             TabIndex        =   21
  90.             Top             =   4050
  91.             Width           =   1065
  92.          End
  93.          Begin VB.TextBox LrText 
  94.             Height          =   300
  95.             Index           =   5
  96.             Left            =   1110
  97.             TabIndex        =   6
  98.             Text            =   "5"
  99.             Top             =   2340
  100.             Width           =   1725
  101.          End
  102.          Begin VB.CheckBox Chk_CashFlow 
  103.             Caption         =   "现金或现金等价物"
  104.             Height          =   315
  105.             Left            =   4410
  106.             TabIndex        =   22
  107.             Top             =   4320
  108.             Width           =   1785
  109.          End
  110.          Begin VB.Frame Frame4 
  111.             Caption         =   "项目核算(I)"
  112.             ForeColor       =   &H00FF0000&
  113.             Height          =   945
  114.             Left            =   4380
  115.             TabIndex        =   40
  116.             Top             =   2940
  117.             Width           =   2955
  118.             Begin VB.CommandButton Ydcommand1 
  119.                Height          =   300
  120.                Index           =   4
  121.                Left            =   2550
  122.                Picture         =   "基础设置_会计科目设置.frx":107A
  123.                Style           =   1  'Graphical
  124.                TabIndex        =   42
  125.                Top             =   540
  126.                Visible         =   0   'False
  127.                Width           =   300
  128.             End
  129.             Begin VB.TextBox LrText 
  130.                Height          =   300
  131.                Index           =   4
  132.                Left            =   870
  133.                TabIndex        =   20
  134.                Text            =   "4"
  135.                Top             =   540
  136.                Width           =   1680
  137.             End
  138.             Begin VB.CheckBox Chk_Ass 
  139.                Caption         =   "项目核算"
  140.                Height          =   255
  141.                Index           =   3
  142.                Left            =   90
  143.                TabIndex        =   19
  144.                Top             =   270
  145.                Width           =   1335
  146.             End
  147.             Begin VB.Label TsLabel 
  148.                AutoSize        =   -1  'True
  149.                Caption         =   "项目类别:"
  150.                Height          =   180
  151.                Index           =   4
  152.                Left            =   60
  153.                TabIndex        =   41
  154.                Top             =   600
  155.                Width           =   810
  156.             End
  157.          End
  158.          Begin VB.CommandButton BcCommand 
  159.             Caption         =   "保存(&S)"
  160.             Height          =   300
  161.             Left            =   4530
  162.             TabIndex        =   23
  163.             Top             =   5430
  164.             Width           =   1120
  165.          End
  166.          Begin VB.CommandButton QxCommand 
  167.             Cancel          =   -1  'True
  168.             Caption         =   "取消(&C)"
  169.             Height          =   300
  170.             Left            =   5730
  171.             TabIndex        =   24
  172.             Top             =   5430
  173.             Width           =   1120
  174.          End
  175.          Begin VB.CheckBox ChkStopUse 
  176.             Caption         =   "停用"
  177.             Height          =   315
  178.             Left            =   4380
  179.             TabIndex        =   12
  180.             Top             =   180
  181.             Width           =   705
  182.          End
  183.          Begin VB.ComboBox Combo_AccFormat 
  184.             Height          =   300
  185.             Left            =   1125
  186.             Style           =   2  'Dropdown List
  187.             TabIndex        =   5
  188.             Top             =   1920
  189.             Width           =   1725
  190.          End
  191.          Begin VB.Frame Frame3 
  192.             Caption         =   "外币核算(&F)"
  193.             ForeColor       =   &H00FF0000&
  194.             Height          =   975
  195.             Left            =   270
  196.             TabIndex        =   36
  197.             Top             =   2730
  198.             Width           =   3615
  199.             Begin VB.CommandButton Ydcommand1 
  200.                Height          =   300
  201.                Index           =   2
  202.                Left            =   3150
  203.                Picture         =   "基础设置_会计科目设置.frx":1404
  204.                Style           =   1  'Graphical
  205.                TabIndex        =   39
  206.                Top             =   540
  207.                Visible         =   0   'False
  208.                Width           =   300
  209.             End
  210.             Begin VB.TextBox LrText 
  211.                Height          =   300
  212.                Index           =   2
  213.                Left            =   990
  214.                TabIndex        =   8
  215.                Text            =   "2"
  216.                Top             =   540
  217.                Width           =   2160
  218.             End
  219.             Begin VB.CheckBox Chk_ForiFlag 
  220.                Caption         =   "外币核算"
  221.                Height          =   225
  222.                Left            =   180
  223.                TabIndex        =   7
  224.                Top             =   270
  225.                Width           =   2055
  226.             End
  227.             Begin VB.Label TsLabel 
  228.                AutoSize        =   -1  'True
  229.                Caption         =   "核算币种:"
  230.                Height          =   180
  231.                Index           =   6
  232.                Left            =   180
  233.                TabIndex        =   37
  234.                Top             =   600
  235.                Width           =   810
  236.             End
  237.          End
  238.          Begin VB.Frame Frame2 
  239.             Caption         =   "数量核算(&Q)"
  240.             ForeColor       =   &H00FF0000&
  241.             Height          =   1035
  242.             Index           =   2
  243.             Left            =   270
  244.             TabIndex        =   34
  245.             Top             =   3780
  246.             Width           =   3615
  247.             Begin VB.TextBox LrText 
  248.                Height          =   300
  249.                Index           =   3
  250.                Left            =   990
  251.                TabIndex        =   10
  252.                Text            =   "3"
  253.                Top             =   570
  254.                Width           =   2460
  255.             End
  256.             Begin VB.CheckBox Chk_QuatFlag 
  257.                Caption         =   "数量核算"
  258.                Height          =   255
  259.                Left            =   180
  260.                TabIndex        =   9
  261.                Top             =   270
  262.                Width           =   2385
  263.             End
  264.             Begin VB.Label TsLabel 
  265.                AutoSize        =   -1  'True
  266.                Caption         =   "计量单位:"
  267.                Height          =   180
  268.                Index           =   5
  269.                Left            =   180
  270.                TabIndex        =   35
  271.                Top             =   630
  272.                Width           =   810
  273.             End
  274.          End
  275.          Begin VB.Frame Frame2 
  276.             Caption         =   "辅助核算(&A)"
  277.             ForeColor       =   &H00FF0000&
  278.             Height          =   1395
  279.             Index           =   1
  280.             Left            =   4380
  281.             TabIndex        =   33
  282.             Top             =   1470
  283.             Width           =   1695
  284.             Begin VB.CheckBox Chk_Ass 
  285.                Caption         =   "供应商往来"
  286.                Height          =   255
  287.                Index           =   4
  288.                Left            =   180
  289.                TabIndex        =   16
  290.                Top             =   510
  291.                Width           =   1335
  292.             End
  293.             Begin VB.CheckBox Chk_Ass 
  294.                Caption         =   "个人往来"
  295.                Height          =   255
  296.                Index           =   2
  297.                Left            =   180
  298.                TabIndex        =   18
  299.                Top             =   1050
  300.                Width           =   1335
  301.             End
  302.             Begin VB.CheckBox Chk_Ass 
  303.                Caption         =   "部门"
  304.                Height          =   255
  305.                Index           =   1
  306.                Left            =   180
  307.                TabIndex        =   17
  308.                Top             =   795
  309.                Width           =   1335
  310.             End
  311.             Begin VB.CheckBox Chk_Ass 
  312.                Caption         =   "客户往来"
  313.                Height          =   255
  314.                Index           =   0
  315.                Left            =   180
  316.                TabIndex        =   15
  317.                Top             =   240
  318.                Width           =   1335
  319.             End
  320.          End
  321.          Begin VB.Frame Frame2 
  322.             Caption         =   "余额方向(&O)"
  323.             ForeColor       =   &H00FF0000&
  324.             Height          =   825
  325.             Index           =   0
  326.             Left            =   4380
  327.             TabIndex        =   32
  328.             Top             =   540
  329.             Width           =   1695
  330.             Begin VB.OptionButton Opt_Yefx 
  331.                Caption         =   "贷方"
  332.                Height          =   225
  333.                Index           =   1
  334.                Left            =   150
  335.                TabIndex        =   14
  336.                Top             =   510
  337.                Width           =   1215
  338.             End
  339.             Begin VB.OptionButton Opt_Yefx 
  340.                Caption         =   "借方"
  341.                Height          =   225
  342.                Index           =   0
  343.                Left            =   150
  344.                TabIndex        =   13
  345.                Top             =   240
  346.                Width           =   1215
  347.             End
  348.          End
  349.          Begin VB.ComboBox Combo_Prop 
  350.             Height          =   300
  351.             Left            =   1125
  352.             Style           =   2  'Dropdown List
  353.             TabIndex        =   4
  354.             Top             =   1485
  355.             Width           =   1725
  356.          End
  357.          Begin VB.ComboBox Combo_Class 
  358.             Height          =   300
  359.             Left            =   1125
  360.             Style           =   2  'Dropdown List
  361.             TabIndex        =   3
  362.             Top             =   1065
  363.             Width           =   1725
  364.          End
  365.          Begin VB.CommandButton Ydcommand1 
  366.             Height          =   300
  367.             Index           =   0
  368.             Left            =   8370
  369.             Picture         =   "基础设置_会计科目设置.frx":178E
  370.             Style           =   1  'Graphical
  371.             TabIndex        =   27
  372.             Top             =   1320
  373.             Visible         =   0   'False
  374.             Width           =   300
  375.          End
  376.          Begin VB.TextBox LrText 
  377.             Height          =   300
  378.             Index           =   1
  379.             Left            =   1125
  380.             TabIndex        =   2
  381.             Text            =   "1"
  382.             Top             =   660
  383.             Width           =   2775
  384.          End
  385.          Begin VB.TextBox LrText 
  386.             Height          =   300
  387.             Index           =   0
  388.             Left            =   1140
  389.             TabIndex        =   1
  390.             Text            =   "0"
  391.             Top             =   240
  392.             Width           =   1710
  393.          End
  394.          Begin VB.Label TsLabel 
  395.             AutoSize        =   -1  'True
  396.             Caption         =   "助记码:"
  397.             Height          =   180
  398.             Index           =   8
  399.             Left            =   270
  400.             TabIndex        =   43
  401.             Top             =   2400
  402.             Width           =   630
  403.          End
  404.          Begin VB.Label TsLabel 
  405.             AutoSize        =   -1  'True
  406.             Caption         =   "帐页格式:"
  407.             Height          =   180
  408.             Index           =   7
  409.             Left            =   285
  410.             TabIndex        =   38
  411.             Top             =   1980
  412.             Width           =   810
  413.          End
  414.          Begin VB.Label TsLabel 
  415.             AutoSize        =   -1  'True
  416.             Caption         =   "科目性质:"
  417.             Height          =   180
  418.             Index           =   2
  419.             Left            =   285
  420.             TabIndex        =   31
  421.             Top             =   1545
  422.             Width           =   810
  423.          End
  424.          Begin VB.Label TsLabel 
  425.             AutoSize        =   -1  'True
  426.             Caption         =   "科目类型:"
  427.             Height          =   180
  428.             Index           =   3
  429.             Left            =   285
  430.             TabIndex        =   30
  431.             Top             =   1125
  432.             Width           =   810
  433.          End
  434.          Begin VB.Label TsLabel 
  435.             AutoSize        =   -1  'True
  436.             Caption         =   "科目名称:"
  437.             Height          =   180
  438.             Index           =   1
  439.             Left            =   285
  440.             TabIndex        =   29
  441.             Top             =   720
  442.             Width           =   810
  443.          End
  444.          Begin VB.Label TsLabel 
  445.             AutoSize        =   -1  'True
  446.             Caption         =   "科目编码:"
  447.             Height          =   180
  448.             Index           =   0
  449.             Left            =   285
  450.             TabIndex        =   28
  451.             Top             =   300
  452.             Width           =   810
  453.          End
  454.       End
  455.       Begin VSFlex6DAOCtl.vsFlexGrid CzxsGrid 
  456.          Height          =   5895
  457.          Left            =   90
  458.          TabIndex        =   25
  459.          Top             =   390
  460.          Width           =   9135
  461.          _ExtentX        =   16113
  462.          _ExtentY        =   10398
  463.          _ConvInfo       =   1
  464.          Appearance      =   1
  465.          BorderStyle     =   1
  466.          Enabled         =   -1  'True
  467.          BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
  468.             Name            =   "宋体"
  469.             Size            =   9
  470.             Charset         =   134
  471.             Weight          =   400
  472.             Underline       =   0   'False
  473.             Italic          =   0   'False
  474.             Strikethrough   =   0   'False
  475.          EndProperty
  476.          MousePointer    =   0
  477.          BackColor       =   -2147483643
  478.          ForeColor       =   -2147483640
  479.          BackColorFixed  =   -2147483633
  480.          ForeColorFixed  =   -2147483630
  481.          BackColorSel    =   -2147483635
  482.          ForeColorSel    =   -2147483634
  483.          BackColorBkg    =   8421504
  484.          BackColorAlternate=   -2147483643
  485.          GridColor       =   -2147483633
  486.          GridColorFixed  =   -2147483632
  487.          TreeColor       =   -2147483632
  488.          FloodColor      =   192
  489.          SheetBorder     =   -2147483642
  490.          FocusRect       =   1
  491.          HighLight       =   1
  492.          AllowSelection  =   -1  'True
  493.          AllowBigSelection=   -1  'True
  494.          AllowUserResizing=   0
  495.          SelectionMode   =   0
  496.          GridLines       =   1
  497.          GridLinesFixed  =   2
  498.          GridLineWidth   =   1
  499.          Rows            =   5000
  500.          Cols            =   10
  501.          FixedRows       =   1
  502.          FixedCols       =   0
  503.          RowHeightMin    =   0
  504.          RowHeightMax    =   0
  505.          ColWidthMin     =   0
  506.          ColWidthMax     =   0
  507.          ExtendLastCol   =   0   'False
  508.          FormatString    =   ""
  509.          ScrollTrack     =   0   'False
  510.          ScrollBars      =   3
  511.          ScrollTips      =   0   'False
  512.          MergeCells      =   0
  513.          MergeCompare    =   0
  514.          AutoResize      =   -1  'True
  515.          AutoSizeMode    =   0
  516.          AutoSearch      =   0
  517.          MultiTotals     =   -1  'True
  518.          SubtotalPosition=   1
  519.          OutlineBar      =   0
  520.          OutlineCol      =   0
  521.          Ellipsis        =   0
  522.          ExplorerBar     =   0
  523.          PicturesOver    =   0   'False
  524.          FillStyle       =   0
  525.          RightToLeft     =   0   'False
  526.          PictureType     =   0
  527.          TabBehavior     =   0
  528.          OwnerDraw       =   0
  529.          Editable        =   0   'False
  530.          ShowComboButton =   -1  'True
  531.          WordWrap        =   0   'False
  532.          TextStyle       =   0
  533.          TextStyleFixed  =   0
  534.          OleDragMode     =   0
  535.          OleDropMode     =   0
  536.          DataMode        =   0
  537.          VirtualData     =   -1  'True
  538.       End
  539.    End
  540.    Begin MSComctlLib.ImageList ImageList1 
  541.       Left            =   0
  542.       Top             =   420
  543.       _ExtentX        =   1005
  544.       _ExtentY        =   1005
  545.       BackColor       =   -2147483643
  546.       ImageWidth      =   16
  547.       ImageHeight     =   16
  548.       MaskColor       =   12632256
  549.       _Version        =   393216
  550.       BeginProperty Images {2C247F25-8591-11D1-B16A-00C0F0283628} 
  551.          NumListImages   =   29
  552.          BeginProperty ListImage1 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  553.             Picture         =   "基础设置_会计科目设置.frx":1B18
  554.             Key             =   "sz"
  555.          EndProperty
  556.          BeginProperty ListImage2 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  557.             Picture         =   "基础设置_会计科目设置.frx":1EB2
  558.             Key             =   "dy"
  559.          EndProperty
  560.          BeginProperty ListImage3 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  561.             Picture         =   "基础设置_会计科目设置.frx":224C
  562.             Key             =   "yl"
  563.          EndProperty
  564.          BeginProperty ListImage4 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  565.             Picture         =   "基础设置_会计科目设置.frx":25E6
  566.             Key             =   "xg"
  567.          EndProperty
  568.          BeginProperty ListImage5 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  569.             Picture         =   "基础设置_会计科目设置.frx":2980
  570.             Key             =   "zh"
  571.          EndProperty
  572.          BeginProperty ListImage6 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  573.             Picture         =   "基础设置_会计科目设置.frx":2D1A
  574.             Key             =   "sh"
  575.          EndProperty
  576.          BeginProperty ListImage7 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  577.             Picture         =   "基础设置_会计科目设置.frx":30B4
  578.             Key             =   "bc"
  579.          EndProperty
  580.          BeginProperty ListImage8 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  581.             Picture         =   "基础设置_会计科目设置.frx":344E
  582.             Key             =   "fq"
  583.          EndProperty
  584.          BeginProperty ListImage9 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  585.             Picture         =   "基础设置_会计科目设置.frx":37E8
  586.             Key             =   "bz"
  587.          EndProperty
  588.          BeginProperty ListImage10 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  589.             Picture         =   "基础设置_会计科目设置.frx":3B82
  590.             Key             =   "tc"
  591.          EndProperty
  592.          BeginProperty ListImage11 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  593.             Picture         =   "基础设置_会计科目设置.frx":3F1C
  594.             Key             =   "bcgs"
  595.          EndProperty
  596.          BeginProperty ListImage12 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  597.             Picture         =   "基础设置_会计科目设置.frx":42B6
  598.             Key             =   "mrlk"
  599.          EndProperty
  600.          BeginProperty ListImage13 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  601.             Picture         =   "基础设置_会计科目设置.frx":4650
  602.             Key             =   "xsxm"
  603.          EndProperty
  604.          BeginProperty ListImage14 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  605.             Picture         =   "基础设置_会计科目设置.frx":49EA
  606.             Key             =   "first"
  607.          EndProperty
  608.          BeginProperty ListImage15 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  609.             Picture         =   "基础设置_会计科目设置.frx":4D84
  610.             Key             =   "prev"
  611.          EndProperty
  612.          BeginProperty ListImage16 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  613.             Picture         =   "基础设置_会计科目设置.frx":511E
  614.             Key             =   "next"
  615.          EndProperty
  616.          BeginProperty ListImage17 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  617.             Picture         =   "基础设置_会计科目设置.frx":54B8
  618.             Key             =   "last"
  619.          EndProperty
  620.          BeginProperty ListImage18 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  621.             Picture         =   "基础设置_会计科目设置.frx":5852
  622.             Key             =   "xx"
  623.          EndProperty
  624.          BeginProperty ListImage19 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  625.             Picture         =   "基础设置_会计科目设置.frx":5BEC
  626.             Key             =   "define"
  627.          EndProperty
  628.          BeginProperty ListImage20 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  629.             Picture         =   "基础设置_会计科目设置.frx":5F86
  630.             Key             =   "exec"
  631.          EndProperty
  632.          BeginProperty ListImage21 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  633.             Picture         =   "基础设置_会计科目设置.frx":6320
  634.             Key             =   "xz"
  635.          EndProperty
  636.          BeginProperty ListImage22 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  637.             Picture         =   "基础设置_会计科目设置.frx":66BA
  638.             Key             =   "sc"
  639.          EndProperty
  640.          BeginProperty ListImage23 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  641.             Picture         =   "基础设置_会计科目设置.frx":6A54
  642.             Key             =   "sx"
  643.          EndProperty
  644.          BeginProperty ListImage24 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  645.             Picture         =   "基础设置_会计科目设置.frx":6DEE
  646.             Key             =   "cx"
  647.          EndProperty
  648.          BeginProperty ListImage25 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  649.             Picture         =   "基础设置_会计科目设置.frx":7188
  650.             Key             =   "zd"
  651.          EndProperty
  652.          BeginProperty ListImage26 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  653.             Picture         =   "基础设置_会计科目设置.frx":7522
  654.             Key             =   "dz"
  655.          EndProperty
  656.          BeginProperty ListImage27 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  657.             Picture         =   "基础设置_会计科目设置.frx":78BC
  658.             Key             =   "ph"
  659.          EndProperty
  660.          BeginProperty ListImage28 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  661.             Picture         =   "基础设置_会计科目设置.frx":7C56
  662.             Key             =   "fz"
  663.          EndProperty
  664.          BeginProperty ListImage29 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  665.             Picture         =   "基础设置_会计科目设置.frx":7FF0
  666.             Key             =   "dw"
  667.          EndProperty
  668.       EndProperty
  669.    End
  670.    Begin MSComctlLib.Toolbar SzToolbar 
  671.       Align           =   1  'Align Top
  672.       Height          =   570
  673.       Left            =   0
  674.       TabIndex        =   46
  675.       Top             =   0
  676.       Width           =   9375
  677.       _ExtentX        =   16536
  678.       _ExtentY        =   1005
  679.       ButtonWidth     =   820
  680.       ButtonHeight    =   953
  681.       AllowCustomize  =   0   'False
  682.       Appearance      =   1
  683.       Style           =   1
  684.       ImageList       =   "ImageList1"
  685.       _Version        =   393216
  686.       BeginProperty Buttons {66833FE8-8583-11D1-B16A-00C0F0283628} 
  687.          NumButtons      =   13
  688.          BeginProperty Button1 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  689.             Caption         =   "设置"
  690.             Key             =   "ymsz"
  691.             ImageKey        =   "sz"
  692.          EndProperty
  693.          BeginProperty Button2 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  694.             Caption         =   "打印"
  695.             Key             =   "dy"
  696.             Object.ToolTipText     =   "点击或按Ctrl+P打印表格"
  697.             ImageKey        =   "dy"
  698.          EndProperty
  699.          BeginProperty Button3 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  700.             Caption         =   "预览"
  701.             Key             =   "yl"
  702.             ImageKey        =   "yl"
  703.          EndProperty
  704.          BeginProperty Button4 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  705.             Style           =   3
  706.          EndProperty
  707.          BeginProperty Button5 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  708.             Caption         =   "增加"
  709.             Key             =   "zj"
  710.             Object.ToolTipText     =   "点击或按Ctrl+A增加记录"
  711.             ImageKey        =   "xz"
  712.          EndProperty
  713.          BeginProperty Button6 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  714.             Caption         =   "修改"
  715.             Key             =   "xg"
  716.             ImageKey        =   "xg"
  717.          EndProperty
  718.          BeginProperty Button7 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  719.             Caption         =   "删除"
  720.             Key             =   "sc"
  721.             Object.ToolTipText     =   "点击或按Ctrl+D删除当前记录"
  722.             ImageKey        =   "sc"
  723.          EndProperty
  724.          BeginProperty Button8 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  725.             Style           =   3
  726.          EndProperty
  727.          BeginProperty Button9 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  728.             Caption         =   "定位"
  729.             Key             =   "dw"
  730.             ImageKey        =   "dw"
  731.          EndProperty
  732.          BeginProperty Button10 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  733.             Caption         =   "刷新"
  734.             Key             =   "sx"
  735.             ImageKey        =   "sx"
  736.          EndProperty
  737.          BeginProperty Button11 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  738.             Style           =   3
  739.          EndProperty
  740.          BeginProperty Button12 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  741.             Caption         =   "帮助"
  742.             Key             =   "bz"
  743.             ImageKey        =   "bz"
  744.          EndProperty
  745.          BeginProperty Button13 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  746.             Caption         =   "退出"
  747.             Key             =   "fh"
  748.             ImageKey        =   "tc"
  749.          EndProperty
  750.       EndProperty
  751.       BorderStyle     =   1
  752.       Begin MSComctlLib.Toolbar GsToolbar 
  753.          Height          =   540
  754.          Left            =   6870
  755.          TabIndex        =   47
  756.          Top             =   0
  757.          Width           =   2475
  758.          _ExtentX        =   4366
  759.          _ExtentY        =   953
  760.          ButtonWidth     =   1455
  761.          ButtonHeight    =   953
  762.          AllowCustomize  =   0   'False
  763.          Appearance      =   1
  764.          Style           =   1
  765.          ImageList       =   "ImageList1"
  766.          _Version        =   393216
  767.          BeginProperty Buttons {66833FE8-8583-11D1-B16A-00C0F0283628} 
  768.             NumButtons      =   3
  769.             BeginProperty Button1 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  770.                Caption         =   "保存格式"
  771.                Key             =   "bcgs"
  772.                ImageKey        =   "bcgs"
  773.             EndProperty
  774.             BeginProperty Button2 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  775.                Caption         =   "默认列宽"
  776.                Key             =   "hfmrgs"
  777.                ImageKey        =   "mrlk"
  778.             EndProperty
  779.             BeginProperty Button3 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  780.                Caption         =   "显示项目"
  781.                Key             =   "szxsxm"
  782.                ImageKey        =   "xsxm"
  783.             EndProperty
  784.          EndProperty
  785.       End
  786.    End
  787. End
  788. Attribute VB_Name = "JC_KjkmszFrm"
  789. Attribute VB_GlobalNameSpace = False
  790. Attribute VB_Creatable = False
  791. Attribute VB_PredeclaredId = True
  792. Attribute VB_Exposed = False
  793. '*******************************************************
  794. '*    模 块 名 称 :会计科目设置
  795. '*    功 能 描 述 :设置公司会计科目
  796. '*    程序员姓名  :张建忠
  797. '*    最后修改人  :张建忠
  798. '*    最后修改时间:2001/11/17
  799. '*    备        注:
  800. '*******************************************************
  802. Dim Rec_CodeSet As New ADODB.Recordset   '编码设置表
  803. Dim RecCodeScheme As New ADODB.Recordset '系统编码方案表
  804. Dim RecTemp As Recordset                 '临时使用动态集
  805. Dim Int_CodeScheme() As Integer          '会计科目编码方案
  806. Dim Int_CodeLev As Integer               '会计科目编码级次
  807. Dim jdzygs As Integer                    '控件焦点转移个数
  808. Dim Lrzt As Integer                      '录入状态标志(0-非录入状态 1-增加 2-修改)
  809. Dim ReportTitle As String                '报表主标题
  810. Dim Bln_ChkAssLock As Boolean            '辅助核算控制锁
  811.   
  812. '以下为固定使用变量(网格)
  813. Dim Cxnrrec As New ADODB.Recordset       '显示查询内容动态集
  814. Dim Dyymctbl As New DY_Dyymsz            '打印页面窗体变量
  815. Dim GridCode As String                   '显示网格网格代码
  816. Dim GridInf() As Variant                 '整个网格设置信息
  817. Dim Tsxx As String                       '系统提示信息
  818. Dim Qslz As Long                         '网格隐藏(非操作显示)列数
  819. Dim Sjhgd As Double                      '网格数据行高度
  820. Dim GridBoolean() As Boolean             '网格列信息(布尔型)
  821. Dim GridStr()  As String                 '网格列信息(字符型)
  822. Dim GridInt() As Integer                 '网格列信息(整型)
  823. Dim Szzls As Integer                     '数组总列数(网格列数-1)
  825. '以下为固定使用变量(文本框)
  826. Dim Textvar() As Variant                 '存储变体型文本框信息
  827. Dim Textboolean() As Boolean             '存储布尔型文本框信息
  828. Dim Textint() As Integer                 '存储整型文本框信息
  829. Dim Textstr() As String                  '存储字符型文本框信息
  830. Dim Max_Text_Index As Integer            '最大录入文本框索引值
  831. Dim TextGroupCode As String              '文本框录入分组编码
  832. Dim TextValiLock As Boolean              '文本框失去焦点是否进行有效性控制判断
  833. Dim TextValiJudgeLock() As Boolean       '文本框录入有效性判断控制锁
  834. Dim CurTextIndex As Integer              '当前文本框索引值
  835. Dim TextChangeLock As Boolean            '文本框内容变换控制锁
  836. Dim Bln_Cancel As Boolean                '取消按钮信息传递
  838. Private Sub Form_KeyPress(KeyAscii As Integer)   '控 制 焦 点 转 移
  840.     jdzygs = 25
  841.     
  842.     Select Case KeyAscii
  843.         Case vbKeyReturn
  844.             If Kjjdzy(jdzygs) Then
  845.                 KeyAscii = 0
  846.             End If
  847.         Case 39           '屏蔽"'"
  848.             KeyAscii = 0
  849.     End Select
  850.    
  851. End Sub
  853. Private Sub Form_Load()
  854.   
  855.     '打印报表标题信息
  856.     ReportTitle = "会 计 科 目 表"
  857.      
  858.     '调入打印页面设置窗体
  859.     XtReportCode = "Cwzz_Kjkmsz"
  860.     Load Dyymctbl
  861.     
  862.     '以下为文本框处理程序(读入文本框录入信息)
  863.     TextGroupCode = "Cwzz_Kjkmsz"
  864.     Call Drwbkxx(TextGroupCode, Textvar(), Textboolean(), Textint(), Textstr())
  865.     Call Wbkcsh
  866.     
  867.     '调入网格设置信息
  868.     GridCode = "Cwzz_Kjkmsz"
  869.     Call BzWgcsh(CzxsGrid, GridCode, GridInf(), GridBoolean(), GridInt(), GridStr())
  870.     Qslz = GridInf(1)
  871.     Sjhgd = GridInf(2)
  872.     Szzls = CzxsGrid.Cols - 1
  873.     
  874.     '填 充 网 格
  875.     Call Cxnrtcwg
  876.        
  877.     '初始化ToolBar,Tab卡状态
  878.     StTab.Tab = 0
  879.     StTab.TabEnabled(1) = False
  880.     Frame1.Enabled = False
  881.     
  882.     '设置为非录入状态
  883.     Lrzt = 0
  884.           
  885.    '初始化科目类型列表框
  886.    Call FillCombo(Combo_Class, "Cwzz_Kmlx", "", 0)
  887.    
  888.    '初始化科目性质列表框
  889.    Call FillCombo(Combo_Prop, "Cwzz_Kmxz", "", 0)
  890.    
  891.    '初始化帐页格式列表框
  892.    Call FillCombo(Combo_AccFormat, "Cwzz_Zygs", "", 0)
  893.    
  894.    '读入会计科目编码方案
  895.    Set RecCodeScheme = Cw_DataEnvi.DataConnect.Execute("Select CodeScheme From Gy_CodeScheme Where ItemCode='Cwzz_Kmcode'")
  896.    With RecCodeScheme
  897.         If Not .EOF Then
  898.             Int_CodeLev = Len(Trim(.Fields("CodeScheme")))
  899.             ReDim Int_CodeScheme(Int_CodeLev)
  900.             lenjsq = 0
  901.             For jsqte = 1 To Int_CodeLev
  902.                 lenjsq = lenjsq + Mid(Trim(.Fields("CodeScheme")), jsqte, 1)
  903.                 Int_CodeScheme(jsqte) = lenjsq
  904.             Next jsqte
  905.         End If
  906.         .Close
  907.    End With
  908.    
  909.    '初始化余额方向
  910.     Opt_Yefx(0).Value = True
  911.     
  912.    '初始化外币 数量 项目核算标志 汇总打印
  913.     Call Textwx(LrText(2))
  914.     Call Textwx(LrText(3))
  915.     Ydcommand1(2).Enabled = False
  916.     Call Textwx(LrText(4))
  917.     Ydcommand1(4).Enabled = False
  918.     Call Textwx(LrText(6))
  919.     
  920. End Sub
  922. Private Sub Cxnrtcwg()                               '查询内容填充网格
  924.     Dim SqlStr As String              '查询连接串
  925.     Dim jsqte As Long                 '查询临时使用变量
  926.   
  927.     '为加快显示速度,将网格刷新动作冻结
  928.     CzxsGrid.Redraw = False
  929.   
  930.     '[>>查询连接串
  931.     SqlStr = "SELECT Cwzz_AccCode.*, Gy_ForeignCurrency.ForeignCurrName FROM Cwzz_AccCode LEFT OUTER JOIN" & _
  932.       " Gy_ForeignCurrency ON" & _
  933.       " Cwzz_AccCode.ForeignCurrCode = Gy_ForeignCurrency.ForeignCurrCode order by Ccode"
  934.     '<<]
  935.     Set Cxnrrec = Cw_DataEnvi.DataConnect.Execute(SqlStr)
  936.     
  937.     With Cxnrrec
  938.         CzxsGrid.Rows = CzxsGrid.FixedRows
  939.         If .EOF And .BOF Then
  940.             CzxsGrid.Redraw = True
  941.             Exit Sub
  942.         End If
  943.         jsqte = CzxsGrid.FixedRows
  944.         Do While Not .EOF
  945.             CzxsGrid.AddItem ""
  946.             Call Jltcwg(Cxnrrec, jsqte)                              '调入填充网格子过程
  947.             CzxsGrid.RowHeight(jsqte) = Sjhgd                        '设置网格高度
  948.             .MoveNext
  949.             jsqte = jsqte + 1
  950.         Loop
  951.     End With
  952.   
  953.     '将网格刷新动作解冻
  954.     CzxsGrid.Redraw = True
  955.     
  956. End Sub
  958. Private Sub Jltcwg(Jlbrec As ADODB.Recordset, Rowjsq As Long)           '记录内容填充网格
  960.     Dim Str_Fzhs As String      '辅助核算
  961.     
  962.     '[以下为自定义部分
  963.      With Jlbrec
  964.         
  965.         CzxsGrid.TextMatrix(Rowjsq, Sydz("001", GridStr(), Szzls)) = Trim(.Fields("CClass"))
  966.         CzxsGrid.TextMatrix(Rowjsq, Sydz("002", GridStr(), Szzls)) = .Fields("CodeLevel")
  967.         CzxsGrid.TextMatrix(Rowjsq, Sydz("003", GridStr(), Szzls)) = Trim(.Fields("CCode") & "")
  968.         CzxsGrid.TextMatrix(Rowjsq, Sydz("004", GridStr(), Szzls)) = Trim(.Fields("Cname") & "")
  969.         CzxsGrid.TextMatrix(Rowjsq, Sydz("005", GridStr(), Szzls)) = Trim(.Fields("ForeignCurrName") & "")
  970.         CzxsGrid.TextMatrix(Rowjsq, Sydz("006", GridStr(), Szzls)) = Trim(.Fields("Measure") & "")
  971.         CzxsGrid.TextMatrix(Rowjsq, Sydz("007", GridStr(), Szzls)) = Trim(.Fields("Cproperty") & "")
  972.         Str_Fzhs = ""
  973.         If .Fields("DeptFlag") Then
  974.            Str_Fzhs = Str_Fzhs + "部门 "
  975.         End If
  976.         If .Fields("CusFlag") Then
  977.            Str_Fzhs = Str_Fzhs + "客户 "
  978.         End If
  979.         If .Fields("SupplierFlag") Then
  980.            Str_Fzhs = Str_Fzhs + "供应商 "
  981.         End If
  982.         If .Fields("PersonFlag") Then
  983.            Str_Fzhs = Str_Fzhs + "个人 "
  984.         End If
  985.         If .Fields("ItemFlag") Then
  986.            Str_Fzhs = Str_Fzhs + "项目 "
  987.         End If
  988.         CzxsGrid.TextMatrix(Rowjsq, Sydz("008", GridStr(), Szzls)) = Trim(Str_Fzhs)
  989.         CzxsGrid.TextMatrix(Rowjsq, Sydz("009", GridStr(), Szzls)) = Trim(.Fields("AccFormat") & "")
  990.         CzxsGrid.TextMatrix(Rowjsq, Sydz("010", GridStr(), Szzls)) = Trim(.Fields("BalanceOri") & "")
  991.         CzxsGrid.TextMatrix(Rowjsq, Sydz("011", GridStr(), Szzls)) = Trim(.Fields("StopFlag") & "")
  992.         CzxsGrid.TextMatrix(Rowjsq, Sydz("012", GridStr(), Szzls)) = Trim(.Fields("AssCode") & "")
  993.         
  994.      End With
  995.     '以上为自定义部分]
  997. End Sub
  999. Private Sub Form_Unload(Cancel As Integer)             '窗体卸载
  1001.     Set Cxnrrec = Nothing
  1002.     Set Rec_CodeSet = Nothing
  1003.     Unload Dyymctbl
  1004.    
  1005. End Sub
  1006. Private Function Bclrsj() As Boolean                   '判断录入数据有效性,并保存数据
  1008.     Dim jsqte As Integer
  1009.     Dim Str_Parent As String   '上级科目号
  1010.     Dim CodeLength As Integer  '录入科目长度
  1011.     Dim CodeLev As Integer     '录入科目级次
  1012.   
  1013.     '对文本框录入内容进行为零和为空判断(固定不变)
  1014.     With Rec_CodeSet
  1015.         For jsqte = 0 To Max_Text_Index
  1016.             If Textint(jsqte, 8) = 1 Then     '字段不能为空
  1017.                 If Len(Trim(LrText(jsqte).Text)) = 0 Then
  1018.                     Tsxx = Textstr(jsqte, 7) & "不能为空!"
  1019.                     Call Xtxxts(Tsxx, 0, 1)
  1020.                     LrText(jsqte).SetFocus
  1021.                     Bclrsj = False
  1022.                     Exit Function
  1023.                 End If
  1024.             Else
  1025.                 If Textint(jsqte, 8) = 2 Then   '字段不能为零
  1026.                     If Val(Trim(LrText(jsqte).Text)) = 0 Then
  1027.                         Tsxx = Textstr(jsqte, 7) & "不能为零!"
  1028.                         Call Xtxxts(Tsxx, 0, 1)
  1029.                         LrText(jsqte).SetFocus
  1030.                         Bclrsj = False
  1031.                         Exit Function
  1032.                     End If
  1033.                 End If
  1034.             End If
  1035.         Next jsqte
  1036.         
  1037.         '如有外币核算,则外币栏不能为空
  1038.          If Chk_ForiFlag.Value = 1 Then
  1039.             If Len(Trim(LrText(2).Text)) = 0 Then
  1040.               Tsxx = "科目进行外币核算,则外币项不能为空!"
  1041.               Call Xtxxts(Tsxx, 0, 1)
  1042.               LrText(2).SetFocus
  1043.               Bclrsj = False
  1044.               Exit Function
  1045.             End If
  1046.          End If
  1047.         
  1048.         '如有数量核算,则数量栏不能为空
  1049.          If Chk_QuatFlag.Value = 1 Then
  1050.             If Len(Trim(LrText(3).Text)) = 0 Then
  1051.               Tsxx = "科目进行数量核算,则数量项不能为空!"
  1052.               Call Xtxxts(Tsxx, 0, 1)
  1053.               LrText(3).SetFocus
  1054.               
  1055.               Bclrsj = False
  1056.               Exit Function
  1057.             End If
  1058.          End If
  1059.          
  1060.          '如有项目核算,则项目类别栏不能为空
  1061.          If Chk_Ass(3).Value = 1 Then
  1062.             If Len(Trim(LrText(4).Text)) = 0 Then
  1063.               Tsxx = "科目进行项目核算,则项目类别项不能为空!"
  1064.               Call Xtxxts(Tsxx, 0, 1)
  1065.               LrText(4).SetFocus
  1066.               Bclrsj = False
  1067.               Exit Function
  1068.             End If
  1069.          End If
  1070.     
  1071.         '对需要进行事后判断的文本框录入内容进行有效性判断 (固定不变)
  1072.         For jsqte = 0 To Max_Text_Index
  1073.             If Textint(jsqte, 9) = 0 Or Textint(jsqte, 9) = 2 Then
  1074.                 If Not TextYxxpd(jsqte) Then
  1075.                     Exit Function
  1076.                 End If
  1077.             End If
  1078.         Next jsqte
  1079.    
  1080.         If Lrzt = 1 Then  '增 加
  1081.         
  1082.             '判断科目编码是否符合规则,如有效则同时计算科目级次和上级科目编码
  1083.             For jsqte = 1 To Int_CodeLev
  1084.                 If Int_CodeScheme(jsqte) = Len(Trim(LrText(0).Text)) Then
  1085.                    CodeLev = jsqte
  1086.                    Exit For
  1087.                 End If
  1088.             Next jsqte
  1089.             If jsqte <= CodeLev Then
  1090.                 If jsqte > 1 Then
  1091.                    Str_Parent = Mid(Trim(LrText(0).Text), 1, Int_CodeScheme(jsqte - 1))
  1092.                 Else
  1093.                    Str_Parent = ""
  1094.                 End If
  1095.             Else
  1096.                 Tsxx = "科目编码不符合编码规则!"
  1097.                 Call Xtxxts(Tsxx, 0, 1)
  1098.                 LrText(0).SetFocus
  1099.                 Bclrsj = False
  1100.                 Exit Function
  1101.             End If
  1102.     
  1103.             '判断此科目是否已建立上级科目
  1104.             If Str_Parent <> "" Then
  1105.                 Set Rec_CodeSet = Cw_DataEnvi.DataConnect.Execute("SELECT CCode,StopFlag FROM Cwzz_AccCode  Where CCode='" & Trim(Str_Parent) & "'")
  1106.                 If Rec_CodeSet.EOF Then
  1107.                     Tsxx = "请先建立其上级科目编码!"
  1108.                     Call Xtxxts(Tsxx, 0, 1)
  1109.                     LrText(0).Text = Str_Parent
  1110.                     LrText(0).SelStart = Len(LrText(0).Text)
  1111.                     LrText(0).SetFocus
  1112.                     Bclrsj = False
  1113.                     Exit Function
  1114.                 Else
  1115.                     If Rec_CodeSet.Fields("StopFlag") Then
  1116.                         Tsxx = "其上级科目编码已停用,不能建立下级科目!"
  1117.                         Call Xtxxts(Tsxx, 0, 1)
  1118.                         LrText(0).SetFocus
  1119.                         Bclrsj = False
  1120.                         Exit Function
  1121.                      End If
  1122.                 End If
  1123.                 Set RecTemp = Cw_DataEnvi.DataConnect.Execute("SELECT Top 1 CCode FROM Cwzz_AccVouchSub Where CCode='" & Trim(Str_Parent) & "'")
  1124.                 If Not RecTemp.EOF Then
  1125.                     Tsxx = "科目编码(" + Str_Parent + ")已使用,不能建立下级科目!"
  1126.                     Call Xtxxts(Tsxx, 0, 1)
  1127.                     LrText(0).SelStart = Len(LrText(0).Text)
  1128.                     LrText(0).SetFocus
  1129.                     Bclrsj = False
  1130.                     Exit Function
  1131.                 End If
  1132.             End If
  1134.             '[>>判断编码是否重复
  1135.             If .State = 1 Then .Close
  1136.             .Open "SELECT * FROM Cwzz_AccCode WHERE Ccode= '" + Trim(LrText(0).Text) + "'", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
  1137.             If Not .EOF Then
  1138.                 Tsxx = "科目编码重复!"
  1139.                 Call Xtxxts(Tsxx, 0, 1)
  1140.                 LrText(0).SetFocus
  1141.                 Bclrsj = False
  1142.                 Exit Function
  1143.             End If
  1144.             
  1145.             '判断名称是否重复
  1146.             If .State = 1 Then .Close
  1147.             .Open "SELECT * FROM Cwzz_AccCode WHERE Cname= '" + Trim(LrText(1).Text) + "'", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
  1148.             If Not .EOF Then
  1149.                 Tsxx = "科目名称重复!"
  1150.                 Call Xtxxts(Tsxx, 0, 1)
  1151.                 LrText(1).SetFocus
  1152.                 Bclrsj = False
  1153.                 Exit Function
  1154.             End If
  1155.     
  1156.             '判断助记码是否唯一
  1157.             If Trim(LrText(5).Text) <> "" Then
  1158.                 If .State = 1 Then .Close
  1159.                 .Open "SELECT * FROM Cwzz_AccCode WHERE AssCode= '" + Trim(LrText(5).Text) + "'", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
  1160.                 If Not .EOF Then
  1161.                     Tsxx = "助记码不唯一!"
  1162.                     Call Xtxxts(Tsxx, 0, 1)
  1163.                     LrText(5).SetFocus
  1164.                     Bclrsj = False
  1165.                     Exit Function
  1166.                 End If
  1167.             End If
  1168.             
  1169.             '如果科目汇总打印则其汇总科目不能为空且为其上级科目
  1170.             If Chk_SumPrint.Value = 1 Then
  1171.                 If Len(Trim(LrText(6).Text)) = 0 Then
  1172.                     Tsxx = "科目进行汇总打印,则汇总科目不能为空!"
  1173.                     Call Xtxxts(Tsxx, 0, 1)
  1174.                     LrText(6).SetFocus
  1175.                     Bclrsj = False
  1176.                     Exit Function
  1177.                 Else
  1178.                     If InStr(1, Trim(LrText(0).Text), Trim(LrText(6).Text)) = 0 Then
  1179.                         Tsxx = "汇总打印科目必须为其上级科目!"
  1180.                         Call Xtxxts(Tsxx, 0, 1)
  1181.                         LrText(6).SetFocus
  1182.                         Bclrsj = False
  1183.                         Exit Function
  1184.                     End If
  1185.                     
  1186.                     '判断汇总科目是否存在
  1187.                     Set RecTemp = Cw_DataEnvi.DataConnect.Execute("Select Ccode From Cwzz_AccCode Where Ccode='" & Trim(LrText(6).Text) & "'")
  1188.                     
  1189.                     If RecTemp.EOF Then
  1190.                         Tsxx = "汇总打印科目不存在!"
  1191.                         Call Xtxxts(Tsxx, 0, 1)
  1192.                         LrText(6).SetFocus
  1193.                         Bclrsj = False
  1194.                         Exit Function
  1195.                     End If
  1196.                 End If
  1197.             End If
  1198.     
  1199.             '判断记录内容无误后,将记录内容写入数据表
  1200.             On Error GoTo Swcwcl
  1201.     
  1202.             Cw_DataEnvi.DataConnect.BeginTrans
  1203.    
  1204.             .AddNew
  1205.                  .Fields("Cclass") = Combo_Class.Text           '科目类型
  1206.                  .Fields("ParentCode") = Str_Parent             '上级科目编码
  1207.                  .Fields("Ccode") = Trim(LrText(0).Text)        '科目编码
  1208.                  .Fields("AssCode") = Trim(LrText(5).Text)      '助记码
  1209.                  .Fields("Cname") = Trim(LrText(1).Text)        '科目名称
  1210.                  .Fields("CodeLevel") = CodeLev                 '科目级次
  1211.                  .Fields("CProperty") = Combo_Prop.Text         '科目性质
  1212.                  .Fields("AccFormat") = Combo_AccFormat.Text    '帐页格式
  1213.                  If Chk_ForiFlag.Value = 1 Then                 '外币
  1214.                     .Fields("ForeignFlag") = 1
  1215.                     .Fields("ForeignCurrCode") = Trim(LrText(2).Tag)
  1216.                  Else
  1217.                     .Fields("ForeignFlag") = 0
  1218.                     .Fields("ForeignCurrCode") = Null
  1219.                  End If
  1220.                  If Chk_QuatFlag.Value = 1 Then                 '数量单位
  1221.                     .Fields("QuantityFlag") = 1
  1222.                     .Fields("Measure") = Trim(LrText(3).Text)
  1223.                  Else
  1224.                     .Fields("QuantityFlag") = 0
  1225.                     .Fields("Measure") = ""
  1226.                  End If
  1227.                  If Chk_SumPrint.Value = 1 Then                 '汇总打印
  1228.                     .Fields("IIFSum") = 1
  1229.                     .Fields("cSumCode") = Trim(LrText(6).Text)
  1230.                  Else
  1231.                     .Fields("IIFSum") = 1
  1232.                     .Fields("cSumCode") = Trim(LrText(6).Text)
  1233.                  End If
  1234.                  If Opt_Yefx(0) Then                            '余额方向
  1235.                     .Fields("BalanceOri") = "借"
  1236.                  Else
  1237.                     .Fields("BalanceOri") = "贷"
  1238.                  End If
  1239.                  
  1240.                  If Chk_Ass(0).Value = 1 Then                   '客户核算
  1241.                     .Fields("CusFlag") = 1
  1242.                  Else
  1243.                     .Fields("CusFlag") = 0
  1244.                  End If
  1245.                  If Chk_Ass(4).Value = 1 Then                   '供应商核算
  1246.                     .Fields("SupplierFlag") = 1
  1247.                  Else
  1248.                     .Fields("SupplierFlag") = 0
  1249.                  End If
  1250.                  If Chk_Ass(1).Value = 1 Then                   '部门核算
  1251.                     .Fields("DeptFlag") = 1
  1252.                  Else
  1253.                     .Fields("DeptFlag") = 0
  1254.                  End If
  1255.                  If Chk_Ass(2).Value = 1 Then                   '个人核算
  1256.                     .Fields("PersonFlag") = 1
  1257.                  Else
  1258.                     .Fields("PersonFlag") = 0
  1259.                  End If
  1260.                  If Chk_Ass(3).Value = 1 Then                   '项目核算
  1261.                     .Fields("ItemFlag") = 1
  1262.                     .Fields("ItemClassCode") = Trim(LrText(4).Tag)
  1263.                  Else
  1264.                     .Fields("ItemFlag") = 0
  1265.                     .Fields("ItemClassCode") = Null
  1266.                  End If
  1267.                  If Chk_DayBookFlag.Value = 1 Then                 '日记帐
  1268.                     .Fields("DayBookFlag") = 1
  1269.                  Else
  1270.                     .Fields("DayBookFlag") = 0
  1271.                  End If
  1272.                  If Chk_CashFlow.Value = 1 Then                 '现金或现金等价物
  1273.                     .Fields("CashFlowFlag") = 1
  1274.                  Else
  1275.                     .Fields("CashFlowFlag") = 0
  1276.                  End If
  1277.                  .Fields("EndFlag") = 1                         '末级标志
  1278.             .Update
  1279.             
  1280.              '将上级科目末级标志置0
  1281.              
  1282.              Set RecTemp = Cw_DataEnvi.DataConnect.Execute("Update Cwzz_AccCode Set Endflag=0 Where Ccode='" & Trim(Str_Parent) & "'")
  1283.              
  1284.              Cw_DataEnvi.DataConnect.CommitTrans
  1285.    
  1286.             SqlStr = "SELECT Cwzz_AccCode.*, Gy_ForeignCurrency.ForeignCurrName FROM Cwzz_AccCode LEFT OUTER JOIN" & _
  1287.                     " Gy_ForeignCurrency ON" & _
  1288.                     " Cwzz_AccCode.ForeignCurrCode = Gy_ForeignCurrency.ForeignCurrCode WHERE Ccode= '" & Trim(LrText(0).Text) & "'"
  1289.             Set Cxnrrec = Cw_DataEnvi.DataConnect.Execute(SqlStr)
  1290.    
  1291.             With CzxsGrid
  1292.                 .AddItem ""
  1293.                 .RowHeight(.Rows - 1) = Sjhgd
  1294.                 .Select .Rows - 1, Qslz
  1295.                 Call Jltcwg(Cxnrrec, .Rows - 1)
  1296.             End With
  1297.    
  1298.             Tsxx = "保存完毕!"
  1299.             Call Xtxxts(Tsxx, 0, 4)
  1300.             Call Cshlrxx(1)
  1301.             LrText(0).SetFocus
  1302.    
  1303.             '将网格按科目编码排序
  1304.             With CzxsGrid
  1305.                 .Col = Sydz("003", GridStr(), Szzls)
  1306.                 CzxsGrid.Sort = flexSortStringAscending
  1307.             End With
  1308.     
  1309.         Else  '否则为修改记录
  1310.  
  1311.             If .State = 1 Then .Close
  1312.             .Open "SELECT * FROM Cwzz_AccCode WHERE Cname= '" + Trim(LrText(1).Text) + "' and CCode<>'" & Trim(LrText(0).Text) & "'", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
  1313.             If Not .EOF Then
  1314.                 Tsxx = "科目名称重复!"
  1315.                 Call Xtxxts(Tsxx, 0, 1)
  1316.                 LrText(1).SetFocus
  1317.                 Bclrsj = False
  1318.                 Exit Function
  1319.             End If
  1320.              
  1321.              '判断助记码是否唯一
  1322.             If Trim(LrText(5).Text) <> "" Then
  1323.                 If .State = 1 Then .Close
  1324.                 .Open "SELECT * FROM Cwzz_AccCode WHERE AssCode= '" + Trim(LrText(5).Text) + "' and CCode<>'" & Trim(LrText(0).Text) & "'", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
  1325.                 If Not .EOF Then
  1326.                     Tsxx = "助记码不唯一!"
  1327.                     Call Xtxxts(Tsxx, 0, 1)
  1328.                     LrText(5).SetFocus
  1329.                     Bclrsj = False
  1330.                     Exit Function
  1331.                 End If
  1332.             End If
  1333.             
  1334.             '如果科目汇总打印则其汇总科目不能为空且为其上级科目
  1335.             If Chk_SumPrint.Value = 1 Then
  1336.                 If Len(Trim(LrText(6).Text)) = 0 Then
  1337.                     Tsxx = "科目进行汇总打印,则汇总科目不能为空!"
  1338.                     Call Xtxxts(Tsxx, 0, 1)
  1339.                     LrText(6).SetFocus
  1340.                     Bclrsj = False
  1341.                     Exit Function
  1342.                 Else
  1343.                     If InStr(1, Trim(LrText(0).Text), Trim(LrText(6).Text)) = 0 Then
  1344.                         Tsxx = "汇总打印科目必须为其上级科目!"
  1345.                         Call Xtxxts(Tsxx, 0, 1)
  1346.                         LrText(6).SetFocus
  1347.                         Bclrsj = False
  1348.                         Exit Function
  1349.                     End If
  1350.                     
  1351.                     '判断汇总科目是否存在
  1352.                     Set RecTemp = Cw_DataEnvi.DataConnect.Execute("Select Ccode From Cwzz_AccCode Where Ccode='" & Trim(LrText(6).Text) & "'")
  1353.                     
  1354.                     If RecTemp.EOF Then
  1355.                         Tsxx = "汇总打印科目不存在!"
  1356.                         Call Xtxxts(Tsxx, 0, 1)
  1357.                         LrText(6).SetFocus
  1358.                         Bclrsj = False
  1359.                         Exit Function
  1360.                     End If
  1361.                 End If
  1362.             End If
  1363.     
  1364.             On Error GoTo Swcwcl
  1365.     
  1366.             Cw_DataEnvi.DataConnect.BeginTrans
  1367.      
  1368.             If .State = 1 Then .Close
  1369.             .Open "SELECT * FROM Cwzz_AccCode WHERE Ccode= '" + Trim(LrText(0).Text) + "'", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
  1370.             If Not .EOF Then
  1371.                 .Fields("AssCode") = Trim(LrText(5).Text)      '助记码
  1372.                 .Fields("Cclass") = Combo_Class.Text           '科目类型
  1373.                 .Fields("Cname") = Trim(LrText(1).Text)        '科目名称
  1374.                 .Fields("CProperty") = Combo_Prop.Text         '科目性质
  1375.                 .Fields("AccFormat") = Combo_AccFormat.Text    '帐页格式
  1376.                 If Chk_ForiFlag.Value = 1 Then                 '外币
  1377.                     .Fields("ForeignFlag") = 1
  1378.                     .Fields("ForeignCurrCode") = Trim(LrText(2).Tag)
  1379.                 Else
  1380.                     .Fields("ForeignFlag") = 0
  1381.                     .Fields("ForeignCurrCode") = Null
  1382.                 End If
  1383.                 If Chk_QuatFlag.Value = 1 Then                 '数量单位
  1384.                     .Fields("QuantityFlag") = 1
  1385.                     .Fields("Measure") = Trim(LrText(3).Text)
  1386.                 Else
  1387.                     .Fields("QuantityFlag") = 0
  1388.                     .Fields("Measure") = ""
  1389.                 End If
  1390.                 If Chk_SumPrint.Value = 1 Then                 '汇总打印
  1391.                     .Fields("IIFSum") = 1
  1392.                     .Fields("cSumCode") = Trim(LrText(6).Text)
  1393.                 Else
  1394.                     .Fields("IIFSum") = 0
  1395.                     .Fields("cSumCode") = ""
  1396.                 End If
  1397.                 If Opt_Yefx(0) Then                            '余额方向
  1398.                     .Fields("BalanceOri") = "借"
  1399.                 Else
  1400.                     .Fields("BalanceOri") = "贷"
  1401.                 End If
  1402.             
  1403.                 If Chk_Ass(0).Value = 1 Then                   '客户核算
  1404.                     .Fields("CusFlag") = 1
  1405.                 Else
  1406.                     .Fields("CusFlag") = 0
  1407.                 End If
  1408.                 
  1409.                 If Chk_Ass(4).Value = 1 Then                   '供应商核算
  1410.                     .Fields("SupplierFlag") = 1
  1411.                 Else
  1412.                     .Fields("SupplierFlag") = 0
  1413.                 End If
  1414.                 
  1415.                 If Chk_Ass(1).Value = 1 Then                   '部门核算
  1416.                     .Fields("DeptFlag") = 1
  1417.                 Else
  1418.                     .Fields("DeptFlag") = 0
  1419.                 End If
  1420.                 
  1421.                 If Chk_Ass(2).Value = 1 Then                   '个人核算
  1422.                     .Fields("PersonFlag") = 1
  1423.                 Else
  1424.                     .Fields("PersonFlag") = 0
  1425.                 End If
  1426.                 If Chk_Ass(3).Value = 1 Then                   '项目核算
  1427.                     .Fields("ItemFlag") = 1
  1428.                     .Fields("ItemClassCode") = Trim(LrText(4).Tag)
  1429.                 Else
  1430.                     .Fields("ItemFlag") = 0
  1431.                     .Fields("ItemClassCode") = Null
  1432.                 End If
  1433.                    
  1434.                 If ChkStopUse.Value = 1 Then                   '停用
  1435.                     .Fields("StopFlag") = 1
  1436.                 Else
  1437.                     .Fields("StopFlag") = 0
  1438.                 End If
  1439.                 
  1440.                 If Chk_DayBookFlag.Value = 1 Then                 '日记帐
  1441.                     .Fields("DayBookFlag") = 1
  1442.                 Else
  1443.                     .Fields("DayBookFlag") = 0
  1444.                 End If
  1445.                 
  1446.                 If Chk_CashFlow.Value = 1 Then                 '现金或现金等价物
  1447.                     .Fields("CashFlowFlag") = 1
  1448.                 Else
  1449.                     .Fields("CashFlowFlag") = 0
  1450.                 End If
  1451.              
  1452.                 .Update
  1453.       
  1454.                 '修改其下级科目科目类型
  1455.                 SqlStr = "Update Cwzz_AccCode Set Cclass='" & Combo_Class.Text & "' Where Ccode Like  '" & Trim(LrText(0).Text) & "%'"
  1456.                 Cw_DataEnvi.DataConnect.Execute (SqlStr)
  1457.       
  1458.             End If
  1459.   
  1460.             Cw_DataEnvi.DataConnect.CommitTrans
  1461.      
  1462.             SqlStr = "SELECT Cwzz_AccCode.*, Gy_ForeignCurrency.ForeignCurrName FROM Cwzz_AccCode LEFT OUTER JOIN" & _
  1463.                     " Gy_ForeignCurrency ON" & _
  1464.                     " Cwzz_AccCode.ForeignCurrCode = Gy_ForeignCurrency.ForeignCurrCode WHERE Ccode= '" & Trim(LrText(0).Text) & "'"
  1465.             Set Cxnrrec = Cw_DataEnvi.DataConnect.Execute(SqlStr)
  1466.             
  1467.             If Not Cxnrrec.EOF Then
  1468.                 With CzxsGrid
  1469.                     Call Jltcwg(Cxnrrec, .Row)
  1470.                 End With
  1471.             End If
  1472.   
  1473.   End If
  1474.   
  1475.   '保存记录成功,函数返回真值
  1476.   Bclrsj = True
  1477.   Exit Function
  1478.     
  1479. End With
  1481. Swcwcl:
  1483.     Cw_DataEnvi.DataConnect.RollbackTrans
  1484.     
  1485.     Tsxx = "存盘过程中出现错误,程序自动恢复保存前状态!"
  1486.     Call Xtxxts(Tsxx, 0, 1)
  1487.     
  1488.     Exit Function
  1489.      
  1490. End Function
  1492. Private Function Cshlrxx(lrztxx As Integer) As Boolean              '初始化录入字段信息
  1494.     TextChangeLock = True       '关闭文本框Chang事件
  1495.     
  1496.     If lrztxx = 1 Then
  1497.     
  1498.         '增加新记录时将文本框清空
  1499.         For jsqte = 0 To Max_Text_Index
  1500.             If Len(Trim(Textstr(jsqte, 1))) <> 0 Then
  1501.                 LrText(jsqte).Text = ""
  1502.                 LrText(jsqte).Tag = ""
  1503.             End If
  1504.             TextValiJudgeLock(jsqte) = True
  1505.         Next jsqte
  1506.        
  1507.         '[>>
  1508.         '在此处可添加新增记录时初始化设置
  1509.         Chk_ForiFlag.Value = 0
  1510.         Chk_QuatFlag.Value = 0
  1511.         Chk_SumPrint.Value = 0
  1512.         ChkStopUse.Value = 0
  1513.         Opt_Yefx(0).Value = True
  1514.         For jsqte = 0 To 3
  1515.             Chk_Ass(jsqte).Value = 0
  1516.         Next jsqte
  1517.      
  1518.         ChkStopUse.Enabled = False
  1519.         '<<]
  1520.     Else
  1521.     
  1522.         '修改记录时根据记录关键字(编码)从数据表中读入其他字段内容
  1523.         SqlStr = "SELECT Cwzz_AccCode.*, Gy_ForeignCurrency.ForeignCurrName,Cwzz_ItemClass.ItemClassName FROM Cwzz_AccCode LEFT OUTER JOIN" & _
  1524.                 " Gy_ForeignCurrency ON" & _
  1525.                 " Cwzz_AccCode.ForeignCurrCode = Gy_ForeignCurrency.ForeignCurrCode LEFT OUTER JOIN" & _
  1526.                 " Cwzz_ItemClass ON" & _
  1527.                 " Cwzz_AccCode.ItemClassCode = Cwzz_ItemClass.ItemClassCode  Where CCode='" & Trim(CzxsGrid.TextMatrix(CzxsGrid.Row, Sydz("003", GridStr(), Szzls))) & "'"
  1528.  
  1529.         Set RecTemp = Cw_DataEnvi.DataConnect.Execute(SqlStr)
  1530.        
  1531.         If Not RecTemp.EOF Then
  1532.            
  1533.                 LrText(0).Text = Trim(RecTemp.Fields("Ccode"))                 '科目编码
  1534.                 LrText(5).Text = Trim(RecTemp.Fields("AssCode") & "")          '助记码
  1535.                 LrText(1).Text = Trim(RecTemp.Fields("Cname") & "")            '科目名称
  1536.                 Combo_Class.Text = Trim(RecTemp.Fields("CClass"))              '科目类型
  1537.                 Combo_Prop.Text = Trim(RecTemp.Fields("CProperty"))            '科目性质
  1538.                 Combo_AccFormat = Trim(RecTemp.Fields("AccFormat"))            '帐页格式
  1539.                 
  1540.                 If RecTemp.Fields("ForeignFlag") Then
  1541.                     Chk_ForiFlag.Value = 1                                         '外币核算标志
  1542.                     LrText(2).Text = Trim(RecTemp.Fields("ForeignCurrName") & "")
  1543.                     LrText(2).Tag = Trim(RecTemp.Fields("ForeignCurrCode") & "")
  1544.                     Call Textyx(LrText(2))
  1545.                     Ydcommand1(2).Enabled = True
  1546.                 Else
  1547.                     Chk_ForiFlag.Value = 0
  1548.                     LrText(2).Text = ""
  1549.                     LrText(2).Tag = ""
  1550.                     Call Textwx(LrText(2))
  1551.                     Ydcommand1(2).Enabled = False
  1552.                 End If
  1553.                     
  1554.                 If RecTemp.Fields("QuantityFlag") Then
  1555.                     Chk_QuatFlag.Value = 1                                          '数量核算标志
  1556.                     LrText(3).Text = Trim(RecTemp.Fields("Measure") & "")
  1557.                     Call Textyx(LrText(3))
  1558.                 Else
  1559.                     Chk_QuatFlag.Value = 0
  1560.                     Call Textwx(LrText(3))
  1561.                     LrText(3).Text = ""
  1562.                 End If
  1563.                 
  1564.                 If RecTemp.Fields("IIFSum") Then
  1565.                     Chk_SumPrint.Value = 1                                          '汇总打印
  1566.                     LrText(6).Text = Trim(RecTemp.Fields("cSumCode") & "")
  1567.                     Call Textyx(LrText(6))
  1568.                 Else
  1569.                     Chk_SumPrint.Value = 0
  1570.                     Call Textwx(LrText(6))
  1571.                     LrText(6).Text = ""
  1572.                 End If
  1573.                 
  1574.                 If Trim(RecTemp.Fields("BalanceOri")) = "借" Then                  '余额方向
  1575.                    Opt_Yefx(0).Value = True
  1576.                 Else
  1577.                    Opt_Yefx(1).Value = True
  1578.                 End If
  1579.                 
  1580.                 If RecTemp.Fields("CusFlag") Then
  1581.                     Chk_Ass(0).Value = 1                                           '辅助核算(客户)
  1582.                 Else
  1583.                     Chk_Ass(0).Value = 0
  1584.                 End If
  1585.                 
  1586.                 If RecTemp.Fields("SupplierFlag") Then
  1587.                     Chk_Ass(4).Value = 1                                           '辅助核算(供应商)
  1588.                 Else
  1589.                     Chk_Ass(4).Value = 0
  1590.                 End If
  1591.                 
  1592.                 If RecTemp.Fields("DeptFlag") Then
  1593.                     Chk_Ass(1).Value = 1                                           '辅助核算(部门)
  1594.                 Else
  1595.                     Chk_Ass(1).Value = 0
  1596.                 End If
  1597.                 
  1598.                 If RecTemp.Fields("PersonFlag") Then
  1599.                     Chk_Ass(2).Value = 1                                           '辅助核算(个人)
  1600.                 Else
  1601.                     Chk_Ass(2).Value = 0
  1602.                 End If
  1603.                 
  1604.                 If RecTemp.Fields("ItemFlag") Then                                 '辅助核算(项目)
  1605.                     Chk_Ass(3).Value = 1
  1606.                     LrText(4).Text = Trim(RecTemp.Fields("ItemClassName") & "")
  1607.                     LrText(4).Tag = Trim(RecTemp.Fields("ItemClassCode") & "")
  1608.                     Call Textyx(LrText(4))
  1609.                     Ydcommand1(4).Enabled = True
  1610.                 Else
  1611.                     Chk_Ass(3).Value = 0
  1612.                     LrText(4).Text = ""
  1613.                     LrText(4).Tag = ""
  1614.                     Call Textwx(LrText(4))
  1615.                     Ydcommand1(4).Enabled = False
  1616.                 End If
  1617.                 
  1618.                 If RecTemp.Fields("DayBookFlag") Then                             '日记帐
  1619.                    Chk_DayBookFlag.Value = 1
  1620.                 Else
  1621.                    Chk_DayBookFlag.Value = 0
  1622.                 End If
  1623.                 
  1624.                 If RecTemp.Fields("CashFlowFlag") Then                             '现金或现金等价物
  1625.                    Chk_CashFlow.Value = 1
  1626.                 Else
  1627.                    Chk_CashFlow.Value = 0
  1628.                 End If
  1629.                 
  1630.                 If RecTemp.Fields("StopFlag") Then                                  '停用
  1631.                    ChkStopUse.Value = 1
  1632.                 Else
  1633.                    ChkStopUse.Value = 0
  1634.                 End If
  1635.                 
  1636.                 If RecTemp.Fields("EndFlag") Then                                   '停用是否有效
  1637.                    ChkStopUse.Enabled = True
  1638.                 Else
  1639.                    ChkStopUse.Enabled = False
  1640.                 End If
  1641.                 
  1642.                 
  1643.                 
  1644.         Else
  1645.                Tsxx = "该科目已经被其他人删除,请刷新当前数据!"
  1646.                Call Xtxxts(Tsxx, 0, 4)
  1647.                Call Cancel
  1648.                TextChangeLock = False
  1649.                Exit Function
  1650.         End If
  1651.       
  1652.     End If
  1653.     
  1654.     Cshlrxx = True
  1655.     TextChangeLock = False
  1656.     
  1657. End Function
  1659. Private Sub Scdqjl()                 '删 除 当 前 记 录
  1660.     
  1661.     Dim Str_Parent As String
  1662.     Dim yhAnswer As Integer
  1663.   
  1664.     '非数据行不能删除
  1665.     If CzxsGrid.Row < CzxsGrid.FixedRows Then
  1666.         Exit Sub
  1667.     End If
  1668.   
  1669.     '用户确认是否删除记录
  1670.     Tsxx = "请确认是否删除当前记录?"
  1671.     yhAnswer = Xtxxts(Tsxx, 2, 2)
  1672.     
  1673.     If yhAnswer = 2 Then
  1674.         Exit Sub
  1675.     End If
  1677.     '判断此科目是否存在下级科目,如存在则提示不能删除
  1678.   
  1679.     Set RecTemp = Cw_DataEnvi.DataConnect.Execute("Select Ccode From Cwzz_AccCode  Where ParentCode='" & Trim(CzxsGrid.TextMatrix(CzxsGrid.Row, Sydz("003", GridStr(), Szzls))) & "'")
  1680.     
  1681.     If Not RecTemp.EOF Then
  1682.        Tsxx = "此科目存在下级科目,不能删除!"
  1683.        Call Xtxxts(Tsxx, 0, 1)
  1684.        Exit Sub
  1685.     End If
  1686.     
  1687.     Set RecTemp = Cw_DataEnvi.DataConnect.Execute("Select ParentCode From Cwzz_AccCode  Where CCode='" & Trim(CzxsGrid.TextMatrix(CzxsGrid.Row, Sydz("003", GridStr(), Szzls))) & "'")
  1688.     
  1689.     If Not RecTemp.EOF Then
  1690.        Str_Parent = Trim(RecTemp.Fields("ParentCode") & "")
  1691.     End If
  1692.   
  1693.     On Error GoTo Cwcl
  1694.     
  1695.     Cw_DataEnvi.DataConnect.BeginTrans
  1696.   
  1697.     '[以下需自定义部分
  1698.     
  1699.     Cw_DataEnvi.DataConnect.Execute "delete Cwzz_AccCode where CCode = '" + Trim(CzxsGrid.TextMatrix(CzxsGrid.Row, Sydz("003", GridStr(), Szzls))) + "'"
  1700.     
  1701.     '依情况修改上级科目末级标志
  1702.   
  1703.     If Str_Parent <> "" Then
  1704.   
  1705.         Set RecTemp = Cw_DataEnvi.DataConnect.Execute("Select Ccode From Cwzz_AccCode  Where ParentCode='" & Str_Parent & "'")
  1706.         
  1707.         If RecTemp.EOF Then
  1708.            Set RecTemp = Cw_DataEnvi.DataConnect.Execute("Update Cwzz_AccCode Set Endflag=1 Where Ccode='" & Trim(Str_Parent) & "'")
  1709.         End If
  1710.     End If
  1711.     
  1712.     '以上为自定义部分]
  1713.     Cw_DataEnvi.DataConnect.CommitTrans
  1714.   
  1715.     CzxsGrid.RemoveItem CzxsGrid.Row
  1716.   
  1717.   Exit Sub
  1718.   
  1719. Cwcl:
  1721.     Cw_DataEnvi.DataConnect.RollbackTrans
  1722.     
  1723.     If Err.Number = -2147217873 Then              '(-2147217873 为SQL Server 2000通过建立外键产生的错误号)
  1724.         Tsxx = "该编码已经被使用,不能删除!"
  1725.         Call Xtxxts(Tsxx, 0, 1)
  1726.         Exit Sub
  1727.     Else
  1728.         Tsxx = "出现未知情况,该编码不能被删除!"
  1729.         Call Xtxxts(Tsxx, 0, 1)
  1730.         Exit Sub
  1731.     End If
  1732.     
  1733. End Sub
  1735. '*******************以下区域为编写自定义过程区域**********************
  1737. Private Sub Chk_ForiFlag_Click()                 '单击外币核算标志
  1738.     
  1739.     If Chk_ForiFlag.Value = 1 Then
  1740.         Call Textyx(LrText(2))
  1741.         Ydcommand1(2).Enabled = True
  1742.     Else
  1743.         Call Textwx(LrText(2))
  1744.         Ydcommand1(2).Enabled = False
  1745.     End If
  1746.     
  1747. End Sub
  1749. Private Sub Chk_QuatFlag_Click()                 '单击数量核算标志
  1751.     If Chk_QuatFlag.Value = 1 Then
  1752.         Call Textyx(LrText(3))
  1753.     Else
  1754.         Call Textwx(LrText(3))
  1755.     End If
  1756.    
  1757. End Sub
  1759. Private Sub Chk_SumPrint_Click()                 '单击汇总打印
  1761.     If Chk_SumPrint.Value = 1 Then
  1762.         Call Textyx(LrText(6))
  1763.     Else
  1764.         Call Textwx(LrText(6))
  1765.     End If
  1767. End Sub
  1769. Private Sub Chk_Ass_Click(Index As Integer)      '单击项目核算标志
  1771.     If Chk_Ass(3).Value = 1 Then
  1772.         Call Textyx(LrText(4))
  1773.         Ydcommand1(4).Enabled = True
  1774.     Else
  1775.         Call Textwx(LrText(4))
  1776.         Ydcommand1(4).Enabled = False
  1777.     End If
  1779.     Select Case Index
  1780.     Case 0                 '客户往来
  1781.       If Chk_Ass(Index).Value = 1 Then
  1782.          Chk_Ass(2).Enabled = False
  1783.          Chk_Ass(4).Enabled = False
  1784.          If Chk_Ass(3).Value = 1 Then
  1785.             Chk_Ass(1).Enabled = False
  1786.          End If
  1787.          If Chk_Ass(1).Value = 1 Then
  1788.             Chk_Ass(3).Enabled = False
  1789.          End If
  1790.       Else
  1791.          If Chk_Ass(3).Value <> 1 And Chk_Ass(4).Value <> 1 Then
  1792.             Chk_Ass(2).Enabled = True
  1793.          End If
  1794.          Chk_Ass(1).Enabled = True
  1795.          Chk_Ass(3).Enabled = True
  1796.          Chk_Ass(4).Enabled = True
  1797.       End If
  1798.     Case 1                 '部门核算
  1799.       If Chk_Ass(Index).Value = 1 Then
  1800.          If Chk_Ass(3).Value = 1 Then
  1801.             Chk_Ass(0).Enabled = False
  1802.             Chk_Ass(4).Enabled = False
  1803.          End If
  1804.          If Chk_Ass(0).Value = 1 Then
  1805.             Chk_Ass(3).Enabled = False
  1806.             Chk_Ass(4).Enabled = False
  1807.          End If
  1808.          If Chk_Ass(4).Value = 1 Then
  1809.             Chk_Ass(0).Enabled = False
  1810.             Chk_Ass(3).Enabled = False
  1811.          End If
  1812.       Else
  1813.          If Chk_Ass(0).Value <> 1 And Chk_Ass(3).Value <> 1 And Chk_Ass(4).Value <> 1 Then
  1814.             Chk_Ass(2).Enabled = True
  1815.          End If
  1816.          Chk_Ass(3).Enabled = True
  1817.          If Chk_Ass(0).Value <> 1 Then
  1818.             Chk_Ass(4).Enabled = True
  1819.          End If
  1820.          If Chk_Ass(4).Value <> 1 Then
  1821.             Chk_Ass(0).Enabled = True
  1822.          End If
  1823.       End If
  1824.     Case 2                 '个人往来
  1825.       If Chk_Ass(Index).Value = 1 Then
  1826.          Chk_Ass(0).Enabled = False
  1827.          Chk_Ass(3).Enabled = False
  1828.          Chk_Ass(4).Enabled = False
  1829.       Else
  1830.          Chk_Ass(0).Enabled = True
  1831.          Chk_Ass(3).Enabled = True
  1832.          Chk_Ass(4).Enabled = True
  1833.       End If
  1834.     Case 3                 '项目核算
  1835.       If Chk_Ass(Index).Value = 1 Then
  1836.          Chk_Ass(2).Enabled = False
  1837.          If Chk_Ass(1).Value = 1 Then
  1838.             Chk_Ass(0).Enabled = False
  1839.             Chk_Ass(4).Enabled = False
  1840.          End If
  1841.          If Chk_Ass(0).Value = 1 Then
  1842.             Chk_Ass(1).Enabled = False
  1843.             Chk_Ass(4).Enabled = False
  1844.          End If
  1845.          If Chk_Ass(4).Value = 1 Then
  1846.             Chk_Ass(0).Enabled = False
  1847.             Chk_Ass(1).Enabled = False
  1848.          End If
  1849.       Else
  1850.          If Chk_Ass(0).Value <> 1 And Chk_Ass(4).Value <> 1 Then
  1851.             Chk_Ass(2).Enabled = True
  1852.          End If
  1853.          Chk_Ass(1).Enabled = True
  1854.          If Chk_Ass(0).Value <> 1 Then
  1855.             Chk_Ass(4).Enabled = True
  1856.          End If
  1857.          If Chk_Ass(4).Value <> 1 Then
  1858.             Chk_Ass(0).Enabled = True
  1859.          End If
  1860.       End If
  1861.     Case 4                 '供应商往来
  1862.       If Chk_Ass(Index).Value = 1 Then
  1863.          Chk_Ass(2).Enabled = False
  1864.          Chk_Ass(0).Enabled = False
  1865.          If Chk_Ass(3).Value = 1 Then
  1866.             Chk_Ass(1).Enabled = False
  1867.          End If
  1868.          If Chk_Ass(1).Value = 1 Then
  1869.             Chk_Ass(3).Enabled = False
  1870.          End If
  1871.       Else
  1872.          If Chk_Ass(3).Value <> 1 And Chk_Ass(0).Value <> 1 Then
  1873.             Chk_Ass(2).Enabled = True
  1874.          End If
  1875.          Chk_Ass(1).Enabled = True
  1876.          Chk_Ass(3).Enabled = True
  1877.          Chk_Ass(0).Enabled = True
  1878.       End If
  1879.   End Select
  1881. End Sub
  1882. Private Sub Combo_Class_Change()                       '根据类型改变余额方向
  1884.     If Combo_Class.ListIndex = 0 Or Combo_Class.ListIndex = 3 Then   '资产类和成本类余额方向一般为借方
  1885.         Opt_Yefx(0).Value = True
  1886.     Else
  1887.         Opt_Yefx(1).Value = True
  1888.     End If
  1889.     
  1890. End Sub
  1892. '*******************以上区域为编写自定义过程区域**********************
  1894. '*******************************以下为基本处理程序(固定不变)*******************************************'
  1895. Private Sub Form_KeyUp(KeyCode As Integer, Shift As Integer)        '支持热键操作
  1897.     If Shift = 2 Then
  1898.         Select Case UCase(Chr(KeyCode))
  1899.             Case "P"                                                                          'Ctrl+P 打印
  1900.                 If SzToolbar.Buttons("dy").Visible And SzToolbar.Buttons("dy").Enabled Then
  1901.                     Call bbyl(False)
  1902.                 End If
  1903.             Case "A"                                                                          'Ctrl+A 增加
  1904.                 If SzToolbar.Buttons("zj").Visible And SzToolbar.Buttons("zj").Enabled Then
  1905.                     Call Toolbjzt
  1906.                     Lrzt = 1
  1907.                     Call Cshlrxx(Lrzt)
  1908.                     LrText(0).SetFocus
  1909.                     LrText(0).Locked = False
  1910.                 End If
  1911.             Case "D"                                                                          'Ctrl+D 删除
  1912.                 If SzToolbar.Buttons("sc").Visible And SzToolbar.Buttons("sc").Enabled Then
  1913.                     Call Scdqjl
  1914.                 End If
  1915.         End Select
  1916.     End If
  1917.   
  1918. End Sub
  1920. Private Sub SzToolbar_ButtonClick(ByVal Button As MSComctlLib.Button)
  1922.     Select Case Button.Key
  1923.         Case "ymsz"                                          '页面设置
  1924.             Dyymctbl.Show 1
  1925.         Case "yl"                                            '预 览
  1926.             Call bbyl(True)
  1927.         Case "dy"                                            '打 印
  1928.              Call bbyl(False)
  1929.         Case "zj"                                            '增 加
  1930.             Call Toolbjzt
  1931.             Lrzt = 1
  1932.             Call Cshlrxx(Lrzt)
  1933.             LrText(0).SetFocus
  1934.             LrText(0).Locked = False
  1935.         Case "dw"                                            '定 位
  1936.             JC_FrmKmdw.Show 1
  1937.             If Xtfhcs <> "" Then
  1938.                 With CzxsGrid
  1939.                     For jsqte = .FixedRows To .Rows - 1
  1940.                         If Mid(.TextMatrix(jsqte, Sydz("003", GridStr(), Szzls)), 1, Len(Xtfhcs)) = Xtfhcs Then
  1941.                             .Select jsqte, Sydz("003", GridStr(), Szzls)
  1942.                             .TopRow = jsqte
  1943.                             Exit For
  1944.                         End If
  1945.                     Next jsqte
  1946.                 End With
  1947.             End If
  1948.         Case "xg"                                            '修 改
  1949.             Call Xgdqjl
  1950.         Case "sc"                                            '删 除
  1951.             Call Scdqjl
  1952.         Case "sx"                                            '刷 新
  1953.             Call Cxnrtcwg
  1954.         Case "bz"                                            '帮 助
  1955.             Call F1bz
  1956.         Case "fh"                                            '退 出
  1957.             Unload Me
  1958.     End Select
  1959.     
  1960. End Sub
  1962. Private Sub CzxsGrid_DblClick()                                         '修改当前编码记录
  1964.     Call Xgdqjl
  1965.     
  1966. End Sub
  1968. Private Sub Xgdqjl()                                                    '修改当前编码记录
  1970.     If CzxsGrid.Row < CzxsGrid.FixedRows Then
  1971.         Exit Sub
  1972.     End If
  1973.     
  1974.     Call Toolbjzt
  1975.     Lrzt = 2
  1976.     
  1977.     If Cshlrxx(Lrzt) Then
  1978.         LrText(1).SetFocus
  1979.         LrText(0).Locked = True
  1980.     End If
  1981.   
  1982. End Sub
  1984. Private Sub Toolbjzt()                                                  'Toolbar状态(编辑状态)
  1986.     StTab.TabEnabled(1) = True
  1987.     StTab.Tab = 1
  1988.     Frame1.Enabled = True
  1989.     StTab.TabEnabled(0) = False
  1990.     CzxsGrid.Enabled = False
  1991.     
  1992.     With SzToolbar
  1993.         .Buttons("ymsz").Enabled = False
  1994.         .Buttons("dy").Enabled = False
  1995.         .Buttons("yl").Enabled = False
  1996.         .Buttons("zj").Enabled = False
  1997.         .Buttons("xg").Enabled = False
  1998.         .Buttons("sc").Enabled = False
  1999.         .Buttons("sx").Enabled = False
  2000.         .Buttons("dw").Enabled = False
  2001.     End With
  2002.   
  2003. End Sub
  2005. Private Sub Toolfbjzt()                                                 'Toolbar状态(非编辑状态)
  2007.     StTab.TabEnabled(0) = True
  2008.     StTab.Tab = 0
  2009.     CzxsGrid.Enabled = True
  2010.     Frame1.Enabled = False
  2011.     StTab.TabEnabled(1) = False
  2012.     Lrzt = 0
  2013.     
  2014.     With SzToolbar
  2015.         .Buttons("ymsz").Enabled = True
  2016.         .Buttons("dy").Enabled = True
  2017.         .Buttons("yl").Enabled = True
  2018.         .Buttons("zj").Enabled = True
  2019.         .Buttons("xg").Enabled = True
  2020.         .Buttons("sc").Enabled = True
  2021.         .Buttons("sx").Enabled = True
  2022.         .Buttons("dw").Enabled = True
  2023.     End With
  2024.   
  2025. End Sub
  2027. Private Sub BcCommand_Click()                                           '保 存
  2029.     If Not Bclrsj Then
  2030.         Exit Sub
  2031.     End If
  2032.     
  2033.     If Lrzt = 2 Then
  2034.         Call Toolfbjzt
  2035.     End If
  2036.   
  2037. End Sub
  2039. Private Sub QxCommand_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)       '取消
  2040.   
  2041.     '避免执行Click程序
  2042.     Bln_Cancel = True
  2043.     
  2044.     Call Cancel
  2045.   
  2046. End Sub
  2048. Private Sub QxCommand_Click()                                           '取消
  2050.     If Bln_Cancel Then
  2051.         Bln_Cancel = False
  2052.         Exit Sub
  2053.     End If
  2054.     
  2055.     Call Cancel
  2056.     
  2057. End Sub
  2059. Private Sub Cancel()                                                    '取消
  2061.     '文本框加锁
  2062.     For jsqte = 0 To Max_Text_Index
  2063.         TextValiJudgeLock(jsqte) = True
  2064.     Next jsqte
  2065.     
  2066.     Call Toolfbjzt
  2067.   
  2068. End Sub
  2070. Private Sub CzxsGrid_BeforeMoveColumn(ByVal Col As Long, Position As Long)           '网格列发生移动时自动交换网格索引信息
  2071.   
  2072.     Call FnBln_RefreshArray(Col, Position, GridStr(), GridInf())
  2073.   
  2074. End Sub
  2076. Private Sub GsToolbar_ButtonClick(ByVal Button As MSComctlLib.Button)   '表格格式设置(通用)
  2078.     Select Case Button.Key
  2079.         Case "bcgs"                                       '保存表格格式
  2080.             Call Bcwggs(CzxsGrid, GridCode, GridStr())
  2081.         Case "hfmrgs"                                     '恢复默认格式
  2082.             Call Hfmrgs(CzxsGrid, GridCode, GridStr())
  2083.         Case "szxsxm"                                     '设置显示项目
  2084.             Call Szxsxm(CzxsGrid, GridCode)
  2085.     End Select
  2086.     
  2087. End Sub
  2089. Private Sub bbyl(bbylte As Boolean)                    '报表打印预览
  2091.     Dim Bbzbt$, Bbxbt() As String, bbxbtzzxs() As Integer, Bbxbtgs As Integer
  2092.     Dim Bbbwh() As String, Bbbwhzzxs() As Integer, Bbbwhgs As Integer
  2093.     Bbxbtgs = 1                                          '报 表 小 标 题 行 数
  2094.     Bbbwhgs = 0                                          '报 表 表 尾 行 数
  2095.     ReDim Bbxbt(1 To Bbxbtgs)
  2096.     ReDim bbxbtzzxs(1 To Bbxbtgs)
  2097.     
  2098.     If Bbbwhgs <> 0 Then
  2099.         ReDim Bbbwh(1 To Bbbwhgs)
  2100.         ReDim Bbbwhzzxs(1 To Bbbwhgs)
  2101.     End If
  2102.     
  2103.     Bbzbt = ReportTitle
  2104.     Bbxbt(1) = " "
  2105.     bbxbtzzxs(1) = 0                                     '报表行组织形式(0-居左 1-居中 2-居右)
  2106.   
  2107.     Call Scyxsjb(CzxsGrid)                               '生成报表数据
  2108.     Call Scdybb(Dyymctbl, Bbzbt, Bbxbt(), bbxbtzzxs(), Bbxbtgs, Bbbwh(), Bbbwhzzxs(), Bbbwhgs, bbylte)
  2109.     
  2110.     If Not bbylte Then
  2111.         Unload DY_Tybbyldy
  2112.     End If
  2113.     
  2114. End Sub
  2116. '************以下为文本框录入处理程序(固定不变部分)*************'
  2118. Private Sub Wbklrwbcl(Index As Integer)    '文本框录入事后处理程序
  2119.   
  2120.     '以下为依据实际情况自定义部分[
  2121.     
  2122.         '在此填写文本框录入事后处理程序
  2123.      
  2124.     ']以上为依据实际情况自定义部分
  2125.   
  2126. End Sub
  2128. Private Sub LrText_Change(Index As Integer)
  2130.     '屏蔽程序改变控制
  2131.     If TextChangeLock Then
  2132.         Exit Sub
  2133.     End If
  2134.     
  2135.     TextValiJudgeLock(Index) = False    '打开有效性判断锁
  2136.     
  2137.     '限制字段录入长度
  2138.           
  2139.     TextChangeLock = True  '加锁(防止执行Lrtext_Change)
  2140.      
  2141.     Select Case Textint(Index, 1)
  2142.         Case 8, 11       '金额型
  2143.             Call Sjgskz(LrText(Index), Xtjezws - Xtjexsws - 1, Xtjexsws)
  2144.         Case 9, 12       '数量型
  2145.             Call Sjgskz(LrText(Index), Xtslzws - Xtslxsws - 1, Xtslxsws)
  2146.         Case 10          '单价型
  2147.             Call Sjgskz(LrText(Index), Xtdjzws - Xtdjxsws - 1, Xtdjxsws)
  2148.         Case Else        '其他小数类型控制
  2149.             If Textint(Index, 6) <> 0 Or Textint(Index, 7) <> 0 Then
  2150.                 Call Sjgskz(LrText(Index), Textint(Index, 6), Textint(Index, 7))
  2151.             End If
  2152.     End Select
  2153.     
  2154.     '自动调入上级科目科目名称
  2155.     Select Case Index
  2156.         Case 0
  2157.             For jsqte = 1 To Int_CodeLev
  2158.                 If Int_CodeScheme(jsqte) = Len(Trim(LrText(0).Text)) Then
  2159.                     CodeLev = jsqte
  2160.                     Exit For
  2161.                 End If
  2162.             Next jsqte
  2163.             If jsqte <= CodeLev Then
  2164.                 If jsqte > 1 Then
  2165.                     Str_Parent = Mid(Trim(LrText(0).Text), 1, Int_CodeScheme(jsqte - 1))
  2166.                 Else
  2167.                     Str_Parent = ""
  2168.                 End If
  2169.                 Set RecTemp = Cw_DataEnvi.DataConnect.Execute("SELECT CCode,Cname FROM Cwzz_AccCode  Where CCode='" & Trim(Str_Parent) & "'")
  2170.                 If Not RecTemp.EOF Then
  2171.                     LrText(1).Text = Trim(RecTemp.Fields("Cname")) + "/"
  2172.                 End If
  2173.             Else
  2174.                 LrText(1).Text = ""
  2175.             End If
  2177.             If Val(Mid(LrText(0).Text, 1)) <= 5 And Val(Mid(LrText(0).Text, 1)) >= 1 Then
  2178.                 Combo_Class.Text = Combo_Class.List(Val(Mid(LrText(0).Text, 1)) - 1)
  2179.             End If
  2180.     End Select
  2181.         
  2182.     TextChangeLock = False '解锁
  2183.    
  2184. End Sub
  2186. Private Sub LrText_GotFocus(Index As Integer)                                                 '文本框得到焦点,显示相应信息
  2187.    
  2188.     Call TextShow(Index)
  2189.     CurTextIndex = Index
  2190.     LrText(Index).SelStart = Len(LrText(Index))
  2191.    
  2192. End Sub
  2194. Private Sub LrText_KeyDown(Index As Integer, KeyCode As Integer, Shift As Integer)            '字段按F2键提供帮助
  2195.    
  2196.     Select Case KeyCode
  2197.         Case vbKeyF2
  2198.             Call Text_Help(Index)
  2199.     End Select
  2200.    
  2201. End Sub
  2203. Private Sub LrText_KeyPress(Index As Integer, KeyAscii As Integer)                            '文本框录入事中控制
  2204.    
  2205.     Call InputFieldLimit(LrText(Index), Textint(Index, 1), KeyAscii)
  2207. End Sub
  2209. Private Sub LrText_LostFocus(Index As Integer)                                                '文本框失去焦点
  2211.     '显示相应信息但不能进行有效性判断
  2212.   
  2213. End Sub
  2215. Private Sub Ydcommand1_MouseDown(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)     '按钮提供帮助
  2216.    
  2217.     Call Text_Help(Index)
  2218.     
  2219. End Sub
  2221. Private Sub Text_Help(Index As Integer)                                                       '录入字段帮助
  2222.   
  2223.     If Not Textboolean(Index, 1) Then
  2224.         Exit Sub
  2225.     End If
  2226.      
  2227.     '调用帮助
  2228.     Call Drbmhelp(Textint(Index, 2), Textstr(Index, 4), Trim(LrText(Index).Text))
  2229.   
  2230.     '根据设置选择显示编码和名称,并进行存储
  2231.     If Len(Xtfhcs) <> 0 Then
  2232.         If Textint(Index, 3) = 1 Then
  2233.             LrText(Index).Text = Xtfhcsfz
  2234.             LrText(Index).Tag = Xtfhcs
  2235.         Else
  2236.             LrText(Index).Text = Xtfhcs
  2237.             LrText(Index).Tag = Xtfhcsfz
  2238.         End If
  2239.     End If
  2240.    
  2241.     LrText(Index).SetFocus
  2242.     
  2243. End Sub
  2245. Private Sub TextShow(Index As Integer)        '文本框得到焦点,显示相应信息
  2247.     '填写文本框得到焦点,进行相应信息处理程序
  2248.    
  2249. End Sub
  2251. Private Sub Wbkcsh()                          '录入文本框初始化
  2253.     Dim jsqte As Integer
  2254.   
  2255.     '最大录入文本框索引值
  2256.     Max_Text_Index = Textvar(1)
  2257.   
  2258.     ReDim TextValiJudgeLock(Max_Text_Index)
  2259.   
  2260.     For jsqte = 0 To Max_Text_Index
  2261.         If Len(Trim(Textstr(jsqte, 1))) <> 0 Then
  2262.             If Textboolean(jsqte, 1) Then
  2263.                 If jsqte <> 0 And Not Textboolean(jsqte, 3) Then
  2264.                     Load Ydcommand1(jsqte)
  2265.                 End If
  2266.                 Ydcommand1(jsqte).Visible = True
  2267.                 Ydcommand1(jsqte).Move LrText(jsqte).Left + LrText(jsqte).Width, LrText(jsqte).Top
  2268.             End If
  2269.             
  2270.             TextChangeLock = True
  2271.             LrText(jsqte).Text = ""
  2272.             LrText(jsqte).Tag = ""
  2273.             
  2274.             If Textint(jsqte, 5) <> 0 Then
  2275.                 LrText(jsqte).MaxLength = Textint(jsqte, 5)
  2276.             End If
  2277.             
  2278.             TextChangeLock = False
  2279.         End If
  2280.        
  2281.         TextValiJudgeLock(jsqte) = True
  2282.     Next jsqte
  2283.     
  2284. End Sub
  2286. Private Function TextYxxpd(Index As Integer) As Boolean           '文本框有效性判断
  2288.     Dim SqlStr As String
  2289.     Dim Findrec As ADODB.Recordset
  2290.   
  2291.     '文本框内容未曾改变不进行有效性判断
  2292.     If TextValiJudgeLock(Index) Then
  2293.         TextYxxpd = True
  2294.         Exit Function
  2295.     End If
  2296.   
  2297.     '文本框内容为空认为有效,并清空其Tag值
  2298.     If Trim(LrText(Index)) = "" Then
  2299.         LrText(Index).Tag = ""
  2300.         Call Wbklrwbcl(Index)
  2301.         TextValiJudgeLock(Index) = True
  2302.         TextYxxpd = True
  2303.         Exit Function
  2304.     End If
  2305.   
  2306.     '可在此加入不做有效性判断的理由
  2307.     
  2308.         '1.外币核算
  2309.     If Index = 2 Then
  2310.         If Chk_ForiFlag.Value = 0 Then
  2311.             TextYxxpd = True
  2312.             Exit Function
  2313.         End If
  2314.     End If
  2315.     
  2316.         '2.项目核算
  2317.     If Index = 4 Then
  2318.         If Chk_Ass(3).Value = 0 Then
  2319.             TextYxxpd = True
  2320.             Exit Function
  2321.         End If
  2322.     End If
  2323.     
  2324.     Select Case Textint(Index, 4)
  2325.         Case 1      '编码型
  2326.             SqlStr = Trim(Textstr(Index, 5))
  2327.             SqlStr = Replace(SqlStr, "@", "'" + Trim(LrText(Index).Text) + "'")
  2328.             Set Findrec = Cw_DataEnvi.DataConnect.Execute(SqlStr)
  2329.             
  2330.             If Findrec.EOF Then
  2331.                 Call Xtxxts(Trim(Textstr(Index, 6)), 0, 1)
  2332.                 LrText(Index).SetFocus
  2333.                 Exit Function
  2334.             Else
  2335.                 Select Case Textint(Index, 3)
  2336.                     Case 0
  2337.                     
  2338.                         If Len(Trim(Textstr(Index, 2))) <> 0 Then
  2339.                             LrText(Index).Text = Trim(Findrec.Fields(Trim(Textstr(Index, 2))))
  2340.                         End If
  2341.                         
  2342.                         If Len(Trim(Textstr(Index, 3) & "")) <> 0 Then
  2343.                             LrText(Index).Tag = Trim(Findrec.Fields(Trim(Textstr(Index, 3))))
  2344.                         End If
  2345.                         
  2346.                     Case 1
  2347.                     
  2348.                         If Len(Trim(Textstr(Index, 3) & "")) <> 0 Then
  2349.                             LrText(Index).Text = Trim(Findrec.Fields(Trim(Textstr(Index, 3))))
  2350.                         End If
  2351.                         
  2352.                         If Len(Trim(Textstr(Index, 2))) <> 0 Then
  2353.                             LrText(Index).Tag = Trim(Findrec.Fields(Trim(Textstr(Index, 2))))
  2354.                         End If
  2355.                 End Select
  2356.             End If
  2357.             
  2358.         Case 2      '日期型
  2359.             If IsDate(LrText(Index).Text) Then
  2360.                 LrText(Index).Text = Format(LrText(Index).Text, "yyyy-mm-dd")
  2361.                 If Val(Mid(LrText(Index), 1, 4)) < 1900 Then
  2362.                     LrText(Index).Text = "1900" + Mid(LrText(Index), 5, 6)
  2363.                 End If
  2364.             Else
  2365.                 Tsxx = "非法公历日期!(格式:" + Format(Date, "yyyy-mm-dd") + ")"
  2366.                 Call Xtxxts(Tsxx, 0, 1)
  2367.                 LrText(Index).SetFocus
  2368.                 Exit Function
  2369.             End If
  2370.             
  2371.         Case 3      '其他类型
  2372.         
  2373.     End Select
  2374.     
  2375.     '如果有效则加锁,用户不改变内容则不再进行有效性判断
  2376.     TextValiJudgeLock(Index) = True
  2378.     '调用文本框事后处理程序
  2379.     Call Wbklrwbcl(Index)
  2380.    
  2381.     '有效性判断通过则返回True
  2382.     TextYxxpd = True
  2383.    
  2384. End Function