frmbusinessaddresscard.frm

金算盘软件代码

      Left            =   135
      TabIndex        =   0
      Top             =   195
      Width           =   1395
   End
   Begin VB.Label lblAddress 
      AutoSize        =   -1  'True
      Caption         =   "收发地址名称(&N)"
      Height          =   180
      Index           =   4
      Left            =   135
      TabIndex        =   2
      Top             =   555
      Width           =   1350
   End
   Begin VB.Label lblAddress 
      Caption         =   "联系人(&M)"
      Height          =   195
      Index           =   3
      Left            =   3900
      TabIndex        =   8
      Top             =   195
      Width           =   825
   End
   Begin VB.Label lblAddress 
      Caption         =   "办公电话(&O)"
      Height          =   195
      Index           =   6
      Left            =   135
      TabIndex        =   4
      Top             =   921
      Width           =   1005
   End
   Begin VB.Label lblAddress 
      Caption         =   "住宅电话(&H)"
      Height          =   195
      Index           =   8
      Left            =   135
      TabIndex        =   6
      Top             =   1284
      Width           =   1005
   End
   Begin VB.Label lblAddress 
      Caption         =   "电子信箱(&E)"
      Height          =   195
      Index           =   11
      Left            =   135
      TabIndex        =   18
      Top             =   2010
      Width           =   1005
   End
   Begin VB.Label lblAddress 
      Caption         =   "收发地址(&S)"
      Height          =   195
      Index           =   10
      Left            =   135
      TabIndex        =   16
      Top             =   1647
      Width           =   1005
   End
   Begin VB.Label lblAddress 
      Caption         =   "传真(&F)"
      Height          =   195
      Index           =   7
      Left            =   3900
      TabIndex        =   12
      Top             =   915
      Width           =   675
   End
   Begin VB.Label lblAddress 
      Caption         =   "邮编(&V)"
      Height          =   195
      Index           =   9
      Left            =   3900
      TabIndex        =   14
      Top             =   1290
      Width           =   675
   End
   Begin VB.Label lblAddress 
      Caption         =   "职务(&T)"
      Height          =   195
      Index           =   5
      Left            =   3900
      TabIndex        =   10
      Top             =   555
      Width           =   675
   End
