frmtermlistcard.frm

金算盘软件代码

End Function

'新增付款方式记录
Private Function InsertTerm(ByVal strCode As String, ByVal strName As String, ByVal blnIsInActive As Boolean, _
        ByVal DueDay As Integer, ByVal DiscountDay1 As Integer, ByVal DiscountRate1 As Double, _
        ByVal DiscountDay2 As Integer, ByVal DiscountRate2 As Double, ByVal DiscountDay3 As Integer, _
        ByVal DiscountRate3 As Double) As Boolean
    Dim strSql As String
    
    'Strsql = "INSERT INTO Term (strTermCode,strTermName,blnIsInActive,intDueDay, " _
        & "intDiscountDay1,dblDiscountRate1,intDiscountDay2,dblDiscountRate2,intDiscountDay3,dblDiscountRate3) " _
        & "VALUES ('" & strCode & "','" & strName & "'," & blnIsInActive & "," & DueDay & "," _
        & DiscountDay1 & "," & DiscountRate1 & "," & DiscountDay2 & "," & DiscountRate2 & "," & DiscountDay3 & "," & DiscountRate3 & ")"
    strSql = "INSERT INTO Term (strTermCode,strTermName,blnIsInActive,intDueDay, " _
        & "intDiscountDay1,dblDiscountRate1,intDiscountDay2,dblDiscountRate2,intDiscountDay3,dblDiscountRate3) " _
        & "VALUES ('" & strCode & "','" & strName & "'," & IIf(blnIsInActive, 1, 0) & "," & DueDay & "," _
        & DiscountDay1 & "," & DiscountRate1 & "," & DiscountDay2 & "," & DiscountRate2 & "," & DiscountDay3 & "," & DiscountRate3 & ")"
    InsertTerm = gclsBase.ExecSQL(strSql)
End Function

'修改付款方式记录
Private Function EditTerm(ByVal lngID As Long, ByVal strCode As String, ByVal strName As String, _
        ByVal blnIsInActive As Boolean, ByVal DueDay As Integer, ByVal DiscountDay1 As Integer, _
        ByVal DiscountRate1 As Double, ByVal DiscountDay2 As Integer, ByVal DiscountRate2 As Double, _
        ByVal DiscountDay3 As Integer, ByVal DiscountRate3 As Double) As Boolean
    
    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
    strSql = "UPDATE Term Set strTermCode = '" & strCode _
        & "', strTermName = '" & strName & "', blnIsInActive = " & IIf(blnIsInActive, 1, 0) _
        & ", 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(Optional strName As String = "")
    'Dim recRecordset as rdoresultset
    Dim recRecordset As rdoResultset
    Dim i As Integer
    
    mblnChangeIsFirst = True
    If mlngTermID > 0 Then
        '按照当前付款方式ID提取记录
        Set recRecordset = GetByTermID(mlngTermID)
        With recRecordset
            'If .rowcount = 0 Then
            If .RowCount = 0 Then
                ShowMsg 0, "当前付款条件不存在，不能修改！", _
                             vbExclamation + MB_TASKMODAL, "修改付款条件 "
                Unload Me
                Exit Sub
            Else
                txtCodeName(0).Text = !strTermCode
                txtCodeName(1).Text = !strTermName
                txtDiscountDay(0).Text = !intDiscountDay1
                txtDiscountRate(0).Text = IIf(Val(!dbldiscountrate1) < 1 And Val(!dbldiscountrate1) <> 0, "0" & !dbldiscountrate1, !dbldiscountrate1)
                txtDiscountDay(1).Text = !intDiscountDay2
                txtDiscountRate(1).Text = IIf(Val(!dbldiscountrate2) < 1 And Val(!dbldiscountrate2) <> 0, "0" & !dbldiscountrate2, !dbldiscountrate2)
                txtDiscountDay(2).Text = !intDiscountDay3
                txtDiscountRate(2).Text = IIf(Val(!dbldiscountrate3) < 1 And Val(!dbldiscountrate3) <> 0, "0" & !dbldiscountrate3, !dbldiscountrate3)
                txtDueDay.Text = !intDueDay
                chkInActive.Value = IIf(!blnIsInActive, 1, 0)
                For i = 0 To 2
                    If txtDiscountDay(i).Text = 0 Then txtDiscountDay(i).Text = ""
                    If txtDiscountRate(i).Text = 0 Then txtDiscountRate(i).Text = ""
                Next
                If txtDueDay.Text = 0 Then txtDueDay.Text = ""
            End If
        End With
        recRecordset.Close
    Else
        If txtCodeName(0).Text = "" Or txtCodeName(0).Text = "Text" Then
           txtCodeName(0).Text = ""
        Else
           txtCodeName(0).Text = GetNextCode(txtCodeName(0).Text)
        End If
        txtCodeName(1).Text = strName
        txtCodeName(0).SelStart = 0
        txtCodeName(0).SelLength = strLen(txtCodeName(0).Text)
        txtCodeName(0).SetFocus
        
        txtDiscountDay(0).Text = ""
        txtDiscountRate(0) = ""
        txtDiscountDay(1).Text = ""
        txtDiscountRate(1) = ""
        txtDiscountDay(2).Text = ""
        txtDiscountRate(2) = ""
        txtDueDay.Text = ""
        chkInActive.Value = 0
    End If
    
    mblnChangeIsFirst = False
    mblnIsChanged = False
