paymentmethodlistcard.frm

金算盘软件代码

    Else
        Unload Me
        Exit Function
    End If
    SaveCard = blnFinish
End Function

Private Sub cmdPaymentMethod_Click(Index As Integer)
    Dim strSql As String
    Dim recPaymentmethod As rdoResultset
    
    Select Case Index
           Case 0
                If SaveCard() Then
                   strSql = "select * from paymentmethod order by lngPaymentMethodID"
                   Set recPaymentmethod = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
                   If recPaymentmethod.RowCount > 0 Then
                      recPaymentmethod.MoveLast
                      ID = recPaymentmethod!lngPaymentMethodID
                   Else
                      ID = 0
                   End If
                Else
                   Exit Sub
                End If
                Unload Me
           Case 1
                mblnIsChanged = False
                Unload Me
           Case 2
                If SaveCard() Then
                   InitCard
                Else
                    Exit Sub
                End If
    End Select
End Sub

'判断编码是否存在
Private Function blnCodeIsExisted() As Boolean
    Dim recRecordset As rdoResultset
    Dim strSql As String
    
    blnCodeIsExisted = False
    strSql = "select * from PaymentMethod where strPaymentMethodCode='" & Trim(txtPaymentMethod(0).Text) & "'"
    Set recRecordset = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    If recRecordset.RowCount > 0 Then blnCodeIsExisted = True
    recRecordset.Close
    If Not recRecordset Is Nothing Then Set recRecordset = Nothing
    
End Function
'判断名称是否存在
Private Function blnNameIsExisted(ByVal strName As String) As Boolean
    Dim recRecordset As rdoResultset
    Dim strSql As String
    
    blnNameIsExisted = False
    strSql = "select * from PaymentMethod where strPaymentMethodName='" & strName & "'"
    Set recRecordset = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    blnNameIsExisted = Not recRecordset.EOF
    recRecordset.Close
    If Not recRecordset Is Nothing Then Set recRecordset = Nothing
    
End Function
Private Sub Form_Load()
    Set cmdPaymentMethod(0).Picture = LoadResPicture(1001, vbResBitmap)
    Set cmdPaymentMethod(1).Picture = LoadResPicture(1002, vbResBitmap)
    Set cmdPaymentMethod(2).Picture = LoadResPicture(1004, vbResBitmap)
    Set mclsMainControl = gclsSys.MainControls.Add(Me)
    SetHelpID Me.hwnd, 30041 ' 27004
    frmPaymentmethodList.IsShowCard = True
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
    Dim intResponse As Integer
    
    If UnloadMode = vbFormControlMenu Then
       If mblnIsChanged Then
          intResponse = ShowMsg(0, "当前付款方式已被修改，是否保存？", _
                    vbQuestion + vbYesNoCancel + MB_TASKMODAL, Me.Caption)
          If intResponse = vbYes Then
             Cancel = True
             Cancel = Not SaveCard()
          ElseIf intResponse = vbCancel Then
             Cancel = True
          End If
       End If
    End If
    If Not Cancel Then mblnIsChanged = False
End Sub



Private Sub Form_Activate()
    Dim vntMessage As Variant
    
    '响应消息
'    For Each vntMessage In mclsMainControl.Messages
'        If vntMessage = Message.msgPaymentMethod Then
'            If mlngPaymentMethodID > 0 Then
'                InitCard
'            End If
'        End If
'    Next
    
End Sub

'编辑卡片
Public Sub EditCard(ByVal lngID As Long, Optional intModal As Integer = 0)
    Dim intResponse As Integer
    
    '设置当前付款方式ID
    cmdPaymentMethod(2).Default = False
    cmdPaymentMethod(0).Default = True
    If mblnIsChanged Then
        If lngID <> mlngPaymentMethodID Then
            intResponse = ShowMsg(0, "当前付款方式已被修改，是否保存？", _
                     vbQuestion + vbYesNoCancel + MB_TASKMODAL, Me.Caption)
            If intResponse = vbYes Then
                If SaveCard() Then
                    mlngPaymentMethodID = lngID
                    InitCard
                End If
            ElseIf intResponse = vbNo Then
                mlngPaymentMethodID = lngID
                
                InitCard
            End If
        End If
    Else
        mlngPaymentMethodID = lngID
        
        InitCard
    End If
    
    '显示卡片
    Me.Caption = "修改付款方式"
    cmdPaymentMethod(2).Visible = (mlngPaymentMethodID = 0)
    chkInActive.top = Me.Height - 2 * chkInActive.Height - CardFormButtonCheckBox
    If Me.WindowState = 1 Then Me.WindowState = 0
    Show intModal
    
    If intModal <> vbModal Then
       Refresh
       ZOrder 0
    End If
