frmmain.frm

《VB6数据库开发指南》所有的例程的源码

VERSION 5.00
Object = "{6B7E6392-850A-101B-AFC0-4210102A8DA7}#2.0#0"; "MSCOMCTL.OCX"
Begin VB.Form frmMain 
   Caption         =   "Authors"
   ClientHeight    =   5295
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   8895
   LinkTopic       =   "Form1"
   ScaleHeight     =   5295
   ScaleWidth      =   8895
   StartUpPosition =   3  'Windows Default
   Begin VB.CommandButton cmdExit 
      Caption         =   "Exit"
      Height          =   495
      Left            =   7560
      TabIndex        =   4
      Top             =   1920
      Width           =   1215
   End
   Begin VB.CommandButton cmdDelete 
      Caption         =   "Delete"
      Height          =   495
      Left            =   7560
      TabIndex        =   3
      Top             =   1320
      Width           =   1215
   End
   Begin VB.CommandButton cmdEdit 
      Caption         =   "Edit"
      Height          =   495
      Left            =   7560
      TabIndex        =   2
      Top             =   720
      Width           =   1215
   End
   Begin VB.CommandButton cmdNew 
      Caption         =   "New"
      Height          =   495
      Left            =   7560
      TabIndex        =   1
      Top             =   120
      Width           =   1215
   End
   Begin ComctlLib.ListView listAuthors 
      Height          =   5055
      Left            =   120
      TabIndex        =   0
      Top             =   120
      Width           =   7335
      _ExtentX        =   12938
      _ExtentY        =   8916
      View            =   3
      LabelEdit       =   1
      LabelWrap       =   -1  'True
      HideSelection   =   -1  'True
      _Version        =   393217
      ForeColor       =   -2147483640
      BackColor       =   -2147483643
      BorderStyle     =   1
      Appearance      =   1
      NumItems        =   8
      BeginProperty ColumnHeader(1) {BDD1F052-858B-11D1-B16A-00C0F0283628} 
         Text            =   "Last"
         Object.Width           =   1764
      EndProperty
      BeginProperty ColumnHeader(2) {BDD1F052-858B-11D1-B16A-00C0F0283628} 
         SubItemIndex    =   1
         Text            =   "First"
         Object.Width           =   1764
      EndProperty
      BeginProperty ColumnHeader(3) {BDD1F052-858B-11D1-B16A-00C0F0283628} 
         SubItemIndex    =   2
         Text            =   "Address"
         Object.Width           =   3528
      EndProperty
      BeginProperty ColumnHeader(4) {BDD1F052-858B-11D1-B16A-00C0F0283628} 
         SubItemIndex    =   3
         Text            =   "City"
         Object.Width           =   2540
      EndProperty
      BeginProperty ColumnHeader(5) {BDD1F052-858B-11D1-B16A-00C0F0283628} 
         SubItemIndex    =   4
         Text            =   "State"
         Object.Width           =   882
      EndProperty
      BeginProperty ColumnHeader(6) {BDD1F052-858B-11D1-B16A-00C0F0283628} 
         SubItemIndex    =   5
         Text            =   "Zip"
         Object.Width           =   1235
      EndProperty
      BeginProperty ColumnHeader(7) {BDD1F052-858B-11D1-B16A-00C0F0283628} 
         SubItemIndex    =   6
         Text            =   "Phone"
         Object.Width           =   2540
      EndProperty
      BeginProperty ColumnHeader(8) {BDD1F052-858B-11D1-B16A-00C0F0283628} 
         SubItemIndex    =   7
         Text            =   "Contract"
         Object.Width           =   1235
      EndProperty
      _Items          =   "frmMain.frx":0000
   End
End
Attribute VB_Name = "frmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private mAuthors As cAuthor

Private Sub cmdDelete_Click()
    'delete the current author
    On Error GoTo DeleteError
    mAuthors.DeleteAuthor listAuthors.SelectedItem.Key
    listAuthors.ListItems.Remove listAuthors.SelectedItem.Key
    
    Exit Sub
DeleteError:
    MsgBox Err.Number + " - " + Err.Description
    Exit Sub
End Sub

