paymentmethodcard.frm

金算盘软件代码

VERSION 5.00
Begin VB.Form frmPaymentMethodCard 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "付款方式卡片"
   ClientHeight    =   2190
   ClientLeft      =   585
   ClientTop       =   1110
   ClientWidth     =   5460
   HelpContextID   =   30041
   Icon            =   "PaymentMethodCard.frx":0000
   KeyPreview      =   -1  'True
   LinkTopic       =   "Form1"
   LockControls    =   -1  'True
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   2190
   ScaleWidth      =   5460
   StartUpPosition =   2  '屏幕中心
   Begin VB.CheckBox chkM 
      Caption         =   "票据管理"
      Height          =   345
      Left            =   4200
      TabIndex        =   4
      Top             =   1290
      Width           =   1035
   End
   Begin VB.TextBox txtPaymentMethod 
      Height          =   300
      Index           =   0
      Left            =   1650
      MaxLength       =   8
      TabIndex        =   1
      Top             =   450
      Width           =   2280
   End
   Begin VB.TextBox txtPaymentMethod 
      Height          =   300
      Index           =   1
      Left            =   1650
      MaxLength       =   20
      TabIndex        =   3
      Top             =   1200
      Width           =   2280
   End
   Begin VB.CommandButton cmdPaymentMethod 
      Height          =   345
      Index           =   1
      Left            =   4200
      Style           =   1  'Graphical
      TabIndex        =   6
      Tag             =   "1002"
      Top             =   495
      UseMaskColor    =   -1  'True
      Width           =   1215
   End
   Begin VB.CommandButton cmdPaymentMethod 
      Height          =   345
      Index           =   2
      Left            =   4200
      Style           =   1  'Graphical
      TabIndex        =   7
      Tag             =   "1009"
      Top             =   870
      UseMaskColor    =   -1  'True
      Width           =   1215
   End
   Begin VB.CommandButton cmdPaymentMethod 
      Height          =   345
      Index           =   0
      Left            =   4200
      Style           =   1  'Graphical
      TabIndex        =   5
      Tag             =   "1001"
      Top             =   135
      UseMaskColor    =   -1  'True
      Width           =   1215
   End
   Begin VB.CheckBox chkInActive 
      Caption         =   "停用"
      Height          =   240
      Left            =   4200
      TabIndex        =   8
      Top             =   1785
      Width           =   735
   End
   Begin VB.Label lblCode 
      AutoSize        =   -1  'True
      BackColor       =   &H00C0C0C0&
      Caption         =   "付款方式编码(&C)"
      Height          =   180
      Left            =   270
      TabIndex        =   0
      Top             =   510
      Width           =   1350
   End
   Begin VB.Label lblName 
      AutoSize        =   -1  'True
      BackColor       =   &H00C0C0C0&
      Caption         =   "付款方式名称(&N)"
      Height          =   180
      Left            =   270
      TabIndex        =   2
      Top             =   1260
      Width           =   1350
   End
End
Attribute VB_Name = "frmPaymentMethodCard"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'''''''''''''''''''''''''''''''''''''''
'   付款方式卡片
'   作者：郑权
'   日期：98.6.23
'
'引入参数: IsShowCard 功能: 设置付款方式卡片是否关闭
'   引出参数：msgpaymentmethod 功能：判断付款方式卡片是否发出（增加或修改）改变消息
'
'''''''''''''''''''''''''''''''''''''''
Option Explicit

Private mlngPaymentMethodID As Long                             '卡片付款方式记录对应的ID
Private mblnIsChanged As Boolean                                '修改标志
Private mblnIsList As Boolean
'Private WithEvents mclsMainControl As MainControl               '主控对象
Private mstrCode As String
Private mstrName As String
Private ID As Long
Private mblnChangeIsFirst As Boolean    '检查文本框的Change事件是否是第一次发生


'新增付款方式记录
Private Function InsertPaymentMethod(ByVal strCode As String, ByVal strName As String, ByVal blnIsInActive As Boolean) As Boolean
    Dim strSql As String
    
    ID = GetNewID("PaymentMethod")
    strSql = "INSERT INTO PaymentMethod (lngPaymentMethodID,strPaymentMethodCode," _
        & "strPaymentMethodName,blnIsInActive,blnIsCheck) VALUES (" & ID & ",'" _
        & strCode & "','" & strName & "'," & IIf(blnIsInActive, 1, 0) & "," & chkM.Value & ")"

    InsertPaymentMethod = gclsBase.ExecSQL(strSql)
End Function

'修改付款方式记录
Private Function EditPaymentMethod(ByVal lngID As Long, ByVal strCode As String, ByVal strName As String, ByVal pblnIsInActive As Boolean) As Boolean
    Dim strSql As String
    
    strSql = "UPDATE PaymentMethod Set strPaymentMethodCode = '" & strCode _
        & "', strPaymentMethodName = '" & strName & "', blnIsInActive = " & IIf(pblnIsInActive, 1, 0) _
        & ",blnIsCheck=" & chkM.Value & " WHERE lngPaymentMethodID = " & lngID

    EditPaymentMethod = gclsBase.ExecSQL(strSql)