End Sub

'新增卡片
Public Function AddCard(Optional strName As String = "", Optional intModal As Integer = 0) As Long
    Dim intResponse As Integer
    
    
    '设置当前付款方式ID
    cmdPaymentMethod(0).Default = False
    cmdPaymentMethod(2).Default = True
    If mblnIsChanged Then
        If mlngPaymentMethodID <> 0 Then
            intResponse = ShowMsg(0, "当前付款方式已被修改，是否保存？", _
                          vbQuestion + vbYesNoCancel + MB_TASKMODAL, Me.Caption)
            If intResponse = vbYes Then
                If SaveCard() Then
                    mlngPaymentMethodID = 0
                    InitCard (strName)
                End If
            ElseIf intResponse = vbNo Then
                mlngPaymentMethodID = 0
                InitCard (strName)
            End If
        End If
    Else
        mlngPaymentMethodID = 0
        InitCard (strName)
    End If
    
    '显示卡片
    Me.Caption = "新增付款方式"
    '显示卡片
    cmdPaymentMethod(2).Visible = (mlngPaymentMethodID = 0)
    chkInActive.top = Me.Height - 2 * chkInActive.Height - CardFormButtonCheckBox
    If Me.WindowState = 1 Then Me.WindowState = 0
    Show intModal
    AddCard = ID
    
    If intModal <> vbModal Then
       Refresh
       ZOrder 0
    End If
    
End Function


Private Sub chkInActive_Click()
    mblnIsChanged = True
End Sub

Private Sub Form_Unload(Cancel As Integer)
    Utility.UnLoadFormResPicture Me
    gclsSys.CurrFormName = ""
    gclsSys.MainControls.Remove Me
    Set mclsMainControl = Nothing
    frmPaymentmethodList.IsShowCard = False
End Sub

Private Sub txtPaymentMethod_Change(Index As Integer)
    If mblnChangeIsFirst = True Then Exit Sub
    If ContainErrorChar(txtPaymentMethod(Index).Text, "'") Then
       SendKeys "{BS}"
       Exit Sub
    End If
    mblnIsChanged = True
End Sub
Private Function PaymentMethodIsUsed(ByVal lngID As Long) As Boolean
        PaymentMethodIsUsed = True
        If CheckIDUsed("Activity", "lngPaymentMethodID", lngID) Then Exit Function '
        If CheckIDUsed("BankDetail", "lngPaymentMethodID", lngID) Then Exit Function '
        If CheckIDUsed("BankInit", "lngPaymentMethodID", lngID) Then Exit Function
        PaymentMethodIsUsed = False
End Function
        
Public Function DelCard(ByVal lngID As Long) As Boolean
    Dim recRecordset As rdoResultset
    Dim strSql As String
    Dim blnDel As Boolean
    Dim intMsgReturn As Integer
    
    DelCard = False
    If frmPaymentmethodList.IsShowCard = True Then
       If lngID = frmPaymentMethodListCard.PaymentMethodID Then
            ShowMsg 0, "不能删除当前编辑的付款方式！", _
                      vbExclamation + MB_TASKMODAL, "付款方式删除提示"
            frmPaymentMethodListCard.Show
            Exit Function
       End If
    End If
    strSql = "Select * From paymentMethod Where lngpaymentMethodID = " & lngID
    Set recRecordset = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    If recRecordset.RowCount = 0 Then
       Exit Function
    Else
        If PaymentMethodIsUsed(lngID) Then
            ShowMsg 0, "当前选定的付款方式已经发生业务，不能删除！", _
                       vbExclamation + MB_TASKMODAL, "付款方式删除提示"
        Else
            intMsgReturn = ShowMsg(0, "你确实要删除当前选定的付款方式吗?", _
                       vbQuestion + vbYesNo + MB_TASKMODAL, "付款方式删除提示")
            If intMsgReturn = vbYes Then
                strSql = "Delete From PaymentMethod Where lngPaymentMethodID = " & lngID
                blnDel = gclsBase.ExecSQL(strSql)
                If blnDel Then
                       '发出付款条件消息
                     '  gclsSys.SendMessage CStr(0), Message.msgPaymentMethod
                End If
            Else
                Exit Function
            End If
        End If
    End If
    DelCard = blnDel
    recRecordset.Close

End Function