termcard.frm

金算盘软件代码

    Dim strSql As String
    
    strSql = "UPDATE Term Set strTermCode = '" & strCode _
        & "', strTermName = '" & strName & "', blnIsInActive = " & blnIsInActive _
        & ", intDueDay = " & DueDay & ", intDiscountDay1 = " & DiscountDay1 _
        & ", dblDiscountRate1 = " & DiscountRate1 & ", intDiscountDay2 = " & DiscountDay2 _
        & ", dblDiscountRate2 = " & DiscountRate2 & ", intDiscountDay3 = " & DiscountDay3 _
        & ", dblDiscountRate3 = " & DiscountRate3 _
        & " WHERE lngTermID = " & lngID
    
    EditTerm = gclsBase.ExecSQL(strSql)
End Function
'返回卡片当前对应的付款方式ID
Public Property Get TermID() As Long
    TermID = mlngTermID
End Property

'初始化卡片
Private Sub InitCard()
    Dim recRecordset As Recordset
    
    If mlngTermID > 0 Then
        '按照当前付款方式ID提取记录
        Set recRecordset = GetByTermID(mlngTermID)
        With recRecordset
            If .RecordCount = 0 Then
                MsgBox "当前付款方式已被其它用户删除！", vbExclamation
                
                Unload Me
            Else
                txtCode.Text = !strTermCode
                txtName.Text = !strTermName
                txtDiscountDay(0).Text = !intDiscountDay1
                txtDiscountRate(0).Text = !dblDiscountRate1
                txtDiscountDay(1).Text = !intDiscountDay2
                txtDiscountRate(1).Text = !dblDiscountRate2
                txtDiscountDay(2).Text = !intDiscountDay3
                txtDiscountRate(2).Text = !dblDiscountRate3
                txtDueDay.Text = !intDueDay
                chkInActive.Value = IIf(!blnIsInActive, 1, 0)
            End If
        End With
        recRecordset.Close
    Else
        txtCode.Text = ""
        txtName.Text = ""
        txtDiscountDay(0) = "0"
        txtDiscountRate(0) = "0"
        txtDiscountDay(1) = "0"
        txtDiscountRate(1) = "0"
        txtDiscountDay(2) = "0"
        txtDiscountRate(2) = "0"
        txtDueDay.Text = "0"
        chkInActive.Value = 0
    End If
    
    'txtCode.SetFocus
    
    mblnIsChanged = False
End Sub

'显示卡片
Private Sub ShowCard()
    cmdNext.Visible = (mlngTermID = 0)
    
'    If mlngTermID = 0 Then
'        chkInActive.Top = cmdNext.Top + cmdNext.Height + CardFormButtonCheckBox
'    Else
'        chkInActive.Top = cmdCancel.Top + cmdCancel.Height + CardFormButtonCheckBox
'    End If
    
 '  chkInActive.Top = Me.Height - 2 * chkInActive.Height - CardFormButtonCheckBox
    Show
    Refresh
    ZOrder 0
End Sub
    

'保存卡片
Private Function SaveCard() As Boolean
    Dim blnFinish As Boolean
    
    If mblnIsChanged Then
        blnFinish = False
        
        txtCode.Text = Trim(txtCode.Text)
        txtName.Text = Trim(txtName.Text)
        txtDueDay.Text = Trim(txtDueDay.Text)
        txtDiscountDay(0).Text = Trim(txtDiscountDay(0).Text)
        txtDiscountRate(0).Text = Trim(txtDiscountRate(0).Text)
        txtDiscountDay(1).Text = Trim(txtDiscountDay(1).Text)
        txtDiscountRate(1).Text = Trim(txtDiscountRate(1).Text)
        txtDiscountDay(2).Text = Trim(txtDiscountDay(2).Text)
        txtDiscountRate(2).Text = Trim(txtDiscountRate(2).Text)
       'If Not IsRightTerm Then
       'SaveCard = False
       'Exit Function
       'End If
       IsRightTerm
       If mlngTermID > 0 Then
            blnFinish = EditTerm(mlngTermID, txtCode.Text, txtName.Text, (chkInActive.Value = 1), CInt(txtDueDay.Text), _
                    CInt(txtDiscountDay(0).Text), CDbl(txtDiscountRate(0).Text), CInt(txtDiscountDay(1).Text), _
                    CDbl(txtDiscountRate(1).Text), CInt(txtDiscountDay(2).Text), CDbl(txtDiscountRate(2).Text))
        Else
            blnFinish = InsertTerm(txtCode.Text, txtName.Text, (chkInActive.Value = 1), CInt(txtDueDay.Text), _
                    CInt(txtDiscountDay(0).Text), CDbl(txtDiscountRate(0).Text), CInt(txtDiscountDay(1).Text), _
                    CDbl(txtDiscountRate(1).Text), CInt(txtDiscountDay(2).Text), CDbl(txtDiscountRate(2).Text))
        End If
        
        If blnFinish Then
            '发出付款方式消息
            gclsSys.SendMessage CStr(Me.hwnd), Message.msgPaymentMethod
            
            mblnIsChanged = False
        End If
    Else
        blnFinish = True
    End If
    
    SaveCard = blnFinish
End Function