End Function
'返回卡片当前对应的付款方式ID
Public Property Get PaymentMethodID() As Long
    PaymentMethodID = mlngPaymentMethodID
End Property

'初始化卡片
Private Sub InitCard(Optional strName As String = "")
    Dim recRecordset As rdoResultset
    
    mblnChangeIsFirst = True
    If mlngPaymentMethodID > 0 Then
        '按照当前付款方式ID提取记录
        frmCommList.SetListType 3
        Set recRecordset = frmCommList.GetbyListID(mlngPaymentMethodID)
        With recRecordset
            If .RowCount = 0 Then
                ShowMsg 0, "当前付款方式不存在，不能修改！", _
                           vbExclamation + MB_TASKMODAL, "修改付款方式"
                Unload Me
            Else
                txtPaymentMethod(0).Text = !strpaymentMethodCode
                mstrCode = !strpaymentMethodCode
                txtPaymentMethod(1).Text = !strPaymentMethodName
                mstrName = !strPaymentMethodName
                ChkInActive.Value = !blnIsInActive
                chkM.Value = !blnIsCheck
            End If
        End With
        recRecordset.Close
    Else
        If txtPaymentMethod(0).Text = "" Or txtPaymentMethod(0).Text = "Text" Then
           txtPaymentMethod(0).Text = ""
        Else
           txtPaymentMethod(0).Text = GetNextCode(txtPaymentMethod(0).Text)
        End If
        txtPaymentMethod(0).Text = strName
        txtPaymentMethod(0).SelStart = 0
        txtPaymentMethod(0).SelLength = StrLen(txtPaymentMethod(0).Text)
'        txtPaymentMethod(0).SetFocus
        mstrCode = ""
        mstrName = ""
        ChkInActive.Value = 0
        chkM.Value = 0
    End If
    
    mblnChangeIsFirst = False
    mblnIsChanged = False
End Sub

Private Function TranCodetoName(ByVal strCode As String) As String
    Dim strSql As String
    Dim recCode As rdoResultset
    
    strSql = "select * from PaymentMethod where strPaymentMethodCode='" & strCode & "'"
    Set recCode = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    If recCode.EOF Then
       TranCodetoName = ""
       Exit Function
    Else
       TranCodetoName = recCode!strPaymentMethodName
    End If
    recCode.Close
End Function
    
Private Function TranCodetoID(ByVal strCode As String) As Long
    Dim strSql As String
    Dim recCode As rdoResultset
    
    strSql = "select * from PaymentMethod where strPaymentMethodCode='" & strCode & "'"
    Set recCode = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    If recCode.EOF Then
       TranCodetoID = 0
       Exit Function
    Else
       TranCodetoID = recCode!lngPaymentMethodID
    End If
    recCode.Close
End Function

Private Function UnionPaymentmethod(ByVal lngOldID As String, ByVal lngNewID As String) As Boolean
    Dim strSql As String
    
    UnionPaymentmethod = False
    strSql = "update  Activity  set lngPaymentMethodID=" & lngNewID & _
             " where lngpaymentmethodid=" & lngOldID
    If Not gclsBase.ExecSQL(strSql) Then Exit Function
    
    strSql = "update  BankDetail  set lngPaymentMethodID=" & lngNewID & _
             " where lngpaymentmethodid=" & lngOldID
    If Not gclsBase.ExecSQL(strSql) Then Exit Function
    
    strSql = "update  BankInit  set lngPaymentMethodID=" & lngNewID & _
             " where lngpaymentmethodid=" & lngOldID
    If Not gclsBase.ExecSQL(strSql) Then Exit Function
    
    strSql = "Delete from paymentmethod where lngpaymentmethodid=" & lngOldID
    If Not gclsBase.ExecSQL(strSql) Then Exit Function
    UnionPaymentmethod = True
End Function
    

'保存卡片
Private Function SaveCard() As Boolean
    Dim blnFinish As Boolean
    Dim msgReturn As Integer
    
    SaveCard = False
    If Len(Trim(txtPaymentMethod(0).Text)) = 0 Then
       ShowMsg 0, "付款方式编码不能为空！", _
                 vbExclamation + MB_TASKMODAL, Me.Caption
       txtPaymentMethod(0).SetFocus
       Exit Function
    End If
    If ContainErrorChar(txtPaymentMethod(0).Text, "'|") Then
       ShowMsg 0, "付款方式编码包含了异常字符！", _
                 vbExclamation + MB_TASKMODAL, Me.Caption
       txtPaymentMethod(0).SetFocus
       Exit Function
    End If
    If Len(Trim(txtPaymentMethod(1).Text)) = 0 Then
       ShowMsg 0, "付款方式名称不能为空！", _
                 vbExclamation + MB_TASKMODAL, Me.Caption
       txtPaymentMethod(1).SetFocus
       Exit Function
    End If
    If ContainErrorChar(txtPaymentMethod(1).Text, "'|") Then
       ShowMsg 0, "付款方式名称包含了异常字符！", _
                 vbExclamation + MB_TASKMODAL, Me.Caption
       txtPaymentMethod(1).SetFocus
       Exit Function
    End If