企业管理

开发平台：
Visual Basic

：源码内容
							VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "mscomctl.ocx"
Begin VB.Form FAVari_Variation 
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "固定资产变动"
   ClientHeight    =   6570
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   9720
   HelpContextID   =   503001
   Icon            =   "固定资产变动.frx":0000
   KeyPreview      =   -1  'True
   LinkTopic       =   "Form1"
   LockControls    =   -1  'True
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   6570
   ScaleWidth      =   9720
   ShowInTaskbar   =   0   'False
   StartUpPosition =   2  '屏幕中心
   Begin VB.Frame Frame1 
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   10.5
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H00000000&
      Height          =   5895
      Left            =   3270
      TabIndex        =   16
      Top             =   630
      Width           =   6405
      Begin VB.CommandButton YdCommand 
         Height          =   300
         Index           =   12
         Left            =   5895
         Picture         =   "固定资产变动.frx":1042
         Style           =   1  'Graphical
         TabIndex        =   73
         Top             =   2175
         Width           =   300
      End
      Begin VB.CommandButton YdCommand 
         Height          =   300
         Index           =   10
         Left            =   5895
         Picture         =   "固定资产变动.frx":13CC
         Style           =   1  'Graphical
         TabIndex        =   72
         Top             =   1810
         Width           =   300
      End
      Begin VB.CommandButton YdCommand 
         Height          =   300
         Index           =   3
         Left            =   5895
         Picture         =   "固定资产变动.frx":1756
         Style           =   1  'Graphical
         TabIndex        =   71
         Top             =   1445
         Width           =   300
      End
      Begin VB.ComboBox Com_DeprMethod 
         Enabled         =   0   'False
         ForeColor       =   &H00000000&
         Height          =   300
         Index           =   1
         ItemData        =   "固定资产变动.frx":1AE0
         Left            =   4140
         List            =   "固定资产变动.frx":1AF9
         Style           =   2  'Dropdown List
         TabIndex        =   5
         Top             =   2540
         Width           =   2055
      End
      Begin VB.ComboBox Com_DeprMethod 
         Enabled         =   0   'False
         Height          =   300
         Index           =   0
         ItemData        =   "固定资产变动.frx":1B7B
         Left            =   1050
         List            =   "固定资产变动.frx":1B94
         Style           =   2  'Dropdown List
         TabIndex        =   62
         Top             =   2540
         Width           =   2055
      End
      Begin VB.CommandButton YdCommand 
         Height          =   300
         Index           =   0
         Left            =   2790
         Picture         =   "固定资产变动.frx":1C16
         Style           =   1  'Graphical
         TabIndex        =   35
         Top             =   1080
         Width           =   300
      End
      Begin VB.CommandButton QdCommand 
         Caption         =   "生成变动单"
         Enabled         =   0   'False
         Height          =   300
         Left            =   5010
         TabIndex        =   13
         Top             =   5490
         Width           =   1215
      End
      Begin VB.TextBox lrtext 
         Enabled         =   0   'False
         ForeColor       =   &H00000000&
         Height          =   300
         Index           =   8
         Left            =   1050
         TabIndex        =   12
         Text            =   "8"
         Top             =   5100
         Width           =   5145
      End
      Begin VB.TextBox lrtext 
         Enabled         =   0   'False
         ForeColor       =   &H00000000&
         Height          =   300
         Index           =   7
         Left            =   4140
         TabIndex        =   11
         Text            =   "7"
         Top             =   4730
         Width           =   2055
      End
      Begin VB.TextBox lrtext 
         Enabled         =   0   'False
         Height          =   300
         Index           =   6
         Left            =   1050
         TabIndex        =   32
         Text            =   "6"
         Top             =   4730
         Width           =   2055
      End
      Begin VB.TextBox lrtext 
         Enabled         =   0   'False
         ForeColor       =   &H00000000&
         Height          =   300
         Index           =   5
         Left            =   4140
         TabIndex        =   10
         Text            =   "5"
         Top             =   4365
         Width           =   2055
      End
      Begin VB.TextBox lrtext 
         Enabled         =   0   'False
         Height          =   300
         Index           =   4
         Left            =   1050
         TabIndex        =   30
         Text            =   "4"
         Top             =   4365
         Width           =   2055
      End
      Begin VB.TextBox lrtext 
         Enabled         =   0   'False
         Height          =   300
         Index           =   1
         Left            =   4140
         TabIndex        =   1
         Text            =   "1"
         Top             =   1080
         Width           =   2055
      End
      Begin VB.TextBox lrtext 
         Enabled         =   0   'False
         Height          =   300
         Index           =   0
         Left            =   1050
         TabIndex        =   0
         Text            =   "0"
         Top             =   1080
         Width           =   1755
      End
      Begin VB.TextBox lrtext 
         Enabled         =   0   'False
         Height          =   300
         Index           =   17
         Left            =   1050
         TabIndex        =   40
         Text            =   "17"
         Top             =   4000
         Width           =   2055
      End
      Begin VB.TextBox lrtext 
         Enabled         =   0   'False
         Height          =   300
         Index           =   15
         Left            =   1050
         TabIndex        =   39
         Text            =   "15"
         Top             =   3635
         Width           =   2055
      End
      Begin VB.TextBox lrtext 
         Enabled         =   0   'False
         Height          =   300
         Index           =   13
         Left            =   1050
         TabIndex        =   38
         Text            =   "13"
         Top             =   3270
         Width           =   2055
      End
      Begin VB.TextBox lrtext 
         Enabled         =   0   'False
         ForeColor       =   &H00000000&
         Height          =   300
         Index           =   18
         Left            =   4140
         TabIndex        =   9
         Text            =   "18"
         Top             =   4000
         Width           =   2055
      End
      Begin VB.TextBox lrtext 
         Enabled         =   0   'False
         ForeColor       =   &H00000000&
         Height          =   300
         Index           =   16
         Left            =   4140
         TabIndex        =   8
         Text            =   "16"
         Top             =   3635
         Width           =   2055
      End
      Begin VB.TextBox lrtext 
         Enabled         =   0   'False
         ForeColor       =   &H00000000&
         Height          =   300
         Index           =   14
         Left            =   4140
         TabIndex        =   7
         Text            =   "14"
         Top             =   3270
         Width           =   2055
      End
      Begin VB.TextBox lrtext 
         Enabled         =   0   'False
         ForeColor       =   &H00000000&
         Height          =   300
         Index           =   3
         Left            =   4140
         TabIndex        =   2
         Text            =   "3"
         Top             =   1445
         Width           =   1755
      End
      Begin VB.TextBox lrtext 
         Enabled         =   0   'False
         ForeColor       =   &H00000000&
         Height          =   300
         Index           =   12
         Left            =   4140
         TabIndex        =   4
         Text            =   "12"
         Top             =   2175
         Width           =   1755
      End
      Begin VB.TextBox lrtext 
         Enabled         =   0   'False
         ForeColor       =   &H00000000&
         Height          =   300
         Index           =   10
         Left            =   4140
         TabIndex        =   3
         Text            =   "10"
         Top             =   1810
         Width           =   1755
      End
      Begin VB.TextBox lrtext 
         Enabled         =   0   'False
         Height          =   300
         Index           =   2
         Left            =   1050
         TabIndex        =   28
         Text            =   "2"
         Top             =   1445
         Width           =   2055
      End
      Begin VB.TextBox lrtext 
         Enabled         =   0   'False
         Height          =   300
         Index           =   11
         Left            =   1050
         TabIndex        =   37
         Text            =   "11"
         Top             =   2175
         Width           =   2055
      End
      Begin VB.TextBox lrtext 
         Enabled         =   0   'False
         Height          =   300
         Index           =   9
         Left            =   1050
         TabIndex        =   36
         Text            =   "9"
         Top             =   1810
         Width           =   2055
      End
      Begin VB.TextBox lrtext 
         Enabled         =   0   'False
         Height          =   300
         Index           =   19
         Left            =   1050
         TabIndex        =   46
         Text            =   "19"
         Top             =   2905
         Width           =   2055
      End
      Begin VB.TextBox lrtext 
         Enabled         =   0   'False
         ForeColor       =   &H00000000&
         Height          =   300
         Index           =   20
         Left            =   4140
         TabIndex        =   6
         Text            =   "20"
         Top             =   2905
         Width           =   2055
      End
      Begin VB.Label Lbl_Name 
         AutoSize        =   -1  'True
         Caption         =   "资产名称:"
         Height          =   180
         Left            =   240
         TabIndex        =   70
         Top             =   660
         Width           =   810
      End
      Begin VB.Label Lbl_FAName 
         BorderStyle     =   1  'Fixed Single
         Height          =   240
         Left            =   1050
         TabIndex        =   69
         Top             =   630
         Width           =   1050
      End
      Begin VB.Label lbl_Y 
         AutoSize        =   -1  'True
         Caption         =   "会计年度:"
         ForeColor       =   &H00000080&
         Height          =   180
         Left            =   2160
         TabIndex        =   68
         Top             =   660
         Width           =   810
      End
      Begin VB.Label Xt_Year 
         AutoSize        =   -1  'True
         BorderStyle     =   1  'Fixed Single
         ForeColor       =   &H00000000&
         Height          =   240
         Left            =   3000
         TabIndex        =   67
         Top             =   630
         Width           =   480
      End
      Begin VB.Label Period 
         AutoSize        =   -1  'True
         Caption         =   "期间:"
         ForeColor       =   &H00000080&
         Height          =   180
         Left            =   3570
         TabIndex        =   66
         Top             =   660
         Width           =   450
      End
      Begin VB.Label Xt_Period 
         BorderStyle     =   1  'Fixed Single
         ForeColor       =   &H00000000&
         Height          =   240
         Left            =   4050
         TabIndex        =   65
         Top             =   630
         Width           =   240
      End
      Begin VB.Label Xt_Czy 
         BorderStyle     =   1  'Fixed Single
         ForeColor       =   &H00000000&
         Height          =   240
         Left            =   5025
         TabIndex        =   64
         Top             =   630
         Width           =   1170
      End
      Begin VB.Label Czy 
         AutoSize        =   -1  'True
         Caption         =   "操作员:"
         ForeColor       =   &H00000080&
         Height          =   180
         Left            =   4380
         TabIndex        =   63
         Top             =   660
         Width           =   630
      End
      Begin VB.Label Label7 
         BackColor       =   &H00000080&
         BorderStyle     =   1  'Fixed Single
         Height          =   180
         Left            =   3660
         TabIndex        =   61
         Top             =   5550
         Width           =   375
      End
      Begin VB.Label Label6 
         AutoSize        =   -1  'True
         Caption         =   "变动后:"
         Height          =   180
         Left            =   3060
         TabIndex        =   60
         Top             =   5550
         Width           =   630
      End
      Begin VB.Label Label4 
         BackColor       =   &H00000000&
         BorderStyle     =   1  'Fixed Single
         Height          =   180
         Left            =   2430
         TabIndex        =   59
         Top             =   5550
         Width           =   375
      End
      Begin VB.Label Label2 
         AutoSize        =   -1  'True
         Caption         =   "变动前:"
         Height          =   180
         Left            =   1830
         TabIndex        =   58
         Top             =   5550
         Width           =   630
      End
      Begin VB.Label LblName 
         AutoSize        =   -1  'True
         Caption         =   "使用年限:"
         ForeColor       =   &H00000000&
         Height          =   180
         Index           =   20
         Left            =   3300
         TabIndex        =   57
         Tag             =   "UseYears"
         Top             =   2965
         Width           =   810
      End
      Begin VB.Label LblName 
         AutoSize        =   -1  'True
         Caption         =   "使用年限:"
         Height          =   180
         Index           =   19
         Left            =   240
         TabIndex        =   56
         Top             =   2965
         UseMnemonic     =   0   'False
         Width           =   810
      End
      Begin VB.Label LblName 
         AutoSize        =   -1  'True
         Caption         =   "净 残 值:"
         ForeColor       =   &H00000000&
         Height          =   180
         Index           =   18
         Left            =   3300
         TabIndex        =   55
         Tag             =   "Sal"
         Top             =   4060
         Width           =   810
      End
      Begin VB.Label LblName 
         AutoSize        =   -1  'True
         Caption         =   "净 残 值:"
         Height          =   180
         Index           =   17
         Left            =   240
         TabIndex        =   54
         Top             =   4060
         UseMnemonic     =   0   'False
         Width           =   810
      End
      Begin VB.Label LblName 
         AutoSize        =   -1  'True
         Caption         =   "工作总量:"
         ForeColor       =   &H00000000&
         Height          =   180
         Index           =   16
         Left            =   3300
         TabIndex        =   53
         Tag             =   "Acti"
         Top             =   3695
         Width           =   810
      End
      Begin VB.Label LblName 
         AutoSize        =   -1  'True
         Caption         =   "工作总量:"
         Height          =   180
         Index           =   15
         Left            =   240
         TabIndex        =   52
         Top             =   3695
         Width           =   810
      End
      Begin VB.Label LblName 
         AutoSize        =   -1  'True
         Caption         =   "累计折旧:"
         ForeColor       =   &H00000000&
         Height          =   180
         Index           =   14
         Left            =   3300
         TabIndex        =   51
         Tag             =   "DeprSum"
         Top             =   3330
         Width           =   810
      End
      Begin VB.Label LblName 
         AutoSize        =   -1  'True
         Caption         =   "累计折旧:"
         Height          =   180
         Index           =   13
         Left            =   240
         TabIndex        =   50
         Top             =   3330
         Width           =   810
      End
      Begin VB.Label LblCom 
         AutoSize        =   -1  'True
         Caption         =   "折旧方法:"
         ForeColor       =   &H00000000&
         Height          =   180
         Index           =   1
         Left            =   3300
         TabIndex        =   49
         Tag             =   "DeprMothed"
         Top             =   2600
         Width           =   810
      End
      Begin VB.Label LblName 
         AutoSize        =   -1  'True
         Caption         =   "资产原值:"
         ForeColor       =   &H00000000&
         Height          =   180
         Index           =   5
         Left            =   3300
         TabIndex        =   48
         Tag             =   "FAValue"
         Top             =   4425
         Width           =   810
      End
      Begin VB.Label LblName 
         AutoSize        =   -1  'True
         Caption         =   "资产原值:"
         Height          =   180
         Index           =   4
         Left            =   240
         TabIndex        =   47
         Top             =   4425
         Width           =   810
      End
      Begin VB.Label LblCom 
         AutoSize        =   -1  'True
         Caption         =   "折旧方法:"
         Height          =   180
         Index           =   0
         Left            =   240
         TabIndex        =   45
         Top             =   2600
         Width           =   810
      End
      Begin VB.Label LblName 
         AutoSize        =   -1  'True
         Caption         =   "资产类别:"
         ForeColor       =   &H00000000&
         Height          =   180
         Index           =   12
         Left            =   3300
         TabIndex        =   44
         Tag             =   "FASort"
         Top             =   2235
         Width           =   810
      End
      Begin VB.Label LblName 
         AutoSize        =   -1  'True
         Caption         =   "变动原因:"
         ForeColor       =   &H00000080&
         Height          =   180
         Index           =   8
         Left            =   240
         TabIndex        =   34
         Top             =   5160
         Width           =   810
      End
      Begin VB.Label LblName 
         AutoSize        =   -1  'True
         Caption         =   "资产数量:"
         ForeColor       =   &H00000000&
         Height          =   180
         Index           =   7
         Left            =   3300
         TabIndex        =   33
         Tag             =   "Quantity"
         Top             =   4790
         Width           =   810
      End
      Begin VB.Label LblName 
         AutoSize        =   -1  'True
         Caption         =   "资产数量:"
         Height          =   180
         Index           =   6
         Left            =   240
         TabIndex        =   31
         Top             =   4790
         Width           =   810
      End
      Begin VB.Label LblName 
         AutoSize        =   -1  'True
         Caption         =   "所属部门:"
         ForeColor       =   &H00000000&
         Height          =   180
         Index           =   3
         Left            =   3300
         TabIndex        =   29
         Tag             =   "DeptName"
         Top             =   1505
         Width           =   810
      End
      Begin VB.Label LblName 
         AutoSize        =   -1  'True
         Caption         =   "所属部门:"
         Height          =   180
         Index           =   2
         Left            =   240
         TabIndex        =   27
         Top             =   1505
         Width           =   810
      End
      Begin VB.Label LblName 
         AutoSize        =   -1  'True
         Caption         =   "凭 证 号:"
         ForeColor       =   &H00000080&
         Height          =   180
         Index           =   1
         Left            =   3300
         TabIndex        =   26
         Top             =   1140
         Width           =   810
      End
      Begin VB.Label LblName 
         AutoSize        =   -1  'True
         Caption         =   "凭证类别:"
         ForeColor       =   &H00000080&
         Height          =   180
         Index           =   0
         Left            =   240
         TabIndex        =   25
         Top             =   1140
         Width           =   810
      End
      Begin VB.Line Line2 
         BorderColor     =   &H80000005&
         X1              =   180
         X2              =   6300
         Y1              =   990
         Y2              =   990
      End
      Begin VB.Line Line1 
         X1              =   120
         X2              =   6270
         Y1              =   960
         Y2              =   960
      End
      Begin VB.Label Label29 
         AutoSize        =   -1  'True
         Caption         =   "操作员:"
         Height          =   180
         Left            =   4380
         TabIndex        =   24
         Top             =   360
         Width           =   630
      End
      Begin VB.Label Lbl_Operator 
         BorderStyle     =   1  'Fixed Single
         Height          =   240
         Left            =   5025
         TabIndex        =   23
         Top             =   330
         Width           =   1170
      End
      Begin VB.Label Lbl_Period 
         AutoSize        =   -1  'True
         BorderStyle     =   1  'Fixed Single
         Height          =   240
         Left            =   4050
         TabIndex        =   22
         Top             =   330
         Width           =   240
      End
      Begin VB.Label Label5 
         AutoSize        =   -1  'True
         Caption         =   "期间:"
         Height          =   180
         Left            =   3570
         TabIndex        =   21
         Top             =   360
         Width           =   450
      End
      Begin VB.Label Lbl_Year 
         AutoSize        =   -1  'True
         BorderStyle     =   1  'Fixed Single
         Height          =   240
         Left            =   3000
         TabIndex        =   20
         Top             =   330
         Width           =   480
      End
      Begin VB.Label Label3 
         AutoSize        =   -1  'True
         Caption         =   "会计年度:"
         Height          =   180
         Left            =   2160
         TabIndex        =   19
         Top             =   360
         Width           =   810
      End
      Begin VB.Label Lbl_Num 
         BorderStyle     =   1  'Fixed Single
         Height          =   240
         Left            =   1050
         TabIndex        =   18
         Top             =   330
         Width           =   1050
      End
      Begin VB.Label Label1 
         AutoSize        =   -1  'True
         Caption         =   "卡片编号:"
         Height          =   180
         Left            =   240
         TabIndex        =   17
         Top             =   360
         Width           =   810
      End
      Begin VB.Label LblName 
         AutoSize        =   -1  'True
         Caption         =   "使用状况:"
         ForeColor       =   &H00000000&
         Height          =   180
         Index           =   10
         Left            =   3300
         TabIndex        =   42
         Tag             =   "FAState"
         Top             =   1870
         Width           =   810
      End
      Begin VB.Label LblName 
         AutoSize        =   -1  'True
         Caption         =   "使用状况:"
         Height          =   180
         Index           =   9
         Left            =   240
         TabIndex        =   41
         Top             =   1870
         Width           =   810
      End
      Begin VB.Label LblName 
         AutoSize        =   -1  'True
         Caption         =   "资产类别:"
         Height          =   180
         Index           =   11
         Left            =   240
         TabIndex        =   43
         Top             =   2235
         Width           =   810
      End
   End
   Begin MSComctlLib.TreeView TreeView 
      Height          =   5865
      Left            =   30
      TabIndex        =   14
      Top             =   630
      Width           =   3165
      _ExtentX        =   5583
      _ExtentY        =   10345
      _Version        =   393217
      Indentation     =   661
      LabelEdit       =   1
      LineStyle       =   1
      Style           =   7
      ImageList       =   "ImageList2"
      Appearance      =   1
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "宋体"
         Size            =   9
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
   End
   Begin MSComctlLib.Toolbar SzToolbar 
      Align           =   1  'Align Top
      Height          =   555
      Left            =   0
      TabIndex        =   15
      Top             =   0
      Width           =   9720
      _ExtentX        =   17145
      _ExtentY        =   979
      ButtonWidth     =   820
      ButtonHeight    =   926
      AllowCustomize  =   0   'False
      Appearance      =   1
      Style           =   1
      ImageList       =   "ImageList1"
      _Version        =   393216
      BeginProperty Buttons {66833FE8-8583-11D1-B16A-00C0F0283628} 
         NumButtons      =   2
         BeginProperty Button1 {66833FEA-8583-11D1-B16A-00C0F0283628} 
            Caption         =   "帮助"
            Key             =   "bz"
            ImageKey        =   "bz"
         EndProperty
         BeginProperty Button2 {66833FEA-8583-11D1-B16A-00C0F0283628} 
            Caption         =   "退出"
            Key             =   "fh"
            ImageKey        =   "tc"
         EndProperty
      EndProperty
      BorderStyle     =   1
      Begin MSComctlLib.ImageList ImageList1 
         Left            =   5760
         Top             =   0
         _ExtentX        =   1005
         _ExtentY        =   1005
         BackColor       =   -2147483643
         ImageWidth      =   16
         ImageHeight     =   16
         MaskColor       =   12632256
         _Version        =   393216
         BeginProperty Images {2C247F25-8591-11D1-B16A-00C0F0283628} 
            NumListImages   =   2
            BeginProperty ListImage1 {2C247F27-8591-11D1-B16A-00C0F0283628} 
               Picture         =   "固定资产变动.frx":1FA0
               Key             =   "bz"
            EndProperty
            BeginProperty ListImage2 {2C247F27-8591-11D1-B16A-00C0F0283628} 
               Picture         =   "固定资产变动.frx":233A
               Key             =   "tc"
            EndProperty
         EndProperty
      End
   End
   Begin MSComctlLib.ImageList ImageList2 
      Left            =   0
      Top             =   0
      _ExtentX        =   1005
      _ExtentY        =   1005
      BackColor       =   -2147483643
      ImageWidth      =   16
      ImageHeight     =   16
      MaskColor       =   12632256
      _Version        =   393216
      BeginProperty Images {2C247F25-8591-11D1-B16A-00C0F0283628} 
         NumListImages   =   4
         BeginProperty ListImage1 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "固定资产变动.frx":26D4
            Key             =   "T"
         EndProperty
         BeginProperty ListImage2 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "固定资产变动.frx":2FAE
            Key             =   "C"
         EndProperty
         BeginProperty ListImage3 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "固定资产变动.frx":3888
            Key             =   "Cl"
         EndProperty
         BeginProperty ListImage4 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "固定资产变动.frx":48DA
            Key             =   "O"
         EndProperty
      EndProperty
   End
