企业管理

开发平台：
Visual Basic

：源码内容
							VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "mscomctl.ocx"
Begin VB.Form FAVari_Lessen 
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "固定资产减少"
   ClientHeight    =   5805
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   9375
   HelpContextID   =   503001
   Icon            =   "资产减少.frx":0000
   KeyPreview      =   -1  'True
   LinkTopic       =   "Form1"
   LockControls    =   -1  'True
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   5805
   ScaleWidth      =   9375
   ShowInTaskbar   =   0   'False
   StartUpPosition =   2  '屏幕中心
   Begin VB.ListBox Lst_Sort 
      Height          =   5100
      Left            =   60
      TabIndex        =   45
      Top             =   630
      Width           =   2775
   End
   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          =   5085
      Left            =   2910
      TabIndex        =   6
      Top             =   660
      Width           =   6405
      Begin VB.TextBox lrtext 
         Enabled         =   0   'False
         Height          =   300
         Index           =   13
         Left            =   4140
         TabIndex        =   53
         Text            =   "13"
         Top             =   3138
         Width           =   2055
      End
      Begin VB.TextBox lrtext 
         Enabled         =   0   'False
         Height          =   300
         Index           =   4
         Left            =   1080
         TabIndex        =   52
         Text            =   "4"
         Top             =   1606
         Width           =   2055
      End
      Begin VB.TextBox lrtext 
         Enabled         =   0   'False
         Height          =   300
         Index           =   16
         Left            =   1080
         TabIndex        =   1
         Text            =   "16"
         Top             =   3904
         Width           =   1725
      End
      Begin VB.TextBox lrtext 
         Enabled         =   0   'False
         Height          =   300
         Index           =   17
         Left            =   4140
         TabIndex        =   2
         Text            =   "17"
         Top             =   3904
         Width           =   2055
      End
      Begin VB.CommandButton YdCommand 
         Height          =   300
         Index           =   0
         Left            =   2820
         Picture         =   "资产减少.frx":1042
         Style           =   1  'Graphical
         TabIndex        =   49
         Top             =   3904
         Visible         =   0   'False
         Width           =   300
      End
      Begin VB.TextBox lrtext 
         Enabled         =   0   'False
         ForeColor       =   &H00000000&
         Height          =   300
         Index           =   15
         Left            =   4140
         TabIndex        =   3
         Text            =   "15"
         Top             =   3521
         Width           =   2055
      End
      Begin VB.TextBox lrtext 
         Enabled         =   0   'False
         Height          =   300
         Index           =   12
         Left            =   1080
         TabIndex        =   5
         Text            =   "12"
         Top             =   3138
         Width           =   2055
      End
      Begin VB.TextBox lrtext 
         Enabled         =   0   'False
         Height          =   300
         Index           =   0
         Left            =   1080
         TabIndex        =   46
         Text            =   "0"
         Top             =   840
         Width           =   2055
      End
      Begin VB.TextBox lrtext 
         Enabled         =   0   'False
         Height          =   300
         Index           =   5
         Left            =   4140
         TabIndex        =   17
         Text            =   "5"
         Top             =   1606
         Width           =   2055
      End
      Begin VB.TextBox lrtext 
         Enabled         =   0   'False
         Height          =   300
         Index           =   2
         Left            =   1080
         TabIndex        =   16
         Text            =   "2"
         Top             =   1223
         Width           =   2055
      End
      Begin VB.TextBox lrtext 
         Enabled         =   0   'False
         Height          =   300
         Index           =   3
         Left            =   4140
         TabIndex        =   15
         Text            =   "3"
         Top             =   1223
         Width           =   2055
      End
      Begin VB.TextBox lrtext 
         Enabled         =   0   'False
         Height          =   300
         Index           =   1
         Left            =   4140
         TabIndex        =   14
         Text            =   "1"
         Top             =   840
         Width           =   2055
      End
      Begin VB.TextBox lrtext 
         Enabled         =   0   'False
         ForeColor       =   &H00000000&
         Height          =   300
         Index           =   7
         Left            =   4140
         TabIndex        =   13
         Text            =   "7"
         Top             =   1989
         Width           =   2055
      End
      Begin VB.TextBox lrtext 
         Enabled         =   0   'False
         Height          =   300
         Index           =   6
         Left            =   1080
         TabIndex        =   12
         Text            =   "6"
         Top             =   1989
         Width           =   2055
      End
      Begin VB.TextBox lrtext 
         Enabled         =   0   'False
         Height          =   300
         Index           =   14
         Left            =   1080
         TabIndex        =   0
         Text            =   "14"
         Top             =   3521
         Width           =   2055
      End
      Begin VB.TextBox lrtext 
         Enabled         =   0   'False
         Height          =   300
         Index           =   8
         Left            =   1080
         TabIndex        =   11
         Text            =   "8"
         Top             =   2372
         Width           =   2055
      End
      Begin VB.TextBox lrtext 
         Enabled         =   0   'False
         ForeColor       =   &H00000000&
         Height          =   300
         Index           =   9
         Left            =   4140
         TabIndex        =   10
         Text            =   "9"
         Top             =   2372
         Width           =   2055
      End
      Begin VB.TextBox lrtext 
         Enabled         =   0   'False
         Height          =   300
         Index           =   10
         Left            =   1080
         TabIndex        =   9
         Text            =   "10"
         Top             =   2755
         Width           =   2055
      End
      Begin VB.TextBox lrtext 
         Enabled         =   0   'False
         ForeColor       =   &H00000000&
         Height          =   300
         Index           =   11
         Left            =   4140
         TabIndex        =   8
         Text            =   "11"
         Top             =   2755
         Width           =   2055
      End
      Begin VB.TextBox lrtext 
         Enabled         =   0   'False
         ForeColor       =   &H00000000&
         Height          =   300
         Index           =   18
         Left            =   1080
         TabIndex        =   4
         Text            =   "18"
         Top             =   4290
         Width           =   5115
      End
      Begin VB.CommandButton QdCommand 
         Caption         =   "确定(&O)"
         Enabled         =   0   'False
         Height          =   300
         Left            =   5160
         TabIndex        =   7
         Top             =   4680
         Width           =   1005
      End
      Begin VB.Label LblName 
         AutoSize        =   -1  'True
         Caption         =   "净 残 值:"
         ForeColor       =   &H00000080&
         Height          =   180
         Index           =   12
         Left            =   3330
         TabIndex        =   54
         Top             =   3198
         Width           =   810
      End
      Begin VB.Label LblName 
         AutoSize        =   -1  'True
         Caption         =   "凭证类别:"
         Height          =   180
         Index           =   0
         Left            =   240
         TabIndex        =   51
         Top             =   3964
         Width           =   810
      End
      Begin VB.Label LblName 
         AutoSize        =   -1  'True
         Caption         =   "凭 证 号:"
         Height          =   180
         Index           =   1
         Left            =   3330
         TabIndex        =   50
         Top             =   3964
         Width           =   810
      End
      Begin VB.Label LblName 
         AutoSize        =   -1  'True
         Caption         =   "清理收入:"
         ForeColor       =   &H00000000&
         Height          =   180
         Index           =   10
         Left            =   3330
         TabIndex        =   48
         Top             =   3581
         Width           =   810
      End
      Begin VB.Label LblName 
         AutoSize        =   -1  'True
         Caption         =   "净 残 值:"
         Height          =   180
         Index           =   3
         Left            =   240
         TabIndex        =   47
         Top             =   3198
         Width           =   810
      End
      Begin VB.Label Label29 
         AutoSize        =   -1  'True
         Caption         =   "操作员:"
         Height          =   180
         Left            =   4410
         TabIndex        =   44
         Top             =   360
         Width           =   630
      End
      Begin VB.Label Lbl_Operator 
         BorderStyle     =   1  'Fixed Single
         Height          =   240
         Left            =   5055
         TabIndex        =   43
         Top             =   330
         Width           =   1170
      End
      Begin VB.Label Lbl_Period 
         AutoSize        =   -1  'True
         BorderStyle     =   1  'Fixed Single
         Height          =   240
         Left            =   4050
         TabIndex        =   42
         Top             =   330
         Width           =   240
      End
      Begin VB.Label Label5 
         AutoSize        =   -1  'True
         Caption         =   "期间:"
         Height          =   180
         Left            =   3570
         TabIndex        =   41
         Top             =   360
         Width           =   450
      End
      Begin VB.Label Lbl_Year 
         AutoSize        =   -1  'True
         BorderStyle     =   1  'Fixed Single
         Height          =   240
         Left            =   3000
         TabIndex        =   40
         Top             =   330
         Width           =   480
      End
      Begin VB.Label Label3 
         AutoSize        =   -1  'True
         Caption         =   "会计年度:"
         Height          =   180
         Left            =   2160
         TabIndex        =   39
         Top             =   360
         Width           =   810
      End
      Begin VB.Label LblName 
         AutoSize        =   -1  'True
         Caption         =   "资产类别:"
         Height          =   180
         Index           =   11
         Left            =   3330
         TabIndex        =   37
         Top             =   1283
         Width           =   810
      End
      Begin VB.Label LblName 
         AutoSize        =   -1  'True
         Caption         =   "使用状况:"
         Height          =   180
         Index           =   9
         Left            =   240
         TabIndex        =   36
         Top             =   1283
         Width           =   810
      End
      Begin VB.Label Label1 
         AutoSize        =   -1  'True
         Caption         =   "卡片编号:"
         Height          =   180
         Left            =   240
         TabIndex        =   35
         Top             =   360
         Width           =   810
      End
      Begin VB.Label Lbl_Num 
         BorderStyle     =   1  'Fixed Single
         Height          =   240
         Left            =   1050
         TabIndex        =   34
         Top             =   330
         Width           =   1050
      End
      Begin VB.Line Line1 
         X1              =   120
         X2              =   6270
         Y1              =   690
         Y2              =   690
      End
      Begin VB.Line Line2 
         BorderColor     =   &H80000005&
         X1              =   180
         X2              =   6300
         Y1              =   720
         Y2              =   720
      End
      Begin VB.Label LblName 
         AutoSize        =   -1  'True
         Caption         =   "所属部门:"
         Height          =   180
         Index           =   2
         Left            =   3330
         TabIndex        =   33
         Top             =   900
         Width           =   810
      End
      Begin VB.Label LblName 
         AutoSize        =   -1  'True
         Caption         =   "资产数量:"
         Height          =   180
         Index           =   6
         Left            =   240
         TabIndex        =   32
         Top             =   2815
         Width           =   810
      End
      Begin VB.Label LblName 
         AutoSize        =   -1  'True
         Caption         =   "资产数量:"
         ForeColor       =   &H00000080&
         Height          =   180
         Index           =   7
         Left            =   3330
         TabIndex        =   31
         Top             =   2815
         Width           =   810
      End
      Begin VB.Label LblName 
         AutoSize        =   -1  'True
         Caption         =   "减少原因:"
         ForeColor       =   &H00000000&
         Height          =   180
         Index           =   8
         Left            =   240
         TabIndex        =   30
         Top             =   4350
         Width           =   810
      End
      Begin VB.Label LblCom 
         AutoSize        =   -1  'True
         Caption         =   "折旧方法:"
         Height          =   180
         Index           =   0
         Left            =   240
         TabIndex        =   29
         Top             =   1666
         Width           =   810
      End
      Begin VB.Label LblName 
         AutoSize        =   -1  'True
         Caption         =   "资产原值:"
         Height          =   180
         Index           =   4
         Left            =   240
         TabIndex        =   28
         Top             =   2432
         Width           =   810
      End
      Begin VB.Label LblName 
         AutoSize        =   -1  'True
         Caption         =   "资产原值:"
         ForeColor       =   &H00000080&
         Height          =   180
         Index           =   5
         Left            =   3330
         TabIndex        =   27
         Top             =   2432
         Width           =   810
      End
      Begin VB.Label LblName 
         AutoSize        =   -1  'True
         Caption         =   "累计折旧:"
         Height          =   180
         Index           =   13
         Left            =   240
         TabIndex        =   26
         Top             =   2049
         Width           =   810
      End
      Begin VB.Label LblName 
         AutoSize        =   -1  'True
         Caption         =   "累计折旧:"
         ForeColor       =   &H00000080&
         Height          =   180
         Index           =   14
         Left            =   3330
         TabIndex        =   25
         Top             =   2049
         Width           =   810
      End
      Begin VB.Label LblName 
         AutoSize        =   -1  'True
         Caption         =   "减少数量:"
         Height          =   180
         Index           =   17
         Left            =   240
         TabIndex        =   24
         Top             =   3581
         UseMnemonic     =   0   'False
         Width           =   810
      End
      Begin VB.Label LblName 
         AutoSize        =   -1  'True
         Caption         =   "使用年限:"
         Height          =   180
         Index           =   19
         Left            =   3330
         TabIndex        =   23
         Top             =   1666
         UseMnemonic     =   0   'False
         Width           =   810
      End
      Begin VB.Label Label2 
         AutoSize        =   -1  'True
         Caption         =   "减少前:"
         Height          =   180
         Left            =   1920
         TabIndex        =   22
         Top             =   4740
         Width           =   630
      End
      Begin VB.Label Label4 
         BackColor       =   &H00000000&
         BorderStyle     =   1  'Fixed Single
         Height          =   180
         Left            =   2520
         TabIndex        =   21
         Top             =   4740
         Width           =   375
      End
      Begin VB.Label Label6 
         AutoSize        =   -1  'True
         Caption         =   "减少后:"
         Height          =   180
         Left            =   3150
         TabIndex        =   20
         Top             =   4740
         Width           =   630
      End
      Begin VB.Label Label7 
         BackColor       =   &H00000080&
         BorderStyle     =   1  'Fixed Single
         Height          =   180
         Left            =   3750
         TabIndex        =   19
         Top             =   4740
         Width           =   375
      End
      Begin VB.Label Lbl_Name 
         AutoSize        =   -1  'True
         Caption         =   "资产名称:"
         Height          =   180
         Left            =   240
         TabIndex        =   18
         Top             =   900
         Width           =   810
      End
   End
   Begin MSComctlLib.Toolbar SzToolbar 
      Align           =   1  'Align Top
      Height          =   555
      Left            =   0
      TabIndex        =   38
      Top             =   0
      Width           =   9375
      _ExtentX        =   16536
      _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":13CC
               Key             =   "bz"
            EndProperty
            BeginProperty ListImage2 {2C247F27-8591-11D1-B16A-00C0F0283628} 
               Picture         =   "资产减少.frx":1766
               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":1B00
            Key             =   "T"
         EndProperty
         BeginProperty ListImage2 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "资产减少.frx":23DA
            Key             =   "C"
         EndProperty
         BeginProperty ListImage3 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "资产减少.frx":2CB4
            Key             =   "Cl"
         EndProperty
         BeginProperty ListImage4 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "资产减少.frx":3D06
            Key             =   "O"
         EndProperty
      EndProperty
   End
