frmcustomeraddresscard.frm

金算盘软件代码

            cmdOk(2).Enabled = False
            cmdOk(3).Enabled = False
            cmdOk(2).Caption = "新增(&A)"
            txtAddress(0).SetFocus
        End If
    Case 4
'        If mblnAddressIsAdd Then
            For i = 0 To 8
                txtAddress(i).Text = ""
            Next i
            lstTitle.Text = ""
'        Else
'            txtAddress(0).Text = .TextMatrix(mintRow, 1)
'            txtAddress(2).Text = .TextMatrix(mintRow, 2)
'            txtAddress(7).Text = .TextMatrix(mintRow, 3)
'            txtAddress(1).Text = .TextMatrix(mintRow, 4)
'            lstTitle.Text = .TextMatrix(mintRow, 5)
'            txtAddress(4).Text = .TextMatrix(mintRow, 6)
'            txtAddress(6).Text = .TextMatrix(mintRow, 7)
'            txtAddress(3).Text = .TextMatrix(mintRow, 8)
'            txtAddress(5).Text = .TextMatrix(mintRow, 9)
'            txtAddress(8).Text = .TextMatrix(mintRow, 10)
'        End If
        mblnAddressIsAdd = True
        cmdOk(2).Enabled = False
        cmdOk(3).Enabled = False
        cmdOk(4).Enabled = False
        cmdOk(2).Caption = "新增(&A)"
        txtAddress(0).SetFocus
    End Select
    End With
End Sub

Private Function CodeIsUsed(ByVal lngID As Long) As Boolean
    CodeIsUsed = True
    If lngID <> 0 Then
        If CheckIDUsed("ItemActivity", "lngCustomerAddressID", lngID) Then Exit Function
        If CheckIDUsed("PurchaseOrder", "lngCustomerAddressID", lngID) Then Exit Function
        If CheckIDUsed("SaleOrder", "lngCustomerAddressID", lngID) Then Exit Function
    End If
    CodeIsUsed = False
End Function

Private Sub Form_Activate()
    SetHelpID Me.HelpContextID
End Sub

Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)

    mblnIsRefer = False
    If KeyCode = vbKeyEscape Or KeyCode = vbKeyReturn Then
       mblnIsRefer = lstTitle.ReferVisible
    End If
End Sub

Private Sub Form_KeyPress(KeyAscii As Integer)
    If mblnIsList Then
        mblnIsList = False
        Exit Sub
    End If
    If KeyAscii = vbKeyReturn Then
        If Not mblnIsRefer Then
            BKKEY Me.ActiveControl.hwnd, vbKeyTab
        End If
    ElseIf KeyAscii = vbKeyEscape Then
        cmdOk(1).Value = Not mblnIsRefer
    End If
End Sub

Private Sub Form_KeyUp(KeyCode As Integer, Shift As Integer)
    If Shift = 4 And KeyCode = vbKeyL Then msgAddress_Click
    If KeyCode = vbKeyReturn And Shift = 2 Then
        cmdOk(0).Value = True
    ElseIf KeyCode = vbKeyL And Shift = 4 Then
        msgAddress.Row = msgAddress.Rows - 1
    End If
End Sub

Private Sub Form_Load()
    Dim edtErrReturn As ErrDealType
    
    On Error GoTo ErrHandle
'    SetHelpID hwnd, 15008
    Utility.LoadFormResPicture Me
    Set mclsGrid = New Grid
    Set mclsGrid.Grid = msgAddress
    mblnAddressIsAdd = True
    Exit Sub
ErrHandle:
    edtErrReturn = Errors.ErrorsDeal
    
    If edtErrReturn = edtResume Then
         Resume
    Else
         On Error Resume Next
         Unload Me
    End If
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
    Dim intResponse As Integer
    
    If mblnIsChanged And UnloadMode = vbFormControlMenu Then
        intResponse = ShowMsg(hwnd, "当前单位收发地址已被修改，是否保存？", _
            vbYesNoCancel + vbQuestion, Caption)
        If intResponse = vbYes Then
            Cancel = Not SaveCard()
        ElseIf intResponse = vbCancel Then
            Cancel = True
        End If
    End If
End Sub

Private Sub Form_Unload(Cancel As Integer)
    On Error Resume Next
    Unload frmWorkName
    Set mclsGrid = Nothing
    mblnIsChanged = False
    Utility.UnLoadFormResPicture Me
End Sub

Private Sub lstTitle_AddNew()
    Dim lngID As Long
        
    lngID = frmWorkName.AddCard(, vbModal, True)
    If lngID <> 0 Then mlngTitleID = lngID
    setlistbox lstTitle, 4, mlngTitleID
    mblnIsChanged = True
End Sub