End
Attribute VB_Name = "FAVari_Variation"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'*******************************************************
'*    模 块 名 称 :资产变动
'*    功 能 描 述 :资产变动
'*    程序员姓名  :徐衍民
'*    最后修改人  :徐衍民
'*    最后修改时间:2001/11/29
'*    备        注:自定义模块
'*******************************************************
 
Dim RecDigest As New ADODB.Recordset     '常用摘要表
Dim jdzygs As Integer                    '控件焦点转移个数
Dim Lrzt As Integer                      '录入状态标志(0-非录入状态 1-增加 2-修改)
Dim ReportTitle As String                '报表主标题
Dim Tsxx As String                       '提示信息
Dim Rs_Temp As ADODB.Recordset           '打开数据集临时变量
Dim Sqlstr As String                     '字符串变量
Dim MaxCode As String                    '最大变动单据号变量
Dim Jsqte As Integer                     '控件个数变量
  
'以下为固定使用变量(文本框)
Dim Textvar() As Variant                 '存储变体型文本框信息
Dim Textboolean() As Boolean             '存储布尔型文本框信息
Dim Textint() As Integer                 '存储整型文本框信息
Dim Textstr() As String                  '存储字符型文本框信息
Dim Max_Text_Index As Integer            '最大录入文本框索引值
Dim TextGroupCode As String              '文本框录入分组编码
Dim TextValiLock As Boolean              '文本框失去焦点是否进行有效性控制判断
Dim TextValiJudgeLock() As Boolean       '文本框录入有效性判断控制锁
Dim CurTextIndex As Integer              '当前文本框索引值
Dim TextChangeLock As Boolean            '文本框内容变换控制锁
'<<<<<<<<<<<<<<<<<<
Dim nodX As Node                         '树控件Node集合变量
Private Sub Form_Activate()              '填充窗体内容
    If Me.AutoRedraw = False Then
        '填充文本框
        Call Card_Rs
    End If
    
    Me.AutoRedraw = True
    
