class2card.frm

金算盘软件代码

VERSION 5.00
Object = "{F42BDC2B-FC9B-11D1-9ABD-444553540000}#3.4#0"; "ATLEDIT1.OCX"
Begin VB.Form frmClass2Card 
   BorderStyle     =   1  'Fixed Single
   ClientHeight    =   2265
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   5100
   HelpContextID   =   30014
   KeyPreview      =   -1  'True
   LinkTopic       =   "Form1"
   LockControls    =   -1  'True
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   2265
   ScaleWidth      =   5100
   ShowInTaskbar   =   0   'False
   StartUpPosition =   2  '屏幕中心
   Begin VB.CommandButton cmdClass 
      Height          =   350
      Index           =   2
      Left            =   3780
      Style           =   1  'Graphical
      TabIndex        =   6
      Tag             =   "1009"
      Top             =   885
      UseMaskColor    =   -1  'True
      Width           =   1215
   End
   Begin AtlEdit.TEdit txtClass 
      Height          =   300
      Index           =   0
      Left            =   1290
      TabIndex        =   1
      Top             =   555
      Width           =   2250
      _ExtentX        =   3969
      _ExtentY        =   529
      maxchar         =   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
      Text            =   ""
   End
   Begin VB.CheckBox chkInActive 
      Caption         =   "停用"
      Height          =   350
      Left            =   3780
      TabIndex        =   8
      Top             =   1785
      Width           =   1155
   End
   Begin VB.CommandButton cmdClass 
      Height          =   350
      Index           =   0
      Left            =   3780
      Style           =   1  'Graphical
      TabIndex        =   4
      Tag             =   "1001"
      Top             =   135
      UseMaskColor    =   -1  'True
      Width           =   1215
   End
   Begin VB.CommandButton cmdClass 
      Cancel          =   -1  'True
      Height          =   350
      Index           =   1
      Left            =   3780
      Style           =   1  'Graphical
      TabIndex        =   5
      Tag             =   "1002"
      Top             =   510
      UseMaskColor    =   -1  'True
      Width           =   1215
   End
   Begin VB.CommandButton cmdClass 
      Height          =   350
      Index           =   3
      Left            =   3780
      Style           =   1  'Graphical
      TabIndex        =   7
      Tag             =   "1013"
      Top             =   1245
      UseMaskColor    =   -1  'True
      Width           =   1215
   End
   Begin AtlEdit.TEdit txtClass 
      Height          =   300
      Index           =   1
      Left            =   1290
      TabIndex        =   3
      Top             =   1455
      Width           =   2250
      _ExtentX        =   3969
      _ExtentY        =   529
      maxchar         =   30
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "宋体"
         Size            =   9
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Text            =   ""
   End
   Begin VB.Label lblClass 
      AutoSize        =   -1  'True
      Caption         =   "项目名称(&N)"
      Height          =   180
      Index           =   1
      Left            =   300
      TabIndex        =   2
      Top             =   1515
      Width           =   990
   End
   Begin VB.Label lblClass 
      AutoSize        =   -1  'True
      Caption         =   "项目编码(&C)"
      Height          =   180
      Index           =   0
      Left            =   300
      TabIndex        =   0
      Top             =   645
      Width           =   990
   End
End
Attribute VB_Name = "frmClass2Card"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'功能:          完成项目的增、删、改。
'卡片接口:            EditCard 参数: lngID 记录的ID号
'作用:                          LNGID为零是增加记录、其它为编辑记录
'                   DelCard 参数: lngID 记录的ID号
'作用:                           删除ID号为LNGID的记录
'作者：     苏涛


Option Explicit
Option Compare Text