Private Sub lstTitle_Change()
    If ContainErrorChar(lstTitle.Text, "`~!@#$%^&*=+'"";:,./?|\") Then BKKEY lstTitle.hwnd
    If Not mblnIsInit Then
        If Trim(txtAddress(0).Text) <> "" And Trim(txtAddress(2).Text) <> "" Then
            cmdOk(2).Enabled = True
        End If
        mblnIsChanged = True
    End If
End Sub

Private Sub lstTitle_Choose()
    mlngTitleID = lstTitle.ID
    If Not mblnIsInit Then
        mblnIsChanged = True
        If Trim(txtAddress(0).Text) <> "" And Trim(txtAddress(2).Text) <> "" Then
            cmdOk(2).Enabled = True
        End If
    End If
End Sub

Private Sub lstTitle_Delete()
    If frmWorkName.DelCard(mlngTitleID, Me.hwnd) Then mlngTitleID = 0
    setlistbox lstTitle, 4, mlngTitleID
    mblnIsChanged = True
End Sub

Private Sub lstTitle_Edit()
    frmWorkName.EditCard mlngTitleID, vbModal, lstTitle.Text
    setlistbox lstTitle, 4, mlngTitleID
    If lstTitle.Text = "" Then mlngTitleID = 0
    mblnIsChanged = True
End Sub

Private Sub lstTitle_GotFocus()
    cmdOk(0).Default = False
End Sub

Private Sub lstTitle_ItemNotExist()
    Dim iResponse As Integer
    Dim lngID As Long, strSql As String

    On Error Resume Next
    If Trim(lstTitle.Text) = "" Then
        lstTitle.Text = ""
        Exit Sub
    End If
    mblnIsExist = True
    iResponse = frmMsgQuickAdd.MsgAddShow(Caption, "职务中没有" & lstTitle.Text)
    If iResponse = vbOK Then
        lngID = frmWorkName.AddCard(lstTitle.Text, 1, True)
    ElseIf iResponse = 0 Then
        lngID = GetNewID("Title")
        strSql = "INSERT INTO Title(lngTitleID,strTitleName) VALUES (" & lngID & ",'" & lstTitle.Text & "')"
        gclsBase.BaseDB.Execute strSql
    Else
        lstTitle.Text = ""
    End If
    If lngID <> 0 Then mlngTitleID = lngID
    setlistbox lstTitle, 4, mlngTitleID
    mblnIsChanged = True
    mblnIsExist = False
End Sub

Private Sub lstTitle_KeyUp(KeyCode As Integer, Shift As Integer)
    If Trim(lstTitle.Text) = "" Then mlngTitleID = 0
    If KeyCode = vbKeyReturn And Trim(lstTitle.Text) <> "" Then SendKeys "{TAB}"
End Sub

Private Sub lstTitle_LostFocus()
    cmdOk(0).Default = True
    If Trim(lstTitle.Text) = "" Then mlngTitleID = 0
    lstTitle.MoveFocus
'    BKKEY lstTitle.hwnd, vbKeyHome
End Sub

Private Sub msgAddress_Click()

    If msgAddress.Row = 0 Or msgAddress.RowHeight(msgAddress.Row) = 0 Then Exit Sub
    
    If Not mblnAddressIsAdd Then
        If cmdOk(2).Enabled Then
            If ShowMsg(hwnd, "要保存修改的数据吗?", vbQuestion + vbYesNo + MB_TASKMODAL, _
                Caption) = vbYes Then
                
                CheckAddressCode
                If Not mblnAddressCodeValid Then
                    ShowMsg hwnd, "开户行" & Trim$(txtAddress(0).Text) & "及帐号" & _
                        Trim$(txtAddress(1).Text) & "已被使用,请重新录入!", vbExclamation + MB_TASKMODAL, Caption
                    SendKeys "{HOME}+{END}"
                    SendKeys "%{0}"
                    Exit Sub
                End If
                mblnIsChanged = True
                msgAddress.RowData(mintRow) = -5 '被修改
                msgAddress.TextMatrix(mintRow, 1) = txtAddress(0).Text
                msgAddress.TextMatrix(mintRow, 2) = txtAddress(2).Text
                msgAddress.TextMatrix(mintRow, 3) = txtAddress(7).Text
                msgAddress.TextMatrix(mintRow, 4) = txtAddress(1).Text
                msgAddress.TextMatrix(mintRow, 5) = lstTitle.TextMatrix(lstTitle.ReferRow, 2)
                msgAddress.TextMatrix(mintRow, 6) = txtAddress(4).Text
                msgAddress.TextMatrix(mintRow, 7) = txtAddress(6).Text
                msgAddress.TextMatrix(mintRow, 8) = txtAddress(3).Text
                msgAddress.TextMatrix(mintRow, 9) = txtAddress(5).Text
                msgAddress.TextMatrix(mintRow, 10) = txtAddress(8).Text
                msgAddress.TextMatrix(mintRow, 11) = lstTitle.TextMatrix(lstTitle.ReferRow, 1)
            End If
        End If
    Else
        If cmdOk(2).Enabled Then
            If ShowMsg(hwnd, "要保存新增的数据吗?", vbQuestion + vbYesNo + MB_TASKMODAL, Caption) = vbYes Then
                CheckAddressCode
                If Not mblnAddressCodeValid Then
                    ShowMsg hwnd, "开户行" & Trim$(txtAddress(0).Text) & "及帐号" & _
                        Trim$(txtAddress(1).Text) & "已被使用,请重新录入!", vbExclamation + MB_TASKMODAL, Caption
                    SendKeys "{HOME}+{END}"
                    SendKeys "%{0}"
                    Exit Sub
                End If
                mblnIsChanged = True
                msgAddress.Rows = msgAddress.Rows + 1
                msgAddress.TextMatrix(msgAddress.Rows - 1, 0) = 0    '新增
                msgAddress.TextMatrix(mintRow, 1) = txtAddress(0).Text
                msgAddress.TextMatrix(mintRow, 2) = txtAddress(2).Text
                msgAddress.TextMatrix(mintRow, 3) = txtAddress(7).Text
                msgAddress.TextMatrix(mintRow, 4) = txtAddress(1).Text
                msgAddress.TextMatrix(mintRow, 5) = lstTitle.TextMatrix(lstTitle.ReferRow, 2)
                msgAddress.TextMatrix(mintRow, 6) = txtAddress(4).Text
                msgAddress.TextMatrix(mintRow, 7) = txtAddress(6).Text
                msgAddress.TextMatrix(mintRow, 8) = txtAddress(3).Text
                msgAddress.TextMatrix(mintRow, 9) = txtAddress(5).Text
                msgAddress.TextMatrix(mintRow, 10) = txtAddress(8).Text
                msgAddress.TextMatrix(mintRow, 11) = lstTitle.TextMatrix(lstTitle.ReferRow, 1)
            End If
        End If
        'cmdOk(2).Picture = LoadPicture(App.Path & "\Edit.Bmp")
    End If
    mintRow = msgAddress.Row
    txtAddress(0).Text = Trim(msgAddress.TextMatrix(mintRow, 1))
    txtAddress(2).Text = Trim(msgAddress.TextMatrix(mintRow, 2))
    txtAddress(7).Text = Trim(msgAddress.TextMatrix(mintRow, 3))
    txtAddress(1).Text = Trim(msgAddress.TextMatrix(mintRow, 4))
    lstTitle.Text = Trim(msgAddress.TextMatrix(mintRow, 5))
    txtAddress(4).Text = Trim(msgAddress.TextMatrix(mintRow, 6))
    txtAddress(6).Text = Trim(msgAddress.TextMatrix(mintRow, 7))
    txtAddress(3).Text = Trim(msgAddress.TextMatrix(mintRow, 8))
    txtAddress(5).Text = Trim(msgAddress.TextMatrix(mintRow, 9))
    txtAddress(8).Text = Trim(msgAddress.TextMatrix(mintRow, 10))
    mblnAddressIsAdd = False
    cmdOk(3).Enabled = True
    cmdOk(4).Enabled = True
    cmdOk(2).Enabled = False
    cmdOk(2).Caption = "修改(&E)"
    SendKeys "%{0}"
End Sub

Private Function SaveCard() As Boolean
    Dim i As Integer  ', j As Integer, recBank As rdoResultset
    Dim strSql As String
    
    SaveCard = True
    If mblnIsExist Then
        SaveCard = False
        Exit Function
    End If
    If Not mblnIsChanged Then Exit Function
    On Error GoTo ErrHandle
    gclsBase.BaseWorkSpace.BeginTrans
'    j = 0           '最后新增的收发地址
    With msgAddress
    For i = 1 To .Rows - 1
        If .RowData(i) <> -1 Then
            If .TextMatrix(i, 0) = 0 Then
                mlngCustomerAddressID = GetNewID("CustomerAddress")
                strSql = "INSERT INTO CustomerAddress(lngCustomerAddressID,strCustomerAddressCode," _
                    & "strCustomerAddressName,strContactName,lngTitleID," _
                    & "strOfficePhoneNumber,strHomePhoneNumber,strFaxNumber," _
                    & "strEMail,strAddress,strPostalCode,lngCustomerID) " _
                    & "VALUES(" & mlngCustomerAddressID & ",'" & IIf(.TextMatrix(i, 1) = "", " ", .TextMatrix(i, 1)) _
                    & "','" & IIf(.TextMatrix(i, 2) = "", " ", .TextMatrix(i, 2)) _
                    & "','" & IIf(.TextMatrix(i, 4) = "", " ", .TextMatrix(i, 4)) & "'," & TxtToDouble(.TextMatrix(i, 11)) _
                    & ",'" & IIf(.TextMatrix(i, 8) = "", " ", .TextMatrix(i, 8)) & "','" & IIf(.TextMatrix(i, 9) = "", " ", .TextMatrix(i, 9)) _
                    & "','" & IIf(.TextMatrix(i, 6) = "", " ", .TextMatrix(i, 6)) & "','" & IIf(.TextMatrix(i, 10) = "", " ", .TextMatrix(i, 10)) _
                    & "','" & IIf(.TextMatrix(i, 3) = "", " ", .TextMatrix(i, 3)) & "','" & IIf(.TextMatrix(i, 7) = "", " ", .TextMatrix(i, 7)) _
                    & "'," & mlngCustomerID & ")"
'                j = i
            ElseIf .RowData(i) = -5 Then
                strSql = "UPDATE CustomerAddress SET strCustomerAddressCode='" _
                    & IIf(.TextMatrix(i, 1) = "", " ", .TextMatrix(i, 1)) & "',strCustomerAddressName='" _
                    & IIf(.TextMatrix(i, 2) = "", " ", .TextMatrix(i, 2)) & "',strContactName='" & IIf(.TextMatrix(i, 4) = "", " ", .TextMatrix(i, 4)) _
                    & "',lngTitleID=" & TxtToDouble(.TextMatrix(i, 11)) _
                    & ",strOfficePhoneNumber='" & IIf(.TextMatrix(i, 8) = "", " ", .TextMatrix(i, 8)) & "'," _
                    & "strHomePhoneNumber='" & IIf(.TextMatrix(i, 9) = "", " ", .TextMatrix(i, 9)) & "'," _
                    & "strFaxNumber='" & IIf(.TextMatrix(i, 6) = "", " ", .TextMatrix(i, 6)) & "',strEMail='" _
                    & IIf(.TextMatrix(i, 10) = "", " ", .TextMatrix(i, 10)) & "',strAddress='" & IIf(.TextMatrix(i, 3) = "", " ", .TextMatrix(i, 3)) _
                    & "',strPostalCode='" & .TextMatrix(i, 7) & "' WHERE " _
                    & "lngCustomerAddressID=" & msgAddress.TextMatrix(i, 0)
            Else
                strSql = ""
            End If
        Else
            strSql = "DELETE FROM CustomerAddress WHERE lngCustomerAddressID=" & _
                msgAddress.TextMatrix(i, 0)
        End If
        If strSql <> "" Then
            If Not gclsBase.ExecSQL(strSql) Then GoTo ErrHandle
        End If
    Next i
'    If j > 0 Then
'        strSql = "SELECT * FROM CustomerAddress WHERE trim(strCustomerAddressCode)='" _
'            & Trim(.TextMatrix(j, 1)) & "' AND trim(strCustomerAddressName)='" _
'            & Trim(.TextMatrix(j, 2)) & "'"
'        Set recBank = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
'        If Not recBank.EOF Then mlngCustomerAddressID = recBank!lngCustomerAddressID
'        recBank.Close
'    End If
    End With
    gclsBase.BaseWorkSpace.CommitTrans
    gclsSys.SendMessage Me.hwnd, Message.msgCustomerAddress
    mblnIsChanged = False
    Exit Function
ErrHandle:
    SaveCard = False
End Function

Private Sub txtAddress_Change(Index As Integer)
    If mblnAddressIsAdd Then
        If Trim$(txtAddress(0).Text) = "" Or Trim$(txtAddress(2).Text) = "" Then
            cmdOk(2).Enabled = False
        Else
            cmdOk(2).Enabled = True
        End If
    Else
        cmdOk(2).Enabled = True
    End If
    If Trim$(txtAddress(0).Text) <> "" Or Trim$(txtAddress(2).Text) <> "" Then
        cmdOk(4).Enabled = True
    Else
        cmdOk(4).Enabled = False
    End If
    If Index = 7 Or Index = 8 Then
        If ContainErrorChar(txtAddress(Index).Text, "'`~|") Then BKKEY txtAddress(Index).hwnd
    Else
        If ContainErrorChar(txtAddress(Index).Text) Then BKKEY txtAddress(Index).hwnd
    End If
    If Not mblnIsInit Then mblnIsChanged = True
End Sub

Private Sub txtAddress_KeyPress(Index As Integer, KeyAscii As Integer)
    If Index = 7 Or Index = 8 Then
        If InStr("'`~|", Chr(KeyAscii)) > 0 Then KeyAscii = 0
    Else
        If InStr("`~!@#$%^&*=+' "";:,./?|\", Chr(KeyAscii)) > 0 Then KeyAscii = 0
    End If
End Sub