frmcustomer.frm

个人VB学习源码精选,自己学习时的一些编程小程序,希望对大家有帮助

VERSION 5.00
Begin VB.Form frmCustomer 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "ADO Project"
   ClientHeight    =   6585
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   7305
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   6585
   ScaleWidth      =   7305
   StartUpPosition =   3  'Windows Default
   Begin VB.Frame Frame1 
      Height          =   735
      Left            =   247
      TabIndex        =   26
      Top             =   5625
      Width           =   6810
      Begin VB.CommandButton cmdClose 
         Caption         =   "&Close"
         Height          =   330
         Left            =   5220
         TabIndex        =   30
         Top             =   270
         Width           =   1140
      End
      Begin VB.CommandButton cmdSave 
         Caption         =   "&Save"
         Height          =   330
         Left            =   3615
         TabIndex        =   29
         Top             =   270
         Width           =   1140
      End
      Begin VB.CommandButton cmdDelete 
         Caption         =   "&Delete"
         Height          =   330
         Left            =   2010
         TabIndex        =   28
         Top             =   270
         Width           =   1140
      End
      Begin VB.CommandButton cmdNew 
         Caption         =   "&New"
         Height          =   330
         Left            =   405
         TabIndex        =   27
         Top             =   270
         Width           =   1140
      End
   End
   Begin VB.TextBox txtFields 
      Height          =   285
      Index           =   11
      Left            =   3735
      TabIndex        =   12
      Top             =   4635
      Width           =   1770
   End
   Begin VB.TextBox txtFields 
      Height          =   285
      Index           =   10
      Left            =   3735
      TabIndex        =   11
      Top             =   4230
      Width           =   3435
   End
   Begin VB.TextBox txtFields 
      Height          =   285
      Index           =   9
      Left            =   3735
      TabIndex        =   10
      Top             =   3825
      Width           =   1770
   End
   Begin VB.TextBox txtFields 
      Height          =   285
      Index           =   8
      Left            =   3735
      TabIndex        =   9
      Top             =   3420
      Width           =   3435
   End
   Begin VB.TextBox txtFields 
      Height          =   285
      Index           =   7
      Left            =   3735
      TabIndex        =   8
      Top             =   3015
      Width           =   3435
   End
   Begin VB.TextBox txtFields 
      Height          =   285
      Index           =   6
      Left            =   3735
      TabIndex        =   7
      Top             =   2610
      Width           =   915
   End
   Begin VB.TextBox txtFields 
      Height          =   285
      Index           =   5
      Left            =   3735
      TabIndex        =   6
      Top             =   2205
      Width           =   3435
   End
   Begin VB.TextBox txtFields 
      Height          =   285
      Index           =   4
      Left            =   3735
      TabIndex        =   5
      Top             =   1800
      Width           =   3435
   End
   Begin VB.TextBox txtFields 
      Height          =   285
      Index           =   3
      Left            =   3735
      TabIndex        =   4
      Top             =   1395
      Width           =   3435
   End
   Begin VB.TextBox txtFields 
      Height          =   285
      Index           =   2
      Left            =   3735
      TabIndex        =   3
      Top             =   990
      Width           =   3435
   End
   Begin VB.TextBox txtFields 
      Height          =   285
      Index           =   1
      Left            =   3735
      TabIndex        =   2
      Top             =   585
      Width           =   3435
   End
   Begin VB.TextBox txtFields 
      Height          =   285
      Index           =   0
      Left            =   3735
      TabIndex        =   1
      Top             =   180
      Width           =   1725
   End
   Begin VB.ListBox lstCustomers 
      Height          =   4935
      Left            =   135
      TabIndex        =   0
      Top             =   135
      Width           =   1815
   End
   Begin VB.Label lblRecNo 
      Height          =   240
      Left            =   2160
      TabIndex        =   25
      Top             =   5040
      Width           =   1635
   End
   Begin VB.Label lblColumnHeaders 
      Caption         =   "Active Flag:"
      Height          =   195
      Index           =   11
      Left            =   2160
      TabIndex        =   24
      Top             =   4680
      Width           =   1545
   End
   Begin VB.Label lblColumnHeaders 
      Caption         =   "customer Type:"
      Height          =   195
      Index           =   10
      Left            =   2160
      TabIndex        =   23
      Top             =   4275
      Width           =   1545
   End
   Begin VB.Label lblColumnHeaders 
      Caption         =   "Entry Date:"
      Height          =   195
      Index           =   9
      Left            =   2160
      TabIndex        =   22
      Top             =   3870
      Width           =   1545
   End
   Begin VB.Label lblColumnHeaders 
      Caption         =   "Phone Number:"
      Height          =   195
      Index           =   8
      Left            =   2160
      TabIndex        =   21
      Top             =   3465
      Width           =   1545
   End
   Begin VB.Label lblColumnHeaders 
      Caption         =   "Zip/Postal Code:"
      Height          =   195
      Index           =   7
      Left            =   2160
      TabIndex        =   20
      Top             =   3060
      Width           =   1545
   End
   Begin VB.Label lblColumnHeaders 
      Caption         =   "State/Prov:"
      Height          =   195
      Index           =   6
      Left            =   2160
      TabIndex        =   19
      Top             =   2655
      Width           =   1545
   End
   Begin VB.Label lblColumnHeaders 
      Caption         =   "City:"
      Height          =   195
      Index           =   5
      Left            =   2160
      TabIndex        =   18
      Top             =   2250
      Width           =   1545
   End
   Begin VB.Label lblColumnHeaders 
      Caption         =   "Street Address:"
      Height          =   195
      Index           =   4
      Left            =   2160
      TabIndex        =   17
      Top             =   1845
      Width           =   1545
   End
   Begin VB.Label lblColumnHeaders 
      Caption         =   "Last Name:"
      Height          =   195
      Index           =   3
      Left            =   2160
      TabIndex        =   16
      Top             =   1440
      Width           =   1545
   End
   Begin VB.Label lblColumnHeaders 
      Caption         =   "First Name:"
      Height          =   195
      Index           =   2
      Left            =   2160
      TabIndex        =   15
      Top             =   1035
      Width           =   1545
   End
   Begin VB.Label lblColumnHeaders 
      Caption         =   "Company Name:"
      Height          =   195
      Index           =   1
      Left            =   2160
      TabIndex        =   14
      Top             =   630
      Width           =   1545
   End
   Begin VB.Label lblColumnHeaders 
      Caption         =   "Customer ID:"
      Height          =   195
      Index           =   0
      Left            =   2160
      TabIndex        =   13
      Top             =   225
      Width           =   1545
   End