End
Attribute VB_Name = "FAVari_Lessen"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'*******************************************************
'*    模 块 名 称 :资产减少
'*    功 能 描 述 :资产减少
'*    程序员姓名  :徐衍民
'*    最后修改人  :徐衍民
'*    最后修改时间:2001/12/4
'*    备        注:自定义模块
'*******************************************************
Dim Tsxx As String                       '系统信息提示
Dim Rs_Temp As ADODB.Recordset           '数据集变量
Dim Sqlstr As String                     '字符串变量
Dim Activities As String                 '工作总量
Dim MaxCode As String                    '最大变动单据号变量
'以下为固定使用变量(文本框)
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 Bln_Cancel As Boolean                '取消按钮信息传递
Private Sub Form_Activate()              '赋值给各文本框
    Call Card_Edit
End Sub
Private Sub Form_KeyPress(KeyAscii As Integer)   '控 制 焦 点 转 移
    
    Dim jdzygs As Integer                         '控件焦点转移个数
    jdzygs = 30
    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()
   
    '以下为文本框处理程序
    TextGroupCode = "Gdzc_lessen"
    Call Drwbkxx(TextGroupCode, Textvar(), Textboolean(), Textint(), Textstr())  '读入文本框录入信息
    Call Wbkcsh
    
    '显示资产减少方式
    Call VariationMode
    '赋初值
    Lbl_Year.Caption = Xtyear                        '会计年度
    Lbl_Period.Caption = Format(Xtmm, "00")          '会计期间
    Lbl_Operator.Caption = Xtczy                     '系统操作员
    
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
    Kpgl_CardList.Timer1.Enabled = True
