frmitemtypelistcard.frm

金算盘软件代码

VERSION 5.00
Object = "{F42BDC2B-FC9B-11D1-9ABD-444553540000}#3.2#0"; "ATLEDIT.OCX"
Begin VB.Form frmItemTypeListCard 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "新增商品类型"
   ClientHeight    =   2190
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   5265
   LinkTopic       =   "Form1"
   LockControls    =   -1  'True
   MaxButton       =   0   'False
   MDIChild        =   -1  'True
   ScaleHeight     =   2190
   ScaleWidth      =   5265
   ShowInTaskbar   =   0   'False
   Begin AtlEdit.TEdit txtInput 
      Height          =   300
      Index           =   1
      Left            =   1740
      TabIndex        =   3
      Top             =   1320
      Width           =   1785
      _ExtentX        =   3149
      _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 AtlEdit.TEdit txtInput 
      Height          =   300
      Index           =   0
      Left            =   1740
      TabIndex        =   1
      Top             =   480
      Width           =   1785
      _ExtentX        =   3149
      _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.CommandButton cmdOKCancel 
      Height          =   350
      Index           =   2
      Left            =   3900
      Style           =   1  'Graphical
      TabIndex        =   7
      Tag             =   "1009"
      Top             =   960
      UseMaskColor    =   -1  'True
      Width           =   1215
   End
   Begin VB.CommandButton cmdOKCancel 
      Default         =   -1  'True
      Height          =   350
      Index           =   0
      Left            =   3900
      Style           =   1  'Graphical
      TabIndex        =   5
      Tag             =   "1001"
      Top             =   180
      UseMaskColor    =   -1  'True
      Width           =   1215
   End
   Begin VB.CommandButton cmdOKCancel 
      Cancel          =   -1  'True
      Height          =   350
      Index           =   1
      Left            =   3900
      Style           =   1  'Graphical
      TabIndex        =   6
      Tag             =   "1002"
      Top             =   570
      UseMaskColor    =   -1  'True
      Width           =   1215
   End
   Begin VB.CheckBox chkPause 
      Caption         =   "停用"
      Height          =   255
      Left            =   3900
      TabIndex        =   4
      Top             =   1860
      Width           =   975
   End
   Begin VB.Label lblTitle 
      Caption         =   "商品类型编码(&C)"
      Height          =   165
      Index           =   0
      Left            =   360
      TabIndex        =   0
      Top             =   550
      Width           =   1365
   End
   Begin VB.Label lblTitle 
      Caption         =   "商品类型名称(&N)"
      Height          =   195
      Index           =   1
      Left            =   360
      TabIndex        =   2
      Top             =   1390
      Width           =   1365
   End
End
Attribute VB_Name = "frmItemTypeListCard"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'  商品类型卡片
'  作者：苏涛
'  日期：1998.07.08
'
'  功能：完成商品类型表的增、删、改操作
'
'  接口： AddCard   增加商品类型记录。
'                   参数：intModal 显示模式，strName 用户输入值
'         EditCard  修改商品类型记录。
'                   参数： lngRecordID 被修改的记录的ID，intModal 显示模式
'         DelCard   删除商品类型记录。
'                   参数： lngRecordID 被删除的记录的ID
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Option Explicit
Option Compare Text

Private mblnIsInit As Boolean
Private mblnIsNew As Boolean                           '是新增还是修改操作
Private mblnIsInActive As Boolean
Private mblnIsChanged As Boolean
Private mblnIsDetail 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 mlngItemTypeID As Long
Private mstrCode As String
Private mstrName As String
Private mstrOldCode As String                           '以前的CODE
Private mstrOldName As String                           '以前的NAME
Private mstrOldFullName As String
Private mstrFullName As String
Private mstrStartDate As String
Private WithEvents mclsMainControl As MainControl               '主控对象
Attribute mclsMainControl.VB_VarHelpID = -1

Public Property Get getID() As Long
    getID = mlngItemTypeID
End Property

'进入新增商品类型操作
Public Function AddCard(Optional strName As String = "", Optional intModal As Integer) As Long
    
    If IsContinue Then Exit Function
    mblnIsNew = True
    mlngItemTypeID = 0
    Caption = "新增商品类型"
    cmdOKCancel(2).Default = True
    cmdOKCancel(2).Visible = True
    InitCard strName
    Show intModal
    AddCard = mlngItemTypeID
    Refresh
    ZOrder 0
    Unload MsgForm
End Function

