paymentmethodcard.frm

金算盘软件代码

 
    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, Me.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
    Else
        Unload Me
        Exit Function
    End If
    SaveCard = blnFinish
End Function

Private Sub chkM_Click()
    mblnIsChanged = True
End Sub

Private Sub cmdPaymentMethod_Click(index As Integer)
    Dim strSql As String, strNextCode 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
                    strNextCode = GetNextCode(txtPaymentMethod(0).Text)
                    InitCard
                    txtPaymentMethod(0).Text = strNextCode
                    txtPaymentMethod(1).Text = ""
                    txtPaymentMethod(0).SetFocus
                    txtPaymentMethod(0).SelStart = 0
                    txtPaymentMethod(0).SelLength = Len(txtPaymentMethod(0).Text)
                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_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 Then
        If Shift = 2 Then
            cmdPaymentMethod(0).Value = True
        End If
    ElseIf KeyCode = vbKeyEscape Then
        cmdPaymentMethod(1).Value = True
        KeyCode = 0
    End If
End Sub

Private Sub Form_Load()
    On Error GoTo ErrHandle
    Utility.LoadFormResPicture Me
'    SendKeys "%{C}"
    'Set mclsMainControl = gclsSys.MainControls.Add(Me)
'    SetHelpID Me.hwnd, 30041 ' 27004
   ' frmPaymentmethodList.IsShowCard = True
   Exit Sub
    Dim edtErrReturn As ErrDealType
ErrHandle:
    edtErrReturn = Errors.ErrorsDeal
    
    If edtErrReturn = edtResume Then
         Resume
    Else
         On Error Resume Next
         Unload Me
    End If
End Sub

Private Sub Form_Paint()
    FrameBox hwnd, 120, 150, 120 + 3945, 150 + 1905
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

'编辑卡片
Public Sub EditCard(ByVal lngID As Long, Optional intModal As Integer = 0)
    Dim intResponse As Integer
    
    mlngPaymentMethodID = lngID
    InitCard
    Me.Caption = "修改付款方式"
    cmdPaymentMethod(2).Default = False
    cmdPaymentMethod(2).Visible = (mlngPaymentMethodID = 0)
    chkM.top = chkM.top - cmdPaymentMethod(2).Height
    ChkInActive.top = Me.Height - 2 * ChkInActive.Height - CardFormButtonCheckBox
    Show intModal
End Sub

'新增卡片
Public Function AddCard(Optional strName As String = "", Optional intModal As Integer = 0, _
    Optional ByVal IsList As Boolean = False) As Long
    Dim intResponse As Integer
    
    mlngPaymentMethodID = 0
    InitCard (strName)
    Me.Caption = "新增付款方式"
    cmdPaymentMethod(2).Visible = (mlngPaymentMethodID = 0)
    mblnIsList = IsList
    ChkInActive.top = Me.Height - 2 * ChkInActive.Height - CardFormButtonCheckBox
    Show intModal
    AddCard = ID
End Function


Private Sub chkInActive_Click()
    mblnIsChanged = True
End Sub

Private Sub Form_Unload(Cancel As Integer)
    On Error Resume Next
    Utility.UnLoadFormResPicture Me
End Sub

Private Sub txtPaymentMethod_Change(index As Integer)
    If mblnChangeIsFirst = True Then Exit Sub
    If ContainErrorChar(txtPaymentMethod(index).Text, "'|") Then
       BKKEY txtPaymentMethod(index).hwnd
       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
        If CheckIDUsed("Check1", "lngPaymentMethodID", lngID) Then Exit Function
        PaymentMethodIsUsed = False
End Function
        
Public Function DelCard(ByVal lngID As Long, Optional ByVal lnghWnd As Long = 0, Optional blnFromList As Boolean = False) 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 lnghWnd, "不能删除当前编辑的付款方式！", _
'                      vbExclamation + MB_SYSTEMMODAL, "付款方式删除提示"
'            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 lnghWnd, "当前选定的付款方式已经发生业务，不能删除！", _
                       vbExclamation + MB_TASKMODAL, "付款方式删除提示"
        Else
            intMsgReturn = ShowMsg(lnghWnd, "你确实要删除当前选定的付款方式吗?", _
                       vbQuestion + vbYesNo + MB_TASKMODAL, "付款方式删除提示")
            If intMsgReturn = vbYes Then
                strSql = "Delete From PaymentMethod Where lngPaymentMethodID = " & lngID
                blnDel = gclsBase.ExecSQL(strSql)
                If blnDel Then
                       '发出付款条件消息
                    If Not blnFromList Then gclsSys.SendMessage CStr(0), Message.msgPaymentMethod
                End If
            Else
                Exit Function
            End If
        End If
    End If
    DelCard = blnDel
    recRecordset.Close

End Function