frmtermlistcard.frm

金算盘软件代码

       Unload frmTermListCard
       Exit Sub
    End If
    '设置当前付款方式ID
    If mblnIsChanged Then
        If lngID <> mlngTermID Then
            intResponse = ShowMsg(0, "当前付款方式已被修改，是否保存？", _
                         vbQuestion + vbYesNoCancel + MB_TASKMODAL, Me.Caption)
            If intResponse = vbYes Then
                If SaveCard() Then
                    mlngTermID = lngID
                    
                    InitCard
                    Me.Caption = "修改付款条件"
                End If
            ElseIf intResponse = vbNo Then
                mlngTermID = lngID
                InitCard
                Me.Caption = "修改付款条件"
            End If
        End If
    Else
        mlngTermID = lngID
        
        InitCard
        Me.Caption = "修改付款条件"
    End If
    
    '显示卡片
    If Me.WindowState = 1 Then Me.WindowState = 0
    ShowCard intModal
End Sub

'新增卡片
Public Function AddCard(Optional strName As String = "", Optional intModal As Integer = 0) As Long
    Dim intResponse As Integer
    
    cmdOKCancel(0).Default = False
    cmdOKCancel(2).Default = True
    '设置当前付款方式ID
    If mblnIsChanged Then
        If mlngTermID <> 0 Then
            intResponse = ShowMsg(0, "当前付款方式已被修改，是否保存？", _
                                vbQuestion + vbYesNoCancel + MB_TASKMODAL, Me.Caption)
            If intResponse = vbYes Then
                If SaveCard() Then
                    mlngTermID = 0
                    InitCard (strName)
                    Me.Caption = "新增付款条件"
                End If
            ElseIf intResponse = vbNo Then
                mlngTermID = 0
                InitCard (strName)
                Me.Caption = "新增付款条件"
            End If
        End If
    Else
        mlngTermID = 0
        InitCard (strName)
        Me.Caption = "新增付款条件"
    End If
    
    '显示卡片
    If Me.WindowState = 1 Then Me.WindowState = 0
    ShowCard intModal
    AddCard = ID
End Function


Private Sub chkInActive_Click()
    mblnIsChanged = True
End Sub

Private Sub Form_Resize()
    On Error Resume Next
    'Me.Width = 5775
    'Me.Height = intFormHeight
    If Me.Left + Me.Width < 0 Or Me.Left > Screen.Width Then
       Me.Left = 300
    End If
End Sub

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

Private Sub txtCodeName_Change(Index As Integer)
    If mblnChangeIsFirst = True Then Exit Sub
    If ContainErrorChar(txtCodeName(Index).Text, "'") Then
       SendKeys "{BS}"
       Exit Sub
    End If
    mblnIsChanged = True
End Sub

Private Sub txtDiscountDay_Change(Index As Integer)
   If mblnChangeIsFirst = True Then Exit Sub
   If DuedayIsRight(txtDiscountDay(Index).Text) Then mblnIsChanged = True
End Sub

Private Sub txtDiscountDay_LostFocus(Index As Integer)
   ' If Len(Trim(txtDiscountDay(Index).Text)) = 0 Then txtDiscountDay(Index).Text = 0
End Sub

Private Sub txtDiscountRate_Change(Index As Integer)
   If mblnChangeIsFirst = True Then Exit Sub
   If CheckIsRight(txtDiscountRate(Index).Text) Then mblnIsChanged = True
End Sub

Private Sub txtDiscountRate_LostFocus(Index As Integer)
   ' If Len(Trim(txtDiscountRate(Index).Text)) = 0 Then txtDiscountRate(Index).Text = 0
    If mblnIsChanged = True Then
       If Val(txtDiscountRate(Index).Text) > 100 Then
          ShowMsg 0, "折扣率" & (Index + 1) & "的范围是0-100%,请重输!", _
                     vbExclamation + MB_TASKMODAL, Me.Caption
          txtDiscountRate(Index).SetFocus
          Exit Sub
       End If
    End If
End Sub

Private Sub txtDueDay_Change()
   If mblnChangeIsFirst = True Then Exit Sub
   If DuedayIsRight(txtDueDay.Text) Then mblnIsChanged = True
End Sub

Private Sub txtDueDay_LostFocus()
  '  If Len(Trim(txtDueDay.Text)) = 0 Then txtDueDay.Text = 0
End Sub


Public Function DuedayIsRight(strChecked As String) As Boolean
    Dim n As Integer
    
    DuedayIsRight = False
    If Len(strChecked) = 0 Then Exit Function
    For n = 1 To Len(strChecked)
       If InStr(1, "1234567890", Mid(strChecked, n, 1)) = 0 Then
            SendKeys "{BS}"
            Exit Function
       End If
    Next
    If Val(strChecked) > mDays Then
       SendKeys "{BS}"
       Exit Function
    End If
    DuedayIsRight = True
End Function


Public Function CheckIsRight(strChecked As String) As Boolean
    Dim n As Integer
    
    CheckIsRight = False
    If Len(strChecked) = 0 Then Exit Function
    If Not ChickIsRight(strChecked) Then Exit Function
    If Val(strChecked) > 100 Then
       SendKeys "{BS}"
       Exit Function
    End If
    If Not IsNbite(strChecked) Then
       SendKeys "{BS}"
       Exit Function
    End If
    CheckIsRight = True
End Function

