paymentmethodlistcard.frm

金算盘软件代码

VERSION 5.00
Begin VB.Form frmPaymentMethodListCard 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "付款方式卡片"
   ClientHeight    =   1995
   ClientLeft      =   585
   ClientTop       =   1110
   ClientWidth     =   5460
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MDIChild        =   -1  'True
   ScaleHeight     =   1995
   ScaleWidth      =   5460
   ShowInTaskbar   =   0   'False
   Begin VB.Frame Frame1 
      Height          =   1935
      Left            =   60
      TabIndex        =   0
      Top             =   0
      Width           =   4035
      Begin VB.TextBox txtPaymentMethod 
         Height          =   300
         Index           =   1
         Left            =   1560
         MaxLength       =   20
         TabIndex        =   4
         Top             =   1170
         Width           =   2340
      End
      Begin VB.TextBox txtPaymentMethod 
         Height          =   300
         Index           =   0
         Left            =   1560
         MaxLength       =   8
         TabIndex        =   2
         Top             =   540
         Width           =   2340
      End
      Begin VB.Label lblName 
         AutoSize        =   -1  'True
         BackColor       =   &H00C0FFC0&
         BackStyle       =   0  'Transparent
         Caption         =   "付款方式名称(&N)"
         Height          =   180
         Left            =   180
         TabIndex        =   3
         Top             =   1230
         Width           =   1350
      End
      Begin VB.Label lblCode 
         AutoSize        =   -1  'True
         BackColor       =   &H00C0FFC0&
         BackStyle       =   0  'Transparent
         Caption         =   "付款方式编码(&C)"
         Height          =   180
         Left            =   180
         TabIndex        =   1
         Top             =   600
         Width           =   1350
      End
   End
   Begin VB.CommandButton cmdPaymentMethod 
      Cancel          =   -1  'True
      Height          =   345
      Index           =   1
      Left            =   4200
      Style           =   1  'Graphical
      TabIndex        =   6
      Tag             =   "1002"
      Top             =   532
      UseMaskColor    =   -1  'True
      Width           =   1215
   End
   Begin VB.CommandButton cmdPaymentMethod 
      Height          =   345
      Index           =   2
      Left            =   4200
      Style           =   1  'Graphical
      TabIndex        =   7
      Tag             =   "1009"
      Top             =   960
      UseMaskColor    =   -1  'True
      Width           =   1215
   End
   Begin VB.CommandButton cmdPaymentMethod 
      Default         =   -1  'True
      Height          =   345
      Index           =   0
      Left            =   4200
      Style           =   1  'Graphical
      TabIndex        =   5
      Tag             =   "1001"
      Top             =   105
      UseMaskColor    =   -1  'True
      Width           =   1215
   End
   Begin VB.CheckBox chkInActive 
      Caption         =   "停用"
      Height          =   240
      Left            =   4200
      TabIndex        =   8
      Top             =   1695
      Width           =   735
   End
End
Attribute VB_Name = "frmPaymentMethodListCard"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'''''''''''''''''''''''''''''''''''''''
'   付款方式卡片
'   作者：郑权
'   日期：98.11.14
'
'引入参数: IsShowCard 功能: 设置付款方式卡片是否关闭
'   引出参数：msgpaymentmethod 功能：判断付款方式卡片是否发出（增加或修改）改变消息
'
'''''''''''''''''''''''''''''''''''''''
Option Explicit

Private mlngPaymentMethodID As Long                             '卡片付款方式记录对应的ID
Private mblnIsChanged As Boolean                                '修改标志
Private WithEvents mclsMainControl As MainControl               '主控对象
Attribute mclsMainControl.VB_VarHelpID = -1
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
    
    strSql = "INSERT INTO PaymentMethod (strPaymentMethodCode,strPaymentMethodName," & _
              "blnIsInActive) VALUES ('" & strCode & "','" & strName & "'," & IIf(blnIsInActive, 1, 0) & ")"

    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) _
        & " 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
    Dim strSql As String
    
    mblnChangeIsFirst = True
    If mlngPaymentMethodID > 0 Then
        '按照当前付款方式ID提取记录
        strSql = "select * from paymentmethod where lngpaymentmethodid=" & mlngPaymentMethodID
        Set recRecordset = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
        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
            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(1).Text = strName
        txtPaymentMethod(0).SelStart = 0
        txtPaymentMethod(0).SelLength = strLen(txtPaymentMethod(0).Text)
        txtPaymentMethod(0).SetFocus
        mstrCode = ""
        mstrName = ""
        chkInActive.Value = 0
    End If
    
    mblnChangeIsFirst = False
    mblnIsChanged = False
End Sub


    

'保存卡片
Private Function SaveCard() As Boolean
    Dim blnFinish As Boolean
    
    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 Len(Trim(txtPaymentMethod(1).Text)) = 0 Then
       ShowMsg 0, "付款方式名称不能为空！", _
                 vbExclamation + MB_TASKMODAL, Me.Caption
       txtPaymentMethod(1).SetFocus
       Exit Function
    End If
    If mblnIsChanged = True Then
       If PaymentMethodID > 0 Then
          If UCase(Trim(txtPaymentMethod(0).Text)) <> UCase(mstrCode) Then
             If blnCodeIsExisted Then
                ShowMsg 0, "该付款方式编码已经存在，请重新输入！", _
                            vbExclamation + MB_TASKMODAL, Caption
                txtPaymentMethod(0).SetFocus
                Exit Function
             End If
          End If
          If UCase(Trim(txtPaymentMethod(1).Text)) <> UCase(mstrName) Then
             If blnNameIsExisted(txtPaymentMethod(1).Text) Then
                ShowMsg 0, "该付款方式名称已经存在，请重新输入！", _
                           vbExclamation + MB_TASKMODAL, Me.Caption
                txtPaymentMethod(1).SetFocus
                Exit Function
             End If
          End If
       Else
          If blnCodeIsExisted Then
             ShowMsg 0, "该付款方式编码已经存在，请重新输入！", _
                           vbExclamation + MB_TASKMODAL, Me.Caption
             txtPaymentMethod(0).SetFocus
             Exit Function
          End If
          If blnNameIsExisted(txtPaymentMethod(1).Text) Then
             ShowMsg 0, "该付款方式名称已经存在，请重新输入！", vbExclamation + MB_TASKMODAL, Me.Caption
             txtPaymentMethod(1).SetFocus
             Exit Function
          End If
       End If
        txtPaymentMethod(0).Text = Trim(txtPaymentMethod(0).Text)
        txtPaymentMethod(1).Text = Trim(txtPaymentMethod(1).Text)
        If mlngPaymentMethodID > 0 Then
           blnFinish = EditPaymentMethod(mlngPaymentMethodID, txtPaymentMethod(0).Text, txtPaymentMethod(1).Text, (chkInActive.Value = 1))
        Else
           blnFinish = InsertPaymentMethod(txtPaymentMethod(0).Text, txtPaymentMethod(1).Text, (chkInActive.Value = 1))
        End If
        If blnFinish Then
                '发出付款方式消息
            gclsSys.SendMessage Me.hwnd, Message.msgPaymentMethod
            mblnIsChanged = False
        End If