frmcustomertypecard.frm

金算盘软件代码

VERSION 5.00
Object = "{F42BDC2B-FC9B-11D1-9ABD-444553540000}#3.4#0"; "ATLEDIT1.OCX"
Begin VB.Form frmCustomerTypeCard 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "新增单位类型"
   ClientHeight    =   2400
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   5970
   HelpContextID   =   30006
   KeyPreview      =   -1  'True
   LinkTopic       =   "Form1"
   LockControls    =   -1  'True
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   2400
   ScaleWidth      =   5970
   ShowInTaskbar   =   0   'False
   StartUpPosition =   2  '屏幕中心
   Begin AtlEdit.TEdit txtInput 
      Height          =   300
      Index           =   1
      Left            =   1755
      TabIndex        =   3
      Top             =   1470
      Width           =   2475
      _ExtentX        =   4366
      _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            =   1755
      TabIndex        =   1
      Top             =   510
      Width           =   2475
      _ExtentX        =   4366
      _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            =   4530
      Style           =   1  'Graphical
      TabIndex        =   6
      Tag             =   "1009"
      Top             =   930
      UseMaskColor    =   -1  'True
      Width           =   1215
   End
   Begin VB.CommandButton cmdOKCancel 
      Cancel          =   -1  'True
      Height          =   350
      Index           =   1
      Left            =   4530
      Style           =   1  'Graphical
      TabIndex        =   5
      Tag             =   "1002"
      Top             =   540
      UseMaskColor    =   -1  'True
      Width           =   1215
   End
   Begin VB.CommandButton cmdOKCancel 
      Height          =   350
      Index           =   0
      Left            =   4530
      Style           =   1  'Graphical
      TabIndex        =   4
      Tag             =   "1001"
      Top             =   150
      UseMaskColor    =   -1  'True
      Width           =   1215
   End
   Begin VB.CheckBox chkPause 
      Caption         =   "停用"
      Height          =   195
      Left            =   4530
      TabIndex        =   7
      Top             =   1950
      Width           =   975
   End
   Begin VB.Label lblTitle 
      Caption         =   "单位类型编码(&C)"
      Height          =   195
      Index           =   0
      Left            =   360
      TabIndex        =   0
      Top             =   540
      Width           =   1365
   End
   Begin VB.Label lblTitle 
      Caption         =   "单位类型名称(&N)"
      Height          =   195
      Index           =   1
      Left            =   360
      TabIndex        =   2
      Top             =   1500
      Width           =   1365
   End
End
Attribute VB_Name = "frmCustomerTypeCard"
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 mblnIsNew As Boolean                           '是新增还是修改操作
Private mblnIsList As Boolean
Private mblnIsInit 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 mlngCustomerTypeID As Long
Private mstrCode As String
Private mstrName As String
Private mstrOldCode As String                           '以前的CODE
Private mstrOldFullName As String
Private mstrOldName As String                           '以前的NAME
Private mstrFullName As String
Private mstrStartDate As String
'引入单位类别
Public Function AddCustomerType(ByVal strCustomerType As String) As Integer
    Dim strCode As String, strName As String, blnIsStop As Boolean
    Dim strTemp As String
    
    AddCustomerType = 0
    If Not GetString(strCustomerType, strCode, 1) Then Exit Function
    If Not GetString(strCustomerType, strName, 2) Then Exit Function
    If Not GetString(strCustomerType, strTemp, 3) Then Exit Function
    blnIsStop = (strTemp = "1")
    
    If strCode = "" Or strName = "" Then Exit Function
    txtInput(0).Text = strCode
    txtInput(1).Text = strName
    chkPause.Value = IIf(blnIsStop, 1, 0)
    mblnIsNew = True
    If Not SaveCard(True) Then Exit Function
    AddCustomerType = 1
End Function

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

'进入新增单位类型操作
Public Function AddCard(Optional strName As String = "", Optional intModal As Integer, _
    Optional ByVal IsList As Boolean = False) As Long
    
    mblnIsNew = True
    mlngCustomerTypeID = 0
    Caption = "新增单位类型"
    cmdOKCancel(2).Visible = True
    mblnIsList = IsList
    InitCard strName
    Show intModal
    AddCard = mlngCustomerTypeID
