frmcustomerlistcard.frm

金算盘软件代码

'   修改人：王滔滔
'   日期：1998.10.28
'   状态：完成
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Option Explicit

Private mblnIsChanged As Boolean
Private mblnIsInit 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
Private WithEvents mclsMainControl As MainControl               '主控对象
Attribute mclsMainControl.VB_VarHelpID = -1

Public Property Get getID()
    getID = mlngCustomerID
End Property

'进入新增单位
Public Function AddCard(Optional strName As String = "", Optional intModal As Integer = 0) As Long
    
    If IsContinue Then Exit Function
    mblnIsNew = True
'    mblnIsChanged = True
    mlngCustomerID = 0
    Caption = "新增往来单位"
    cmdOKCancel(2).Default = True
    cmdOKCancel(2).Visible = True
    InitCard 0, strName
    Show intModal
    AddCard = mlngCustomerID
    Refresh
    ZOrder 0
    Unload MsgForm
End Function

'检查录入 1--正确  -1--编码重复  -2--名称重复
Private Function CodeCheck() As Integer
    'Dim recCustomer As Recordset, strSql As String
    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.OpenRecordset(strSql, dbOpenForwardOnly)
    Set recCustomer = gclsBase.BaseDB.OpenResultset(strSql, rdOpenForwardOnly)
    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
    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 AS 收发地址编码," _
        & "CustomerAddress.strCustomerAddressName AS 收发地址名称," _
        & "CustomerAddress.strAddress AS 收发地址," _
        & "CustomerAddress.strEMail AS 电子信箱," _
        & "CustomerAddress.strContactName AS 联系人," _
        & "Title.strTitleName AS 职务," _
        & "Title.lngTitleID," _
        & "CustomerAddress.strOfficePhoneNumber AS 办公电话," _
        & "CustomerAddress.strHomePhoneNumber AS 住宅电话," _
        & "CustomerAddress.strFaxNumber AS 传真," _
        & "CustomerAddress.strPostalCode AS 邮编 " _
        & " FROM CustomerAddress LEFT JOIN Title" _
        & " ON CustomerAddress.lngTitleID=Title.lngTitleID WHERE " _
        & "CustomerAddress.lngCustomerID=" & lngID
    strSql = "SELECT CustomerAddress.lngCustomerAddressID," _
        & " CustomerAddress.strCustomerAddressCode AS ""收发地址编码""," _
        & " CustomerAddress.strCustomerAddressName AS ""收发地址名称""," _
        & " CustomerAddress.strAddress AS ""收发地址""," _
        & " CustomerAddress.strEMail AS ""电子信箱""," _
        & " CustomerAddress.strContactName AS ""联系人""," _
        & " Title.strTitleName AS ""职务""," _
        & " Title.lngTitleID," _
        & " CustomerAddress.strOfficePhoneNumber AS ""办公电话""," _
        & " CustomerAddress.strHomePhoneNumber AS ""住宅电话""," _
        & " CustomerAddress.strFaxNumber AS ""传真""," _
        & " CustomerAddress.strPostalCode AS ""邮编"" " _
        & " FROM CustomerAddress, Title" _
        & " WHERE CustomerAddress.lngTitleID=Title.lngTitleID(+)" _
        & " AND CustomerAddress.lngCustomerID=" & lngID
    'Set datCustomer(1).Recordset = gclsBase.BaseDB.OpenRecordset _
        (strSql, dbOpenSnapshot)
    Set datCustomer(1).Resultset = gclsBase.BaseDB.OpenResultset _
        (strSql, rdOpenStatic)
    'If datCustomer(1).Recordset.EOF Then
    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 AS 开户银行名称," _
        & "strAccountNO AS 开户银行帐号 FROM CustomerBank" _
        & " WHERE lngCustomerID=" & lngID
    strSql = "SELECT lngCustomerBankID,strBankName AS ""开户银行名称""," _
        & "strAccountNO AS ""开户银行帐号"" FROM CustomerBank" _
        & " WHERE lngCustomerID=" & lngID
    'Set datCustomer(0).Recordset = gclsBase.BaseDB.OpenRecordset _
        (strSql, dbOpenSnapshot)
    Set datCustomer(0).Resultset = gclsBase.BaseDB.OpenResultset _
        (strSql, rdOpenStatic)
    'If datCustomer(0).Recordset.EOF Then
    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 Recordset, strSql As String
    Dim recCustomer As rdoResultset, strSql As String
    
    mblnIsInit = True
    mblnIsChanged = False
    mlngDCustomerID = 0
    CboCustomer.Clear
    CboCustomer.AddItem "应付", 0
    CboCustomer.AddItem "应收", 1
    CboCustomer.AddItem "应收应付", 2
    cmdDelete(0).Enabled = False
    cmdDelete(1).Enabled = False
    If mblnIsNew Then
        For i = 1 To 22
            If i < 8 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
        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 = Trim(Format(!strTaxNO, "@;;"))
        If !dblDiscountRate <> 0 Then
            If !dblDiscountRate - Int(!dblDiscountRate) > 0 And _
                !dblDiscountRate - Int(!dblDiscountRate) < 1 Then
                txtInput(3).Text = Format(!dblDiscountRate, ".0000")
            Else
                txtInput(3).Text = !dblDiscountRate
            End If
        End If
        If !dblCreditLimit <> 0 Then
            If !dblCreditLimit - Int(!dblCreditLimit) > 0 And _
                !dblCreditLimit - Int(!dblCreditLimit) < 1 Then
                txtInput(4).Text = Format(!dblCreditLimit, ".0000")
            Else
                txtInput(4).Text = !dblCreditLimit
            End If
        End If
        txtInput(5).Text = Trim(Format(!strEMail, "@;;"))
        txtInput(6).Text = Trim(Format(!strBillToAddress, "@;;"))
        txtInput(7).Text = Trim(Format(!strContactName, "@;;"))
        txtInput(8).Text = Trim(Format(!strOfficePhoneNumber, "@;;"))
        txtInput(9).Text = Trim(Format(!strHomePhoneNumber, "@;;"))
        txtInput(10).Text = Trim(Format(!strFaxNumber, "@;;"))
        txtInput(11).Text = Trim(Format(!strBillToPostalCode, "@;;"))
        mstrNotes = Trim(Format(!strNotes, "@;;"))
        mstrCustomer = txtInput(0).Text & " " & txtInput(1).Text
        
        chkPause.Value = !blnIsInActive
        CboCustomer.ListIndex = !strCategory - 1
        mlngLstID(0) = !lngCustomerTypeID
        mlngLstID(1) = !lngAreaID
        mlngLstID(2) = !lngTermID
        mlngLstID(3) = !lngTitleID
        mlngLstID(4) = !lngEmployeeID
        mlngLstID(5) = !lngARAccountID
        mlngLstID(6) = !lngAPAccountID
        lstCustomer(0).Text = !strCustomerTypeCode & " " & !strCustomerTypeName
        lstCustomer(1).Text = Format(!strAreaCode, "@;;") & " " & Format(!strAreaName, "@;;")
        lstCustomer(2).Text = Format(!strTermCode, "@;;") & " " & Format(!strTermName, "@;;")
        lstCustomer(3).Text = Format(!strTitleName, "@;;")
        lstCustomer(4).Text = Format(!strEmployeeCode, "@;;") & " " & Format(!strEmployeeName, "@;;")
        lstCustomer(5).Text = Format(!strRACode, "@;;") & " " & Format(!strRAName, "@;;")
        lstCustomer(6).Text = Format(!strPACode, "@;;") & " " & Format(!strPAName, "@;;")
        .Close
        End With
    End If
    InitBankGrid lngID
    InitAddressGrid lngID
    mblnIsInit = False