Private mblnIsInit As Boolean
Private mblnIsList As Boolean
Private mblnIsChanged As Boolean
Private mblnIsDetail As Boolean
Private mblnIsNew As Boolean
Private mblnIsInActive As Boolean
Private mblnPIsInActive As Boolean    'NEW--上级停用，EDIT--目的停用
Private mblnPIsDetail As Boolean      'NEW--上级明细，EDIT--目的明细
Private mintLevel As Integer
Private mintOldLevel As Integer
Private mlngPCodeID As Long           'NEW--上级ID，EDIT--目的ID
Private mlngClassID As Long      '当前项目ID
Private mstrNotes As String
Private mstrLastCode As String
Private mstrCode As String
Private mstrName As String
Private mstrLastName As String
Private mstrFullName As String
Private mstrOldFullName As String
Private mstrStartDate As String
'直接增加项目
Public Function AddClass2(ByVal strClass2 As String) As Integer
    Dim blnIsStop As Boolean, strTemp As String
    Dim strCode As String, strName As String
    
    AddClass2 = 0
    If Not GetString(strClass2, strCode, 1) Then Exit Function
    If Not GetString(strClass2, strName, 2) Then Exit Function
    If Not GetString(strClass2, mstrNotes, 6) Then Exit Function
    If Not GetString(strClass2, strTemp, 7) Then Exit Function
    blnIsStop = (strTemp = "1")
    
    If strCode = "" Or strName = "" Then Exit Function
    txtClass(0).Text = strCode
    txtClass(1).Text = strName
    chkInActive.Value = IIf(blnIsStop, 1, 0)
    mblnIsNew = True
    If Not SaveCard(True) Then Exit Function
    AddClass2 = 1
End Function

Public Property Get ClassID() As Variant
    ClassID = mlngClassID
End Property

Public Function AddCard(Optional strName As String = "", Optional intModal As Integer, _
    Optional ByVal IsList As Boolean = False) As Long
    
    mlngClassID = 0
    mblnIsChanged = True
    mblnIsNew = True
    InitCard strName
    Caption = "新增项目"
    mblnIsList = IsList
    Show vbModal
    AddCard = mlngClassID
End Function

Public Sub EditCard(ByVal lngID As Long, Optional intModal As Integer = 0, _
    Optional strClass2 As String)
    Dim strMess As String
    
    If Not CheckIDUsed("Class2", "lngClassID", lngID) Then
        If Trim(strClass2) <> "" Then
            strMess = "“" & strClass2 & "”"
        Else
            strMess = "该"
        End If
        ShowMsg 0, strMess & "项目不存在,不能进行修改！", _
            vbExclamation + MB_TASKMODAL, "修改项目"
        Unload Me
    Else
        mlngClassID = lngID
        mblnIsNew = False
        mblnIsChanged = False
        InitCard
        Caption = "修改项目"
        cmdClass(2).Visible = False
        cmdClass(3).Move cmdClass(2).Left, cmdClass(2).top
        Show vbModal
    End If
End Sub

Private Sub chkInActive_Click()
'    Dim strClass As String
'
'    strClass = txtClass(0).Text & " " & txtClass(1).Text
'    If chkInActive.Value = Checked And Not mblnIsNew Then
'        If CodeIsUsed(mlngClassID) Then
'            ShowMsg hwnd, strClass & "项目已有业务发生,不能停用！", vbExclamation, Caption
'            chkInActive.Value = Unchecked
'        End If
'    End If
    If Not mblnIsInit Then mblnIsChanged = True
End Sub

Private Sub cmdClass_Click(Index As Integer)
    Dim strNextCode As String
    
    If Index = 0 Then
        If Not SaveCard Then Exit Sub
    ElseIf Index = 2 Then
        If SaveCard Then
            strNextCode = GetNextCode(txtClass(0).Text)
'            mlngClassID = 0
            InitCard
            txtClass(0).Text = strNextCode
            txtClass(0).SetFocus
            txtClass(0).SelStart = 0
            txtClass(0).SelLength = Len(txtClass(0).Text)
        End If
        Exit Sub
    ElseIf Index = 3 Then
        mstrNotes = frmNotePad.EditCard(Me.Caption, txtClass(0).Text, _
            txtClass(1).Text, mstrNotes)    '调记事
        Exit Sub
    End If
    Unload Me
    
End Sub

Public Function DelCard(ByVal lngID As Long) As Boolean
    Dim recClass As rdoResultset, strSql As String
    Dim StrClass As String, strCode As String
    