End
Attribute VB_Name = "frmBusinessAddress"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
''''''''''''''''''''''''''''''''''''''''''
'企业收发地址卡片
'
'作者：苏涛
'
'接口：DelCard(lngID); AddCard(Optional strName,Optional intModal); EditCard(lngID,Optional intModal)
'
'时间:1998-07-29
'
'''''''''''''''''''''''''''''''''''''''''
Option Explicit
Option Compare Text

Private mclsGrid As Grid
Private mblnIsList As Boolean
Private mblnIsExist As Boolean
Private mblnIsChanged As Boolean
Private mblnAddressIsAdd As Boolean        '收发地址新增
Private mblnAddressCodeValid As Boolean
Private mblnIsInit As Boolean
Private mblnIsRefer As Boolean
Private mintRow As Integer
Private mlngTitleID As Long
Private mlngBusinessAddressID As Long

Public Function AddCard(Optional strName As String = "", Optional intModal As Integer = 0, _
    Optional ByVal IsList As Boolean = False) As Long
        
    mlngBusinessAddressID = 0
    Caption = "新增企业收发地址"
    InitCard strName
    mblnIsList = IsList
    Show intModal
    AddCard = mlngBusinessAddressID
End Function

Public Function DelCard(ByVal lngID As Long, Optional lnghWnd As Long = 0) As Boolean
    Dim strSql As String
'    Dim recSelect As rdoresultset
    Dim intMsgReturn As Integer
    Dim blnSQLExec As Boolean
    
    DelCard = False
'    strSQL = "SELECT * FROM Customer WHERE lngCustomerID=" & lngID
'    Set recSelect = gclsBase.BaseDB.openresultset(strSQL, rdopenstatic)
'    If recSelect.EOF Then
    If Not CheckIDUsed("BusinessAddress", "lngBusinessAddressID", lngID) Then
        intMsgReturn = ShowMsg(lnghWnd, "该企业收发地址不存在，不能删除！", _
            vbExclamation + vbOKOnly + MB_TASKMODAL, Caption)
'        recSelect.Close
'        frmCustomerList.IsShowCard(0) = False
        Exit Function
    End If
    If CodeUsed(lngID) Then
        intMsgReturn = ShowMsg(hwnd, "其它地方正在使用此企业收发地址，不能删除！", _
            vbExclamation + vbOKOnly + MB_TASKMODAL, Caption)
    Else
        intMsgReturn = ShowMsg(lnghWnd, "你确实要删除该企业收发地址吗！", _
            vbQuestion + vbOKCancel + MB_TASKMODAL, Caption)
        If intMsgReturn = vbOK Then
            strSql = "DELETE FROM BusinessAddress WHERE lngBusinessAddressID = " & lngID
            blnSQLExec = gclsBase.ExecSQL(strSql)
            If Not blnSQLExec Then
                intMsgReturn = ShowMsg(lnghWnd, "删除企业收发地址不成功！", _
                    vbExclamation + vbOKOnly + MB_TASKMODAL, Caption)
            Else
                gclsSys.SendMessage Me.hwnd, Message.msgBusinessAddress
                DelCard = True
            End If
        End If
    End If
'    recSelect.Close
'    frmCustomerList.IsShowCard(0) = False
End Function

'检查收发地址是否合法
Private Sub CheckAddressCode()
    Dim i As Integer

    For i = 1 To msgAddress.Rows - 1
        If msgAddress.RowHeight(i) <> 0 Then
            If mblnAddressIsAdd Then
                If msgAddress.TextMatrix(i, 1) = Trim$(txtAddress(0).Text) And _
                    msgAddress.TextMatrix(i, 2) = Trim$(txtAddress(2).Text) Then Exit For
            Else
                If msgAddress.TextMatrix(i, 1) = Trim$(txtAddress(0).Text) And _
                    msgAddress.TextMatrix(i, 2) = Trim$(txtAddress(2).Text) And _
                    i <> mintRow Then Exit For
            End If
        End If
    Next i
    mblnAddressCodeValid = (i >= msgAddress.Rows)
End Sub

'判断记录是否被使用（可能有多张表会使用此编码）
Private Function CodeUsed(lngID As Long) As Boolean
    CodeUsed = CheckIDUsed("ItemActivity", "lngBusinessAddressID", lngID)
End Function

'进入修改企业
Public Sub EditCard(ByVal lngID As Long, Optional intModal As Integer = 0)
    
    mlngBusinessAddressID = lngID
    Caption = "修改企业收发地址"
    If Not InitCard() Then
        ShowMsg hwnd, "该企业收发地址不存在,不能进行编辑!", vbExclamation + MB_TASKMODAL, Caption
        Unload Me
    End If
    Show intModal
End Sub

Private Function InitCard(Optional strName As String = "") As Boolean
    Dim i As Integer
    
    mblnIsInit = True
    InitGrid
    setlistbox lstTitle, 4
    InitCard = True
    If mlngBusinessAddressID = 0 Then
        txtAddress(0).Text = GetNextCode(txtAddress(0).Text)
        txtAddress(2).Text = Trim(strName)
    Else
        With msgAddress
        For i = 1 To .Rows - 1
            If .TextMatrix(i, 0) = mlngBusinessAddressID Then Exit For
        Next i
        If i < .Rows Then
            .Row = i
            msgAddress_Click
        Else
            InitCard = False
            Exit Function
        End If
        End With
    End If
    mblnIsInit = False
End Function

'刷新收发地址GRID
Private Sub InitGrid()
    Dim i As Integer
    Dim strSql As String
    
    strSql = "SELECT lngBusinessAddressID,strBusinessAddressCode AS 编码," _
        & "strBusinessAddressName AS 名称,strAddress AS 地址,strContactName " _
        & "AS 联系人,Title.strTitleName AS 职务,strFaxNumber AS 传真," _
        & "strPostalCode AS 邮编,strOfficePhoneNumber AS 办公电话," _
        & "strHomePhoneNumber AS 住宅电话,strEMail AS 电子邮件," _
        & "BusinessAddress.lngTitleID FROM BusinessAddress,Title " _
        & "WHERE BusinessAddress.lngTitleID=Title.lngTitleID(+)"
    Set Data1.Resultset = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    If Data1.Resultset.EOF Then
        msgAddress.Rows = 2
        msgAddress.RowHeight(1) = 0
        msgAddress.TextMatrix(1, 0) = 0
        msgAddress.RowData(1) = -1
    End If
    For i = 0 To msgAddress.Cols - 1
        msgAddress.FixedAlignment(i) = flexAlignCenterCenter
    Next i
    msgAddress.ColWidth(0) = 0
    msgAddress.ColWidth(11) = 0
    mintRow = 1
    mclsGrid.SetupStyle
End Sub

Private Sub cmdOk_Click(Index As Integer)
    Dim i As Integer, strMess As String
    
    If mblnIsExist Then Exit Sub
    With msgAddress
    Select Case Index
    Case 0
        If cmdOk(2).Enabled Then
'            If mblnAddressIsAdd Then
'                strMess = "要保存新增的企业收发地址“" & Trim$(txtAddress(0).Text) _
'                    & "”及帐号“" & Trim$(txtAddress(2).Text) & "”吗?"
'            Else
'                strMess = "要保存对企业收发地址“" & Trim$(txtAddress(0).Text) _
'                    & "”及帐号" & Trim$(txtAddress(2).Text) & "“的修改吗?"
'            End If
'            If ShowMsg(hwnd, strMess, vbQuestion + vbYesNo, Caption) = vbYes Then
                cmdOk(2).Value = True
                If Not mblnAddressCodeValid Then Exit Sub
'            End If
        Else
            If txtAddress(0).Text = "" And txtAddress(2).Text <> "" Then
                ShowMsg hwnd, "收发地址编码不能为空.", vbExclamation, Caption
                txtAddress(0).SetFocus
                Exit Sub
            ElseIf txtAddress(0).Text <> "" And txtAddress(2).Text = "" Then
                ShowMsg hwnd, "收发地址名称不能为空.", vbExclamation, Caption
                txtAddress(2).SetFocus
                Exit Sub
            End If
        End If
        If SaveCard Then Unload Me
    Case 1
        Unload Me
    Case 2
        CheckAddressCode
        If Not mblnAddressCodeValid Then
            ShowMsg hwnd, "编码" & Trim$(txtAddress(0).Text) & "及名称" & _
                Trim$(txtAddress(1).Text) & "已被使用,请重新录入!", vbExclamation, Caption
            txtAddress(0).SelStart = 0
            txtAddress(0).SelLength = Len(txtAddress(0).Text)
            txtAddress(0).SetFocus
            Exit Sub
        End If
        If mblnAddressIsAdd Then
            mintRow = .Rows
            .Rows = .Rows + 1
            .TextMatrix(mintRow, 0) = 0  '新增
        Else
            .RowData(mintRow) = -5 '被修改
            cmdOk(3).Enabled = False
            mblnAddressIsAdd = True
        End If
        .TextMatrix(mintRow, 1) = txtAddress(0).Text
        .TextMatrix(mintRow, 2) = txtAddress(2).Text
        .TextMatrix(mintRow, 3) = txtAddress(7).Text
        .TextMatrix(mintRow, 4) = txtAddress(1).Text
        .TextMatrix(mintRow, 5) = lstTitle.TextMatrix(lstTitle.ReferRow, 2)
        .TextMatrix(mintRow, 6) = txtAddress(4).Text
        .TextMatrix(mintRow, 7) = txtAddress(6).Text
        .TextMatrix(mintRow, 8) = txtAddress(3).Text
        .TextMatrix(mintRow, 9) = txtAddress(5).Text
        .TextMatrix(mintRow, 10) = txtAddress(8).Text
        If lstTitle.TextMatrix(lstTitle.ReferRow, 1) = "" Then
            .TextMatrix(mintRow, 11) = 0
        Else
            .TextMatrix(mintRow, 11) = lstTitle.TextMatrix(lstTitle.ReferRow, 1)
        End If
        For i = 0 To 8
            txtAddress(i).Text = ""
        Next i
        lstTitle.Text = ""
        mblnIsChanged = True
        cmdOk(2).Enabled = False
        cmdOk(2).Caption = "新增(&A)"
        txtAddress(0).SetFocus
    Case 3
        If msgAddress.Row = 0 Or msgAddress.RowHeight(msgAddress.Row) = 0 Then Exit Sub
        If CodeIsUsed(msgAddress.TextMatrix(msgAddress.Row, 0)) Then
            ShowMsg Me.hwnd, "企业收发地址已有业务发生,不能删除！", _
                vbExclamation + MB_TASKMODAL, "删除企业收发地址"
        ElseIf ShowMsg(hwnd, "您确实要删除企业收发地址“" & txtAddress(0).Text _
            & "” “" & txtAddress(2).Text & "”吗？", _
            vbQuestion + vbYesNo + vbDefaultButton2, "删除企业收发地址") = vbYes Then
            msgAddress.RowData(mintRow) = -1   '被删除
            msgAddress.RowHeight(mintRow) = 0
            For i = 0 To 8
                txtAddress(i).Text = ""
            Next i
            lstTitle.Text = ""
            mlngTitleID = 0
            mblnAddressIsAdd = True
            mblnIsChanged = True
            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)