End Sub
Private Sub Form_KeyPress(KeyAscii As Integer)   '控 制 焦 点 转 移
    
    jdzygs = 14
    
    Select Case KeyAscii
    
        Case vbKeyReturn
            If Kjjdzy(jdzygs) Then
                KeyAscii = 0
            End If
        Case 39           '屏蔽"'"
            KeyAscii = 0
   End Select
   
End Sub
Private Sub Form_Load()         '窗体装入
    
    '添加树
    Add_Tree
    
    '以下为文本框处理程序
    TextGroupCode = "Gdzc_Variation"
    Call Drwbkxx(TextGroupCode, Textvar(), Textboolean(), Textint(), Textstr())  '读入文本框录入信息
    Call Wbkcsh
    '初始化时显示值
    Xt_Year.Caption = Xtyear                     '会计年度
    Xt_Period.Caption = Format(Xtmm, "00")                    '会计期间
    Xt_Czy.Caption = Xtczy                       '操作员姓名
End Sub
'录入文本框初始化
Private Sub Wbkcsh()
  
    Dim Jsqte As Integer
  
    '最大录入文本框索引值
    Max_Text_Index = Textvar(1)
  
    ReDim TextValiJudgeLock(Max_Text_Index)
    
    For Jsqte = 0 To Max_Text_Index
        LrText(Jsqte).Text = ""
    Next Jsqte
    For Jsqte = 3 To Max_Text_Index
        If Len(Trim(Textstr(Jsqte, 1))) <> 0 Then
            If Textboolean(Jsqte, 1) Then
                If Jsqte <> 0 And Not Textboolean(Jsqte, 3) Then
                    Load ydcommand(Jsqte)
                End If
                ydcommand(Jsqte).Visible = True
                ydcommand(Jsqte).Move LrText(Jsqte).Left + LrText(Jsqte).Width + 10, LrText(Jsqte).Top
            End If
            TextChangeLock = True
            LrText(Jsqte).Text = ""
            LrText(Jsqte).Tag = ""
            If Textint(Jsqte, 5) <> 0 Then
                LrText(Jsqte).MaxLength = Textint(Jsqte, 5)
            End If
            TextChangeLock = False
        End If
        TextValiJudgeLock(Jsqte) = True
    Next Jsqte