End Sub
'单击减少方式，激活文本框编辑状态
Private Sub Lst_Sort_Click()
    
    Dim i As Integer
    
    Frame1.Caption = RightChar(Lst_Sort.List(Lst_Sort.ListIndex))
    Frame1.Tag = LeftChar(Lst_Sort.List(Lst_Sort.ListIndex))
    
    For i = 14 To 18
        LrText(i).Enabled = True
    Next i
    LrText(14).SetFocus
    QdCommand.Enabled = True
    
End Sub
Private Sub QdCommand_Click()                                   '确 定
    Call Save
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 VariationMode()
    Set Rs_Temp = New ADODB.Recordset
    Rs_Temp.Open "select * from Gdzc_VariationMode where VariSort=2", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
    While Not Rs_Temp.EOF
        Lst_Sort.AddItem "(" & Trim(Rs_Temp!FAVariCode) & ")" & Rs_Temp!FAVariName
        Rs_Temp.MoveNext
    Wend
    Rs_Temp.Close
    Set Rs_Temp = Nothing
End Function
'取左字符串函数
Private Function LeftChar(str As String) As String
    
    Dim i As Integer
    i = Len(str)
    LeftChar = Mid(str, 2, InStr(str, ")") - 2)
End Function
'取右字符串函数
Private Function RightChar(str As String) As String
    
    Dim i As Integer
    i = Len(str)
    RightChar = Mid(str, InStr(str, ")") + 1)