Public Function IsRightTerm() As Boolean
    Dim blnIsRight As Boolean
    
    IsRightTerm = False
    
    If Val(txtDiscountDay(0).Text) > Val(txtDueDay.Text) Then
       ShowMsg 0, "优惠日1大于了到期日，请重输！", vbExclamation + MB_TASKMODAL, Me.Caption
       txtDiscountDay(0).SetFocus
       Exit Function
    End If
    If Val(txtDiscountDay(1).Text) > Val(txtDueDay.Text) Then
       ShowMsg 0, "优惠日2大于了到期日，请重输！", vbExclamation + MB_TASKMODAL, Me.Caption
       txtDiscountDay(1).SetFocus
       Exit Function
    End If
    If Val(txtDiscountDay(2).Text) > Val(txtDueDay.Text) Then
       ShowMsg 0, "优惠日3大于了到期日，请重输！", vbExclamation + MB_TASKMODAL, Me.Caption
       txtDiscountDay(2).SetFocus
       Exit Function
    End If
     
    If txtDiscountDay(0).Text <> "0" Or txtDiscountRate(0).Text <> "0" Then
       If txtDiscountDay(1).Text <> "0" Or txtDiscountRate(1).Text <> "0" Then
          If CInt(txtDiscountDay(1).Text) <= CInt(txtDiscountDay(0).Text) Or CDbl(txtDiscountRate(1).Text) >= CDbl(txtDiscountRate(0).Text) Then
             ShowMsg 0, "优惠日2小于等于了优惠日1或者折扣率2大于等于了折扣率1，请重输！", _
                        vbExclamation + MB_TASKMODAL, Me.Caption
             txtDiscountDay(1).SetFocus
             Exit Function
          ElseIf txtDiscountDay(2).Text <> "0" Or txtDiscountRate(2).Text <> "0" Then
             If CInt(txtDiscountDay(2).Text) <= CInt(txtDiscountDay(1).Text) Or CDbl(txtDiscountRate(2).Text) >= CDbl(txtDiscountRate(1).Text) Then
                ShowMsg 0, "优惠日3小于等于了优惠日2或者折扣率3大于等于了折扣率2，请重输！", _
                        vbExclamation + MB_TASKMODAL, Me.Caption
                txtDiscountDay(2).SetFocus
                Exit Function
             End If
          End If
       ElseIf txtDiscountDay(2).Text <> "0" Or txtDiscountRate(2).Text <> "0" Then
              ShowMsg 0, "优惠日2已经为0了，请重输优惠日2！", vbExclamation + MB_TASKMODAL, Me.Caption
              txtDiscountDay(1).SetFocus
              Exit Function
       End If
       
    Else
       If txtDiscountDay(1).Text <> "0" Or txtDiscountRate(1).Text <> "0" Then
          ShowMsg 0, "优惠日1已经为0了，请重输优惠日1！", _
                    vbExclamation + MB_TASKMODAL, Me.Caption
          txtDiscountDay(0).SetFocus
          Exit Function
       ElseIf txtDiscountDay(2).Text <> "0" Or txtDiscountRate(2).Text <> "0" Then
          ShowMsg 0, "优惠日2已经为0了，请重输优惠日2！", _
                     vbExclamation + MB_TASKMODAL, Me.Caption
          txtDiscountDay(1).SetFocus
          Exit Function
       End If
    End If
    IsRightTerm = True
End Function
Private Function TermIsUsed(ByVal lngID As Long) As Boolean
        TermIsUsed = True
        If CheckIDUsed("Activity", "lngtermID", lngID) Then Exit Function
        If CheckIDUsed("ARAPInit", "lngtermID", lngID) Then Exit Function
        If CheckIDUsed("ItemActivity", "lngtermID", lngID) Then Exit Function
        If CheckIDUsed("PurchaseOrder", "lngtermID", lngID) Then Exit Function
        If CheckIDUsed("SaleOrder", "lngtermID", lngID) Then Exit Function
        If CheckIDUsed("Customer", "lngtermID", lngID) Then Exit Function
        TermIsUsed = False
End Function
Public Function DelCard(ByVal lngID As Long) As Boolean
    'Dim recRecordset as rdoresultset
    Dim recRecordset As rdoResultset
    Dim strSql As String
    Dim blnDel As Boolean
    Dim intMsgReturn As Integer
    
    DelCard = False
    If frmTermList.IsShowCard = True Then
       If lngID = frmTermListCard.TermID Then
          ShowMsg 0, "不能删除当前编辑的付款条件！", vbExclamation + MB_TASKMODAL, "删除付款条件"
          frmTermListCard.Show
          Exit Function
       End If
    End If
    strSql = "Select * From term Where lngtermID = " & lngID
    'Set recRecordset = gclsBase.BaseDB.OpenRecordset(Strsql, dbOpenSnapshot)
    Set recRecordset = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    'If recRecordset.rowcount = 0 Then
    If recRecordset.RowCount = 0 Then
       Exit Function
    Else
        If TermIsUsed(lngID) Then
            ShowMsg 0, "当前选定的付款条件已经发生业务,不能删除！", _
                       vbExclamation + MB_TASKMODAL, "删除付款条件"
            Exit Function
        Else
            intMsgReturn = ShowMsg(0, "你确实要删除当前选定的付款条件吗?", _
                       vbQuestion + vbYesNo + MB_TASKMODAL, "删除付款条件")
            If intMsgReturn = vbYes Then
                strSql = "Delete From term Where lngtermID = " & lngID
                blnDel = gclsBase.ExecSQL(strSql)
                If blnDel Then
                       '发出付款条件消息
                     '  gclsSys.SendMessage CStr(Me.hwnd), Message.msgTerm
                End If
            Else
                Exit Function
            End If
        End If
    End If
    DelCard = blnDel
    recRecordset.Close
End Function