End Sub
'添加树项
Private Sub Add_Tree()
    
    Dim aDo_Sort As New Recordset
    
    TreeView.Nodes.Clear
    TreeView.Nodes.Add , 4, "M", "部分增减", "Cl"
    TreeView.Nodes.Add , 4, "Z", "其它变动", "Cl"
    Set aDo_Sort = Cw_DataEnvi.DataConnect.Execute("select * from Gdzc_VariationMode where VariSort > 2 order by FAVariCode")
    With aDo_Sort
        Do While Not .EOF
            If aDo_Sort!VariSort = 3 Then
                Set nodX = TreeView.Nodes.Add("M", 4, "M" & Trim(.Fields("FAVariCode")), "(" & Trim(.Fields("FAVariCode")) & ")" & Trim(.Fields("FAVariName")), "C")
            ElseIf aDo_Sort!VariSort = 4 Then
                Set nodX = TreeView.Nodes.Add("Z", 4, "Z" & Trim(.Fields("FAVariCode")), "(" & Trim(.Fields("FAVariCode")) & ")" & Trim(.Fields("FAVariName")), "C")
            End If
            nodX.EnsureVisible
            .MoveNext
        Loop
    End With
    aDo_Sort.Close
    Set aDo_Sort = Nothing
    
End Sub
'用户录入条件有效性判断
Private Function Lrtjyxxpd() As Boolean
 
    Dim Jsqte As Integer
    Lrtjyxxpd = False
 
    '对需要进行事后判断的文本框录入内容进行有效性判断 (固定不变)
    For Jsqte = 0 To Max_Text_Index
        If Textint(Jsqte, 9) = 0 Or Textint(Jsqte, 9) = 2 Then
            If Not TextYxxpd(Jsqte) Then
                Exit Function
            End If
        End If
    Next Jsqte
    
    Lrtjyxxpd = True
