frmdefinecard.frm

金算盘软件代码

VERSION 5.00
Object = "{F42BDC2B-FC9B-11D1-9ABD-444553540000}#3.4#0"; "ATLEDIT1.OCX"
Begin VB.Form frmDefineCard 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "新增自定项目1"
   ClientHeight    =   2085
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   5850
   HelpContextID   =   30030
   KeyPreview      =   -1  'True
   LinkTopic       =   "Form1"
   LockControls    =   -1  'True
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   2085
   ScaleWidth      =   5850
   ShowInTaskbar   =   0   'False
   StartUpPosition =   2  '屏幕中心
   Begin AtlEdit.TEdit txtInput 
      Height          =   300
      Index           =   1
      Left            =   2130
      TabIndex        =   3
      Top             =   1320
      Width           =   2025
      _ExtentX        =   3572
      _ExtentY        =   529
      maxchar         =   30
      RBmenu          =   0   'False
      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 AtlEdit.TEdit txtInput 
      Height          =   300
      Index           =   0
      Left            =   2130
      TabIndex        =   1
      Top             =   480
      Width           =   2025
      _ExtentX        =   3572
      _ExtentY        =   529
      maxchar         =   16
      RBmenu          =   0   'False
      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.CommandButton cmdOK 
      Cancel          =   -1  'True
      Height          =   350
      Index           =   1
      Left            =   4470
      Style           =   1  'Graphical
      TabIndex        =   5
      Tag             =   "1002"
      Top             =   510
      UseMaskColor    =   -1  'True
      Width           =   1215
   End
   Begin VB.CommandButton cmdOK 
      Height          =   350
      Index           =   0
      Left            =   4470
      Style           =   1  'Graphical
      TabIndex        =   4
      Tag             =   "1001"
      Top             =   150
      UseMaskColor    =   -1  'True
      Width           =   1215
   End
   Begin VB.CommandButton cmdOK 
      Height          =   350
      Index           =   3
      Left            =   4470
      Style           =   1  'Graphical
      TabIndex        =   7
      Tag             =   "1013"
      Top             =   1230
      UseMaskColor    =   -1  'True
      Width           =   1215
   End
   Begin VB.CommandButton cmdOK 
      Height          =   350
      Index           =   2
      Left            =   4470
      Style           =   1  'Graphical
      TabIndex        =   6
      Tag             =   "1009"
      Top             =   870
      UseMaskColor    =   -1  'True
      Width           =   1215
   End
   Begin VB.CheckBox chkStop 
      Caption         =   "停用"
      Height          =   180
      Left            =   4470
      TabIndex        =   8
      Top             =   1740
      Width           =   795
   End
   Begin VB.Label lblTitle 
      AutoSize        =   -1  'True
      Caption         =   "自定项目1编码(&C)"
      Height          =   180
      Index           =   0
      Left            =   360
      TabIndex        =   0
      Top             =   555
      Width           =   1440
   End
   Begin VB.Label lblTitle 
      AutoSize        =   -1  'True
      Caption         =   "自定项目1名称(&N)"
      Height          =   180
      Index           =   1
      Left            =   360
      TabIndex        =   2
      Top             =   1425
      Width           =   1440
   End
End
Attribute VB_Name = "frmDefineCard"
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 mintCustomIndex As Integer
Private mlngPCodeID As Long           'NEW--上级ID，EDIT--目的ID
Private mlngCustomID 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
Private mstrTableName As String

Public Property Get getID() As Variant
    getID = mlngCustomID
End Property

Public Function AddDefine(ByVal strDefine As String, ByVal Index As Integer) As Integer
    Dim strCode As String, strName As String, blnIsStop As Boolean
    Dim strTemp As String
    
    AddDefine = 0
    If Not GetString(strDefine, strCode, 1) Then Exit Function
    If Not GetString(strDefine, strName, 2) Then Exit Function
    If Not GetString(strDefine, mstrNotes, 4) Then Exit Function
    If Not GetString(strDefine, strTemp, 3) Then Exit Function
    blnIsStop = (strTemp = "1")
    
    If strCode = "" Or strName = "" Then Exit Function
    txtInput(0).Text = strCode
    txtInput(1).Text = strName
    chkStop.Value = IIf(blnIsStop, 1, 0)
    mblnIsNew = True
    mintCustomIndex = Index
    mstrTableName = "Custom" & Index
    If Not SaveCard(True) Then Exit Function
    AddDefine = 1
End Function

Public Function AddCard(ByVal strTitleName As String, Optional intModal As Integer, Optional strName As String, _
    Optional ByVal IsList As Boolean = False) As Long
    
    mlngCustomID = 0
    mblnIsChanged = True
    mblnIsNew = True
    Caption = "新增" & strTitleName
    lblTitle(0).Caption = strTitleName & "编码(&C)"
    lblTitle(1).Caption = strTitleName & "名称(&N)"
    If SelectTable(strTitleName) Then
        InitCard strName
        mblnIsList = IsList
        Show intModal
        AddCard = mlngCustomID
    Else
        ShowMsg 0, "自定项目名标题有错。", vbExclamation + vbOKOnly + MB_TASKMODAL, Caption
    End If
End Function

Public Sub EditCard(ByVal strTitleName As String, ByVal lngID As Long, _
    Optional intModal As Integer = 0, Optional strCustom As String = "")
    Dim strMess As String
    
    If Not SelectTable(strTitleName) Then
        ShowMsg 0, "自定项目名标题有错。", vbExclamation + vbOKOnly + _
            MB_TASKMODAL, "修改自定项目"
        Exit Sub
    End If
    If Not CheckIDUsed(mstrTableName, "lngCustomID", lngID) Then
        If Trim(strCustom) <> "" Then
            strMess = "“" & strCustom & "”"
        Else
            strMess = "该"
        End If
        ShowMsg 0, strMess & "自定项目不存在,不能进行修改！", _
            vbExclamation + MB_TASKMODAL, "修改自定项目"
        Unload Me
    Else
        mlngCustomID = lngID
        mblnIsNew = False
        mblnIsChanged = False
        Caption = "修改" & strTitleName
        lblTitle(0).Caption = strTitleName & "编码(&C)"
        lblTitle(1).Caption = strTitleName & "名称(&N)"
        cmdOK(2).Visible = False
        cmdOK(3).Move cmdOK(2).Left, cmdOK(2).top
        InitCard
        Show intModal
    End If
End Sub

Private Function CodeIsUsed(ByVal lngID As Long) As Boolean
    Dim strFname As String
    
    CodeIsUsed = True
    If lngID <> 0 Then
        strFname = "lngCustomID" & mintCustomIndex
        If CheckIDUsed("ARAPInit", strFname, lngID) Then Exit Function
        If CheckIDUsed("CostPriceDetail", strFname, lngID) Then Exit Function
        If CheckIDUsed("ItemActivityDetail", strFname, lngID) Then Exit Function
        If CheckIDUsed("PurchaseOrderDetail", strFname, lngID) Then Exit Function
        If CheckIDUsed("SaleOrderDetail", strFname, lngID) Then Exit Function
        If CheckIDUsed("StockTakingDetail", strFname, lngID) Then Exit Function
    End If