End Function
'为文本框赋初值
Function Card_Edit()
        
    Set Rs_Temp = New ADODB.Recordset
    Sqlstr = "SELECT Gdzc_Card.*, Gdzc_State.FAStateName AS FAStateName," _
        & "Gdzc_Sort.FASortName AS FASortName,Gy_Department.DeptName AS DeptName " _
        & "FROM Gdzc_Card LEFT OUTER JOIN Gdzc_State ON Gdzc_Card.FAStateCode = Gdzc_State.FaStateCode LEFT OUTER JOIN " _
        & "Gy_Department ON Gdzc_Card.DeptCode = Gy_Department.DeptCode LEFT OUTER JOIN " _
        & "Gdzc_Sort ON Gdzc_Card.FASortCode = Gdzc_Sort.FASortCode"
    Sqlstr = Sqlstr & " where cardCode='" & Trim(Lbl_Num.Caption) & "'"
    Rs_Temp.Open Sqlstr, Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
    With Rs_Temp
        If Not .EOF Then
            Activities = !Activities                '工作总量
            LrText(0).Text = !FAName                '资产名称
            LrText(1).Text = !DeptName              '部门名称
            LrText(1).Tag = !DeptCode               '部门编号
            LrText(2).Text = !FAStateName           '使用状况名称
            LrText(2).Tag = !FAStateCode            '使用状况编号
            LrText(3).Text = !FASortName            '资产类别名称
            LrText(3).Tag = !FASortCode             '资产类别编号
            Select Case !DeprMethod                 '折旧方法
                Case "01"
                    LrText(4).Text = "不计提折旧"
                    LrText(4).Tag = "01"
                Case "02"
                    LrText(4).Text = "平均年限法(依净资产计提折旧)"
                    LrText(4).Tag = "02"
                Case "03"
                    LrText(4).Text = "平均年限法(依帐面原值计提折旧)"
                    LrText(4).Tag = "03"
                Case "04"
                    LrText(4).Text = "工作量法"
                    LrText(4).Tag = "04"
                Case "05"
                    LrText(4).Text = "固定折旧额折旧法"
                    LrText(4).Tag = "05"
                Case "06"
                    LrText(4).Text = "年数总和法"
                    LrText(4).Tag = "06"
                Case "07"
                    LrText(4).Text = "双倍余额法"
                    LrText(4).Tag = "07"
            End Select
            LrText(5).Text = !Useyears              '使用年限
            LrText(6).Text = !DeprSum               '累计折旧
            LrText(7).Text = !DeprSum               '累计折旧
            LrText(8).Text = !FAValue               '资产原值
            LrText(9).Text = !FAValue               '资产原值
            LrText(10).Text = !FAQuantity           '资产数量
            LrText(11).Text = !FAQuantity           '资产数量
            LrText(12).Text = !SalValue             '净残值
            LrText(13).Text = !SalValue             '净残值
        End If
    End With
    Rs_Temp.Close
    Set Rs_Temp = Nothing