Private Sub cmdEdit_Click()
    With frmDetails
    
        'fill the detail screen
        .txtId.Text = listAuthors.SelectedItem.Key
        .txtId.Locked = True
        .txtId.BackColor = vbButtonFace
        .txtLastName.Text = listAuthors.SelectedItem.Text
        .txtFirstName.Text = listAuthors.SelectedItem.SubItems(1)
        .txtAddress.Text = listAuthors.SelectedItem.SubItems(2)
        .txtCity.Text = listAuthors.SelectedItem.SubItems(3)
        .txtState.Text = listAuthors.SelectedItem.SubItems(4)
        .txtZip.Text = listAuthors.SelectedItem.SubItems(5)
        .txtPhone.Text = listAuthors.SelectedItem.SubItems(6)
        .chkContract.Value = _
            IIf(listAuthors.SelectedItem.SubItems(7) = "True" _
            , vbChecked, vbUnchecked)
            
        'show the edit dialog
        .OK = False
        .Caption = "Edit Author"
        .Show vbModal
        
        If .OK = True Then
            'user hit OK, update the database
            On Error GoTo EditError
            mAuthors.UpdateAuthor .txtId.Text, .txtLastName.Text _
                , .txtFirstName.Text, .txtPhone.Text, .txtAddress.Text _
                , .txtCity.Text, .txtState.Text, .txtZip.Text _
                , .chkContract.Value = vbChecked
            On Error GoTo 0
            
            'update successfull change ui
            listAuthors.SelectedItem.Text = .txtLastName.Text
            listAuthors.SelectedItem.SubItems(1) = .txtFirstName.Text
            listAuthors.SelectedItem.SubItems(2) = .txtAddress.Text
            listAuthors.SelectedItem.SubItems(3) = .txtCity.Text
            listAuthors.SelectedItem.SubItems(4) = .txtState.Text
            listAuthors.SelectedItem.SubItems(5) = .txtZip.Text
            listAuthors.SelectedItem.SubItems(6) = .txtPhone.Text
            listAuthors.SelectedItem.SubItems(7) = _
                (.chkContract.Value = vbChecked)
                    
        End If

    End With 'frmDetails
    Exit Sub
EditError:
    MsgBox Err.Number + " - " + Err.Description
    Exit Sub
End Sub

Private Sub cmdExit_Click()
    Unload Me
End Sub

Private Sub cmdNew_Click()
    With frmDetails
    
        'fill the detail screen
        .txtId.Text = ""
        .txtId.Locked = False
        .txtId.BackColor = vbWindowBackground
        .txtLastName.Text = ""
        .txtFirstName.Text = ""
        .txtAddress.Text = ""
        .txtCity.Text = ""
        .txtState.Text = ""
        .txtZip.Text = ""
        .txtPhone.Text = ""
        .chkContract.Value = vbUnchecked
            
        'show new dialog
        .OK = False
        .Caption = "New Author"
        .Show vbModal
        
        If .OK = True Then
            'user hit OK, update the database
            
            On Error GoTo NewError
            mAuthors.NewAuthor .txtId.Text, .txtLastName.Text _
                , .txtFirstName.Text, .txtPhone.Text, .txtAddress.Text _
                , .txtCity.Text, .txtState.Text, .txtZip.Text _
                , .chkContract.Value = vbChecked
            On Error GoTo 0
            
            'update successfull change ui
            Dim NewItem As ListItem
            
            Set NewItem = listAuthors.ListItems.Add(, .txtId.Text _
                , .txtLastName.Text)
            NewItem.SubItems(1) = .txtFirstName.Text
            NewItem.SubItems(2) = .txtAddress.Text
            NewItem.SubItems(3) = .txtCity.Text
            NewItem.SubItems(4) = .txtState.Text
            NewItem.SubItems(5) = .txtZip.Text
            NewItem.SubItems(6) = .txtPhone.Text
            NewItem.SubItems(7) = (.chkContract.Value = vbChecked)
                    
        End If

    End With 'frmDetails
    Exit Sub
NewError:
    MsgBox Err.Number + " - " + Err.Description
    Exit Sub

End Sub

Private Sub Form_Load()
    'fill the list with all the authors
    Dim rs As Recordset
    Dim NewItem As ListItem
    
    Set mAuthors = New cAuthor
    
    Set rs = mAuthors.GetList()
    Do Until rs.EOF
        Set NewItem = listAuthors.ListItems.Add(, rs("au_id"), _
            rs("au_lname"))
        NewItem.SubItems(1) = rs("au_fname")
        NewItem.SubItems(2) = rs("address")
        NewItem.SubItems(3) = rs("city")
        NewItem.SubItems(4) = rs("state")
        NewItem.SubItems(5) = rs("zip")
        NewItem.SubItems(6) = rs("phone")
        NewItem.SubItems(7) = rs("contract")
        rs.MoveNext
    Loop
End Sub

Private Sub Form_Unload(Cancel As Integer)
    Set mAuthors = Nothing
    Unload frmDetails
    Set frmDetails = Nothing
End Sub

Private Sub listAuthors_DblClick()
    cmdEdit_Click
End Sub