End Sub

'进入修改单位
Public Sub EditCard(ByVal lngID As Long, Optional intModal As Integer = 0, _
    Optional strCustomer As String)
    Dim strMess As String
    
    If IsContinue Then Exit Sub
    If Not CheckIDUsed("Customer", "lngCustomerID", lngID) Then
        If Trim(strCustomer) <> "" Then
            strMess = "“" & strCustomer & "”"
        Else
            strMess = "该"
        End If
        ShowMsg 0, strMess & "往来单位不存在,不能进行修改！", _
            vbExclamation + MB_TASKMODAL, "修改往来单位"
        Unload Me
    Else
        mblnIsNew = False
        mblnIsChanged = False
        mlngCustomerID = lngID
        Caption = "修改往来单位"
        cmdOKCancel(0).Default = True
        cmdOKCancel(2).Visible = False
        cmdOKCancel(2).TabStop = False
        cmdOKCancel(3).top = cmdOKCancel(2).top
        InitCard mlngCustomerID
        Show intModal
        Refresh
        ZOrder 0
    End If
    Unload MsgForm
End Sub

'进入删除往来单位表，判断记录是否是末级和被使用，删除记录
Public Function DelCard(ByVal lngID As Long) As Boolean
    Dim strSql As String, strCustomer As String
    'Dim recSelect As Recordset
    Dim recSelect As rdoResultset
    Dim intMsgReturn As Integer
    Dim blnSQLExec As Boolean
    
    If lngID = mlngCustomerID And frmCustomerList.IsShowCard(0) Then
        ShowMsg 0, "不能删除正在修改的往来单位！", vbExclamation + MB_TASKMODAL, "删除往来单位"
        Show
        Exit Function
    End If
    DelCard = False
    strSql = "SELECT * FROM Customer WHERE lngCustomerID=" & lngID
    'Set recSelect = gclsBase.BaseDB.OpenRecordset(strSql, dbOpenForwardOnly)
    Set recSelect = gclsBase.BaseDB.OpenResultset(strSql, rdOpenForwardOnly)
    If recSelect.EOF Then
        DelCard = True
        frmCustomerList.IsShowCard(0) = False
        recSelect.Close
        Exit Function
    Else
        strCustomer = recSelect!strCustomerCode & " " & recSelect!strCustomerName
    End If
    If CodeUsed(lngID) Then
        intMsgReturn = ShowMsg(0, "往来单位“" & strCustomer & "”已经发生业务，不能删除！", _
            vbExclamation + vbOKOnly + MB_TASKMODAL, "删除往来单位")
    Else
        intMsgReturn = ShowMsg(0, "您确实要删除往来单位“" & strCustomer & "吗？", _
            vbQuestion + vbOKCancel + MB_TASKMODAL, "删除往来单位")
        If intMsgReturn = vbOK Then
            strSql = "DELETE FROM Customer  WHERE lngCustomerID = " & lngID
            blnSQLExec = gclsBase.ExecSQL(strSql)
            If Not blnSQLExec Then