End Function
'资产减少存盘
Function Save()
    
    '录入有效性判断
    If Judge = False Then Exit Function
    
    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
            !FAValue = CCur(Val(LrText(9).Text))            '资产原值
            !DeprSum = CCur(Val(LrText(7).Text))            '累计折旧
            !FAQuantity = Val(LrText(11).Text)              '资产数量
            !FactValue = Val(!FAValue) - Val(!DeprSum)      '净资产
            !SalValue = CCur(LrText(12).Text)               '净残值
            .Update
        End If
    End With
    Rs_Temp.Close
    Set Rs_Temp = Nothing
    
    '修改会计资产明细表
    Set Rs_Temp = New ADODB.Recordset
    Rs_Temp.Open "select * from Gdzc_DetailedForm where cardCode='" & Trim(Lbl_Num.Caption) & "' and FASortCode='" & Trim(LrText(3).Tag) & "' and year=" & Xtyear & " and period=" & Xtmm, Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
    With Rs_Temp
        If Not .EOF Then
            !FAValueEnd = CCur(Val(!FAValueEnd) + Val(LrText(8).Text) - Val(LrText(9).Text))    '期末原值
            !DeprSumEnd = CCur(Val(!DeprSumEnd) + Val(LrText(7).Text) - Val(LrText(6).Text))    '期末累计折旧
            .Update
        Else
            .AddNew
            !CardCode = Trim(Lbl_Num.Caption)               '卡片编号
            !FASortCode = Trim(LrText(3).Tag)               '资产类别编号
            !Year = Xtyear                                  '会计年度
            !Period = Val(Xtmm)                             '会计期间
            !MmMake = False                                 '录入期间标志
            !FAValueEnd = CCur(Val(LrText(8).Text))         '期末原值
            !DeprSumEnd = CCur(LrText(7).Text)              '期末累计折旧
            .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(1).Tag) & "' and FASortCode='" & Trim(LrText(3).Tag) & "' and year=" & Xtyear & " and Period=" & Xtmm, Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
    With Rs_Temp
        If Not .EOF Then
            !FAvalueEndM = CCur(Val(!FAvalueEndM) - Val(LrText(9).Text) + Val(LrText(8).Text))  '期末资产原值
            !DeprSumEndM = CCur(Val(!DeprSumEndM) - Val(LrText(6).Text) + Val(LrText(7).Text))  '期末累计折旧
            !FAValueOutM = CCur(Val(LrText(8).Text) - Val(LrText(9).Text))                      '本期原值减少
            !DeprSumInM = CCur(Abs(Val(LrText(6).Text) - Val(LrText(7).Text)))                  '本期累计折旧增加
            .Update
        Else
            .AddNew
            !DeptCode = Trim(LrText(1).Tag)                                                     '所属部门
            !FASortCode = Trim(LrText(3).Tag)                                                   '资产类别
            !Year = Xtyear                                                                      '会计年度
            !Period = Xtmm                                                                      '会计期间
            !FAvalueEndM = CCur(Val(!FAvalueEndM) - Val(LrText(9).Text) + Val(LrText(8).Text))  '期末资产原值
            !DeprSumEndM = CCur(Val(!DeprSumEndM) - Val(LrText(6).Text) + Val(LrText(7).Text))  '期末累计折旧
            !FAValueOutM = CCur(Val(LrText(8).Text) - Val(LrText(9).Text))                      '本期原值减少
            !DeprSumInM = CCur(Abs(Val(LrText(6).Text) - Val(LrText(7).Text)))                  '本期累计折旧增加
            .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", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
    With Rs_Temp
        .AddNew
        !VariVouCode = MaxCode                          '变动单据号
        !CardCode = Trim(Lbl_Num.Caption)               '卡片编号
        !Year = Val(Trim(Lbl_Year.Caption))             '会计年度
        !Period = Val(Trim(Lbl_Period.Caption))         '会计期间
        !varidate = Xtrq                                '变动日期
        !FAVariCode = Trim(Frame1.Tag)                  '变动方式
        If Trim(LrText(16).Text) <> "" Then !VouchClassCode = Trim(LrText(16).Tag)                      '凭证类型
        If Trim(LrText(17).Text) <> "" Then !VouchNo = Val(LrText(17).Text)                             '凭证号
        !VariationReason = Trim(LrText(18).Text) & Space(2) & "清理收入:￥" & Format(Val(LrText(15).Text), "###,##0.00")   '变动原因
        !DeptOld = Trim(LrText(1).Tag)                  '变动前所属部门
        !DeptNew = Trim(LrText(1).Tag)                  '变动后所属部门
        !FAStateOld = Trim(LrText(2).Tag)               '变动前使用状况
        !FAStateNew = Trim(LrText(2).Tag)               '变动后使用状况
        !DeprMethOld = Trim(LrText(4).Tag)
        !DeprMethNew = Trim(LrText(4).Tag)              '折旧方法
        !FASortOld = Trim(LrText(3).Tag)
        !FASortNew = Trim(LrText(3).Tag)                '资产类别
        !FAValueOld = CCur(Val(LrText(8).Text))
        !FAValueNew = CCur(Val(LrText(9).Text))         '资产原值
        !SumDeprOld = CCur(Val(LrText(6).Text))
        !SumDeprNew = CCur(Val(LrText(7).Text))         '累计折旧
        !ActivitiesOld = Activities
        !ActivitiesNew = Activities                     '工作总量
        !SalValueOld = CCur(Val(LrText(12).Text))
        !SalValueNew = CCur(Val(LrText(13).Text))       '净残值
        !UseYearsOld = Val(LrText(5).Text)
        !UseYearsNew = Val(LrText(5).Text)              '使用年限
        !FAQuantityOld = Val(LrText(10).Text)
        !FAQuantityNew = Val(LrText(11).Text)           '资产数量
        !Opreator = Trim(Lbl_Operator.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
Cwcl:
    Cw_DataEnvi.DataConnect.RollbackTrans
    Tsxx = "存盘失败，请核对数据!"
    Call Xtxxts(Tsxx, 0, 1)
    Exit Function
End Function
'录入判断
Function Judge() As Boolean
    
    Judge = False
    
    '资产减少数量不能大于原有资产数量
    If Val(LrText(14).Text) > Val(LrText(10).Text) Then
        Tsxx = "资产减少数量不能大于原有资产数量!"
        Call Xtxxts(Tsxx, 0, 4)
        LrText(14).Text = ""
        LrText(14).SetFocus
        Exit Function
    End If
    
    '减少原因不能为空
    If LrText(18).Text = "" Then
        Tsxx = "减少原因不能为空!"
        Call Xtxxts(Tsxx, 0, 4)
        LrText(18).SetFocus
        Exit Function
    End If
    
    Judge = True
    
End Function
'资产折旧后剩余的各数据值
Function Depr()
    
    LrText(7).Text = Format(Val(LrText(6).Text) - Val(LrText(6).Text / Val(LrText(10).Text) * Val(LrText(14).Text)), "##0.00")       '剩余累计折旧
    LrText(9).Text = Format(Val(LrText(8).Text) - Val(LrText(8).Text / Val(LrText(10).Text) * Val(LrText(14).Text)), "##0.00")    '剩余剩余资产原值
    LrText(13).Text = Format(Val(LrText(12).Text) / Val(LrText(10).Text) * Val(Val(LrText(10).Text) - Val(LrText(14).Text)), "##0.00")       '剩余净残值
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 LrText_Change(Index As Integer)
    '屏蔽程序改变控制
    If TextChangeLock Then
        Exit Sub
    End If
   
    TextValiJudgeLock(Index) = False    '打开有效性判断锁
    
    '取得资产减少后的资产数量
    LrText(11).Text = Val(LrText(10).Text) - Val(LrText(14).Text)
    
    '限制字段录入长度
    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
Private Sub LrText_KeyDown(Index As Integer, KeyCode As Integer, Shift As Integer)            '字段按F2键提供帮助
    
    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 Index = 14 Then Call Depr
    
    If Textint(Index, 9) = 0 Or Textint(Index, 9) = 1 Then '事中判断
        Call TextYxxpd(Index)
    End If
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 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
    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 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 = 0 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, 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 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

						