End Function

Private Sub InitCard(Optional ByVal strName As String)
    Dim recCustomerType 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 CustomerType WHERE lngCustomerTypeID=" & mlngCustomerTypeID
        Set recCustomerType = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
        txtInput(0).Text = recCustomerType!strCustomerTypeCode
        txtInput(1).Text = recCustomerType!strCustomerTypeName
        chkPause.Value = recCustomerType!blnIsInActive
        mblnIsInActive = (recCustomerType!blnIsInActive = 1)
        mblnIsDetail = (recCustomerType!blnIsDetail = 1)
        mintOldLevel = recCustomerType!intLevel
        mstrOldFullName = recCustomerType!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 strType As String)
    Dim strMess As String
    
    If Not CheckIDUsed("CustomerType", "lngCustomerTypeID", lngID) Then
        If Trim(strType) <> "" Then
            strMess = "“" & strType & "”"
        Else
            strMess = "该"
        End If
        ShowMsg 0, strMess & "单位类型不存在,不能进行修改!", vbExclamation + MB_TASKMODAL, "修改单位类型"
        Unload Me
    Else
        mblnIsNew = False
        mblnIsChanged = False
        mlngCustomerTypeID = lngID
        Caption = "修改单位类型"
        cmdOKCancel(2).Visible = False
        InitCard
        Show intModal
    End If
End Sub

'进入删除单位类型操作，判断编码是否是末级和被使用，删除记录
Public Function DelCard(ByVal lngID As Long, Optional lnghWnd As Long = 0) As Boolean
    Dim strSql As String, strCode As String, strType As String
    Dim recCustomerType As rdoResultset

'    If lngID = mlngCustomerTypeID And frmCustomerList.IsShowCard(1) Then
'        ShowMsg lnghWnd, "不能删除正在修改的单位类型！", vbExclamation + MB_TASKMODAL, "删除单位类型"
'        Show vbModal
'        Exit Function
'    End If
    DelCard = False
    strSql = "SELECT * FROM CustomerType WHERE lngCustomerTypeID=" & lngID
    Set recCustomerType = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    If recCustomerType.EOF Then
        DelCard = True
        recCustomerType.Close
        Exit Function
    Else
        strCode = Trim(recCustomerType!strCustomerTypeCode)
        strType = Trim(recCustomerType!strCustomerTypeCode) & " " & Trim(recCustomerType!strCustomerTypeName)
        If recCustomerType!blnIsDetail = 0 Then
            ShowMsg lnghWnd, "“" & strType & "”有下级单位类型，不能删除！", _
                    vbExclamation + vbOKOnly + MB_TASKMODAL, "删除单位类型"
            recCustomerType.Close
            Exit Function
        End If
    End If
    recCustomerType.Close
    If CodeUsed(lngID) Then
        ShowMsg lnghWnd, "单位类型“" & strType & "”已有业务发生，不能删除！", _
            vbExclamation + vbOKOnly + MB_TASKMODAL, "删除单位类型"
        Exit Function
    End If
    If ShowMsg(lnghWnd, "您确实要删除单位类型“" & strType & "”吗？" _
        , vbQuestion + vbYesNo + MB_TASKMODAL + vbDefaultButton2, "删除单位类型") = vbNo Then
        Exit Function
    End If
    gclsBase.BaseWorkSpace.BeginTrans
    strSql = "DELETE FROM CustomerType WHERE lngCustomerTypeID = " & lngID
    If Not gclsBase.ExecSQL(strSql) Then GoTo ErrHandle
    If Not ChangeHigherCardDetail("CustomerType", "strCustomerTypeCode", strCode) Then GoTo ErrHandle
    DelCard = True
    gclsSys.SendMessage CStr(Me.hwnd), Message.msgCustomerType
    gclsBase.BaseWorkSpace.CommitTrans
    Exit Function
ErrHandle:
    gclsBase.BaseWorkSpace.RollBacktrans
End Function

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

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

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
        cmdOKCancel(0).Value = True
    End If
End Sub

Private Sub Form_Load()