frmcustomercard.frm

金算盘软件代码

      TabIndex        =   76
      Tag             =   "1001"
      Top             =   450
      UseMaskColor    =   -1  'True
      Width           =   1215
   End
   Begin VB.CommandButton cmdOKCancel 
      Height          =   350
      Index           =   2
      Left            =   6120
      Style           =   1  'Graphical
      TabIndex        =   78
      Tag             =   "1009"
      Top             =   1245
      UseMaskColor    =   -1  'True
      Width           =   1215
   End
   Begin VB.CommandButton cmdOKCancel 
      Height          =   350
      Index           =   3
      Left            =   6120
      Style           =   1  'Graphical
      TabIndex        =   79
      Tag             =   "1013"
      Top             =   1650
      UseMaskColor    =   -1  'True
      Width           =   1215
   End
   Begin VB.CheckBox chkPause 
      Caption         =   "停用"
      Height          =   195
      Left            =   6120
      TabIndex        =   80
      Top             =   4290
      Width           =   975
   End
End
Attribute VB_Name = "frmCustomerCard"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'  单位卡片
'  作者：苏涛
'  日期：1998.06.25
'
'  功能：完成单位表的增、删、改操作
'
'  接口： AddCard   增加单位记录。
'                   参数：intModal 显示模式，strName 用户输入值
'         EditCard  修改单位记录。
'                   参数： lngRecordID 被修改的记录的ID，intModal 显示模式
'         DelCard   删除单位记录。
'                   参数： lngRecordID 被删除的记录的ID
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Option Explicit

Private mblnIsChanged As Boolean
Private mblnIsList As Boolean
Private mblnIsExist As Boolean
Private mblnIsInit As Boolean
Private mblnIsRefer As Boolean
Private mlngLstID(7) As Long
Private mclsGridBank As Grid
Private mblnBankAdd As Boolean                    '开户银行是新增还是修改
Private mintBankRow As Integer                    '选中的开户银行记录的行号
Private mclsGridAddress As Grid                   '主控对象
Private mintAddressRow As Integer                 '选中的发货地址记录的行号
Private mblnAddressAdd As Boolean                 '发货地址是新增还是修改
Private mblnIsNew As Boolean             '是增加记录还是修改记录
Private mlngCustomerID As Long
Private mlngDCustomerID As Long
Private mstrCustomer As String
Private mstrNotes As String
'直接增加单位
Public Function AddCustomer(ByVal strCustomer As String) As Integer
    Dim blnIsStop As Boolean
    Dim dblCreditLimit As Double, dblDiscountRate As Double
    Dim intCategory As Integer
    Dim lngAreaID As Long, lngCustomerTypeID As Long
    Dim lngEmployeeID As Long, lngTermID As Long
    Dim lngTitleID As Long, lngARAccountID As Long
    Dim lngAPAccountID As Long
    Dim strCode As String, strName As String
    Dim strContactName As String, strOfficePhoneNumber As String
    Dim strHomePhoneNumber As String, strFaxNumber As String
    Dim strEMail As String, strTaxNO As String
    Dim strBillToAddress As String, strBillToPostalCode As String
    Dim strTemp As String, strCreateDate As String, strCloseDate As String
    
    On Error GoTo ErrHandle
    AddCustomer = 0
    If Not GetString(strCustomer, strCode, 1) Then Exit Function
    If Not GetString(strCustomer, strName, 2) Then Exit Function
    If Not GetString(strCustomer, strTemp, 3) Then Exit Function
    intCategory = CInt(strTemp)
    If Not GetString(strCustomer, strTemp, 4) Then Exit Function
    lngCustomerTypeID = CLng(strTemp)
    If Not GetString(strCustomer, strTemp, 5) Then Exit Function
    lngTermID = CLng(strTemp)
    If Not GetString(strCustomer, strTemp, 6) Then Exit Function
    dblCreditLimit = CDbl(strTemp)
    If Not GetString(strCustomer, strTemp, 7) Then Exit Function
    dblDiscountRate = CDbl(strTemp)
    If Not GetString(strCustomer, strTemp, 8) Then Exit Function
    lngEmployeeID = CLng(strTemp)
    If Not GetString(strCustomer, strTemp, 9) Then Exit Function
    lngAreaID = CLng(strTemp)
    If Not GetString(strCustomer, strContactName, 10) Then Exit Function
    If Not GetString(strCustomer, strTemp, 11) Then Exit Function
    lngTitleID = CLng(strTemp)
    If Not GetString(strCustomer, strOfficePhoneNumber, 12) Then Exit Function
    If Not GetString(strCustomer, strHomePhoneNumber, 13) Then Exit Function
    If Not GetString(strCustomer, strFaxNumber, 14) Then Exit Function
    If Not GetString(strCustomer, strEMail, 15) Then Exit Function
    If Not GetString(strCustomer, strTaxNO, 16) Then Exit Function
    If Not GetString(strCustomer, strBillToAddress, 17) Then Exit Function
    If Not GetString(strCustomer, strBillToPostalCode, 18) Then Exit Function
    If Not GetString(strCustomer, mstrNotes, 19) Then Exit Function
    If Not GetString(strCustomer, strTemp, 20) Then Exit Function
    lngARAccountID = CLng(strTemp)
    If Not GetString(strCustomer, strTemp, 21) Then Exit Function
    lngAPAccountID = CLng(strTemp)
    If Not GetString(strCustomer, strTemp, 22) Then Exit Function
    blnIsStop = (strTemp = "1")
    If Not GetString(strCustomer, strCreateDate, 24) Then Exit Function
    If Not GetString(strCustomer, strCloseDate, 25) Then Exit Function
    
    If strCode = "" Or strName = "" Then Exit Function
    If ItemIsExist("CustomerType", "lngCustomerTypeID", lngCustomerTypeID) Then
        mlngLstID(0) = lngCustomerTypeID
    Else
        Exit Function
    End If
    If intCategory < 1 Or intCategory > 4 Then Exit Function
    CboCustomer.Clear
    CboCustomer.AddItem "供应商", 0
    CboCustomer.AddItem "客户", 1
    CboCustomer.AddItem "供销", 2
    CboCustomer.AddItem "其它", 3
    CboCustomer.ListIndex = intCategory - 1
    mblnIsNew = True
    If ItemIsExist("Area", "lngAreaID", lngAreaID) Then
        mlngLstID(1) = lngAreaID
    Else
        mlngLstID(1) = 0
    End If
    If ItemIsExist("Term", "lngTermID", lngTermID) Then
        mlngLstID(2) = lngTermID
    Else
        mlngLstID(2) = 0
    End If
    If ItemIsExist("Title", "lngTitleID", lngTitleID) Then
        mlngLstID(3) = lngTitleID
    Else
        mlngLstID(3) = 0
    End If
    If ItemIsExist("Employee", "lngEmployeeID", lngEmployeeID) Then
        mlngLstID(4) = lngEmployeeID
    Else
        mlngLstID(4) = 0
    End If
    If ItemIsExist("Account", "lngAccountID", lngARAccountID) Then
        mlngLstID(5) = lngARAccountID
    Else
        mlngLstID(5) = 0
    End If
    If ItemIsExist("Account", "lngAccountID", lngAPAccountID) Then
        mlngLstID(6) = lngAPAccountID
    Else
        mlngLstID(6) = 0
    End If
    txtInput(0).Text = strCode
    txtInput(1).Text = strName
    txtInput(2).Text = strTaxNO
    txtInput(3).Text = dblDiscountRate
    txtInput(4).Text = dblCreditLimit
    txtInput(5).Text = strEMail
    txtInput(6).Text = strBillToAddress
    txtInput(7).Text = strContactName
    txtInput(8).Text = strOfficePhoneNumber
    txtInput(9).Text = strHomePhoneNumber
    txtInput(10).Text = strFaxNumber
    txtInput(11).Text = strBillToPostalCode
    chkPause.Value = IIf(blnIsStop, 1, 0)
    dteInput(0).Text = Trim(strCreateDate)
    dteInput(1).Text = Trim(strCloseDate)
    If Not SaveCard(True) Then Exit Function
    AddCustomer = 1
