frmaccountcopycard.frm

金算盘软件代码

VERSION 5.00
Object = "{81110CCB-022B-11D3-A348-0080C89152FF}#1.3#0"; "ORAGLIST.OCX"
Begin VB.Form frmAccountCopyCard 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "科目复制"
   ClientHeight    =   2235
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   5910
   KeyPreview      =   -1  'True
   LinkTopic       =   "Form1"
   LockControls    =   -1  'True
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   2235
   ScaleWidth      =   5910
   ShowInTaskbar   =   0   'False
   StartUpPosition =   2  '屏幕中心
   Begin VB.ComboBox cboLevel 
      Height          =   300
      Left            =   1320
      Style           =   2  'Dropdown List
      TabIndex        =   3
      Top             =   825
      Width           =   3045
   End
   Begin VB.CheckBox chkAccountFlags 
      Caption         =   "科目性质"
      Height          =   180
      Index           =   3
      Left            =   180
      TabIndex        =   6
      Top             =   1920
      Width           =   1035
   End
   Begin VB.CommandButton cmdOkorCancel 
      Cancel          =   -1  'True
      Height          =   350
      Index           =   1
      Left            =   4620
      Style           =   1  'Graphical
      TabIndex        =   11
      Tag             =   "1002"
      Top             =   580
      UseMaskColor    =   -1  'True
      Width           =   1215
   End
   Begin VB.CommandButton cmdOkorCancel 
      Height          =   350
      Index           =   0
      Left            =   4620
      Style           =   1  'Graphical
      TabIndex        =   10
      Tag             =   "1001"
      Top             =   180
      UseMaskColor    =   -1  'True
      Width           =   1215
   End
   Begin VB.CheckBox chkAccountFlags 
      Caption         =   "辅助核算"
      Height          =   180
      Index           =   2
      Left            =   3480
      TabIndex        =   9
      Top             =   1920
      Width           =   1035
   End
   Begin VB.CheckBox chkAccountFlags 
      Caption         =   "数量核算"
      Height          =   180
      Index           =   1
      Left            =   2440
      TabIndex        =   8
      Top             =   1920
      Width           =   1035
   End
   Begin VB.CheckBox chkAccountFlags 
      Caption         =   "多币种核算"
      Height          =   180
      Index           =   0
      Left            =   1220
      TabIndex        =   7
      Top             =   1920
      Width           =   1215
   End
   Begin ListRefer.ListText lstAccountSource 
      Height          =   300
      Index           =   1
      Left            =   1320
      TabIndex        =   5
      Top             =   1290
      Width           =   3045
      _ExtentX        =   5371
      _ExtentY        =   529
      CodeSort        =   -1  'True
      BackColor       =   -2147483643
      MaxLenth        =   16
      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 ListRefer.ListText lstAccountSource 
      Height          =   300
      Index           =   0
      Left            =   1320
      TabIndex        =   1
      Top             =   360
      Width           =   3045
      _ExtentX        =   5371
      _ExtentY        =   529
      CodeSort        =   -1  'True
      BackColor       =   -2147483643
      MaxLenth        =   16
      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 VB.Label lblAccountName 
      Caption         =   "指定级次(&N)"
      Height          =   225
      Index           =   2
      Left            =   330
      TabIndex        =   2
      Top             =   870
      Width           =   1005
   End
   Begin VB.Label lblAccountName 
      Caption         =   "目标科目(&P)"
      Height          =   255
      Index           =   1
      Left            =   330
      TabIndex        =   4
      Top             =   1320
      Width           =   1095
   End
   Begin VB.Label lblAccountName 
      Caption         =   "来源科目(&S)"
      Height          =   255
      Index           =   0
      Left            =   330
      TabIndex        =   0
      Top             =   390
      Width           =   1095
   End
End
Attribute VB_Name = "frmAccountCopyCard"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Private mlngSourceAccountID(1) As Long
Private mintDirection As Integer
Private mlngAccountTypeID As Long
Private mlngAccountNatureID As Long
Private mstrSCode As String
Private mstrDCode As String
Private mstrSourceAccount As String
Private mstrDesAccount As String
Private WithEvents mclsMainControl As MainControl               '主控对象
Attribute mclsMainControl.VB_VarHelpID = -1

