frmdefinelistcard.frm

金算盘软件代码

VERSION 5.00
Object = "{F42BDC2B-FC9B-11D1-9ABD-444553540000}#3.2#0"; "ATLEDIT.OCX"
Begin VB.Form frmDefineListCard 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "新增自定项目1"
   ClientHeight    =   2220
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   6120
   LinkTopic       =   "Form1"
   LockControls    =   -1  'True
   MaxButton       =   0   'False
   MDIChild        =   -1  'True
   ScaleHeight     =   2220
   ScaleWidth      =   6120
   ShowInTaskbar   =   0   'False
   Begin AtlEdit.TEdit txtInput 
      Height          =   300
      Index           =   1
      Left            =   1800
      TabIndex        =   3
      Top             =   1320
      Width           =   2355
      _ExtentX        =   4154
      _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            =   1800
      TabIndex        =   1
      Top             =   420
      Width           =   2355
      _ExtentX        =   4154
      _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            =   4680
      Style           =   1  'Graphical
      TabIndex        =   6
      Tag             =   "1002"
      Top             =   661
      UseMaskColor    =   -1  'True
      Width           =   1215
   End
   Begin VB.CommandButton cmdOK 
      Default         =   -1  'True
      Height          =   350
      Index           =   0
      Left            =   4680
      Style           =   1  'Graphical
      TabIndex        =   5
      Tag             =   "1001"
      Top             =   240
      UseMaskColor    =   -1  'True
      Width           =   1215
   End
   Begin VB.CommandButton cmdOK 
      Height          =   350
      Index           =   3
      Left            =   4680
      Style           =   1  'Graphical
      TabIndex        =   8
      Tag             =   "1013"
      Top             =   1498
      UseMaskColor    =   -1  'True
      Width           =   1215
   End
   Begin VB.CommandButton cmdOK 
      Height          =   350
      Index           =   2
      Left            =   4680
      Style           =   1  'Graphical
      TabIndex        =   7
      Tag             =   "1009"
      Top             =   1082
      UseMaskColor    =   -1  'True
      Width           =   1215
   End
   Begin VB.CheckBox chkStop 
      Caption         =   "停用"
      Height          =   180
      Left            =   4680
      TabIndex        =   4
      Top             =   1920
      Width           =   795
   End
   Begin VB.Label lblTitle 
      Caption         =   "自定项目1编码(&C)"
      Height          =   225
      Index           =   0
      Left            =   360
      TabIndex        =   0
      Top             =   495
      Width           =   1455
   End
   Begin VB.Label lblTitle 
      Caption         =   "自定项目1名称(&N)"
      Height          =   195
      Index           =   1
      Left            =   360
      TabIndex        =   2
      Top             =   1425
      Width           =   1515
   End
End
Attribute VB_Name = "frmDefineListCard"
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 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
Private WithEvents mclsMainControl As MainControl               '主控对象
Attribute mclsMainControl.VB_VarHelpID = -1

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