ErrHandle:
End Function

Public Property Get getID()
    getID = mlngCustomerID
End Property

'进入新增单位
Public Function AddCard(Optional strName As String = "", Optional intModal As Integer = 0, _
    Optional ByVal IsList As Boolean = False) As Long
    
    mblnIsNew = True
    mblnIsChanged = True
    mlngCustomerID = 0
    frmCustomerCard.Caption = "新增往来单位"
'    cmdOKCancel(2).Default = True
    cmdOKCancel(2).Visible = True
    mblnIsList = IsList
    InitCard 0, strName
    Show intModal
    AddCard = mlngCustomerID
End Function

'检查录入 1--正确  -1--编码重复  -2--名称重复
Private Function CodeCheck(strName As String) As Integer
    Dim recCustomer As rdoResultset, strSql As String
    
    strSql = "SELECT * FROM Customer WHERE (strCustomerCode='" & txtInput(0).Text _
        & "' Or strCustomerName='" & txtInput(1).Text & "') AND lngCustomerID <>" _
        & IIf(mblnIsNew, 0, mlngCustomerID)
    Set recCustomer = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    If Not recCustomer.EOF Then
        If recCustomer!strCustomerCode = txtInput(0).Text Then
            CodeCheck = -1
            mlngDCustomerID = recCustomer!lngCustomerID
        ElseIf recCustomer!strCustomerName = txtInput(1).Text Then
            CodeCheck = -2
        End If
        strName = recCustomer!strCustomerCode & " " & recCustomer!strCustomerName
    Else
        CodeCheck = 1
    End If
    recCustomer.Close
End Function