End Sub

'显示卡片
Private Sub ShowCard(Optional intModal As Integer = 0)
    cmdOKCancel(2).Visible = (mlngTermID = 0)
    
    If Me.WindowState = 1 Then Me.WindowState = 0
    Show intModal
    
    If intModal <> vbModal Then
       Refresh
       ZOrder 0
    End If
End Sub
    

'保存卡片
Private Function SaveCard() As Boolean
    Dim blnFinish As Boolean
    Dim strSql As String
    'Dim recCode as rdoresultset
    Dim recCode As rdoResultset
    Dim i As Integer
    
    SaveCard = False
    If Trim(txtCodeName(0).Text) = "" Then
       ShowMsg 0, "付款条件编码不能为空！", vbExclamation + MB_TASKMODAL, Me.Caption
       txtCodeName(0).SetFocus
       Exit Function
    End If
    If Trim(txtCodeName(1).Text) = "" Then
       ShowMsg 0, "付款条件名称不能为空！", vbExclamation + MB_TASKMODAL, Me.Caption
       txtCodeName(1).SetFocus
       Exit Function
    End If
    If mblnIsChanged Then
        blnFinish = False
        
        txtCodeName(0).Text = Trim(txtCodeName(0).Text)
        txtCodeName(1).Text = Trim(txtCodeName(1).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 txtDueDay.Text = "" Then txtDueDay.Text = 0
        For i = 0 To 2
            If txtDiscountDay(i).Text = "" Then txtDiscountDay(i).Text = 0
            If txtDiscountRate(i).Text = "" Then txtDiscountRate(i).Text = "0"
        Next
           
       If Not IsRightTerm Then
       SaveCard = False
       Exit Function
       End If
     '  IsRightTerm
       If mlngTermID > 0 Then
            blnFinish = EditTerm(mlngTermID, txtCodeName(0).Text, txtCodeName(1).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
            strSql = "select * from term where strtermcode='" & txtCodeName(0).Text & "'"
            'Set recCode = gclsBase.BaseDB.OpenRecordset(Strsql, dbOpenForwardOnly)
            Set recCode = gclsBase.BaseDB.OpenResultset(strSql, rdOpenForwardOnly)
            'If recCode.rowcount > 0 Then
            If recCode.RowCount > 0 Then
               ShowMsg 0, "付款条件编码" & "“" & txtCodeName(0).Text & "”已经存在，请重新输入！", _
                         vbExclamation + MB_TASKMODAL, Caption
               Exit Function
            End If
            blnFinish = InsertTerm(txtCodeName(0).Text, txtCodeName(1).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.msgTerm
            mblnIsChanged = False
        End If
    Else
        blnFinish = True
    End If
    
    SaveCard = blnFinish
End Function

Private Sub cmdokcancel_Click(Index As Integer)
    Dim strSql As String
    'Dim recTerm as rdoresultset
    Dim recTerm As rdoResultset
    
    Select Case Index
           Case 0
                If SaveCard() Then
                    strSql = "select * from term order by lngtermId"
                    'Set recTerm = gclsBase.BaseDB.OpenRecordset(Strsql, dbOpenSnapshot)
                    Set recTerm = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
                    'If recTerm.rowcount > 0 Then
                    If recTerm.RowCount > 0 Then
                       recTerm.MoveLast
                       ID = recTerm!lngTermID
                    Else
                       ID = 0
                    End If
                    Unload Me
                End If
           Case 1
                Unload Me
           Case 2
                If SaveCard() Then
                    InitCard
                End If
    End Select
    
End Sub

Private Sub Form_Load()
    SetHelpID Me.hwnd, 30043 ' 35006
    If Me.WindowState = 1 Then Me.WindowState = 0
    Set cmdOKCancel(0).Picture = LoadResPicture(1001, vbResBitmap)
    Set cmdOKCancel(1).Picture = LoadResPicture(1002, vbResBitmap)
    Set cmdOKCancel(2).Picture = LoadResPicture(1004, vbResBitmap)
    Set mclsMainControl = gclsSys.MainControls.Add(Me)
    frmTermList.IsShowCard = True
    
End Sub

Private Sub Form_Paint()
    FrameBox Me.hwnd, 120, 120, 4215, 2915
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()
gclsSys.CurrFormName = Me.hwnd
    '响应消息
'    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
End Sub

'编辑卡片
Public Sub EditCard(ByVal lngID As Long, Optional intModal As Integer = 0)
    Dim intResponse As Integer
    
    cmdOKCancel(2).Default = False
    cmdOKCancel(0).Default = True
    If lngID = 0 Then
       ShowMsg 0, "付款条件不存在，不能修改！", vbExclamation + MB_TASKMODAL, "修改付款条件"