Private Sub InitCard(Optional ByVal strName As String)
    Dim recItemType As rdoResultset, strSql As String
    
    mblnIsInit = True
    mlngPCodeID = 0
    mblnPIsDetail = False
    mblnPIsInActive = False
    If mblnIsNew Then
        txtInput(1).Text = ""
        txtInput(0).Text = Trim(strName)
        chkPause.Value = Unchecked
    Else
        strSql = "SELECT * FROM ItemType WHERE lngItemTypeID=" & mlngItemTypeID
        Set recItemType = gclsBase.BaseDB.OpenResultset(strSql, rdOpenForwardOnly)
        txtInput(0).Text = recItemType!strItemTypeCode
        txtInput(1).Text = recItemType!strItemTypeName
        mblnIsDetail = (recItemType!blnIsDetail = 1)
        chkPause.Value = recItemType!blnIsInActive
        mblnIsInActive = (recItemType!blnIsInActive = 1)
        mintOldLevel = recItemType!intLevel
        mstrOldFullName = recItemType!strFullName
        mstrOldCode = txtInput(0).Text
        mstrOldName = txtInput(1).Text
    End If
    mblnIsInit = False
End Sub
'进入修改商品类型操作
Public Sub EditCard(ByVal lngID As Long, Optional intModal As Integer = 0, _
    Optional strItem As String)
    Dim strMess As String
    
    If IsContinue Then Exit Sub
    If Not CheckIDUsed("ItemType", "lngItemTypeID", lngID) Then
        If Trim(strItem) <> "" Then
            strMess = "“" & strItem & "”"
        Else
            strMess = "该"
        End If
        ShowMsg 0, strMess & "商品类型不存在,不能进行修改!", vbExclamation + MB_TASKMODAL, "修改商品类型"
        Unload Me
    Else
        mblnIsNew = False
        mlngItemTypeID = lngID
        Caption = "修改商品类型"
        cmdOKCancel(0).Default = True
        cmdOKCancel(2).Visible = False
        InitCard
        Show intModal
        Refresh
        ZOrder 0
    End If
    Unload MsgForm
End Sub

'进入删除商品类型操作，判断编码是否是末级和被使用，删除记录
Public Function DelCard(ByVal lngID As Long) As Boolean
    Dim strSql As String, strCode As String, strItem As String
    Dim recItemType As rdoResultset

    If lngID = mlngItemTypeID And frmItemList.IsShowCard(0) Then
        ShowMsg 0, "不能删除正在修改的商品类型！", vbExclamation + MB_TASKMODAL, "删除商品类型"
        Show
        Exit Function
    End If
    DelCard = False
    strSql = "SELECT * FROM ItemType WHERE lngItemTypeID=" & lngID
    Set recItemType = gclsBase.BaseDB.OpenResultset(strSql, rdOpenForwardOnly)
    If recItemType.EOF Then
        DelCard = True
        recItemType.Close
        Exit Function
    Else
        strCode = Trim(recItemType!strItemTypeCode)
        strItem = Trim(recItemType!strItemTypeCode) & " " & Trim(recItemType!strItemTypeName)
        If recItemType!blnIsDetail = 0 Then
            ShowMsg 0, "“" & strItem & "”有下级商品类型，不能删除！", _
                    vbExclamation + vbOKOnly + MB_TASKMODAL, "删除商品类型"
            recItemType.Close
            Exit Function
        End If
    End If
    recItemType.Close
    If CodeUsed(lngID) Then
        ShowMsg 0, "商品类型“" & strItem & "”已有业务发生，不能删除！", _
            vbExclamation + vbOKOnly + MB_TASKMODAL, "删除商品类型"
        Exit Function
    End If
    If ShowMsg(0, "您确实要删除商品类型“" & strItem & "”吗？" _
        , vbQuestion + vbYesNo + MB_TASKMODAL, "删除商品类型") = vbNo Then
        Exit Function
    End If
    gclsBase.BaseWorkSpace.BeginTrans
    strSql = "DELETE FROM ItemType WHERE lngItemTypeID = " & lngID
    If Not gclsBase.ExecSQL(strSql) Then GoTo ErrHandle
    If Not ChangeHigherCardDetail("ItemType", "strItemTypeCode", strCode) Then GoTo ErrHandle
    DelCard = True
'    gclsSys.SendMessage CStr(Me.hwnd), Message.msgItemType
    gclsBase.BaseWorkSpace.CommitTrans
    Exit Function
ErrHandle:
    gclsBase.BaseWorkSpace.RollbackTrans
End Function

'判断编码是否被使用（可能有多张表会使用此编码）
Private Function CodeUsed(lngID As Long) As Boolean
    CodeUsed = True
    If CheckIDUsed("Item", "lngItemTypeID", lngID) Then Exit Function
    CodeUsed = False
End Function

Private Sub chkPause_Click()
'    Dim strItem As String
'
'    strItem = txtInput(0).Text & " " & txtInput(1).Text
'    If chkPause.Value = Checked And Not mblnIsNew Then
'        If CodeUsed(mlngItemTypeID) Then
'            ShowMsg hwnd, "商品类型“" & strItem & "”已有业务发生，不能停用！", _
'                vbExclamation, Caption
'            chkPause.Value = Unchecked
'        End If
'    End If
    If Not mblnIsInit Then mblnIsChanged = True
End Sub

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

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