End Function
'*******************以下区域为编写自定义过程区域**********************
'向文本框填充数据
Function Card_Rs()
    
    Sqlstr = "SELECT Gdzc_Card.*, Gdzc_Sort.FASortName AS FASortName," _
        & "Gy_Department.DeptName AS DeptName,Gdzc_State.FAStateName AS FAStateName," _
        & "Cwzz_VouchClass.VouchClassName AS VouchClassName FROM Gdzc_Card INNER JOIN " _
        & "Gdzc_Sort ON Gdzc_Card.FASortCode = Gdzc_Sort.FASortCode INNER JOIN " _
        & "Gdzc_State ON Gdzc_Card.FAStateCode = Gdzc_State.FaStateCode INNER JOIN " _
        & "Gy_Department ON Gdzc_Card.DeptCode = Gy_Department.DeptCode LEFT OUTER JOIN " _
        & "Cwzz_VouchClass ON Gdzc_Card.VouchClassCode = Cwzz_VouchClass.VouchClassCode"
    Sqlstr = Sqlstr & " where gdzc_card.cardcode='" & Trim(Lbl_Num.Caption) & "'"
    Set Rs_Temp = New ADODB.Recordset
    Rs_Temp.Open Sqlstr, Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
    With Rs_Temp
        If Not .EOF Then
            Lbl_FAName.Caption = Trim(!FAName & "")         '资产名称
            Lbl_Year.Caption = !Year                        '会计年度
            Lbl_Period.Caption = Format(!Period, "00")      '会计期间
            Lbl_Operator.Caption = !Opreator                '操作员
            LrText(0).Text = Trim(!VouchClassName & "")     '凭证类别
            LrText(0).Tag = Trim(!VouchClassCode)           '凭证类别编号
            LrText(1).Text = Trim(!VouchNo & "")            '凭证号
            LrText(2).Text = Trim(!DeptName)                '部门名称
            LrText(2).Tag = Trim(!DeptCode)                 '部门编号
            LrText(3).Text = Trim(!DeptName)                '部门名称
            LrText(3).Tag = Trim(!DeptCode)                 '部门编号
            LrText(4).Text = !FAValue                       '资产原值
            LrText(5).Text = !FAValue                       '资产原值
            LrText(6).Text = !FAQuantity                    '资产数量
            LrText(7).Text = !FAQuantity                    '资产数量
            LrText(9).Text = Trim(!FAStateName & "")        '使用状况名称
            LrText(9).Tag = Trim(!FAStateCode & "")         '使用状况编码
            LrText(10).Text = Trim(!FAStateName & "")       '是用状况名称
            LrText(10).Tag = Trim(!FAStateCode & "")        '使用状况编号
            LrText(11).Text = Trim(!FASortName & "")        '资产类别名称
            LrText(11).Tag = Trim(!FASortCode & "")         '资产类别编码
            LrText(12).Text = Trim(!FASortName & "")        '资产类别名称
            LrText(12).Tag = Trim(!FASortCode & "")         '资产类别编号
            LrText(13).Text = !DeprSum                      '累计折旧
            LrText(14).Text = !DeprSum                      '累计折旧
            LrText(15).Text = !Activities                   '工作总量
            LrText(16).Text = !Activities                   '工作总量
            LrText(17).Text = !FactValue                    '净资产
            LrText(18).Text = !FactValue                    '净资产
            LrText(19).Text = !Useyears                     '使用年限
            LrText(20).Text = !Useyears                     '使用年限
            Select Case !DeprMethod                         '折旧方法
                Case "01"
                    Com_DeprMethod(0).Text = "不计提折旧"
                    Com_DeprMethod(1).Text = "不计提折旧"
                Case "02"
                    Com_DeprMethod(0).Text = "平均年限法(依净资产计提折旧)"
                    Com_DeprMethod(1).Text = "平均年限法(依净资产计提折旧)"
                Case "03"
                    Com_DeprMethod(0).Text = "平均年限法(依帐面原值计提折旧)"
                    Com_DeprMethod(1).Text = "平均年限法(依帐面原值计提折旧)"
                Case "04"
                    Com_DeprMethod(0).Text = "工作量法"
                    Com_DeprMethod(1).Text = "工作量法"
                Case "05"
                    Com_DeprMethod(0).Text = "固定折旧额折旧法"
                    Com_DeprMethod(1).Text = "固定折旧额折旧法"
                Case "06"
                    Com_DeprMethod(0).Text = "年数总和法"
                    Com_DeprMethod(1).Text = "年数总和法"
                Case "07"
                    Com_DeprMethod(0).Text = "双倍余额法"
                    Com_DeprMethod(1).Text = "双倍余额法"
            End Select
        End If
    End With
    Rs_Temp.Close
    Set Rs_Temp = Nothing
    
End Function
'解锁
Function Open_Clock()
    LrText(0).Enabled = True
    LrText(1).Enabled = True
    LrText(3).Enabled = True
    LrText(5).Enabled = True
    LrText(7).Enabled = True
    LrText(8).Enabled = True
    LrText(10).Enabled = True
    LrText(12).Enabled = True
    LrText(14).Enabled = True
    LrText(16).Enabled = True
    LrText(18).Enabled = True
    LrText(20).Enabled = True
    Com_DeprMethod(1).Enabled = True
    QdCommand.Enabled = True
    