Private Function AccountIsValid() As Boolean
    Dim recAccount As rdoResultset, strSql As String, strMess As String
    
    AccountIsValid = False
    mlngSourceAccountID(0) = lstAccountSource(0).ID
    mlngSourceAccountID(1) = lstAccountSource(1).ID
    If Trim(lstAccountSource(0).Text) = "" Then
        ShowMsg hwnd, "来源科目不能为空！", vbExclamation, Caption
'        SendKeys "%{S}"
        Exit Function
    End If
    If Trim(lstAccountSource(1).Text) = "" Then
        ShowMsg hwnd, "目标科目不能为空！", vbExclamation, Caption
'        SendKeys "%{P}"
        Exit Function
    End If
    mstrSCode = StringOut(lstAccountSource(0).Text)
    mstrDCode = StringOut(lstAccountSource(1).Text)
    If mstrSCode = mstrDCode Then
        ShowMsg hwnd, "目标科目不能与来源科目相同！", vbExclamation, Caption
'        SendKeys "%{P}"
        Exit Function
    ElseIf InStr("-" & mstrSCode & "-", "-" & mstrDCode & "-") > 0 Then
        ShowMsg hwnd, "来源科目不能是目标科目的下级科目！", vbExclamation, Caption
'        SendKeys "%{S}"
        Exit Function
    ElseIf InStr("-" & mstrDCode & "-", "-" & mstrSCode & "-") > 0 Then
        ShowMsg hwnd, "目标科目不能是来源科目的下级科目！", vbExclamation, Caption
'        SendKeys "%{P}"
        Exit Function
    End If
    
    strSql = "SELECT * FROM Account WHERE lngAccountID=" & mlngSourceAccountID(0) _
        & " AND blnIsDetail=0"
    Set recAccount = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    If recAccount.EOF Then
        ShowMsg hwnd, "来源科目只能是非末级科目，您选择的“" _
            & lstAccountSource(0).Text & " ”无效，请重新选择！", vbExclamation, Caption
        recAccount.Close
'        SendKeys "%{S}"
        Exit Function
    End If
    recAccount.Close
    
    If DesAccountIsUsed(strMess) Then
        ShowMsg hwnd, strMess, vbExclamation, Caption
'        SendKeys "%{P}"
        Exit Function
    End If
    
    strSql = "DELETE FROM Account WHERE strAccountCode LIKE '" & mstrDCode & "-*'"
    If Not gclsBase.ExecSQL(strSql) Then Exit Function
    AccountIsValid = True
End Function
'检查目标科目及其明细是否被使用，并取目标科目的方向和类别
Private Function DesAccountIsUsed(strShow As String) As Boolean
    Dim lngAcnID As Long, recAccount As rdoResultset, strSql As String
    
    DesAccountIsUsed = True
    strSql = "SELECT * FROM Account WHERE strAccountCode='" & mstrDCode _
        & "' OR strAccountCode LIKE '" & mstrDCode & "-*'  ORDER BY strAccountCode DESC"
    Set recAccount = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    If recAccount.EOF Then
        recAccount.Close
        strShow = "您选择的科目“" & lstAccountSource(1).Text & "”不存在，请重新选择！"
        Exit Function
    End If
    Do Until recAccount.EOF
        lngAcnID = recAccount("lngAccountID")
        If mstrDCode = recAccount("strAccountCode") Then
            mlngAccountNatureID = recAccount("lngAccountNatureID")
        End If
        If frmAccountCard.AccountIsUsed(lngAcnID) Then
            recAccount.Close
            strShow = "目标科目或目标科目的下级科目不能发生业务，您选择的“" _
                & lstAccountSource(1).Text & "”无效，请重新选择！"
            Exit Function
        End If
        recAccount.MoveNext
    Loop
    recAccount.MoveLast
    mintDirection = recAccount("intDirection")
    mlngAccountTypeID = recAccount("lngAccountTypeID")
    recAccount.Close
    DesAccountIsUsed = False
End Function

Private Function CopyAccount() As Boolean
    Dim recAccount As rdoResultset, strAccount As String, strSql As String
    Dim intLevel As Integer, intR As Integer
    Dim strAStr As String, lngAcnID As Long
    
    On Error GoTo ErrHandle
    gclsBase.BaseWorkSpace.BeginTrans
    CopyAccount = False
    strAStr = ","
    intLevel = cboLevel.ItemData(cboLevel.ListIndex)
    strSql = "SELECT * FROM Account WHERE strAccountCode LIKE '" & _
        mstrSCode & "-%' ORDER BY strAccountCode"
    Set recAccount = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)