home *** CD-ROM | disk | FTP | other *** search
VERSION 4.00 Begin VB.Form CustomerDetailsListBoxNoDataControl Caption = "Customer Details (Pure OO example using ListBoxes)" ClientHeight = 6150 ClientLeft = 825 ClientTop = 450 ClientWidth = 8820 Height = 6555 Left = 765 LinkTopic = "Form1" ScaleHeight = 6150 ScaleWidth = 8820 Top = 105 Width = 8940 Begin VB.CommandButton Command1 Caption = "Count Sel" Height = 375 Left = 7680 TabIndex = 11 Top = 1560 Width = 975 End Begin VB.ListBox List1 Height = 1815 Left = 0 MultiSelect = 2 'Extended TabIndex = 0 Top = 120 Width = 4215 End Begin VB.CommandButton pbOK Cancel = -1 'True Caption = "OK" Default = -1 'True Height = 375 Left = 7680 TabIndex = 12 Top = 2160 Width = 975 End Begin VB.CommandButton pbDeleteCustomer Caption = "Delete" Height = 375 Left = 7680 TabIndex = 10 Top = 1080 Width = 975 End Begin VB.CommandButton pbUpdateCustomer Caption = "Update" Height = 375 Left = 7680 TabIndex = 9 Top = 600 Width = 975 End Begin VB.CommandButton pbAddNewCustomer Caption = "Add New" Height = 375 Left = 7680 TabIndex = 8 Top = 120 Width = 975 End Begin VB.Frame Frame1 Caption = "Customer Details" Height = 2535 Left = 4320 TabIndex = 32 Top = 0 Width = 3255 Begin VB.ComboBox lbxGenderCodes Height = 315 Left = 2400 Sorted = -1 'True TabIndex = 7 Top = 2160 Width = 615 End Begin VB.ComboBox lbxMaritalStatusCodes Height = 315 Left = 1200 Sorted = -1 'True TabIndex = 6 Top = 2160 Width = 855 End Begin VB.TextBox efCustomerNumber Height = 285 Left = 1200 TabIndex = 1 Top = 360 Width = 1815 End Begin VB.TextBox efDateOfBirth Height = 285 Left = 1200 TabIndex = 5 Top = 1800 Width = 1815 End Begin VB.TextBox efFirstName Height = 285 Left = 1200 TabIndex = 2 Top = 720 Width = 1815 End Begin VB.TextBox efLastName Height = 285 Left = 1200 TabIndex = 3 Top = 1080 Width = 1815 End Begin VB.TextBox efSSN Height = 285 Left = 1200 TabIndex = 4 Top = 1440 Width = 1815 End Begin VB.Label Label1 Caption = "Marital Status" Height = 255 Index = 4 Left = 120 TabIndex = 57 Top = 2160 Width = 975 End Begin VB.Label Label1 Caption = "Sex" Height = 255 Index = 11 Left = 2040 TabIndex = 56 Top = 2160 Width = 375 End Begin VB.Label Label1 Caption = "Cust Number" Height = 255 Index = 12 Left = 120 TabIndex = 37 Top = 360 Width = 975 End Begin VB.Label Label1 Caption = "Date Of Birth" Height = 255 Index = 3 Left = 120 TabIndex = 36 Top = 1800 Width = 975 End Begin VB.Label Label1 Caption = "First Name" Height = 255 Index = 0 Left = 120 TabIndex = 35 Top = 720 Width = 975 End Begin VB.Label Label1 Caption = "Last Name" Height = 255 Index = 1 Left = 120 TabIndex = 34 Top = 1080 Width = 975 End Begin VB.Label Label1 Caption = "SSN" Height = 255 Index = 2 Left = 120 TabIndex = 33 Top = 1440 Width = 975 End End Begin TabDlg.SSTab SSTab1 Height = 3135 Left = 0 TabIndex = 13 Top = 2640 Width = 8775 _Version = 65536 _ExtentX = 15478 _ExtentY = 5530 _StockProps = 15 Caption = "Addresses" TabsPerRow = 2 Tab = 0 TabOrientation = 0 Tabs = 2 Style = 1 TabMaxWidth = 0 TabHeight = 529 TabCaption(0) = "Addresses" Tab(0).ControlCount= 7 Tab(0).ControlEnabled= -1 'True Tab(0).Control(0)= "Label1(13)" Tab(0).Control(1)= "efFormattedAddress" Tab(0).Control(2)= "Frame2" Tab(0).Control(3)= "pbDeleteAddress" Tab(0).Control(4)= "pbUpdateAddress" Tab(0).Control(5)= "pbAddNewAddress" Tab(0).Control(6)= "List2" TabCaption(1) = "Phones" Tab(1).ControlCount= 7 Tab(1).ControlEnabled= 0 'False Tab(1).Control(0)= "Label1(21)" Tab(1).Control(1)= "efFormattedPhoneNumber" Tab(1).Control(2)= "Frame3" Tab(1).Control(3)= "pbDeletePhone" Tab(1).Control(4)= "pbUpdatePhone" Tab(1).Control(5)= "pbAddPhone" Tab(1).Control(6)= "List3" Begin VB.ListBox List3 Height = 1815 Left = -74880 TabIndex = 26 Top = 480 Width = 4095 End Begin VB.ListBox List2 Height = 1230 Left = 120 TabIndex = 14 Top = 480 Width = 4095 End Begin VB.CommandButton pbAddPhone Caption = "Add New" Height = 375 Left = -67320 TabIndex = 29 Top = 480 Width = 975 End Begin VB.CommandButton pbUpdatePhone Caption = "Update" Height = 375 Left = -67320 TabIndex = 30 Top = 960 Width = 975 End Begin VB.CommandButton pbDeletePhone Caption = "Delete" Height = 375 Left = -67320 TabIndex = 31 Top = 1440 Width = 975 End Begin VB.Frame Frame3 Caption = "Address Details" Height = 2535 Left = -70680 TabIndex = 45 Top = 360 Width = 3255 Begin VB.TextBox efUsage Height = 285 Left = 1200 TabIndex = 28 Top = 720 Width = 1815 End Begin VB.TextBox efPhoneNumber Height = 285 Left = 1200 TabIndex = 27 Top = 360 Width = 1815 End Begin VB.Label Label1 Caption = "Usage" Height = 255 Index = 16 Left = 120 TabIndex = 47 Top = 720 Width = 975 End Begin VB.Label Label1 Caption = "Phone Num" Height = 255 Index = 15 Left = 120 TabIndex = 46 Top = 360 Width = 975 End End Begin VB.CommandButton pbAddNewAddress Caption = "Add New" Height = 375 Left = 7680 TabIndex = 23 Top = 480 Width = 975 End Begin VB.CommandButton pbUpdateAddress Caption = "Update" Height = 375 Left = 7680 TabIndex = 24 Top = 960 Width = 975 End Begin VB.CommandButton pbDeleteAddress Caption = "Delete" Height = 375 Left = 7680 TabIndex = 25 Top = 1440 Width = 975 End Begin VB.Frame Frame2 Caption = "Address Details" Height = 2535 Left = 4320 TabIndex = 38 Top = 360 Width = 3255 Begin VB.ComboBox lbxStateCodes Height = 315 Left = 1200 Sorted = -1 'True TabIndex = 19 Top = 1800 Width = 1815 End Begin VB.TextBox efLine1 Height = 285 Left = 1200 TabIndex = 15 Top = 360 Width = 1815 End Begin VB.TextBox efLine2 Height = 285 Left = 1200 TabIndex = 16 Top = 720 Width = 1815 End Begin VB.TextBox efLine3 Height = 285 Left = 1200 TabIndex = 17 Top = 1080 Width = 1815 End Begin VB.TextBox efCity Height = 285 Left = 1200 TabIndex = 18 Top = 1440 Width = 1815 End Begin VB.TextBox efZipCode Height = 285 Left = 1200 MaxLength = 5 TabIndex = 20 Top = 2160 Width = 735 End Begin VB.TextBox efZipExtension Height = 285 Left = 2640 MaxLength = 2 TabIndex = 22 Top = 2160 Width = 375 End Begin VB.TextBox efZipSupplement Height = 285 Left = 2040 MaxLength = 4 TabIndex = 21 Top = 2160 Width = 495 End Begin VB.Label Label1 Caption = "Line 1" Height = 255 Index = 5 Left = 120 TabIndex = 44 Top = 360 Width = 975 End Begin VB.Label Label1 Caption = "Line 2" Height = 255 Index = 6 Left = 120 TabIndex = 43 Top = 720 Width = 975 End Begin VB.Label Label1 Caption = "Line 3" Height = 255 Index = 7 Left = 120 TabIndex = 42 Top = 1080 Width = 975 End Begin VB.Label Label1 Caption = "City" Height = 255 Index = 10 Left = 120 TabIndex = 41 Top = 1440 Width = 975 End Begin VB.Label Label1 Caption = "State" Height = 255 Index = 8 Left = 120 TabIndex = 40 Top = 1800 Width = 975 End Begin VB.Label Label1 Caption = "Zip Code" Height = 255 Index = 9 Left = 120 TabIndex = 39 Top = 2160 Width = 975 End End Begin VB.Label efFormattedPhoneNumber BorderStyle = 1 'Fixed Single ForeColor = &H00FF0000& Height = 255 Left = -74880 TabIndex = 51 Top = 2640 Width = 4095 End Begin VB.Label Label1 Caption = "Formatted Phone" Height = 255 Index = 21 Left = -74880 TabIndex = 50 Top = 2400 Width = 1575 End Begin VB.Label efFormattedAddress BorderStyle = 1 'Fixed Single ForeColor = &H00FF0000& Height = 855 Left = 120 TabIndex = 49 Top = 2040 Width = 4095 End Begin VB.Label Label1 Caption = "Formatted Address" Height = 255 Index = 13 Left = 120 TabIndex = 48 Top = 1800 Width = 1575 End End Begin VB.Label lblPersonDetails AutoSize = -1 'True BackColor = &H00C0C0C0& BorderStyle = 1 'Fixed Single Caption = "lblPersonDetails" ForeColor = &H00000080& Height = 255 Left = 0 TabIndex = 58 Top = 5880 Width = 8775 WordWrap = -1 'True End Begin VB.Label efAge BorderStyle = 1 'Fixed Single ForeColor = &H00FF0000& Height = 255 Left = 3600 TabIndex = 55 Top = 2280 Width = 615 End Begin VB.Label Label1 Caption = "Age" Height = 255 Index = 17 Left = 3600 TabIndex = 54 Top = 2040 Width = 375 End Begin VB.Label Label1 Caption = "Formatted Name" Height = 255 Index = 14 Left = 0 TabIndex = 53 Top = 2040 Width = 1575 End Begin VB.Label efFormattedName BorderStyle = 1 'Fixed Single ForeColor = &H00FF0000& Height = 255 Left = 0 TabIndex = 52 Top = 2280 Width = 3495 End Attribute VB_Name = "CustomerDetailsListBoxNoDataControl" Attribute VB_Creatable = False Attribute VB_Exposed = False Option Explicit ' This example show how the VBOF can ' support the VB application in an enriched ' object-oriented manner without the need ' for conventional, GUI-centric VB programming ' techniques, such as extensive the use of the ' VB DataControl. ' This example expoits the ability of the ' VBOFCollection to work in conjunction with ' the VBOFListBoxWrapper to control ' VB ListBoxes in an object-oriented manner Private pvtCurrentPerson As Person Private pvtCurrentAddress As Address Private pvtCurrentPhone As Phone Private pvtState As State Private pvtPersons As VBOFCollection Private pvtPersonsListBoxWrapper As VBOFListBoxWrapper Private pvtAddresses As VBOFCollection Private pvtAddressesListBoxWrapper As VBOFListBoxWrapper Private pvtPhones As VBOFCollection Private pvtPhonesListBoxWrapper As VBOFListBoxWrapper Private pvtStates As VBOFCollection Private pvtStatesListBoxWrapper As VBOFListBoxWrapper Private pvtGenderCodes As VBOFCollection Private pvtGenderCodesListBoxWrapper As VBOFListBoxWrapper Private pvtMaritalStatusCodes As VBOFCollection Private pvtMaritalStatusCodesListBoxWrapper As VBOFListBoxWrapper Public ObjectManager As VBOFObjectManager Private Sub DisplayPersonalLineage() lblPersonDetails = pvtCurrentPerson.PersonalInformation End Sub Private Sub DisplayStateCapital() If pvtCurrentAddress Is Nothing Then Exit Sub End If If pvtCurrentAddress.State Is Nothing _ Then Exit Sub End If lblPersonDetails = "Capital city of " & pvtCurrentAddress.State.StateName & " is " & pvtCurrentAddress.State.CapitalCity End Sub Private Sub GetListBoxWrappers() Set pvtAddresses = _ New VBOFCollection Set pvtPhones = _ New VBOFCollection ' attach the Collection, ListBox and ListBoxWrapper Set pvtPersonsListBoxWrapper = _ ObjectManager. _ NewVBOFListBoxWrapper( _ Collection:=pvtPersons, _ ListBox:=List1) ' attach the Collection, ListBox and ListBoxWrapper Set pvtAddressesListBoxWrapper = _ ObjectManager. _ NewVBOFListBoxWrapper( _ Collection:=pvtAddresses, _ ListBox:=List2) ' attach the Collection, ListBox and ListBoxWrapper Set pvtPhonesListBoxWrapper = _ ObjectManager. _ NewVBOFListBoxWrapper( _ Collection:=pvtPhones, _ ListBox:=List3) ' attach the Collection, ListBox and ListBoxWrapper Set pvtStatesListBoxWrapper = _ ObjectManager. _ NewVBOFListBoxWrapper( _ Collection:=pvtStates, _ ListBox:=lbxStateCodes) pvtStatesListBoxWrapper. _ AddItems ' attach the Collection, ListBox and ListBoxWrapper Set pvtGenderCodesListBoxWrapper = _ ObjectManager. _ NewVBOFListBoxWrapper( _ Collection:=pvtGenderCodes, _ ListBox:=lbxGenderCodes) pvtGenderCodesListBoxWrapper. _ AddItems ' attach the Collection, ListBox and ListBoxWrapper Set pvtMaritalStatusCodesListBoxWrapper = _ ObjectManager. _ NewVBOFListBoxWrapper( _ Collection:=pvtMaritalStatusCodes, _ ListBox:=lbxMaritalStatusCodes) pvtMaritalStatusCodesListBoxWrapper. _ AddItems End Sub Private Sub RefreshAddressList(Optional Person As Variant) Set pvtAddresses = _ Person.Addresses Set pvtAddresses.Parent = _ pvtCurrentPerson ' rebind the Collection, ListBox and ListBoxWrapper pvtAddressesListBoxWrapper.Rebind _ Collection:=pvtAddresses ' populate the ListBox from the Addresses Collection pvtAddressesListBoxWrapper.Clear pvtAddressesListBoxWrapper.AddItems ' set the ListIndex to the previously selected item ' or the first entry If Not pvtCurrentAddress Is Nothing Then pvtAddressesListBoxWrapper.ListIndex = _ pvtAddresses.CollectionIndex _ (Item:=pvtCurrentAddress) - 1 Else pvtAddressesListBoxWrapper.ListIndex = 0 End If ' get the object at the ListIndex Set pvtCurrentAddress = _ pvtAddressesListBoxWrapper. _ ListIndexObject ' display the current address RefreshAddressFields End Sub Private Sub RefreshCustomerList() ' populate the ListBox from the Persons Collection pvtPersonsListBoxWrapper.Clear pvtPersonsListBoxWrapper.AddItems ' set the ListIndex to the previously selected item ' or the first entry If Not pvtCurrentPerson Is Nothing Then If pvtPersons.CollectionIndex _ (Item:=pvtCurrentPerson) >= 0 Then pvtPersonsListBoxWrapper.ListIndex = _ pvtPersons.CollectionIndex _ (Item:=pvtCurrentPerson) - 1 Else pvtPersonsListBoxWrapper.ListIndex = 0 Set pvtCurrentPerson = _ pvtPersonsListBoxWrapper. _ ListIndexObject End If Else If pvtPersonsListBoxWrapper.ListCount > 0 Then pvtPersonsListBoxWrapper.ListIndex = 0 Set pvtCurrentPerson = _ pvtPersonsListBoxWrapper. _ ListIndexObject End If End If ' preselect the previously CurrentPerson If Not pvtCurrentPerson Is Nothing Then Set pvtPersonsListBoxWrapper. _ SelectObject = _ pvtCurrentPerson End If End Sub Private Sub RefreshPhoneList(Optional Person As Variant) Set pvtPhones = _ Person.Phones Set pvtPhones.Parent = _ pvtCurrentPerson ' rebind the Collection, ListBox and ListBoxWrapper pvtPhonesListBoxWrapper.Rebind _ Collection:=pvtPhones ' populate the ListBox from the Phones Collection pvtPhonesListBoxWrapper.Clear pvtPhonesListBoxWrapper.AddItems ' set the ListIndex to the first entry ' set the ListIndex to the previously selected item ' or the first entry If Not pvtCurrentPhone Is Nothing Then pvtPhonesListBoxWrapper.ListIndex = _ pvtPhones.CollectionIndex _ (Item:=pvtCurrentPhone) - 1 Else pvtPhonesListBoxWrapper.ListIndex = 0 End If ' get the object at the ListIndex Set pvtCurrentPhone = _ pvtPhonesListBoxWrapper. _ ListIndexObject ' display the current phone RefreshPhoneFields End Sub Private Sub Command1_Click() Dim tempCollection As Collection Dim tempPerson As Person Dim tempNameList As String Set tempCollection = _ pvtPersonsListBoxWrapper. _ SelectedObjects tempNameList = "" For Each tempPerson In tempCollection If tempNameList = "" Then tempNameList = tempPerson.FormattedName Else tempNameList = tempNameList & ", " & vbCrLf & tempPerson.FormattedName End If Next tempPerson MsgBox "To demonstrate the '(Get) pvtListBoxSelectedObjects' method, there are " & tempCollection.Count & " selected items:" & vbCrLf & tempNameList & vbCrLf & vbCrLf & "The first of these selected entries will be unselected to demonstrate the '(Set) pvtListBoxSelectedObjects' method." tempCollection.Remove 1 Set pvtPersonsListBoxWrapper. _ SelectedObjects = tempCollection End Sub Private Sub efFormattedAddress_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) DisplayStateCapital End Sub Private Sub efFormattedName_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) DisplayPersonalLineage End Sub Private Sub Form_Load() Set pvtStates = _ pubStates Set pvtGenderCodes = _ pubGenderCodes Set pvtMaritalStatusCodes = _ pubMaritalStatusCodes Set pvtPersons = _ pubPersons GetListBoxWrappers RefreshCustomerList List1_Click RegisterForEvents End Sub Public Sub ObjectEventCallBack(Optional Event As Variant, Optional Object As Variant) Dim tempObjectType As String Dim tempUCaseEvent As String On Local Error Resume Next tempObjectType = TypeName(Object) tempUCaseEvent = UCase$(Event) If tempObjectType = "Person" Then If tempUCaseEvent = "REMOVEDITEM" _ Or tempUCaseEvent = "REPLACEDITEM" _ Or tempUCaseEvent = "CHANGED" _ Then RefreshCustomerList If Object.ObjectID = pvtCurrentPerson.ObjectID Then RefreshCustomerFields End If End If End If If tempObjectType = "Address" Then RefreshAddressFields End If If tempObjectType = "Phone" Then RefreshPhoneFields End If End Sub Private Sub RefreshAddressFields() On Local Error Resume Next If pvtCurrentAddress Is Nothing Or Err = 3021 Then efLine1 = "" efLine2 = "" efLine3 = "" efCity = "" lbxStateCodes = "" efZipCode = "" efZipSupplement = "" efZipExtension = "" efFormattedAddress = "" Exit Sub End If efLine1 = pvtCurrentAddress.Line1 efLine2 = pvtCurrentAddress.Line2 efLine3 = pvtCurrentAddress.Line3 efCity = pvtCurrentAddress.City lbxStateCodes = _ pvtCurrentAddress.State.StateCode efZipCode = pvtCurrentAddress.ZipCode efZipSupplement = pvtCurrentAddress.ZipSupplementString efZipExtension = pvtCurrentAddress.ZipExtensionString efFormattedAddress = pvtCurrentAddress.FormattedAddress Set pvtAddressesListBoxWrapper. _ SelectObject = _ pvtCurrentAddress ' DisplayStateCapital End Sub Private Function PopulateCurrentAddress() On Local Error Resume Next With pvtCurrentAddress .Line1 = efLine1 .Line2 = efLine2 .Line3 = efLine3 .City = efCity .ZipCode = efZipCode .ZipSupplement = efZipSupplement .ZipExtension = efZipExtension End With Set pvtCurrentAddress.State = _ pvtStatesListBoxWrapper.ListIndexObject End Function Private Function PopulateCurrentPerson() On Local Error Resume Next With pvtCurrentPerson .CustomerNumber = efCustomerNumber .FirstName = efFirstName .LastName = efLastName .SSN = efSSN .DateOfBirth = DateValue(efDateOfBirth) .Sex = _ pvtGenderCodesListBoxWrapper. _ ListIndexObject _ (pvtGenderCodesListBoxWrapper.ListBox) _ .GenderCode .MaritalStatus = _ pvtMaritalStatusCodesListBoxWrapper. _ ListIndexObject _ (pvtMaritalStatusCodesListBoxWrapper.ListBox) _ .MaritalStatusCode End With End Function Private Function PopulateCurrentPhone() On Local Error Resume Next With pvtCurrentPhone .PhoneNumber = efPhoneNumber .Usage = efUsage End With End Function Sub RefreshCustomerFields() On Local Error Resume Next ' display the person's detail information efCustomerNumber = pvtCurrentPerson.CustomerNumber efFirstName = pvtCurrentPerson.FirstName efLastName = pvtCurrentPerson.LastName efSSN = pvtCurrentPerson.SSN efDateOfBirth = Format$(pvtCurrentPerson.DateOfBirth, "mm/dd/yyyy") lbxMaritalStatusCodes = pvtCurrentPerson.MaritalStatus lbxGenderCodes = pvtCurrentPerson.Sex efFormattedName = _ pvtCurrentPerson.FormattedName efAge = pvtCurrentPerson.Age Set pvtPersonsListBoxWrapper. _ SelectObject = _ pvtCurrentPerson DisplayPersonalLineage End Sub Private Sub RefreshPhoneFields() On Local Error Resume Next If pvtCurrentPhone Is Nothing Or Err = 3021 Then efPhoneNumber = "" efUsage = "" efFormattedPhoneNumber = "" Exit Sub End If efPhoneNumber = pvtCurrentPhone.PhoneNumber efUsage = pvtCurrentPhone.Usage efFormattedPhoneNumber = pvtCurrentPhone.FormattedPhoneNumber Set pvtPhonesListBoxWrapper. _ SelectObject = _ pvtCurrentPhone End Sub Private Sub RegisterForEvents() #If NoEventMgr = False Then ObjectManager.RegisterForObjectEvent _ TriggerObjectType:="Person", _ RegisterObject:=Me ObjectManager.RegisterForObjectEvent _ TriggerObjectType:="Address", _ RegisterObject:=Me ObjectManager.RegisterForObjectEvent _ TriggerObjectType:="Phone", _ RegisterObject:=Me ObjectManager.RegisterForCollectionEvent _ Collection:=pvtPersons, _ RegisterObject:=Me ObjectManager.RegisterForCollectionEvent _ Collection:=pvtAddresses, _ RegisterObject:=Me ObjectManager.RegisterForCollectionEvent _ Collection:=pvtPhones, _ RegisterObject:=Me #End If End Sub Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer) Me.MousePointer = vbArrowHourglass ObjectManager.Form_QueryUnload _ Me, _ pvtPersonsListBoxWrapper, _ pvtAddressesListBoxWrapper, _ pvtPhonesListBoxWrapper, _ pvtStatesListBoxWrapper, _ pvtGenderCodesListBoxWrapper, _ pvtMaritalStatusCodesListBoxWrapper Set pvtPersons = Nothing Set pvtAddresses = Nothing Set pvtPhones = Nothing Set pvtStates = Nothing Set pvtGenderCodes = Nothing Set pvtMaritalStatusCodes = Nothing #If NoEventMgr = False Then ObjectManager. _ UnRegisterForAllEvents _ RegisterObject:=Me #End If Me.MousePointer = vbArrow End Sub Private Sub List1_Click() Dim tempObjectID As Long Set pvtCurrentPerson = _ pvtPersonsListBoxWrapper. _ ListIndexObject ' These next two statements don't contribute anything ' to the application, but they illustrate usages ' of other interesting ListBoxWrapper methods. Set pvtPersonsListBoxWrapper. _ SelectObject = _ pvtCurrentPerson Set pvtCurrentPerson = _ pvtPersonsListBoxWrapper. _ SelectObject RefreshCustomerFields RefreshAddressList _ pvtCurrentPerson RefreshPhoneList _ pvtCurrentPerson DisplayPersonalLineage End Sub Private Sub List1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) DisplayPersonalLineage End Sub Private Sub List2_Click() ' get the object at the ListIndex Set pvtCurrentAddress = _ pvtAddressesListBoxWrapper. _ ListIndexObject ' display the current address RefreshAddressFields End Sub Private Sub List2_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) DisplayStateCapital End Sub Private Sub List3_Click() ' get the object at the ListIndex Set pvtCurrentPhone = _ pvtPhonesListBoxWrapper. _ ListIndexObject ' display the current phone RefreshPhoneFields End Sub Private Sub pbAddNewAddress_Click() Dim tempNewAddress As New Address On Local Error Resume Next Me.MousePointer = vbArrowHourglass Set pvtCurrentAddress = tempNewAddress PopulateCurrentAddress Set pvtCurrentAddress = _ pvtCurrentPerson.AddAddress _ (Item:=tempNewAddress) RefreshAddressList pvtCurrentPerson Me.MousePointer = vbArrow End Sub Private Sub pbAddNewCustomer_Click() Dim tempNewPerson As New Person On Local Error Resume Next Me.MousePointer = vbArrowHourglass Set pvtCurrentPerson = tempNewPerson PopulateCurrentPerson Set pvtCurrentPerson = _ pvtPersons.Add _ (Item:=tempNewPerson) RefreshAddressList pvtCurrentPerson RefreshPhoneList pvtCurrentPerson Me.MousePointer = vbArrow End Sub Private Sub pbAddPhone_Click() Dim tempNewPhone As New Phone On Local Error Resume Next Me.MousePointer = vbArrowHourglass Set pvtCurrentPhone = tempNewPhone PopulateCurrentPhone Set pvtCurrentPhone = _ pvtCurrentPerson.AddPhone _ (Item:=tempNewPhone) RefreshPhoneList pvtCurrentPerson Me.MousePointer = vbArrow End Sub Private Sub pbDeleteAddress_Click() On Local Error Resume Next Me.MousePointer = vbArrowHourglass pvtAddresses.Remove _ Item:=pvtCurrentAddress Set pvtCurrentAddress = Nothing RefreshAddressList pvtCurrentPerson Me.MousePointer = vbArrow End Sub Private Sub pbDeleteCustomer_Click() On Local Error Resume Next Me.MousePointer = vbArrowHourglass MsgBox "Test this code." pvtPersonsListBoxWrapper.RemoveObject _ pvtCurrentPerson Set pvtCurrentPerson = Nothing RefreshCustomerList Me.MousePointer = vbArrow End Sub Private Sub pbDeletePhone_Click() On Local Error Resume Next Me.MousePointer = vbArrowHourglass pvtPhones.Remove _ Item:=pvtCurrentPhone Set pvtCurrentPhone = Nothing RefreshPhoneList pvtCurrentPerson Me.MousePointer = vbArrow End Sub Private Sub pbOK_Click() Unload Me End Sub Private Sub pbUpdateAddress_Click() On Local Error Resume Next Me.MousePointer = vbArrowHourglass PopulateCurrentAddress pvtAddresses.Replace _ Item:=pvtCurrentAddress, _ ReplaceWith:=pvtCurrentAddress ' trigger the "Changed" event ' Note: This typically a responsibility of the BOM. ' But in this demo package, if it were, then the ' demo window which is based on the DataControl ' would do bunches of database I/O and run for ' an extraordinary period. pvtCurrentAddress. _ ObjectHasChanged RefreshAddressList pvtCurrentPerson Me.MousePointer = vbArrow End Sub Private Sub pbUpdateCustomer_Click() On Local Error Resume Next Me.MousePointer = vbArrowHourglass PopulateCurrentPerson pvtPersons.Replace _ Item:=pvtCurrentPerson, _ ReplaceWith:=pvtCurrentPerson ' trigger the "Changed" event ' Note: This typically a responsibility of the BOM. ' But in this demo package, if it were, then the ' demo window which is based on the DataControl ' would do bunches of database I/O and run for ' an extraordinary period. pvtCurrentPerson. _ ObjectHasChanged RefreshCustomerList Me.MousePointer = vbArrow End Sub Private Sub pbUpdatePhone_Click() On Local Error Resume Next Me.MousePointer = vbArrowHourglass PopulateCurrentPhone pvtPhones.Replace _ Item:=pvtCurrentPhone, _ ReplaceWith:=pvtCurrentPhone ' trigger the "Changed" event ' Note: This typically a responsibility of the BOM. ' But in this demo package, if it were, then the ' demo window which is based on the DataControl ' would do bunches of database I/O and run for ' an extraordinary period. pvtCurrentPhone. _ ObjectHasChanged RefreshPhoneList pvtCurrentPerson Me.MousePointer = vbArrow End Sub 
(.txt)