End Function
'加锁
Function Add_Clock()
    Dim i As Integer
    
    For i = 0 To LrText.count - 1
        LrText(i).Enabled = False
    Next i
    For i = 2 To LblName.count - 1
        If i = 8 Then i = 9
        LblName(i).ForeColor = &H0&
    Next i
    QdCommand.Enabled = False
    Com_DeprMethod(1).Enabled = False
    
End Function
'录入存盘
Function Save()
    If IsValidity = True Then
                
        Dim FAValue_Temp As Double              '修改原资产原值变量
        Dim DeprSum_temp As Double              '修改原累计折旧变量
        Dim Dept_Temp As String                 '部门编号
        Dim Sort As String                      '资产类别
                
        On Error GoTo Cwcl
        Cw_DataEnvi.DataConnect.BeginTrans
        
        '修改资产卡片表
        Set Rs_Temp = New ADODB.Recordset
        Rs_Temp.Open "select * from gdzc_card where cardcode='" & Trim(Lbl_Num.Caption) & "'", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
        With Rs_Temp
            If Not .EOF Then
                Dept_Temp = !DeptCode
                Sort = !FASortCode
                !WhetherVariation = True                        '修改“是否发生变动标志”
                !FAValue = CCur(Val(LrText(5).Text))            '资产原值
                !DeptCode = Trim(LrText(3).Tag)                 '部门编号
                !FASortCode = Trim(LrText(12).Tag)              '资产类别编号
                !FAQuantity = Val(LrText(7).Text)               '资产数量
                !FAStateCode = Trim(LrText(10).Tag)             '使用状况编号
                !DeprSum = CCur(Val(LrText(14).Text))           '累计折旧
                !FactValue = CCur(Val(!FAValue) - Val(!DeprSum)) '净资产
                !Activities = Val(LrText(16).Text)              '工作总量
                !Useyears = Val(LrText(14).Text)                '使用年限
                !SalValue = CCur(Val(LrText(18).Text))          '净残值
                .Update
            End If
        End With
        Rs_Temp.Close
        Set Rs_Temp = Nothing
        
        '修改工作量表
        If Val(LrText(15).Text & "") <> Val(LrText(16).Text & "") Then
            Set Rs_Temp = New ADODB.Recordset
            Rs_Temp.Open "select * from Gdzc_JobQuantity where cardcode='" & Trim(Lbl_Num.Caption) & "' and year=" & Xtyear & " and period=" & Xtmm, Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
            With Rs_Temp
                If Not .EOF Then
                    !AcivitiesAEnd = Val(LrText(16).Text & "")  '变动后工作总量
                    .Update
                End If
            End With
            Rs_Temp.Close
            Set Rs_Temp = Nothing
        End If
        
        '修改固定资产明细帐
        Set Rs_Temp = New ADODB.Recordset
        Rs_Temp.Open "select * from Gdzc_DetailedForm where cardCode='" & Trim(Lbl_Num.Caption) & "' and FASortCode='" & Trim(LrText(12).Tag) & "' and year=" & Xtyear & " and period=" & Xtmm, Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
        With Rs_Temp
            If Not .EOF Then
                If Val(LrText(4).Text) <> Val(LrText(5).Text) Then
                    !FAValueEnd = CCur(Val(!FAValueEnd) + Val(LrText(5).Text))  '期末资产原值
                End If
                If Val(LrText(13).Text) <> Val(LrText(14).Text) Then
                    !DeprSumEnd = CCur(Val(!DeprSumEnd) + Val(LrText(14).Text)) '期末累计折旧
                End If
                .Update
            Else
                .AddNew
                !CardCode = Trim(Lbl_Num.Caption)                               '卡片编号
                !FASortCode = Trim(LrText(12).Tag)                              '资产类别
                !Year = Trim(Xt_Year.Caption)                                   '会计年度
                !Period = Val(Xt_Period.Caption)                                '会计期间
                !MmMake = False                                                 '录入期间标志
                !FAValueEnd = CCur(Val(LrText(5).Text))                         '期末资产原值
                !DeprSumEnd = CCur(LrText(14).Text)                             '期末累计折旧
                !DeprDate = Xtrq                                                '变动日期
                .Update
            End If
        End With
        Rs_Temp.Close
        Set Rs_Temp = Nothing
        
        '修改资产汇总表
        Set Rs_Temp = New ADODB.Recordset
        Rs_Temp.Open "select * from Gdzc_total where DeptCode='" & Trim(LrText(3).Tag) & "' and FASortCode='" & Trim(LrText(12).Tag) & "' and year=" & Xt_Year & " and Period=" & Xt_Period, Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
        With Rs_Temp
            If Not .EOF Then
                !FAvalueEndM = CCur(Val(!FAvalueEndM) - Val(LrText(4).Text) + Val(LrText(5).Text))
                !DeprSumEndM = CCur(Val(!DeprSumEndM) - Val(LrText(13).Text) + Val(LrText(14).Text))
                If Val(LrText(5).Text) - Val(LrText(4).Text) > 0 Then
                    !FAValueInM = CCur(Val(LrText(5).Text) - Val(LrText(4).Text))       '本期原值增加
                Else
                    !FAValueOutM = CCur(Val(LrText(4).Text) - Val(LrText(5).Text))      '本期原值减少
                End If
                If Val(Val(LrText(14).Text) - Val(LrText(13).Text)) > 0 Then
                    !DeprSumInM = CCur(Val(LrText(14).Text) - Val(LrText(13).Text))     '本期累计折旧增加
                Else
                    !DeprSumOutM = CCur(Val(LrText(13).Text) - Val(LrText(14).Text))    '本期累计折旧减少
                End If
                .Update
            Else
                .AddNew
                !DeptCode = Trim(LrText(3).Tag)                                         '所属部门
                !FASortCode = Trim(LrText(12).Tag)                                      '资产类别
                !Year = Trim(Xt_Year.Caption)                                           '会计年度
                !Period = Val(Xt_Period.Caption)                                        '会计期间
                !FAvalueEndM = CCur(Val(LrText(5).Text))                                '期末资产原值
                !DeprSumEndM = CCur(Val(LrText(14).Text))                               '期末累计折旧
                If Val(LrText(5).Text) - Val(LrText(4).Text) > 0 Then
                    !FAValueInM = CCur(Val(LrText(5).Text) - Val(LrText(4).Text))       '原值增加
                Else
                    !FAValueOutM = CCur(Val(LrText(4).Text) - Val(LrText(5).Text))      '原值减少
                End If
                If Val(Val(LrText(14).Text) - Val(LrText(13).Text)) > 0 Then
                    !DeprSumInM = CCur(Val(LrText(14).Text) - Val(LrText(13).Text))     '累计折旧增加
                Else
                    !DeprSumOutM = CCur(Val(LrText(13).Text) - Val(LrText(14).Text))    '累计折旧减少
                End If
                .Update
            End If
        End With
        Rs_Temp.Close
        Set Rs_Temp = Nothing
        
        '生成变动单
        Call Vari                 '生成变动单据号
        Set Rs_Temp = New ADODB.Recordset
        Rs_Temp.Open "select * from Gdzc_Variation where 1=2", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
        With Rs_Temp
            .AddNew
            !VariVouCode = Trim(MaxCode)                                                '变动单号
            !CardCode = Trim(Lbl_Num.Caption)                                           '卡片编号
            !Year = Val(Xt_Year.Caption)                                                '会计年度
            !Period = Val(Xt_Period.Caption)                                            '会计期间
            !varidate = Xtrq                                                            '变动日期
            !FAVariCode = Trim(Frame1.Tag)                                              '变动方式
            If Trim(LrText(0).Text) <> "" Then !VouchClassCode = Trim(LrText(0).Tag)    '凭证类别
            If Trim(LrText(1).Text) <> "" Then !VouchNo = Val(LrText(1).Text)           '凭证号
            !VariationReason = Trim(LrText(8).Text)                                     '变动原因
            !DeptOld = Trim(LrText(2).Tag)                                              '变动前部门
            !DeptNew = Trim(LrText(3).Tag)                                              '变动后部门
            !FAStateOld = Trim(LrText(9).Tag)                                           '变动前使用状况
            !FAStateNew = Trim(LrText(10).Tag)                                          '变动后使用状况
            !DeprMethOld = Trim("0" & Val(Com_DeprMethod(0).ListIndex + 1))             '变动前折旧方法
            !DeprMethNew = Trim("0" & Val(Com_DeprMethod(1).ListIndex + 1))             '变动后这就方法
            !FASortOld = Trim(LrText(11).Tag)                                           '变动前资产类别
            !FASortNew = Trim(LrText(12).Tag)                                           '变动后资产类别
            !FAValueOld = CCur(LrText(4).Text)                                          '变动前资产原值
            !FAValueNew = CCur(LrText(5).Text)                                          '变动后资产原值
            !SumDeprOld = CCur(LrText(13).Text)                                         '变动前累计折旧
            !SumDeprNew = CCur(LrText(14).Text)                                         '变动后累计折旧
            !ActivitiesOld = Val(LrText(15).Text)                                       '变动前工作总量
            !ActivitiesNew = Val(LrText(16).Text)                                       '变动后工作总量
            !SalValueOld = CCur(LrText(17).Text)                                        '变动前净残值
            !SalValueNew = CCur(LrText(18).Text)                                        '变动后净残值
            !UseYearsOld = Val(LrText(19).Text)                                         '变动前使用年限
            !UseYearsNew = Val(LrText(20).Text)                                         '变动后使用年限
            !FAQuantityOld = Val(LrText(6).Text)                                        '变动前资产总量
            !FAQuantityNew = Val(LrText(7).Text)                                        '变动后资产数量
            !Opreator = Trim(Xt_Czy.Caption)                                            '操作员
            .Update
        End With
        Rs_Temp.Close
        Set Rs_Temp = Nothing
        
        Cw_DataEnvi.DataConnect.CommitTrans
        MsgBox "资产变动单生成完毕!变动单号--" + Trim(MaxCode), vbOKOnly + vbInformation, "百利/ERP5.0-固定资产"
        Unload Me
        Exit Function
    End If