Public Function AddCard(ByVal strTitleName As String, Optional intModal As Integer, Optional strName As String) As Long
    
    If IsContinue Then Exit Function
    mlngCustomID = 0
    mblnIsChanged = True
    mblnIsNew = True
    Caption = "新增" & strTitleName
    cmdOk(2).Default = True
    lblTitle(0).Caption = strTitleName & "编码(&C)"
    lblTitle(1).Caption = strTitleName & "名称(&N)"
    If SelectTable(strTitleName) Then
        InitCard strName
        Show intModal
        AddCard = mlngCustomID
        Refresh
        ZOrder 0
    Else
        ShowMsg 0, "自定项目名标题有错。", vbExclamation + vbOKOnly + MB_TASKMODAL, Caption
    End If
    Unload MsgForm
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 IsContinue Then Exit Sub
    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
        cmdOk(0).Default = True
        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
        Refresh
        ZOrder 0
    End If
    Unload MsgForm
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("Item", 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
    CodeIsUsed = False
End Function

Private Sub chkStop_Click()
'    Dim strDefine As String
'
'    strDefine = txtInput(0).Text & " " & txtInput(1).Text
'    If chkStop.Value = Checked And Not mblnIsNew Then
'        If CodeIsUsed(mlngCustomID) Then
'            ShowMsg hwnd, "自定项目“" & strDefine & "“已有业务发生,不能停用！", vbExclamation, Caption
'            chkStop.Value = Unchecked
'        End If
'    End If
    If Not mblnIsInit Then mblnIsChanged = True
End Sub

Private Sub cmdOK_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(txtInput(0).Text)
'            mlngCustomID = 0
            InitCard
            txtInput(0).Text = strNextCode
            txtInput(0).SetFocus
            txtInput(0).SelStart = 0
            txtInput(0).SelLength = Len(txtInput(0).Text)
        End If
        Exit Sub
    ElseIf Index = 3 Then
        mstrNotes = frmNotePad.EditCard(Me.Caption, txtInput(0).Text, _
            txtInput(1).Text, mstrNotes)    '调记事
        Form_Activate
        Exit Sub
    End If
    Unload Me
    
End Sub

Public Function DelCard(ByVal strTitleName As String, ByVal lngID As Long) As Boolean
    Dim recDep As rdoResultset, Strsql As String
    Dim strDep As String, strCode As String
    
    If lngID = mlngCustomID And frmCustomList.IsShowCard Then
        ShowMsg 0, "不能删除正在修改的自定项目！", vbExclamation + MB_TASKMODAL, "删除自定项目"
        Show
        Exit Function
    End If
    DelCard = False
    If Not SelectTable(strTitleName) Then
        ShowMsg 0, "自定项目名标题有错。", vbExclamation + MB_TASKMODAL, "删除自定项目"
        Exit Function
    End If
    On Error GoTo ErrHandle
    gclsBase.BaseWorkSpace.BeginTrans
    If lngID = 0 Then Exit Function
    Strsql = "SELECT * FROM " & mstrTableName & " WHERE lngCustomID=" & lngID
    Set recDep = gclsBase.BaseDB.OpenResultset(Strsql, rdOpenForwardOnly)
    If Not recDep.EOF = True Then
        strCode = recDep!strCustomCode
        strDep = "“" & Trim(recDep!strCustomCode) & " " _
            & Trim(recDep!strCustomName) & "”"
        If recDep!blnIsDetail = 0 Then
            ShowMsg 0, strDep & "有下级自定项目,不能删除！", vbExclamation + MB_TASKMODAL, "删除自定项目"
            GoTo ErrHandle
        End If
    Else
        DelCard = True
        GoTo ErrHandle
    End If
    If CodeIsUsed(lngID) Then
        ShowMsg 0, "自定项目“" & strDep & "”已有业务发生,不能删除！", vbExclamation + MB_TASKMODAL, "删除自定项目"
        GoTo ErrHandle
    End If
    If ShowMsg(0, "你确实要删除" & strDep & "自定项目吗？", vbQuestion + vbYesNo + MB_TASKMODAL, _
        "删除自定项目") = vbNo Then GoTo ErrHandle
    Strsql = "DELETE FROM " & mstrTableName & " WHERE lngCustomID=" & lngID
    If Not gclsBase.ExecSQL(Strsql) Then GoTo ErrHandle
    If Not ChangeHigherCardDetail(mstrTableName, "strCustomCode", strCode) Then GoTo ErrHandle
    gclsBase.BaseWorkSpace.CommitTrans
    DelCard = True
'    Select Case CInt(mintCustomIndex)
'        Case 0
'            gclsSys.SendMessage CStr(Me.hwnd), Message.msgCustom1
'        Case 1
'            gclsSys.SendMessage CStr(Me.hwnd), Message.msgCustom2
'        Case 2
'            gclsSys.SendMessage CStr(Me.hwnd), Message.msgCustom3
'        Case 3
'            gclsSys.SendMessage CStr(Me.hwnd), Message.msgCustom4
'        Case 4
'            gclsSys.SendMessage CStr(Me.hwnd), Message.msgCustom5
'        Case 5
'            gclsSys.SendMessage CStr(Me.hwnd), Message.msgCustom6
'    End Select
    Exit Function
ErrHandle:
    gclsBase.BaseWorkSpace.RollbackTrans
End Function

Private Sub Form_Activate()
    gclsSys.CurrFormName = Me.hwnd
End Sub

Private Sub Form_Load()
    Me.Hide
    Me.Left = -30000
    MsgForm.PleaseWait
    SetHelpID hwnd, 30030
    frmCustomList.IsShowCard = True
    mblnIsChanged = False
    Set mclsMainControl = gclsSys.MainControls.Add(Me)
End Sub

Private Sub Form_Paint()
  FrameBox Me.hwnd, 180, 180, 4335, 2000
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
    Dim intMsgReturn As Integer, strMess As String