End
Attribute VB_Name = "frmCustomer"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private itsConnectionString As String
Private itsProcessClickFlag As Boolean
Private itsErrorMsg As String * 70
Private itsRecCount As Long
Private itsCust_id As Long
Private itsCompanyName As String * 50
Private itsFirstName As String * 15
Private itsLastName As String * 20
Private itsStreetAddress As String * 35
Private itsCity As String * 25
Private itsStateProvCode As String * 2
Private itsZipPostalCode As String * 10
Private itsPhoneNumber As String * 15
Private itsEntryDate As Date
Private itsCustTypeCode As String * 2
Private itsActiveCode As Integer

Private Sub cmdClose_Click()
    Unload Me
End Sub

Private Sub cmdDelete_Click()
    Dim theDeleteFlag As Boolean
    If Not Changed And itsCust_id = 0 Then
        theDeleteFlag = True
    Else
        If MsgBox("Delete the current record?", vbYesNo + vbQuestion, Me.Caption) = vbYes Then
            theDeleteFlag = True
        Else
            theDeleteFlag = False
        End If
    End If
    If theDeleteFlag Then
        DeleteRecord
        GoFirstRecord
    End If
End Sub

Private Sub cmdNew_Click()
    If Save Then
        lblRecNo.Caption = "<New Record>"
        NewRecord
    End If
    DisplayRecord
End Sub

Private Sub cmdSave_Click()
    If Changed Then
        If RecordOK Then
            SaveRecord
        Else
            MsgBox itsErrorMsg, vbCritical, Me.Caption
        End If
    Else
        MsgBox "Not saved: no changes madel", vbInformation, Me.Caption
    End If
End Sub

Private Sub Form_Load()
    Me.Top = (Screen.Height - Me.Height) / 2
    Me.Left = (Screen.Width - Me.Width) / 2
    Me.Caption = App.Title & " V. " & App.Major & "." & App.Minor & "." & App.Revision
    Dim strPath As String
    strPath = App.Path
    If Right(strPath, 1) <> "\" Then
        strPath = strPath & "\"
    End If
    strPath = strPath & "Customer.mdb"
    itsConnectionString = "DRIVER=Microsoft Access Driver (*.mdb);DBQ=" & strPath & ";"
    GoFirstRecord
End Sub

Private Sub Label1_Click(Index As Integer)

End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
    If Changed Then
        Select Case MsgBox("Save Changes before Exiting?", vbYesNoCancel + vbQuestion, Me.Caption)
            Case vbYes
                If RecordOK Then
                    SaveRecord
                Else
                    MsgBox itsErrorMsg, vbCritical, Me.Caption
                    Cancel = True
                End If
            Case vbCancel
                Cancel = True
            Case vbNo
        End Select
    Else
        Select Case MsgBox("Quit this application?", vbYesNo + vbQuestion, Me.Caption)
            Case vbYes
            Case vbNo
                Cancel = True
        End Select
    End If
End Sub

Private Sub lstCustomers_Click()
    If itsProcessClickFlag Then
        If lstCustomers.ListCount > 0 Then
            If lstCustomers.ListIndex >= 0 Then
                lblRecNo.Caption = "Record:" & Trim(lstCustomers.ListIndex + 1) & " of " & Trim(itsRecCount)
                '利用列表框保存的ID，定位记录并获取记录各字段的值
                GetRecord lstCustomers.ItemData(lstCustomers.ListIndex)
            End If
        End If
    End If
End Sub
Private Function Changed() As Boolean
    '判断是否改变了记录
    If Not Trim(txtFields(1)) = Trim(itsCompanyName) Then
        Changed = True
        Exit Function
    End If
    If Not Trim(txtFields(2)) = Trim(itsFirstName) Then
        Changed = True
        Exit Function
    End If