Cwcl:
    Cw_DataEnvi.DataConnect.RollbackTrans
    Tsxx = "您的输入有误导致存盘失败，请核对数据！"
    Call Xtxxts(Tsxx, 0, 1)
    Exit Function
    
End Function
'录入有效性判断
Function IsValidity() As Boolean
    IsValidity = False
    
    '变动方式不能为空
    If Trim(Frame1.Caption) = "" Then
        Tsxx = "请先选择变动方式!"
        Call Xtxxts(Tsxx, 0, 4)
        Exit Function
    End If
    
    '变动原因不能为空
    If Trim(LrText(8).Text) = "" Then
        Tsxx = "变动原因不能为空!"
        Call Xtxxts(Tsxx, 0, 4)
        LrText(8).SetFocus
        Exit Function
    End If
    
    '累计折旧不能大于资产原值
    If Val(LrText(14).Text) - Val(LrText(5).Text) > 0 Then
        Tsxx = "累计折旧不能大于资产原值!"
        Call Xtxxts(Tsxx, 0, 4)
        LrText(14).SetFocus
        Exit Function
    End If
        
    '当折旧方法为“工作量法”后，工作总量不能为空
    If Trim(Com_DeprMethod(1).Text) = "工作量法" Then
        If Trim(LrText(16).Text) = "" Then
            Tsxx = "工作总量不能为空!"
            Call Xtxxts(Tsxx, 0, 4)
            LrText(16).SetFocus
            Exit Function
        End If
    End If
    
    IsValidity = True
    
End Function
'变动单自动编号
Function Vari()
    Dim Max_Code As Double                              '最大值数值变量
    
    Set rstemp = New ADODB.Recordset
    rstemp.Open "select max(VariVouCode) as Max_CardCode from Gdzc_Variation", Cw_DataEnvi.DataConnect, adOpenKeyset, adLockOptimistic
    If Val(rstemp.Fields("Max_CardCode") & "") = 0 Then
        Max_Code = 1
    Else
        Max_Code = Val(rstemp.Fields("Max_CardCode")) + 1
    End If
    rstemp.Close
    Set rstemp = Nothing
    
    MaxCode = IIf(Max_Code < 10, "00000" & Max_Code, IIf(Max_Code < 100, "0000" & Max_Code, IIf(Max_Code < 1000, "000" & Max_Code, IIf(Max_Code < 10000, "00" & Max_Code, IIf(Max_Code < 100000, "0" & Max_Code, Max_Code)))))
End Function
'*******************以上区域为编写自定义过程区域**********************
'************以下为文本框录入处理程序(固定不变部分)*************'
Private Sub Wbklrwbcl(Index As Integer)    '文本框录入事后处理程序
    '以下为依据实际情况自定义部分[
  
    '在此填写文本框录入事后处理程序
   
    ']以上为依据实际情况自定义部分
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
    Kpgl_CardList.Timer1.Enabled = True
End Sub
Private Sub LrText_Change(Index As Integer)
    
    '屏蔽程序改变控制
    If TextChangeLock Then
        Exit Sub
    End If
   
    TextValiJudgeLock(Index) = False    '打开有效性判断锁
    
    '限制字段录入长度
          
    TextChangeLock = True  '加锁(防止执行Lrtext_Change)
    Select Case Textint(Index, 1)
        Case 8, 11      '金额型
            Call Sjgskz(LrText(Index), Xtjezws - Xtjexsws - 1, Xtjexsws)
        Case 9, 12      '数量型
            Call Sjgskz(LrText(Index), Xtslzws - Xtslxsws - 1, Xtslxsws)
        Case 10          '单价型
            Call Sjgskz(LrText(Index), Xtdjzws - Xtdjxsws - 1, Xtdjxsws)
        Case Else        '其他小数类型控制
            If Textint(Index, 6) <> 0 Or Textint(Index, 7) <> 0 Then
                Call Sjgskz(LrText(Index), Textint(Index, 6), Textint(Index, 7))
            End If
        End Select
    TextChangeLock = False '解锁
    