'                intMsgReturn = showmsg(0, "删除单位不成功！", _
                    vbExclamation + vbOKOnly, "删除单位")
            Else
'                gclsSys.SendMessage CStr(Me.hwnd), Message.msgCustomer
                DelCard = True
            End If
        End If
    End If
    recSelect.Close
    frmCustomerList.IsShowCard(0) = False
End Function

'判断记录是否被使用（可能有多张表会使用此编码）
Private Function CodeUsed(lngID As Long) As Boolean
    CodeUsed = True
    If lngID <> 0 Then
        If CheckIDUsed("AccountBalance", "lngCustomerID", lngID) Then Exit Function
        If CheckIDUsed("AccountDaily", "lngCustomerID", lngID) Then Exit Function
        If CheckIDUsed("ActivityDetail", "lngCustomerID", lngID) Then Exit Function
        If CheckIDUsed("ARAPInit", "lngCustomerID", lngID) Then Exit Function
        If CheckIDUsed("BudgetBalance", "lngCustomerID", lngID) Then Exit Function
    '    If CheckIDUsed("CustomerAddress", "lngCustomerID", lngid) Then Exit Function
    '    If CheckIDUsed("CustomerBank", "lngCustomerID", lngID) Then Exit Function
'        If CheckIDUsed("FixedAccount", "lngCustomerID", lngID) Then Exit Function
        If CheckIDUsed("Item", "lngCustomerID", lngID) Then Exit Function
        If CheckIDUsed("ItemActivity", "lngCustomerID", lngID) Then Exit Function
        If CheckIDUsed("Job", "lngCustomerID", lngID) Then Exit Function
    '    If CheckIDUsed("LendItemDetail", "lngCustomerID", lngID) Then Exit Function
        If CheckIDUsed("PurchaseOrder", "lngCustomerID", lngID) Then Exit Function
        If