frmtermedit.frm

金算盘软件代码

Private Sub Form_KeyUp(KeyCode As Integer, Shift As Integer)
    If KeyCode = vbKeyReturn And Shift = 2 Then
        cmdOkCancel(0).Value = True
    End If
End Sub

Private Sub Form_Load()
    On Error GoTo ErrHandle
'    SetHelpID Me.hwnd, 30043 ' 35006
    If Me.WindowState = 1 Then Me.WindowState = 0
    Utility.LoadFormResPicture Me
'    SendKeys "%{C}"
    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 Me.hwnd, 150, 140, 4200, 2945
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(Me.hwnd, "当前付款方式已被修改，是否保存？", _
                     vbQuestion + vbYesNoCancel + MB_TASKMODAL, Caption)
          If intResponse = vbYes Then
             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()
    SetHelpID Me.HelpContextID
End Sub

'编辑卡片
Public Sub EditCard(ByVal lngID As Long, Optional intModal As Integer = 0)
    Dim intResponse As Integer
    
    If lngID = 0 Then
       ShowMsg 0, "付款条件不存在，不能修改！", vbExclamation + MB_TASKMODAL, "修改付款条件"
       Unload frmTermCard
       Exit Sub
    End If
    mlngTermID = lngID
    InitCard
    Me.Caption = "修改付款条件"
    If Me.WindowState = 1 Then Me.WindowState = 0
    ShowCard 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
    
    mlngTermID = 0
    Me.Caption = "新增付款条件"
    mblnIsList = IsList
    InitCard (strName)
    ShowCard 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 txtCodeName_Change(Index As Integer)
    If mblnChangeIsFirst = True Then Exit Sub
    If ContainErrorChar(txtCodeName(Index).Text, "'|") Then
       BKKEY txtCodeName(Index).hwnd
       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_KeyPress(Index As Integer, KeyAscii As Integer, bCancel As Long)
    If KeyAscii = vbKeyReturn Then BKKEY txtDiscountDay(Index).hwnd, vbKeyTab
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 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
       txtDiscountRate(Index).Text = Format(txtDiscountRate(Index).Text, "###,###,###.#0")
       txtDiscountRate(Index).Text = IIf(Val(txtDiscountRate(Index).Text) < 1, "0" & txtDiscountRate(Index).Text, txtDiscountRate(Index).Text)
       If Val(txtDiscountRate(Index).Text) = 0 Then txtDiscountRate(Index).Text = ""
    End If
End Sub

Private Sub txtDueDay_Change()
   If mblnChangeIsFirst = True Then Exit Sub
   If DuedayIsRight(txtDueDay.Text) Then mblnIsChanged = True
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
       CheckIsRight = True
       Exit Function
    End If
    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

Private Function C2lng(ByVal strText As String) As Long
    C2lng = IIf(IsNumeric(strText), Val(strText), 0)
End Function
Public Function IsRightTerm() As Boolean
    Dim blnIsRight As Boolean
    
    IsRightTerm = False
    
    If C2lng(txtDiscountDay(0).Text) > C2lng(txtDueDay.Text) Then
       ShowMsg 0, "优惠日1大于了到期日，请重输！", vbExclamation + MB_TASKMODAL, Me.Caption
       txtDiscountDay(0).SetFocus
       Exit Function
    End If
    If C2lng(txtDiscountDay(1).Text) > C2lng(txtDueDay.Text) Then
       ShowMsg 0, "优惠日2大于了到期日，请重输！", vbExclamation + MB_TASKMODAL, Me.Caption
       txtDiscountDay(1).SetFocus
       Exit Function
    End If
    If C2lng(txtDiscountDay(2).Text) > C2lng(txtDueDay.Text) Then
       ShowMsg 0, "优惠日3大于了到期日，请重输！", vbExclamation + MB_TASKMODAL, Me.Caption
       txtDiscountDay(2).SetFocus
       Exit Function
    End If
     
    If C2lng(txtDiscountDay(0).Text) <> "0" Or C2lng(txtDiscountRate(0).Text) <> "0" Then
       If C2lng(txtDiscountDay(1).Text) <> "0" Or C2lng(txtDiscountRate(1).Text) <> "0" Then
          If C2lng(txtDiscountDay(1).Text) <= C2lng(txtDiscountDay(0).Text) Or C2lng(txtDiscountRate(1).Text) >= C2lng(txtDiscountRate(0).Text) Then
             ShowMsg 0, "优惠日2小于等于了优惠日1或者折扣率2大于等于了折扣率1，请重输！", _
                        vbExclamation + MB_TASKMODAL, Me.Caption
             txtDiscountDay(1).SetFocus
             Exit Function
          ElseIf C2lng(txtDiscountDay(2).Text) <> "0" Or C2lng(txtDiscountRate(2).Text) <> "0" Then
             If C2lng(txtDiscountDay(2).Text) <= C2lng(txtDiscountDay(1).Text) Or C2lng(txtDiscountRate(2).Text) >= C2lng(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 C2lng(txtDiscountDay(2).Text) <> "0" Or C2lng(txtDiscountRate(2).Text) <> "0" Then
              ShowMsg 0, "优惠日2已经为0了，请重输优惠日2！", vbExclamation + MB_TASKMODAL, Me.Caption
              txtDiscountDay(1).SetFocus
              Exit Function
       End If
       
    Else
       If C2lng(txtDiscountDay(1).Text) <> "0" Or C2lng(txtDiscountRate(1).Text) <> "0" Then
          ShowMsg 0, "优惠日1已经为0了，请重输优惠日1！", _
                    vbExclamation + MB_TASKMODAL, Me.Caption
          txtDiscountDay(0).SetFocus
          Exit Function
       ElseIf C2lng(txtDiscountDay(2).Text) <> "0" Or C2lng(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, 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
    strSql = "Select * From term Where lngtermID = " & lngID
    Set recRecordset = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    If recRecordset.RowCount = 0 Then
       Exit Function
    Else
        If TermIsUsed(lngID) Then
            ShowMsg lnghWnd, "当前选定的付款条件已经发生业务,不能删除！", _
                       vbExclamation + MB_TASKMODAL, "删除付款条件"
            Exit Function
        Else
            intMsgReturn = ShowMsg(lnghWnd, "你确实要删除当前选定的付款条件吗?", _
                       vbQuestion + vbYesNo + MB_TASKMODAL, "删除付款条件")
            If intMsgReturn = vbYes Then
                strSql = "Delete From term Where lngtermID = " & lngID
                blnDel = gclsBase.ExecSQL(strSql)
                If blnDel Then
                       '发出付款条件消息
                    If Not blnFromList 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

Private Sub txtDueDay_KeyPress(KeyAscii As Integer, bCancel As Long)
'    If KeyAscii = vbKeyReturn Then txtDueDay.hwnd , vbKeyTab
End Sub