End Sub
'文本框得到焦点,显示相应信息
Private Sub LrText_GotFocus(Index As Integer)
    
    Call TextShow(Index)
    CurTextIndex = Index
    LrText(Index).SelStart = Len(LrText(Index))
End Sub
'字段按F2键提供帮助
Private Sub LrText_KeyDown(Index As Integer, KeyCode As Integer, Shift As Integer)
    
    Select Case KeyCode
        Case vbKeyF2
            Call Text_Help(Index)
    End Select
End Sub
'文本框录入事中控制
Private Sub LrText_KeyPress(Index As Integer, KeyAscii As Integer)
    Call InputFieldLimit(LrText(Index), Textint(Index, 1), KeyAscii)
End Sub
'文本框失去焦点进行有效性判断及相应处理
Private Sub LrText_LostFocus(Index As Integer)
    
    If Textint(Index, 9) = 0 Or Textint(Index, 9) = 1 Then '事中判断
        Call TextYxxpd(Index)
    End If
    
End Sub
Private Sub QdCommand_Click()
    Call Save
End Sub
Private Sub SzToolbar_ButtonClick(ByVal Button As MSComctlLib.Button)
    
    Select Case Button.Key
        Case "bz"
            SendKeys "{F1}"
        Case "fh"                                            '退 出
            Unload Me
    End Select
    
End Sub
'单击树节点，执行相应功能
Private Sub TreeView_NodeClick(ByVal Node As MSComctlLib.Node)
    
    '将变动方式赋值给Frame
    Frame1.Caption = Mid(TreeView.SelectedItem.Text, 8)
    Frame1.Tag = Mid(TreeView.SelectedItem.Text, 2, 5)
    LrText(8).Text = Mid(TreeView.SelectedItem.Text, 8)
    
    If Frame1.Caption <> "" Then
        Call Add_Clock
        Set Rs_Temp = New ADODB.Recordset
        Rs_Temp.Open "select * from Gdzc_VariWbkBj where FAVariCode='" & Trim(Frame1.Tag) & "'", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
        If Not Rs_Temp.EOF Then
            For Jsqte = 0 To LblName.count - 1
                If Trim(Trim(LblName(Jsqte).Tag)) <> "" Then
                    If Rs_Temp.Fields(LblName(Jsqte).Tag) = True Then
                        LrText(Jsqte).Enabled = True
                        LblName(Jsqte).ForeColor = &H80&
                    End If
                End If
            Next Jsqte
            If Rs_Temp.Fields(LblCom(1).Tag) = True Then
                Com_DeprMethod(1).Enabled = True
                LblCom(1).ForeColor = &H80&
            Else
                Com_DeprMethod(1).Enabled = False
                LblCom(1).ForeColor = &H0&
            End If
        End If
        Rs_Temp.Close
        Set Rs_Temp = Nothing
        LrText(0).Enabled = True
        LrText(1).Enabled = True
        LrText(8).Enabled = True
        QdCommand.Enabled = True
    Else
        Call Add_Clock
    End If
    
End Sub
'按钮提供帮助
Private Sub ydcommand_MouseDown(Index As Integer, Button As Integer, Shift As Integer, x As Single, y As Single)
    
    If LrText(Index).Enabled = False Then
        Exit Sub
    End If
    Call Text_Help(Index)
    
End Sub
'录入字段帮助
Private Sub Text_Help(Index As Integer)
    
    If Not Textboolean(Index, 1) Then
        Exit Sub
    End If
    TextValiJudgeLock(Index) = True
   
    '先进行有效性判断
    If Not TextYxxpd(CurTextIndex) Then
        Exit Sub
    End If
     
    '[>>调入参照窗体
    Call Drbmhelp(Textint(Index, 2), Textstr(Index, 4), Trim(LrText(Index).Text))
     '<<]
    If Len(Xtfhcs) <> 0 Then
        If Textint(Index, 3) = 1 Then
            LrText(Index).Text = Xtfhcsfz
            LrText(Index).Tag = Xtfhcs
        Else
            LrText(Index).Text = Xtfhcs
            LrText(Index).Tag = Xtfhcsfz
        End If
    End If
    TextValiJudgeLock(Index) = False
    LrText(Index).SetFocus
    
End Sub
'文本框得到焦点,显示相应信息
Private Sub TextShow(Index As Integer)
    '填写文本框得到焦点,进行相应信息处理程序
   
End Sub
'文本框有效性判断
Private Function TextYxxpd(Index As Integer) As Boolean
    
    Dim Sqlstr As String
    Dim Findrec As ADODB.Recordset
    
    If TextValiJudgeLock(Index) Then    '文本框内容未曾改变不进行有效性判断
        TextYxxpd = True
        Exit Function
    End If
    
    If Trim(LrText(Index)) = "" Then
        LrText(Index).Tag = ""
        Call Wbklrwbcl(Index)
        TextValiJudgeLock(Index) = True
        TextYxxpd = True
        Exit Function
    End If
    
    Select Case Textint(Index, 4)
        Case 1      '编码型
            Sqlstr = Trim(Textstr(Index, 5))
            Sqlstr = Replace(Sqlstr, "@", "'" + Trim(LrText(Index).Text) + "'")
            Set Findrec = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
            If Findrec.EOF Then
                Call Xtxxts(Trim(Textstr(Index, 6)), 0, 1)
                LrText(Index).SetFocus
                Exit Function
            Else
                Select Case Textint(Index, 3)
                    Case 0
                        If Len(Trim(Textstr(Index, 2))) <> 0 Then
                            LrText(Index).Text = Trim(Findrec.Fields(Trim(Textstr(Index, 2))))
                        End If
                        If Len(Trim(Textstr(Index, 3) & "")) <> 0 Then
                            LrText(Index).Tag = Trim(Findrec.Fields(Trim(Textstr(Index, 3))))
                        End If
                    Case 1
                        If Len(Trim(Textstr(Index, 3) & "")) <> 0 Then
                            LrText(Index).Text = Trim(Findrec.Fields(Trim(Textstr(Index, 3))))
                        End If
                        If Len(Trim(Textstr(Index, 2))) <> 0 Then
                            LrText(Index).Tag = Trim(Findrec.Fields(Trim(Textstr(Index, 2))))
                        End If
                End Select
            End If
        Case 2      '日期型
            If IsDate(LrText(Index).Text) Then
                LrText(Index).Text = Format(LrText(Index).Text, "yyyy-mm-dd")
                If Val(Mid(LrText(Index), 1, 4)) < 1900 Then
                    LrText(Index).Text = "1900" + Mid(LrText(Index), 5, 6)
                End If
            Else
                Tsxx = "非法公历日期!(格式:" + Format(Date, "yyyy-mm-dd") + ")"
                Call Xtxxts(Tsxx, 0, 1)
                LrText(Index).SetFocus
                Exit Function
            End If
        Case 3      '其他类型
    End Select
    TextValiJudgeLock(Index) = True
    TextYxxpd = True
End Function

						