'    If lngID = mlngClassID And frmClassItemList.IsShowCard Then
'        ShowMsg 0, "不能删除正在修改的项目！", vbExclamation + MB_TASKMODAL, "删除项目"
'        Show vbModal
'        Exit Function
'    End If
    On Error GoTo ErrHandle
    gclsBase.BaseWorkSpace.BeginTrans
    DelCard = False
    strSql = "SELECT * FROM Class2 WHERE lngClassID=" & lngID
    Set recClass = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    If Not recClass.EOF Then
        strCode = recClass!strClassCode
        StrClass = "“" & Trim(recClass!strClassCode) & " " _
            & Trim(recClass!strClassName) & "”"
        If recClass!blnIsDetail = 0 Then
            ShowMsg 0, StrClass & "有下级项目,不能删除！", vbExclamation + MB_TASKMODAL, "删除项目"
            GoTo ErrHandle
        End If
    Else
        DelCard = True
        GoTo ErrHandle
    End If
    If CodeIsUsed(lngID) Then
        ShowMsg 0, StrClass & "项目已有业务发生,不能删除！", vbExclamation + MB_TASKMODAL, "删除项目"
        GoTo ErrHandle
    End If
    If ShowMsg(0, "你确实要删除" & StrClass & "项目吗？", vbQuestion + vbYesNo + MB_TASKMODAL + vbDefaultButton2, _
        "删除项目") = vbNo Then GoTo ErrHandle
    strSql = "DELETE FROM Class2 WHERE lngClassID=" & lngID
    If Not gclsBase.ExecSQL(strSql) Then GoTo ErrHandle
    If Not ChangeHigherCardDetail("Class2", "strClassCode", strCode) Then GoTo ErrHandle
    gclsBase.BaseWorkSpace.CommitTrans
    DelCard = True
    gclsSys.SendMessage CStr(Me.hwnd), Message.msgClass2
    Exit Function
ErrHandle:
    gclsBase.BaseWorkSpace.RollBacktrans
End Function

'项目是否使用
Private Function CodeIsUsed(ByVal lngID As Long) As Boolean
    
    CodeIsUsed = True
    If UsedInAccountDaily("lngClassID2", lngID) Then Exit Function
    If CheckIDUsed("ActivityDetail", "lngClassID2", lngID) Then Exit Function  '业务明细
    If CheckIDUsed("ARAPInit", "lngClassID2", lngID) Then Exit Function  '应收应付期初
    If CheckIDUsed("BudgetBalance", "lngClassID2", lngID) Then Exit Function   '预算数据
    If CheckIDUsed("CostPrice", "lngClassID2", lngID) Then Exit Function  '入库成本
    If CheckIDUsed("ItemActivity", "lngClassID2", lngID) Then Exit Function  '商品业务
    If CheckIDUsed("purchaseorder", "lngClassID2", lngID) Then Exit Function '采购定单
    If CheckIDUsed("SaleOrder", "lngClassID2", lngID) Then Exit Function   '销售订单
    If CheckIDUsed("StockTaking", "lngClassID2", lngID) Then Exit Function  '盘点
    If CheckIDUsed("TransVoucherDetail", "lngClassID2", lngID) Then Exit Function '转账模板明细
    If CheckIDUsed("VoucherDetail", "lngClassID2", lngID) Then Exit Function    '凭证明细
    CodeIsUsed = False
End Function

Private Sub Form_Activate()
    SetHelpID Me.HelpContextID
End Sub

Private Sub Form_KeyPress(KeyAscii As Integer)
    If mblnIsList Then
        mblnIsList = False
        Exit Sub
    End If
    If KeyAscii = vbKeyReturn Then
        BKKEY Me.ActiveControl.hwnd, vbKeyTab
    End If
End Sub

Private Sub Form_KeyUp(KeyCode As Integer, Shift As Integer)
    If KeyCode = vbKeyReturn And Shift = 2 Then
        cmdClass(0).Value = True
    End If
End Sub

Private Sub Form_Load()
    Dim edtErrReturn As ErrDealType
    
    On Error GoTo ErrHandle
'    SetHelpID hwnd, 30014  ' 13010
'    frmClassItemList.IsShowCard = True
    Utility.LoadFormResPicture Me
    mblnIsChanged = False
'    SendKeys "%{C}"
    Exit Sub
ErrHandle:
    edtErrReturn = Errors.ErrorsDeal