Private Sub cmdOk_Click()
    If SaveCard() Then
        Unload Me
    Else
        MsgBox "付款条件编码或名称不能为空", vbCritical, App.Title
        txtCode.SetFocus
    End If
End Sub

Private Sub cmdCancel_Click()
    Unload Me
End Sub

Private Sub cmdNext_Click()
    If SaveCard() Then
        InitCard
    Else
        MsgBox "付款条件编码或名称不能为空", vbCritical, App.Title
        txtCode.SetFocus
    End If
End Sub

Private Sub Form_Load()
   
    Set mclsMainControl = gclsSys.MainControls.Add(Me)
    frmTermList.IsShowCard = True
     Me.Width = intFormWidth
    Me.Height = intFormHeight
End Sub

Private Sub Form_Paint()
    FrameBox Me.hwnd, 50, 200, 4000, 2950
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
    Dim intResponse As Integer
    
    If mblnIsChanged Then
        intResponse = MsgBox("当前付款方式已被修改，是否保存？", vbYesNoCancel)
        If intResponse = vbYes Then
            Cancel = Not SaveCard()
        ElseIf intResponse = vbCancel Then
            Cancel = True
        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 mlngTermID > 0 Then
                InitCard
            End If
            mclsMainControl.Messages.Remove CStr(vntMessage)
        End If
    Next
    
    With frmMain
        .mnuEditCopy.Enabled = True
        .mnuEditEdit.Enabled = True
        .mnuEditNew.Enabled = True
        .mnuEditDel.Enabled = True
        .mnuEditInActive.Enabled = True
        .mnuToolRefresh.Enabled = True
        .mnuFilePrint.Enabled = True
    End With
End Sub

'编辑卡片
Public Sub EditCard(ByVal lngID As Long)
    Dim intResponse As Integer
    
    '设置当前付款方式ID
    If mblnIsChanged Then
        If lngID <> mlngTermID Then
            intResponse = MsgBox("当前付款方式已被修改，是否保存？", vbYesNoCancel)
            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
    
    '显示卡片
    ShowCard
End Sub

'新增卡片
Public Sub NewCard()
    Dim intResponse As Integer
    
    '设置当前付款方式ID
    If mblnIsChanged Then
        If mlngTermID <> 0 Then
            intResponse = MsgBox("当前付款方式已被修改，是否保存？", vbYesNoCancel)
            If intResponse = vbYes Then
                If SaveCard() Then
                    mlngTermID = 0
                    
                    InitCard
                    Me.Caption = "新增卡片"
                End If
            ElseIf intResponse = vbNo Then
                mlngTermID = 0
                
                InitCard
                Me.Caption = "新增卡片"
            End If
        End If
    Else
        mlngTermID = 0
        
        InitCard
        Me.Caption = "新增卡片"
    End If
    
    '显示卡片
    ShowCard
End Sub


Private Sub chkInActive_Click()
    mblnIsChanged = True
End Sub

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

Private Sub txtCode_Change()
    mblnIsChanged = True
End Sub

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

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

Private Sub txtDueDay_Change()
   If CheckIsRight(txtDueDay.Text) Then mblnIsChanged = True
End Sub

Private Sub txtName_Change()
    mblnIsChanged = True
End Sub


Private Sub VScroll1_Change(Index As Integer)
    Select Case Index
        Case 0
            txtDiscountDay(0).Text = VScroll1(0).Value
        Case 1
        
            txtDiscountDay(1).Text = VScroll1(1).Value
        Case 2
            txtDiscountDay(2).Text = VScroll1(2).Value
        Case 3
            txtDueDay.Text = VScroll1(3).Value
    End Select
End Sub

Public Function CheckIsRight(strChecked As String) As Boolean
    Dim n As Integer
    CheckIsRight = False
    If Left(strChecked, 1) = "." Then
        SendKeys "{BS}"
        Exit Function
    End If
    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
    CheckIsRight = True
End Function

Public Function IsRightTerm() As Boolean
    Dim blnIsRight As Boolean
    If txtDiscountDay(0) = "0" Or txtDiscountRate(0) = "0" Or CDbl(txtDiscountRate(0)) > 100 Then
        txtDiscountDay(0) = "0"
        txtDiscountRate(0) = "0"
        txtDiscountDay(1) = "0"
        txtDiscountRate(1) = "0"
        txtDiscountRate(2) = "0"
        txtDiscountRate(2) = "0"
        blnIsRight = False
    ElseIf txtDiscountDay(1) = "0" Or txtDiscountRate(1) = "0" _
            Or CInt(txtDiscountDay(1)) < CInt(txtDiscountDay(0)) Or CDbl(txtDiscountRate(1)) > CDbl(txtDiscountRate(0)) Or CDbl(txtDiscountRate(1)) > 100 Then
        txtDiscountDay(1) = "0"
        txtDiscountRate(1) = "0"
        txtDiscountRate(2) = "0"
        txtDiscountRate(2) = "0"
        blnIsRight = False
    ElseIf CInt(txtDiscountDay(2)) < CInt(txtDiscountDay(1)) Or CDbl(txtDiscountRate(2)) > CDbl(txtDiscountRate(1)) Or CDbl(txtDiscountRate(2)) > 100 Then
        txtDiscountRate(2) = "0"
        txtDiscountRate(2) = "0"
        blnIsRight = False
    End If
    IsRightTerm = blnIsRight
    
End Function