frmtermedit.frm

金算盘软件代码

        ByVal DiscountDay2 As Integer, ByVal DiscountRate2 As Double, ByVal DiscountDay3 As Integer, _
        ByVal DiscountRate3 As Double) As Boolean
    Dim strSql As String
    
    ID = GetNewID("Term")
    strSql = "INSERT INTO Term (lngTermID,strTermCode,strTermName,blnIsInActive,intDueDay, " _
        & "intDiscountDay1,dblDiscountRate1,intDiscountDay2,dblDiscountRate2,intDiscountDay3,dblDiscountRate3) " _
        & "VALUES(" & ID & ",'" & 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 = " & 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 i As Integer
    
    mblnChangeIsFirst = True
    If mlngTermID > 0 Then
        '按照当前付款方式ID提取记录
        Set recRecordset = GetByTermID(mlngTermID)
        With recRecordset
            If .RowCount = 0 Then
                ShowMsg 0, "当前付款条件不存在，不能修改！", _
                             vbExclamation + MB_TASKMODAL, "修改付款条件 "
                Unload Me
                Exit Sub
            Else
                txtCodeName(0).Text = !strTermCode
                txtCodeName(1).Text = !strTermName
                
                txtDiscountRate(0).Text = Format(!dbldiscountrate1, "###,###,###.#0")
                txtDiscountRate(1).Text = Format(!dbldiscountrate2, "###,###,###.#0")
                txtDiscountRate(2).Text = Format(!dbldiscountrate3, "###,###,###.#0")
                txtDiscountRate(0).Text = IIf(Val(txtDiscountRate(0).Text) < 1 And Val(txtDiscountRate(0).Text) <> 0, "0" & txtDiscountRate(0).Text, txtDiscountRate(0).Text)
                txtDiscountRate(1).Text = IIf(Val(txtDiscountRate(1).Text) < 1 And Val(txtDiscountRate(1).Text) <> 0, "0" & txtDiscountRate(1).Text, txtDiscountRate(1).Text)
                txtDiscountRate(2).Text = IIf(Val(txtDiscountRate(2).Text) < 1 And Val(txtDiscountRate(2).Text) <> 0, "0" & txtDiscountRate(2).Text, txtDiscountRate(2).Text)
                
                txtDiscountDay(0).Text = !intDiscountDay1
                txtDiscountDay(1).Text = !intDiscountDay2
                txtDiscountDay(2).Text = !intDiscountDay3
                txtDueDay.Text = !intDueDay
                chkInActive.Value = !blnIsInActive
                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(0).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 UnionTerm(ByVal lngOldID As Long, ByVal lngNewID As Long) As Boolean
    Dim strSql As String
    
    UnionTerm = False
    strSql = "update Activity set lngtermID=" & lngNewID & _
           " where lngtermid=" & lngOldID
    If Not gclsBase.ExecSQL(strSql) Then Exit Function
    
    strSql = "update ARAPInit set lngtermID=" & lngNewID & _
           " where lngtermid=" & lngOldID
    If Not gclsBase.ExecSQL(strSql) Then Exit Function
    
    strSql = "update ItemActivity set lngtermID=" & lngNewID & _
           " where lngtermid=" & lngOldID
    If Not gclsBase.ExecSQL(strSql) Then Exit Function
    
    strSql = "update PurchaseOrder set lngtermID=" & lngNewID & _
           " where lngtermid=" & lngOldID
    If Not gclsBase.ExecSQL(strSql) Then Exit Function
    
    strSql = "update SaleOrder set lngtermID=" & lngNewID & _
           " where lngtermid=" & lngOldID
    If Not gclsBase.ExecSQL(strSql) Then Exit Function
    
    strSql = "update Customer set lngtermID=" & lngNewID & _
           " where lngtermid=" & lngOldID
    If Not gclsBase.ExecSQL(strSql) Then Exit Function
    
    strSql = "delete from term where lngtermid=" & lngOldID
    If Not gclsBase.ExecSQL(strSql) Then Exit Function
    UnionTerm = True
End Function
'保存卡片
Private Function SaveCard() As Boolean
    Dim blnFinish As Boolean
    Dim strSql As String
    Dim recCode As rdoResultset
    Dim i As Integer
    Dim msgReturn As Integer
    
    SaveCard = False
    If Trim(txtCodeName(0).Text) = "" Then
       ShowMsg 0, "付款条件编码不能为空！", vbExclamation + MB_TASKMODAL, Me.Caption
       txtCodeName(0).SetFocus
       Exit Function
    ElseIf InStr(txtCodeName(0).Text, "'") <> 0 Then
       ShowMsg 0, "付款条件编码不能为‘'’！", vbExclamation + MB_TASKMODAL, Me.Caption
       txtCodeName(0).SetFocus
       Exit Function
    ElseIf InStr(txtCodeName(0).Text, "|") <> 0 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 Trim(txtDiscountRate(0).Text) <> "" Then
       If Trim(txtDiscountDay(0).Text) = "" Then
          ShowMsg 0, "折扣率不为空时,优惠日也不能为空！", vbExclamation + MB_TASKMODAL, Me.Caption
          txtDiscountDay(0).SetFocus
          Exit Function
       End If
    End If
    If Not IsRightTerm Then
       SaveCard = False
       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)
'        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 txtDueDay.Text = "" Then txtDueDay.Text = 0
       
     '  IsRightTerm
       If mlngTermID > 0 Then
          strSql = "select * from term where strtermcode='" & txtCodeName(0).Text & "'" & _
                   " and  lngtermID<>" & mlngTermID
           Set recCode = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
           If Not recCode.EOF Then
              ShowMsg 0, "付款条件编码" & "“" & txtCodeName(0).Text & "”已经存在，请重新输入！", _
                         vbExclamation + MB_TASKMODAL, Caption
              txtCodeName(0).SetFocus
              Exit Function
           End If
            
          blnFinish = EditTerm(mlngTermID, txtCodeName(0).Text, txtCodeName(1).Text, _
                       (chkInActive.Value = 1), C2lng(Trim(txtDueDay.Text)), _
                       C2lng(Trim(txtDiscountDay(0).Text)), TxtToDouble(Trim(txtDiscountRate(0).Text)), _
                       C2lng(Trim(txtDiscountDay(1).Text)), TxtToDouble(Trim(txtDiscountRate(1).Text)), _
                       C2lng(Trim(txtDiscountDay(2).Text)), TxtToDouble(Trim(txtDiscountRate(2).Text)))
       
       Else
            strSql = "select * from term where strtermcode='" & txtCodeName(0).Text & "'"
            Set recCode = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
            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), C2lng(Trim(txtDueDay.Text)), _
                        C2lng(txtDiscountDay(0).Text), TxtToDouble(Trim(txtDiscountRate(0).Text)), _
                        C2lng(Trim(txtDiscountDay(1).Text)), TxtToDouble(Trim(txtDiscountRate(1).Text)), _
                        C2lng(Trim(txtDiscountDay(2).Text)), TxtToDouble(Trim(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
    
    Select Case Index
           Case 0
                If SaveCard() Then
'                    strSql = "select * from term order by lngtermId"
'                    Set recTerm = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
'                    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
                    txtCodeName(0).SetFocus
                End If
    End Select
    
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