Private Sub InitAddressGrid(ByVal lngID As Long)
    Dim i As Integer, strSql As String
    
    mintAddressRow = 0
    msgAddress.Cols = 0
    strSql = "SELECT CustomerAddress.lngCustomerAddressID," _
        & "CustomerAddress.strCustomerAddressCode ""收发地址编码""," _
        & "CustomerAddress.strCustomerAddressName ""收发地址名称""," _
        & "CustomerAddress.strAddress ""收发地址""," _
        & "CustomerAddress.strEMail ""电子信箱""," _
        & "CustomerAddress.strContactName ""联系人""," _
        & "Title.strTitleName ""职务""," _
        & "Title.lngTitleID," _
        & "CustomerAddress.strOfficePhoneNumber ""办公电话""," _
        & "CustomerAddress.strHomePhoneNumber ""住宅电话""," _
        & "CustomerAddress.strFaxNumber ""传真""," _
        & "CustomerAddress.strPostalCode ""邮编"" " _
        & " FROM CustomerAddress,Title" _
        & " WHERE CustomerAddress.lngTitleID=Title.lngTitleID(+) AND " _
        & "CustomerAddress.lngCustomerID=" & lngID
    Set datCustomer(1).Resultset = gclsBase.BaseDB.OpenResultset _
        (strSql, rdOpenStatic)
    If datCustomer(1).Resultset.EOF Then
        msgAddress.Rows = 2
        msgAddress.RowHeight(1) = 0
        msgAddress.TextMatrix(1, 0) = 0
        msgAddress.RowData(1) = -2
    End If
    mblnAddressAdd = True
    msgAddress.ColWidth(0) = 0
    msgAddress.ColWidth(1) = 1170
    msgAddress.ColWidth(2) = 1170
    msgAddress.ColWidth(3) = 810
    msgAddress.ColWidth(4) = 810
    msgAddress.ColWidth(5) = 810
    msgAddress.ColWidth(6) = 810
    msgAddress.ColWidth(7) = 0
    msgAddress.ColWidth(8) = 900
    msgAddress.ColWidth(9) = 900
    msgAddress.ColWidth(10) = 900
    msgAddress.ColWidth(11) = 900
    For i = 1 To msgAddress.Cols - 1
        msgAddress.FixedAlignment(i) = flexAlignCenterCenter
    Next i
    mclsGridAddress.SetupStyle
End Sub

Private Sub InitBankGrid(ByVal lngID As Long)
    Dim strSql As String
    
    mintBankRow = 0
    msgBank.Cols = 0
    strSql = "SELECT lngCustomerBankID,strBankName ""开户银行名称""," _
        & "strAccountNO ""开户银行帐号"" FROM CustomerBank" _
        & " WHERE lngCustomerID=" & lngID
    Set datCustomer(0).Resultset = gclsBase.BaseDB.OpenResultset _
        (strSql, rdOpenStatic)
    If datCustomer(0).Resultset.EOF Then
        msgBank.Rows = 2
        msgBank.RowHeight(1) = 0
        msgBank.TextMatrix(1, 0) = 0
        msgBank.RowData(1) = -2
    End If
    mblnBankAdd = True       '初始化为新增开户银行
    msgBank.ColWidth(0) = 0
    msgBank.ColWidth(1) = 2790
    msgBank.ColWidth(2) = 2430
    msgBank.FixedAlignment(1) = flexAlignCenterCenter
    msgBank.FixedAlignment(2) = flexAlignCenterCenter
    mclsGridBank.SetupStyle
End Sub

Private Sub InitCard(ByVal lngID As Long, Optional strName As String = "")
    Dim i As Integer
    Dim recCustomer As rdoResultset, strSql As String
    
    mblnIsInit = True
    mlngDCustomerID = 0
    CboCustomer.Clear
'    #If conVersionType = 16 Then
        CboCustomer.AddItem "供应商", 0
        CboCustomer.AddItem "客户", 1
        CboCustomer.AddItem "供销", 2
        CboCustomer.AddItem "其它", 3
'    #Else
'        CboCustomer.AddItem "应付", 0
'        CboCustomer.AddItem "应收", 1
'        CboCustomer.AddItem "应收应付", 2
'    #End If
    cmdDelete(0).Enabled = False
    cmdDelete(1).Enabled = False
    If mblnIsNew Then
        For i = 1 To 22
            If i < 8 And i > 0 Then
                mlngLstID(i) = 0
                lstCustomer(i).Text = ""
            End If
            txtInput(i).Text = ""
        Next i
        txtInput(0).Text = Trim(strName)
        txtInput(3).Text = 100
        chkPause.Value = Unchecked
        CboCustomer.ListIndex = 2
        dteInput(0).Value = gclsBase.BaseDate
        mstrCustomer = ""
        mstrNotes = ""
    Else
        strSql = "SELECT * FROM CUSTOMERVIEW WHERE CUSTOMERVIEW.lngCustomerID=" & mlngCustomerID
        Set recCustomer = gclsBase.BaseDB.OpenResultset(strSql, rdOpenForwardOnly)
        With recCustomer
        txtInput(0).Text = !strCustomerCode
        txtInput(1).Text = !strCustomerName
        txtInput(2).Text = !strTaxNO
        If !dblDiscountRate <> 0 Then
'            If !dblDiscountRate < 1 And !dblDiscountRate > 0 Then
                txtInput(3).Text = Format(!dblDiscountRate, "0.00")
'