
ActiveX is the umbrella name Microsoft applies to developer technology that implements the component object model (COM). At its heart, COM allows applications to communicate with each other and use each other's features without regard to the original development language, date of development, or version compatibility. The component object model started from the concepts of object-oriented programming (OOP) and extended that model into the operating system to allow any COM program object to communicate successfully with any other COM object supporting the desired interfaces.
OBJECT-ORIENTED PROGRAMMING
Object-oriented programming provides disciplines and methods for source code re-use and recycling. OOP engineering concepts define an environment in which program objects model "real-world" objects. Each object is responsible for its own data, program logic, lifetime, and interfaces to the outside world. Formally, the academic experts tell us that "true" objects must support encapsulation, inheritance, and polymorphism.
Encapsulation means that each object provides a safe container (or capsule) for its properties (data) and methods (code). The object defines which properties and methods it will allow other objects to see (public) and which ones remain only inside the object (private).
Inheritance means that a new object can be defined as a "kind of" another object and gain all the "parent" object's properties and methods without doing any work.
Polymorphism is the capability of a derived object to change or override the inherited methods of its parents. You can have a dog object with a method to bark, and you can then have a big dog and a little dog inherited from the parent dog, each with a bark--but those two barks can be different (woof, and WOOF WOOF, for example) if that method is overridden in the new object.
The component object model (COM) and the distributed component object model (DCOM) extend the object-oriented programming (see sidebar) paradigm to allow preexisting software applications and objects to interact through a published, stable specification. Microsoft's first widely published implementation of the component object model was Object Linking and Embedding (OLE). This technology allowed previously compiled programs to embed or link their objects (Word documents or Excel spreadsheets) into new documents or forms.
Unfortunately, VB6 does not fully implement object-oriented programming. In particular, polymorphism is given short shrift. In traditional OOP, an object can inherit methods from a parent and then change or override only selected methods without having to re-implement all the parent's methods. With VB6, the programmer must implement all inherited methods of a parent object even if only one method is to be changed. By using the Implements keyword, a programmer tells the VB6 compiler that the class is implementing an interface derived from another class. The "bird" object "flies on" feathered wings. The "airliner" object "flies on" metal wings. In VB6, both the bird and the airliner classes would be declared to implement the FlyingThing class in order to encapsulate the FlyingThing's properties and methods. Both birds and airliners are flying objects, and both implement a "flies on" property, but they appear to share similar properties and behaviors even though they are different objects.
Visual Basic 6 provides several ways to incorporate ActiveX technologies in applications, determined primarily by how the calling application fits into the ActiveX component's environment:
The three ActiveX methods share the use of the component object model as the operating-environment glue that allows successful communication between components.
As developers, we build all our ActiveX code components as class modules. At the simple, practical level, Visual Basic 6 treats class modules as objects implement-ing properties and methods in just the same manner in which we can use the Visual Basic label control from our code. We can set the Caption property and then invoke the Refresh method to ensure that the caption is displayed immediately. Visual Basic will help us write the code with its code completion features and will show us as we type the defined properties and methods for each object in the application. As a result, programmers will reuse existing code more often, develop systems faster, and produce more reliable systems. The use of classes to develop our features and functions helps keep other programmers from using our code in ways we did not intend.
ActiveX code components publish properties and methods that are available for use in your application. An ActiveX code component can be included in an application by referencing a component from the Project menu in the development environment. When included, component properties and methods can be invoked from the calling application as though the calling application had all the component application's functionality. For example, an application referencing a Microsoft Office EXE component can use the Visual Basic for Applications (VBA) methods to manipulate the Office component's properties to create powerful business solutions.
Visual Basic 4 called code components object linking and embedding, which is used to embed or link another application's object within the calling application. The calling application is called the container. A Visual Basic application acting as the container can use the OLE Container control to display linked or embedded objects belonging to server applications. The type of object depends on the server. A spreadsheet program typically provides worksheet objects and graph objects. A word processing program provides document objects. A graphics program provides picture objects.
As mentioned previously, the balance of this chapter pertains to ActiveX code components. The specific How-To's consist of the following tasks.
You can use the OLE Object field type in a Microsoft Access database file to store linked or embedded objects, and then display those objects on a Visual Basic form. Users can view or edit the object from within the Visual Basic application. This How-To shows you how to use an OLE Container control linked to a data control to accomplish this task.
The first step to creating an ActiveX code component is to create and debug a private class module that implements all the desired properties and methods. This How-To shows you a simple class-based replacement for the data control that implements core functions.
After you build a useful class module for simple data access, other members of your workgroup or corporation might find it useful. Company policy, however, requires that your class module's functions only be distributed as object code--you can't share your source. This How-To shows how to convert your class module into an ActiveX DLL that can be used by other applications.
Visual Basic 6.0 has given the language a much stronger and more useful set of object-oriented features with ActiveX. This How-To demonstrates a method of creating an ActiveX EXE component in Visual Basic that can be used from other applications or even from other machines while hiding the details of its operation and encapsulating its data.
The application design requires that all reports be centrally administered, and the Access database has been selected as the report repository. This How-To demonstrates using Microsoft Access from Visual Basic to print reports defined within the database.
Sometimes, an application needs to take advantage of Access database functions that are not available directly to Visual Basic 6.0. This How-To demonstrates using Microsoft Access as a component to use a query containing a user-defined function.
Although Visual Basic is an extremely powerful and flexible tool and environment, it lacks many specialized functions for financial, statistical, and scientific analyses of data in a database. This How-To shows how you can use the specialized statistical functions from Microsoft Excel to make statistical calculations on any database accessible to Visual Basic.
One of the biggest advantages of using ActiveX code components with Visual Basic applications is that you can use the functionality of other applications in Visual Basic. In this How-To, you will see how you can use all the power of Microsoft Word in Visual Basic, eliminating the need to duplicate the program-ming in your own code.
ActiveX code components bring lots of power and flexibility to your applica-tions, but they rely on correct registration in order for other programs to find them. This How-To shows the use of the registration server to register and "unregister" your controls.
The data control provided with Visual Basic 6 is a powerful tool for building many applications, but it can add tremendous amounts of processing overhead because it is a general-purpose tool with methods and events that no one needs for most projects. This How-To shows you how to build a custom data control purpose-built for a single table using data access objects.
The data bound list box provided with Visual Basic is quite powerful, but using a data control to populate can add a lot of unnecessary overhead to an applica-tion. This How-To shows you a data bound combo box control that loads a specific code value type such as HAIRCOLOR from a specified database.
The DataRepeater control, new in Visual Basic 6, takes your custom data bound control and duplicates it so that your custom control acts like a line in a list box. This How-To shows you how to use the DataRepeater control with your custom bound control to build a database application that can browse and edit many records at the same time.
Problem
I'm creating a customer service database with a table that documents contacts with customers. When the customer is sent a letter, I'd like to put a copy of the actual word processing document into the table. How can I do this with Visual Basic?
Technique
Microsoft Access provides the OLE Object field type into which you can place either a linked or an embedded OLE object. An embedded object is actually stored in the database. Linked objects are not stored in the database; rather, the database stores a reference to the file containing the object.
The Visual Basic OLE Container control is a control used to place an OLE object onto a form. The OLE Container control is then bound to an OLE Object field in a Microsoft Access database through a data control. The data control and OLE Container control together manage the retrieval and updating of the OLE Object field and the display of the field's contents on the form.
Visual Basic can insert a new object into a Microsoft Access database OLE Object field in two ways. The OLE Container control's InsertObjectDlg box displays the Insert Object dialog box. The dialog box enables the user to choose to create a new object from any application on the system that can act as an OLE Server. This creates an embedded object. The dialog box also gives the user the means to select a file containing an OLE object and to designate that the object be stored as an embedded or linked object.
If the Clipboard contains an object created by an OLE Server application, and if the current control is an OLE Container, Visual Basic can paste the contents of the Clipboard into the control. The OLE Container's Paste method pastes the object into the control in the default format (which depends on the type of object). The PasteSpecial method displays a dialog box that lets the user select the format for those object types that support more than one format.
Steps
Open the project Embedded.VBP. If necessary, edit the DatabaseName property of the datObjects control to point to a copy of Chapter12.MDB. Then run the project. The form shown in Figure 12.1 appears. Use the record navigation buttons of the data control to page through the records. As you display a record, the application shows you the contents of the OLE Object field, the type of object, and the name of the object. Double-click the object, and Paintbrush opens with the object displayed. Edit the object in Paintbrush, and then choose File | Exit from the Paintbrush menu. When the dialog box appears asking whether you want to update the link to the Visual Basic application, click Yes.
Figure 12.1. The Object Library form.
On the form, click the Add button. Click the OLE Container control, and then choose Edit | Insert Object. The Insert Object dialog box appears, as shown in Figure 12.2. To create a new embedded object from one of the listed applications, choose the object from the list and click OK. To create an object from a file, choose the Create from File option. When the Insert Object dialog box changes in appearance (see Figure 12.3), either enter a filename or click Browse and select a file from the File Open dialog box that appears. If you want to select a linked object, click the Link check box. To create an embedded object, leave the Link check box blank.
Figure 12.2. The Insert Object dialog box.
Figure 12.3. The Insert Object dialog box with the Create from File option selected.
Table 12.1. Objects and properties for the Object Library form.
OBJECT PROPERTY Setting Form Name Form1 Caption "Object Library" Name CommandButton cmdClick Caption "&Close Object" Name CommandButton cmdDelete Caption "&Delete" Name CommandButton cmdAdd Caption "&Add" Name TextBox txtTitle DataField "Title" DataSource "datObjects" Name Data datObjects Connect "Access" DatabaseName "C:\Code\Chapter12\Chapter12.mdb" RecordsetType 1 `Dynaset RecordSource "ObjectLibrary" Name Label lblClass DataField "Object Type" DataSource "datObjects" Name OLE oleObject DataField "Object" DataSource "datObjects" SizeMode 3 `Zoom Name Label Label1 AutoSize -1 `True Name Label Label2 AutoSize -1 `True
Table 12.2. Menu specifications for the Object Library form.
CAPTION Name Shortcut Key &File mnuFile ----E&xit mnuFileExit &Edit mnuEdit ----&Paste mnuEditPaste Ctrl+V ----Past&e Special mnuEditPasteSpecial ---- ---- mnuEditSep ----&Insert Object mnuEditInsertObject
Private mblnDeleting As Boolean
Private Sub cmdAdd_Click()
Data1.Recordset.AddNew
End Sub
Private Sub cmdDelete_Click()
On Error GoTo DeleteError
mblnDeleting = True
datObjects.Recordset.Delete
`oleObject.Class = ""
datObjects.Recordset.MoveNext
` Handle the "no current record" case.
If datObjects.Recordset.EOF Then
` Handle the special case of deleting the
` last record
datObjects.Recordset.MoveLast
End If
mblnDeleting = False
` Reset the error handler
On Error GoTo 0
Exit Sub
DeleteError:
If Err.Number = 3021 Then ` No current record
Resume Next
End If
End Sub
Private Sub mnuEdit_Click()
If Me.ActiveControl.Name = "oleObject" Then
mnuEditPaste.Enabled = oleObject.PasteOK
mnuEditPasteSpecial.Enabled = oleObject.PasteOK
mnuEditInsertObject.Enabled = True
Else
mnuEditPaste.Enabled = False
mnuEditPasteSpecial.Enabled = False
mnuEditInsertObject.Enabled = False
End If
End Sub
Private Sub mnuEditInsertObject_Click()
OLE1.InsertObjDlg
If OLE1.DataChanged Then
lblClass.Caption = OLE1.Class
End If
End Sub
Private Sub mnuEditInsertObject_Click()
oleObject.InsertObjDlg
If oleObject.DataChanged Then
lblClass.Caption = oleObject.Class
End If
End Sub
Private Sub mnuEditPasteSpecial_Click()
oleObject.PasteSpecialDlg
lblClass.Caption = oleObject.Class
End Sub
Private Sub cmdCloseObject_Click()
` Save the updated object
If oleObject.DataChanged Or txtTitle.DataChanged Then
datObjects.UpdateRecord
End If
End Sub
Private Sub mnuFileExit_Click()
If oleObject.DataChanged Or txtTitle.DataChanged Then
datObjects.UpdateRecord
End If
Unload Me
End Sub
Private Sub datObjects_Reposition()
If Not mblnDeleting Then
` Update the label for the oleObject class if the
` reposition is not a MoveNext after deletion of
` the last record. The change to the lblClass value
` forces another validation and record update
` attempt. The update attempt after the deletion of
` the last record causes a "no current record" error
If lblClass.Caption = "" Then
lblClass.Caption = oleObject.Class
End If
End If
End Sub
Dim strDbName As String
Dim strResponse As String
On Error GoTo LoadError
` Set the database of the data control
strDbName = App.Path
strDbName = strDbName & "\Chapter14.mdb"
datObjects.DatabaseName = strDbName
` Indicate that we are not currently deleting a
` record
mblnDeleting = False
Exit Sub
LoadError:
MsgBox Err.Description & Chr(13) & "from " & Err.Source _
& " -- Number: " & CStr(Err.Number)
Unload Me
End Sub
How It Works
The OLE Container control contains the image of the data you are storing, the name of the application used to manipulate the data, and the actual object data (embedded) or a reference to the actual object data (linked). For example, when you embed a spreadsheet in the OLE Container control, the display image of the spreadsheet, the application name (usually Excel), and the spreadsheet data itself are stored in the OLE Container control.
The data control is responsible for storing the embedded object in the Access OLE object database field. You might notice the "extra" work required to deal with the case of record movement after deleting the last record. The form uses a control variable (mblnDeleting) to determine whether a delete operation is in progress. The variable is checked in the Reposition event to prevent use of the oleObject.Class field when the last record has been deleted from the recordset and the unfortunate No current record error. There are 12 data validation constants for the data control to meet every programmer's potential needs, but they can cause unfortunate extra work if a reference to control data is required during a different event's firing. In this case, the Reposition event needs to check a field value, forcing a validation event before the Reposition event is complete.
The OLE Container control does almost all the work for this application for us by managing the properties and methods exposed by the ActiveX Automation components registered on the application's computer. Simply double-click the OLE Container control, and people using the application have almost all the capabilities of the embedded or linked component. The only limitation is that embedded or linked document saving occurs through the OLE container rather than through the application.
Comments
The properties of the OLE Container control give you a great deal of control over how the control works in your application. Two of the most useful properties are the edit-in-place property--actually a setting of the MiscFlags property--and the SizeMode property. More details on other OLE Container control properties can be found in the Visual Basic 6 documentation.
Editing in Place
If an ActiveX Automation application implements in-place editing, the user can edit an object right from your Visual Basic form. When the user double-clicks the OLE Container control, the menu bar changes to the one used by the server application that created the object, and any toolbars associated with the server application appear. The full facilities of the server application are available to the containing application. When the user moves the focus off the OLE Container control, the menus are restored to those of the client (Visual Basic) application.
Unless you specify otherwise, editing in-place is active for those server applica-tions that support it. To disable editing in-place, set the MiscFlags property to the built-in constant value of 2 (or use the constant vbOLEMiscFlagDisableInPlace).
Controlling the Size
Windows gives the user the ability to resize forms. You might not always know in advance the size of the object that will be stored in a database; therefore, Visual Basic enables you to control how the OLE Container or the object it contains is sized. This is implemented through the settings of the SizeMode property, which are shown in Table 12.3. The default for the SizeMode property is 2 (Autosize).
| SETTING | Meaning |
| 0 - vbOLESizeClip | The object is displayed actual size. If the object is larger than the control, the image is clipped by the control. |
| 1 - vbOLESizeStretch | The object's image is sized to fill the control. May not maintain the original proportions. |
| 2 - vbOLESizeAutoSize | The control is resized to display the entire object. Maintains proportions, but requires that the OLE Container control resize event be handled to change the size of the form or the container. |
| 3 - vbOLESizeZoom | The object is resized to fill as much as possible of the control while maintaining the original proportions. |
Problem
I'm writing a companywide expense reporting system and need to control the data access to the expense detail table to ensure that all data is correctly edited before insertion. How do I create a private class module with properties and methods to manage and protect the contents of the expense detail table?
Technique
For this How-To, consider an expense detail table (contained in Expense.MDB). The fields of this table are listed in Table 12.4.
| FIELD | Type |
| ExpenseID | Long--Auto increment |
| EmployeeId | Text |
| ExpenseType | Text |
| AmountSpent | Currency |
| Description | Text |
| DatePurchased | Date/Time |
| DateSubmitted | Date/Time |
The people in the accounting department are very concerned that any entries made to this table always pass certain edit checks. They are most concerned that the submission date always be set to the current date. They want no back-dated submissions to make it look as though they're working slowly. We have decided to manage the expense detail table with a Visual Basic class module to encapsulate the table properties and enforce the critical submission-date requirement.
Class Modules Form the Object Core
Visual Basic class modules implement program objects and are the core building block of all ActiveX code components. Each class implements public or private properties and methods. Properties are data items such as an expense amount. Methods are code procedures that act on the properties. Public items are exposed outside the class to the calling application. Private items are restricted to access by members of the class unless you choose to expose selected methods as friends to be invoked directly by code contained within the same project.
The expense detail class will be constructed to have properties (data items) corresponding to each table field plus an additional property to contain the Access database filename. The class assumes that the table is named Expenses. All properties are implemented with the Private keyword to ensure that callers cannot access the data directly. A private declaration limits access to a variable or function to code contained within the same module. Access to properties is through the Property Let and Property Get methods. These special-purpose, public method procedures assign values to and retrieve values from their properties. As values are set and retrieved, the Let and Get procedures can perform simple edits or complex calculations.
Linking Forms and Classes
The easiest way to link a simple form and its maintenance class is through two subroutines, one for setting the object's values and the other for getting changed object values. These subroutines transfer values between the form's controls and the object's properties by means of the Property Let and Property Set methods. The subroutines are called before any of the object's data movement methods are called.
Building Class Modules
In Visual Basic 6, you can build class modules by typing the entire program module or by using the Class Builder utility. This add-in speeds initial class module construction by automating property variable naming and construction of all required skeleton methods. Unfortunately, the Class Builder cannot delete classes after they are created. The most efficient way to use the Class Builder is to use it for initial definition of most of the class and then use manual editing for the remainder of the code maintenance.
The principal benefit of using the Class Builder utility is that it automatically makes all properties private and creates public Property Let and Property Get methods to allow calling applications to manipulate the object's properties. Although this approach incurs some additional processing overhead, especially in a private class module used only in your application, it automatically provides placeholders where you can later add code to manipulate properties as they are set.
Steps
Open the project ActiveXExpense.VBP and run the project. The form shown in Figure 12.4 appears. Experiment with the form to understand its simple behavior. The class module implements the most common data control methods.
Figure 12.4. The Expense Client form.
Table 12.5. Objects and properties for the Expense client form.
OBJECT Property Setting Form Name frmExpClient Caption "Expense Client" CommandButton Name cmdLast Caption "&Last" CommandButton Name cmdNext Caption "&Next" CommandButton Name cmdPrev Caption "&Prev" CommandButton Name cmdFirst Caption "&First" CommandButton Name cmdDelete Caption "&Delete" CommandButton Name cmdUpdate Caption "&Update" CommandButton Name cmdNewExpense Caption "Ne&w Expense" MaskEdBox Name mskAmountSpent Format "$#,##0.00;($#,##0.00)" TextBox Name txtSubmitDate TextBox Name txtPurchaseDate TextBox Name txtDescription TextBox Name txtExpenseType TextBox Name txtEmployeeId TextBox Name txtExpenseId Label Name Label1 Caption "Expense ID:" Label Name Label2 Caption "Employee:" Label Name Label3 Caption "Expense Type:" Label Name Label4 Caption "Amount Spent:" Label Name Label5 Caption "Description:" Label Name Label6 Caption "Purchase Date:" Label Name Label7 Caption "Submission Date:"
Table 12.6. Menu specifications for the Expense client form.
CAPTION Name Shortcut Key &File mnuFile ----E&xit mnuFileExit
Private expDetailClass As New ExpenseDetail
Private Sub cmdNewExpense_Click()
Dim strResponse As String
strResponse = SetObjectValues
If "OK" = strResponse Then
strResponse = expDetailClass.Insert
If "OK" <> strResponse Then
MsgBox strResponse
Exit Sub
End If
Call ReadObjectValues
Else
MsgBox strResponse
End If
End Sub
Private Sub cmdUpdate_Click()
` Updates current record with form values
Dim strResponse As String
strResponse = SetObjectValues
If "OK" = strResponse Then
strResponse = expDetailClass.Update
If "OK" <> strResponse Then
MsgBox strResponse
Exit Sub
End If
Call ReadObjectValues
Else
MsgBox strResponse
End If
End Sub
Private Sub cmdDelete_Click()
` Deletes current record from database
Dim strResponse As String
strResponse = expDetailClass.Delete
If "OK" <> strResponse Then
MsgBox strResponse
Else
Call ReadObjectValues
End If
End Sub
Private Sub cmdFirst_Click()
` Positions to first record in recordset and displays
` values
Dim strResponse As String
strResponse = expDetailClass.MoveFirst
If "OK" <> strResponse Then
MsgBox strResponse
Else
Call ReadObjectValues
End If
End Sub
Private Sub cmdLast_Click()
` Positions to last record in recordset and displays values
Dim strResponse As String
strResponse = expDetailClass.MoveLast
If "OK" <> strResponse Then
MsgBox strResponse
Else
Call ReadObjectValues
End If
End Sub
Private Sub cmdNext_Click()
` Positions to Next record in recordset and displays values
Dim strResponse As String
strResponse = expDetailClass.MoveNext
If "OK" <> strResponse Then
MsgBox strResponse
Else
Call ReadObjectValues
End If
End Sub
Private Sub cmdPrev_Click()
` Positions to Previous record in recordset and displays
` values
Dim strResponse As String
strResponse = expDetailClass.MovePrev
If "OK" <> strResponse Then
MsgBox strResponse
Else
Call ReadObjectValues
End If
End Sub
Private Function SetObjectValues() As String
` Sets related object values from form fields
Dim strResponse As String
strResponse = expDetailClass. _
strSetExpenseType(txtExpenseType.Text)
On Error GoTo TypeError
If "OK" = strResponse Then
expDetailClass.strEmployeeId = txtEmployeeId.Text
expDetailClass.strDescription = txtDescription.Text
expDetailClass.dtmDatePurchased = txtPurchaseDate.Text
expDetailClass.curAmountSpent = CCur(mskAmountSpent.Text)
End If
SetObjectValues = strResponse
Exit Function
TypeError:
If Err.Number = 13 Then
expDetailClass.curAmountSpent = 0
Resume Next
End If
End Function
Private Sub ReadObjectValues()
` Read the object values into the form fields
txtExpenseId.Text = CStr(expDetailClass.lngExpenseId)
txtEmployeeId.Text = expDetailClass.strEmployeeId
txtExpenseType.Text = expDetailClass.strExpenseType
txtDescription.Text = expDetailClass.strDescription
mskAmountSpent.Text = CStr(expDetailClass.curAmountSpent)
txtPurchaseDate.Text = CStr(expDetailClass.dtmDatePurchased)
txtSubmitDate.Text = CStr(expDetailClass.dtmDateSubmitted)
End Sub
Private Sub Form_Load()
` Get the ActiveX object to open its database and position
` to the first record
Dim strDbName As String
Dim strResponse As String
On Error GoTo LoadError
strDbName = App.Path
strDbName = strDbName & "\Expense.mdb"
expDetailClass.strDbName = strDbName
strResponse = expDetailClass.MoveFirst
If "OK" <> strResponse Then
MsgBox strResponse
Else
Call ReadObjectValues
End If
Exit Sub
LoadError:
MsgBox Err.Description & Chr(13) & "from " & Err.Source _
& " -- Number: " & CStr(Err.Number)
Unload Me
End Sub
Private Sub Form_Unload(Cancel As Integer)
Set expDetailClass = Nothing
End Sub
Private Sub mnuFileExit_Click()
Unload Me
End Sub
Table 12.7. Properties and data types for the ExpenseDetail class.
PROPERTY Data Type lngExpenseID Long strEmployeeId String strExpenseType String curAmmountSpent Currency strDescription String dtmDatePurchased Date dtmDateSubmitted Date strDbName String
Figure 12.5. The VB Property Builder.
Table 12.8. Methods and data types for the ExpenseDetail class.
METHOD Return Data Type Delete String Insert String Update String MoveFirst String MoveNext String MovePrev String MoveLast String
Option Explicit `local variable(s) to hold property value(s) Private mvarlngExpenseId As Long `local copy Private mvarstrEmployeeId As String `local copy Private mvarstrExpenseType As String `local copy Private mvarcurAmountSpent As Currency `local copy Private mvarstrDescription As String `local copy Private mvardtmDatePurchased As Date `local copy Private mvardtmDateSubmitted As Date `local copy Private mvarstrDbName As String `local copy ` Database variables needed to keep track of current ` database condition Private mdbExpense As Database Private mrecExpense As Recordset Private mblnRecSetOpen As Boolean
Public Property Let strDbName(ByVal vData As String)
`used when assigning a value to the property, on the left
`side of an assignment.
`Syntax: X.strDbName = 5
On Error GoTo OpenError
If mblnRecSetOpen Then
mrecExpense.Close
mdbExpense.Close
End If
mvarstrDbName = vData
Set mdbExpense = DBEngine.Workspaces(0). _
OpenDatabase(mvarstrDbName)
Set mrecExpense = mdbExpense.OpenRecordset("Expenses")
mblnRecSetOpen = True
Exit Property
OpenError:
` Because we are designing this class for
` potential unattended operation, we'll have to raise
` an error on our own
Err.Raise Number:=Err.Number
Err.Clear
Exit Property
End Property
Private Sub Class_Initialize()
` Indicate that the database is not yet open
mblnRecSetOpen = False
` Clear all object variables
Call ClearObject
End Sub
Private Sub Class_Terminate()
` We don't really care about errors when cleaning up.
On Error Resume Next
` Close the recordset
mrecExpense.Close
` Close the expense database
mdbExpense.Close
` Reset the error handler
On Error GoTo 0
Exit Sub
End Sub
Private Sub ClearObject()
` Clears all object variables
mvarlngExpenseId = 0
mvarstrEmployeeId = ""
mvarstrExpenseType = ""
mvarcurAmountSpent = 0
mvarstrDescription = ""
mvardtmDatePurchased = CDate("1/1/1980")
mvardtmDateSubmitted = CDate("1/1/1980")
End Sub
Private Sub SetRecordset(recExp As Recordset)
` Copies current values to Recordset
With recExp
!EmployeeId = mvarstrEmployeeId
!ExpenseType = mvarstrExpenseType
!AmountSpent = mvarcurAmountSpent
!Description = mvarstrDescription
!DatePurchased = mvardtmDatePurchased
!DateSubmitted = mvardtmDateSubmitted
End With
End Sub
Private Sub GetRecordset(recExp As Recordset)
` Copies current values to Recordset
With recExp
mvarlngExpenseId = 0 + !ExpenseID
mvarstrEmployeeId = "" & !EmployeeId
mvarstrExpenseType = "" & !ExpenseType
mvarcurAmountSpent = 0 + !AmountSpent
mvarstrDescription = "" & !Description
mvardtmDatePurchased = !DatePurchased
mvardtmDateSubmitted = !DateSubmitted
End With
End Sub
Public Function strSetExpenseType(ByVal vData As String) As String
` Sets the expense type to an allowed value
Dim strTemp As String
strTemp = UCase$(vData)
If strTemp = "TRAVEL" _
Or strTemp = "MEALS" _
Or strTemp = "OFFICE" _
Or strTemp = "AUTO" _
Or strTemp = "TOLL/PARK" Then
mvarstrExpenseType = strTemp
strSetExpenseType = "OK"
Else
strSetExpenseType = "Expense type must be TRAVEL, MEALS, " _
& "OFFICE, AUTO, or TOLL/PARK"
End If
End Function
Public Function Insert() As String
` Inserts a brand-new record into the database and leaves
` the newly inserted values as the current object values.
On Error GoTo InsertError
With mrecExpense
.AddNew
mvardtmDateSubmitted = Now
Call SetRecordset(mrecExpense)
.Update
`Move to the most recently modified record
.Bookmark = .LastModified
Call GetRecordset(mrecExpense)
End With
Insert = "OK"
Exit Function
InsertError:
` Return the error description
Insert = Err.Description
Err.Clear
Exit Function
End Function
Public Function Update() As String
` Updates Expenses table from current object values
Dim strSql As String
On Error GoTo UpdateError
With mrecExpense
.Edit
Call SetRecordset(mrecExpense)
.Update
.Bookmark = .LastModified
Call GetRecordset(mrecExpense)
End With
Update = "OK"
Exit Function
UpdateError:
` Return the error description
Update = Err.Description
Err.Clear
Exit Function
End Function
Public Function Delete() As String
` Deletes the expense detail record whose value is current
` from the database
On Error GoTo DeleteError
With mrecExpense
.Delete
If 0 = .RecordCount Then
Call ClearObject
Else
.MoveNext
If .EOF Then
Call ClearObject
Else
Call GetRecordset(mrecExpense)
End If
End If
End With
Delete = "OK"
Exit Function
DeleteError:
` Return the error description
Delete = Err.Description
Err.Clear
Exit Function
End Function
Public Function MoveFirst() As String
` Retrieve the first record
On Error GoTo MoveError
With mrecExpense
If True = .BOF _
And True = .EOF Then
` Empty recordset
MoveFirst = "BOF"
Else
` Move to the first record
.MoveFirst
Call GetRecordset(mrecExpense)
MoveFirst = "OK"
End If
End With
Exit Function
MoveError:
` Return the error description
MoveFirst = Err.Description
Err.Clear
Exit Function
End Function
Public Function MoveNext() As String
` Moves to next Expenses table record and sets current
` object values
On Error GoTo MoveError
With mrecExpense
If True = .BOF _
And True = .EOF Then
` Empty recordset
MoveNext = "EOF"
Else
` Move to the next record
.MoveNext
If mrecExpense.EOF Then
MoveNext = "EOF"
Else
Call GetRecordset(mrecExpense)
MoveNext = "OK"
End If
End If
End With
Exit Function
MoveError:
` Return the error description
MoveNext = Err.Description
Err.Clear
Exit Function
End Function
Public Function MovePrev() As String
` Retrieve the record prior to the current one
On Error GoTo MoveError
With mrecExpense
If True = .BOF _
And True = .EOF Then
` Empty recordset
MovePrev = "BOF"
Else
` Move to the previous record
.MovePrevious
If .BOF Then
MovePrev = "BOF"
Else
Call GetRecordset(mrecExpense)
MovePrev = "OK"
End If
End If
End With
Exit Function
MoveError:
` Return the error description
MovePrev = Err.Description
Err.Clear
Exit Function
End Function
Public Function MoveLast() As String
` Retrieve the last record
On Error GoTo MoveError
With mrecExpense
If True = .BOF _
And True = .EOF Then
` Empty recordset
MoveLast = "EOF"
Else
` Move to the last record
.MoveLast
Call GetRecordset(mrecExpense)
MoveLast = "OK"
End If
End With
Exit Function
MoveError:
` Return the error description
MoveLast = Err.Description
Err.Clear
Exit Function
End Function
How It Works
On Form_Load (step 10), the client application sets the database name for the class, causing the database and recordset to open in the class module. The MoveFirst method positions the class's recordset at the first record and populates the object's properties. The ReadObjectValues procedure copies the object values to the display fields. Each command button on the form invokes a method very similar to a data control method without the data control's performance overhead or frequently annoying events.
Comments
The use of a private class to manage your objects or tables is the starting of the n-tier architecture for your applications. In n-tier architectures, presentation (or input/output) is managed by one set of components, business rules by a second tier (class modules), and data by another tier (rules and triggers contained in the database management system). The advantage of objects in this environment is that underlying technology can be changed without affecting the callers as long as the interfaces remain stable.
Finally, you can easily convert class modules to ActiveX DLLs or ActiveX EXEs by including them in a different project and recompiling. You can test and debug a new class as a private module and then convert it to an EXE or a DLL. How-To 12.2 converts the ExpenseDetail class to an ActiveX DLL.
Problem
The staff in the accounting department loves the new ExpenseDetail class and the concept of "black box" interfaces, but they are very worried that employees using the private class in source-code form might compromise the class's security by modifying the code to inflate their own expense reimbursements. How can I prevent access to my class's source code while letting other projects take advantage of the ExpenseDetail class?
TECHNIQUE
There are several ways to publish your class's properties and methods without revealing
the source code. After all, major software publishers do it every day. The technique
is to convert the class module into an ActiveX DLL or EXE. This How-To demonstrates
using the ExpenseDetail class module in an ActiveX DLL.
Steps
To preview the ExpenseDetail DLL on your system, you first need to register the code component in your system registry. Visual Basic will register the component for you automatically if you compile once. Open the ActiveXDll.VBP project. Select File | Make ActiveX.DLL to compile the component. Open the ActiveXExpense.vbp project and run it. You should see the form shown in Figure 12.6, which is the same form shown earlier in Figure 12.4 because the form file is identical; only the project composition was changed for the main application program.
Figure 12.6. The Expense Client form, now using an ActiveX DLL.
Figure 12.7. Setting the ActiveX DLL project properties.
Figure 12.8. Adding a reference to the ActiveX DLL.
How It Works
The Expense Client with an ActiveX DLL class works the same way as the bound class because the programs are identical. The power of the component object model is letting the various pieces work together without the Expense Client form needing to know how the class code works. It needs only the names and calling parameters for the public methods and properties exposed by the ActiveX DLL. The exposed interfaces to the ActiveX DLL are made available on your computer when you compile the ActiveX DLL by virtue of Visual Basic 6 automatically registering the DLL in your system registry.
Comments
As you work more with building your own code components, plan to develop a test-and-debug strategy. In How-To 12.2, we developed (and probably tested and debugged) a test client form and a class module linked directly into the project. This approach to class modules simplifies development by allowing you to use the Visual Basic debugger. After the ActiveX DLL is compiled, you can use only the Visual C++ debugger.
Be aware that the use of ActiveX components on your system can eventually lead to excessive Registry entries, especially if you periodically delete and move your development DLL files. How-To 12.9 discusses two Registry utilities from Microsoft that can help keep your Registry under control.
Problem
I have a highly sensitive, protected database for which I must strictly control access--hiding even the details of its format, source, and location, and giving controlled access to sections of the data. How can I create a Visual Basic object that can be used in other applications while protecting the database?
Technique
By creating an ActiveX EXE with a public class object, you can control everything about the database--hiding the details about the database itself, and giving the container application (the application creating and using the object) only limited access to the contents of any or all tables. Because the class methods that access the data are defined by your class module, you can limit access to only one or a few tables, only certain records or a limited number of records, or whatever constraints you choose to place on the database. As far as the container application is concerned, the data could be coming from a network, another program, or anywhere else.
Steps
Open the Visual Basic SECURED.VBP project. Start the application by selecting
Run | Start from the Visual Basic main menu, pressing F5, or clicking the Start button
on the Visual Basic toolbar. Minimize that instance of Visual Basic. Start Microsoft
Excel from the Windows Program Manager and open the SECURED.
XLS workbook. Run the Main macro application by selecting Tools | Macro | Macros,
selecting the Main macro, and clicking Run. Main creates a spreadsheet with the contents
of the database table and then releases the database object. Exit Excel and stop
the Visual Basic SECURED application.
Figure 12.9. The New Project window.
| PROPERTY | SETTING |
| Instancing 3--Single Use | Name ExeExpenseDetail |
Private Sub Class_Initialize()
On Error GoTo OpenError
` Put all the required security code here where it is
` protected by compilation.
mvarstrDbName = App.Path & "\Expense.mdb"
Set mdbExpense = DBEngine.Workspaces(0). _
OpenDatabase(mvarstrDbName)
Set mrecExpense = mdbExpense.OpenRecordset("Expenses")
mblnRecSetOpen = True
Exit Sub
OpenError:
` Because we are designing this class for
` potential unattended operation, we'll have to raise
` an error on our own
Err.Raise Number:=Err.Number
Err.Clear
Exit Sub
End Sub
Private Sub Class_Terminate()
` We don't really care about errors when cleaning up.
On Error Resume Next
` Close the recordset
mrecExpense.Close
` Close the expense database
mdbExpense.Close
` Reset the error handler
On Error GoTo 0
Exit Sub
End Sub
Public Function FieldCount() As Integer
FieldCount = 7
End Function
Public Function GetField(intColumn As Integer) As Variant
` Return the requested field
Select Case intColumn
Case 0
GetField = mvarlngExpenseId
Case 1
GetField = mvarstrEmployeeId
Case 2
GetField = mvarstrExpenseType
Case 3
GetField = mvarcurAmountSpent
Case 4
GetField = mvarstrDescription
Case 5
GetField = mvardtmDatePurchased
Case 6
GetField = mvardtmDateSubmitted
End Select
End Function
Public Property Get BOF() As Boolean
BOF = rs.BOF
End Property
Public Property Get EOF() As Boolean
EOF = rs.EOF
End Property
Property Get FieldCount() As Long
FieldCount = rs.Fields.Count
End Property
Property Get RecordCount() As Long
Dim bm As String
`Save our location in the recordset
bm = rs.Bookmark
rs.MoveLast
RecordCount = rs.RecordCount
`Return to the starting position in the recordset
rs.Bookmark = bm
End Property
Sub Main() End Sub
VBHTOpenSecuredDB.SecuredDatabase
Table 12.10. Project properties for SECURED.VBP.
PROPERTY Setting Startup Object Sub Main Project Name VBHTOpenSecuredDB Project Description Open Secured and Encrypted Chapter14.MDB
Option Explicit
Sub main()
Dim numFields As Long
Dim strResponse As String
Dim objExpenseDetail As Object
Set objExpenseDetail = _
CreateObject("VBHTOpenSecuredDB.ExeExpenseDetail")
Dim i As Long
Dim j As Integer
numFields = objExpenseDetail.FieldCount
Sheets.Add
`Format the column headings
ActiveSheet.Cells(1, 1).Select
Selection.ColumnWidth = 5
ActiveCell.FormulaR1C1 = "ID"
Selection.Font.FontStyle = "Bold"
Selection.HorizontalAlignment = xlCenter
ActiveSheet.Cells(1, 2).Select
Selection.ColumnWidth = 10
ActiveCell.FormulaR1C1 = "Employee"
Selection.Font.FontStyle = "Bold"
Selection.HorizontalAlignment = xlCenter
ActiveSheet.Cells(1, 3).Select
Selection.ColumnWidth = 8
ActiveCell.FormulaR1C1 = "Type"
Selection.Font.FontStyle = "Bold"
Selection.HorizontalAlignment = xlCenter
ActiveSheet.Cells(1, 4).Select
Selection.ColumnWidth = 10
ActiveCell.FormulaR1C1 = "Amount"
Selection.Font.FontStyle = "Bold"
Selection.HorizontalAlignment = xlCenter
ActiveSheet.Cells(1, 5).Select
Selection.ColumnWidth = 15
ActiveCell.FormulaR1C1 = "Description"
Selection.Font.FontStyle = "Bold"
Selection.HorizontalAlignment = xlCenter
ActiveSheet.Cells(1, 6).Select
Selection.ColumnWidth = 10
ActiveCell.FormulaR1C1 = "Purchased"
Selection.Font.FontStyle = "Bold"
Selection.HorizontalAlignment = xlCenter
ActiveSheet.Cells(1, 7).Select
Selection.ColumnWidth = 15
ActiveCell.FormulaR1C1 = "Submitted"
Selection.Font.FontStyle = "Bold"
Selection.HorizontalAlignment = xlCenter
`Put the records into the worksheet
i = 0
strResponse = objExpenseDetail.MoveFirst
Do While "OK" = strResponse
i = i + 1
For j = 0 To numFields - 1
ActiveSheet.Cells(i + 1, j + 1).Select
ActiveCell.FormulaR1C1 = objExpenseDetail.GetField(j)
Next
strResponse = objExpenseDetail.MoveNext
Loop
ActiveSheet.Cells(1, 1).Select
`Clean up by releasing the memory used for objExpenseDetail
Set objExpenseDetail = Nothing
End Sub
How It Works
Visual Basic uses class modules to create objects that can be exposed to other applications. This is essentially the same process used by the Jet engine to expose data access objects or by Microsoft Excel to expose Worksheet or Chart objects.
This How-To has focused on the details of the ActiveX interface between Visual Basic and Excel. Note the comments in the code where you might include parameters for opening secured databases. That information is completely hidden from Excel. For more information about using secured databases, see Chapter 10, "Security and Multiuser Access."
By defining Property Get, Property Let, and Public Sub and Function procedures, you can precisely define the information that the class reveals to the outside world and the actions that it takes in response to demands placed on it by outside applications.
The most important part of setting up the class so that it is visible to outside applications is setting the project's properties. The fact that this is a separate EXE code component makes debugging somewhat tricky. The easiest way to debug an ActiveX EXE under development is to start by doing most of the work with the class module bound into an application EXE. After the class module has been debugged, add it into an Active EXE project. You can still debug the class within an ActiveX EXE by running a copy of Visual Basic dedicated to the class.
Comments
This class was defined to be what is called single-use in ActiveX terminology in order to ensure that different callers would not affect other callers' data stored within the class. In this ActiveX EXE, the database name, recordset position, and property values contain state, or context, information that is related to the calling program. For example, the correct invocation of the MoveNext method assumes that the class properties are correctly set for the caller. If we allowed two different programs to access the ActiveX EXE, Caller A's MoveNext would cause Caller B's MovePrev to return an erroneous result. A multiuse ActiveX EXE class requires that all the information necessary for a successful method invocation is contained in the method's parameters and return values. If more than one invocation is required to retrieve the required data, the class should be defined to be single-use.
Problem
The database provided for my Visual Basic project has already been developed, and the prototyping phase developed several Access reports that we want to use again in the final application. Because all workstations will have Access installed, we want to use this technique. How do I invoke an Access report from within a Visual Basic 6 application?
TECHNIQUE
Microsoft Access is an ActiveX EXE code component. It exposes its Visual Basic for
Applications properties and methods just as any other ActiveX EXE does. The most
powerful command for use in automating Access as a code component is the DoCmd
method of the Access Application object. DoCmd allows your program to issue
most commands within Access that a person sitting at the keyboard can do with a mouse
and keyboard.
Steps
Open the project AccessReport.vbp. The form shown in Figure 12.10 appears. Click the command button. Switch to the Access application to view and print the prepared report (see Figure 12.11).
Figure 12.10. The Invoke Access Report form.
Figure 12.11. The Access Expense report.
Table 12.11. Objects and properties for the Access Expense form.
OBJECT Property Setting Name Form frmInvokeAccessReport Caption "Invoke Access Report" Name CommandButton cmdInvokeReport Caption "&Invoke Access Report"
Private Sub cmdInvokeReport_Click()
` Invokes an Access report in Print Preview mode
` Get the ActiveX object to open its database and position
` to the first record
Dim strDbName As String
Dim objAccess As Object
On Error GoTo LoadError
strDbName = App.Path
strDbName = strDbName & "\Expense.mdb"
Set objAccess = CreateObject("Access.Application")
With objAccess
.OpenCurrentDatabase FilePath:=strDbName
.DoCmd.OpenReport ReportName:="ExpenseReport", _
View:=Access.acPreview
End With
` Give up CPU control
DoEvents
Set objAccess = Nothing
Exit Sub
LoadError:
MsgBox Err.Description & Chr(13) & "from " & Err.Source & _
" -- Number: " & CStr(Err.Number)
Unload Me
End Sub
How It Works
When you click the command button, the Visual Basic CreateObject method starts Access. The reference to "Access.Application" is resolved by the Windows operating system through the system registry. The two commands given to the Access application object open the database and prepare the report in Print Preview mode. The report can then be printed within Access.
Inspection of this code shows that using another application to do your bidding is straightforward; the difficult part is discovering which methods and properties are exposed by the object. For Access and the other Microsoft Office applications, the easiest way to discover the available properties and methods is to use that application's Help files. Use the Help contents to find a reference to Visual Basic, switch to the linked Help file, and then search the Help index for the application object. The various methods and properties of the application object should lead you to the commands you need in order to get your job done.
Comments
Although requiring a person to print the report to the printer might seem like an extra step, it takes advantage of the print preview capabilities of Access and provides quite a bit of program polish with very little development work. Before deploying an automated application such as this one, you probably want to enforce some degree of security on the database as discussed in Chapter 10, "Security and Multiuser Access."
Use Microsoft Access queries containing user-defined functions from Visual Basic?
PROBLEM
Sometimes you will need to use Access user-defined functions within your Visual Basic
programs. Unfortunately, Access user-defined functions can be run only by Access.
How can I use Access to return data from a query containing a user-defined function?
Technique
To use an Access query containing a user-defined function, you first need an Access-based recordset. Because Access exposes its object methods and properties, we can directly manipulate Access recordsets from Visual Basic by using the Visual Basic for Applications methods exposed by Access. The VBA syntax for working with recordsets is identical to Visual Basic 6 syntax, so no learning curve is required. It is important to remember, however, that the Access recordset is running in a different process, and the performance is likely to be much slower than a native recordset. Both Visual Basic and Access recordsets can be included in the same application. In this way, the slower ActiveX Automation recordset is used only when required for the user-defined function query.
This application uses two Access queries to provide required data. The first provides a list of employees who have submitted expense reports:
SELECT DISTINCT EmployeeID FROM Expenses;
The second query is parameter-driven and invokes the user-defined function MyUpper to force the employee name to all uppercase letters:
PARAMETERS EmpToFind Text;
SELECT Expenses.ExpenseID, MyUpper([EmployeeID]) AS Expr1,
Expenses.ExpenseType, Expenses.AmountSpent, Expenses.Description,
Expenses.DatePurchased, Expenses.DateSubmitted
FROM Expenses
WHERE (((MyUpper([EmployeeID]))=[EmpToFind]))
ORDER BY Expenses.ExpenseID;
The EmpToFind parameter limits the query records to only one employee.
Steps
Open the AccessParams.vbp project. If necessary, modify the database location for the database grid's data control to point to your installation directory. Run the application by pressing F5. Then Select an employee and click the Set Employee button to limit the view of expense details to only one employee, as shown in Figure 12.12. Use the data movement buttons to view the selected employee's expenses.
Figure 12.12. The Access User-Defined Function form.
Ole Automation
Microsoft DAO 3.51 Object Library
Microsoft Access 8.0 Object Library
Microsoft Masked Edit Control 6.0
Microsoft FlexGrid Control 6.0
Option Explicit `local variable(s) to hold property value(s) Private mvarlngExpenseId As Long `local copy Private mvarstrEmployeeId As String `local copy Private mvarstrExpenseType As String `local copy Private mvarcurAmountSpent As Currency `local copy Private mvarstrDescription As String `local copy Private mvardtmDatePurchased As Date `local copy Private mvardtmDateSubmitted As Date `local copy Private mvarstrDbName As String `local copy Private mvarstrEmpToQuery As String `local copy Private mblnQueryOpen As Boolean Private mobjAccess As New Access.Application Private mobjRecSetExpense As Object
Public Property Let strDbName(ByVal vData As String)
`used when assigning a value to the property, on the left
`side of an assignment.
`Syntax: X.strDbName = 5
On Error GoTo OpenError
If mblnQueryOpen Then
mobjAccess.CloseCurrentDatabase
End If
mvarstrDbName = vData
mobjAccess.OpenCurrentDatabase mvarstrDbName
mobjAccess.Application.Visible = False
mobjAccess.DBEngine.Workspaces(0).Databases(0). _
QueryDefs("ExpForOneEmployee"). _
Parameters("EmpToFind"). _
Value = mvarstrEmpToQuery
Set mobjRecSetExpense = mobjAccess.DBEngine.Workspaces(0). _
Databases(0).QueryDefs("ExpForOneEmployee"). _
OpenRecordset()
mblnQueryOpen = True
Exit Property
OpenError:
` Because we are designing this class for
` potential unattended operation, we'll have to raise
` an error on our own
Err.Raise Number:=Err.Number
Err.Clear
Exit Property
End Property
Public Property Let strEmpToQuery(ByVal vData As String)
`used when assigning a value to the property, on the left
`side of an assignment.
`Syntax: X.strEmpToQuery = 5
mvarstrEmpToQuery = vData
On Error GoTo OpenError
If mblnQueryOpen Then
mobjRecSetExpense.Close
End If
mobjAccess.DBEngine.Workspaces(0).Databases(0). _
QueryDefs("ExpForOneEmployee"). _
Parameters("EmpToFind"). _
Value = mvarstrEmpToQuery
Set mobjRecSetExpense = mobjAccess.DBEngine.Workspaces(0). _
Databases(0).QueryDefs("ExpForOneEmployee"). _
OpenRecordset()
mblnQueryOpen = True
Exit Property
OpenError:
` Because we are designing this class for
` potential unattended operation, we'll have to raise
` an error on our own
Err.Raise Number:=Err.Number
Err.Clear
Exit Property
End Property
Private Sub ClearObject()
` Clears all object variables
mvarlngExpenseId = 0
mvarstrEmployeeId = ""
mvarstrExpenseType = ""
mvarcurAmountSpent = 0
mvarstrDescription = ""
mvardtmDatePurchased = CDate("1/1/1980")
mvardtmDateSubmitted = CDate("1/1/1980")
mvarstrEmpToQuery = ""
End Sub
Private Sub Class_Initialize()
` Indicate that the database is not yet open
mblnQueryOpen = False
` Clear all object variables
Call ClearObject
End Sub
Private Sub Class_Terminate()
` Close the recordset
mobjRecSetExpense.Close
mobjAccess.CloseCurrentDatabase
mobjAccess.Quit
End Sub
Table 12.12. Objects and properties for the Access Params form.
OBJECT Property Setting Form Name frmExpClient Caption "Expense Client" Data Name datExpEmployees Caption "Exp Employees" DatabaseName "C:\Code\Chapter12\HowTo06\Expense.mdb" RecordsetType 2 `Snapshot RecordSource "ExpEmployeeNames" MSFlexGrid Name dbgExpEmployee DataSource datExpEmployees CommandButton Name cmdSetEmployee Caption "&Set Employee" CommandButton Name cmdLast Caption "&Last" CommandButton Name cmdNext Caption "&Next" CommandButton Name cmdPrev Caption "&Prev" CommandButton Name cmdFirst Caption "&First" MaskEdBox Name mskAmountSpent Format "$#,##0.00;($#,##0.00)" PromptChar "_" TextBox Name txtSubmitDate TextBox Name txtPurchaseDate TextBox Name txtDescription TextBox Name txtExpenseType TextBox Name txtEmployeeId TextBox Name txtExpenseId Label Name Label1 Caption "Expense ID:" Label Name Label2 Caption "Employee:" Label Name Label3 Caption "Expense Type:" Label Name Label4 Caption "Amount Spent:" Label Name Label5 Caption "Description:" Label Name Label6 Caption "Purchase Date:" Label Name Label7 Caption "Submission Date:"
Table 12.13. Menu specifications for the Access Params form.
CAPTION Name Shortcut Key &File mnuFile ----E&xit mnuFileExit
Private Sub cmdSetEmployee_Click()
` Sets Employee ID textbox and initiates new query for
` expenses for the selected employee
Dim strResponse As String
On Error GoTo QueryError
txtEmployeeId.Text = dbgExpEmployee.Text
expDetailParam.strEmpToQuery = dbgExpEmployee.Text
strResponse = expDetailParam.MoveFirst
If "OK" <> strResponse Then
MsgBox strResponse
Else
Call ReadObjectValues
End If
Exit Sub
QueryError:
MsgBox Err.Description & Chr(13) & "from " & Err.Source & _
" -- Number: " & CStr(Err.Number)
Exit Sub
End Sub
Private Sub cmdFirst_Click()
` Positions to first record in recordset and displays values
Dim strResponse As String
strResponse = expDetailParam.MoveFirst
If "OK" <> strResponse Then
MsgBox strResponse
Else
Call ReadObjectValues
End If
End Sub
Private Sub cmdLast_Click()
` Positions to last record in recordset and displays values
Dim strResponse As String
strResponse = expDetailParam.MoveLast
If "OK" <> strResponse Then
MsgBox strResponse
Else
Call ReadObjectValues
End If
End Sub
Private Sub cmdNext_Click()
` Positions to Next record in recordset and displays values
Dim strResponse As String
strResponse = expDetailParam.MoveNext
If "OK" <> strResponse Then
MsgBox strResponse
Else
Call ReadObjectValues
End If
End Sub
Private Sub cmdPrev_Click()
` Positions to Previous record in recordset and displays
` values
Dim strResponse As String
strResponse = expDetailParam.MovePrev
If "OK" <> strResponse Then
MsgBox strResponse
Else
Call ReadObjectValues
End If
End Sub
Private Sub ReadObjectValues()
` Read the object values into the form fields
txtExpenseId.Text = CStr(expDetailParam.lngExpenseId)
txtEmployeeId.Text = expDetailParam.strEmployeeId
txtExpenseType.Text = expDetailParam.strExpenseType
txtDescription.Text = expDetailParam.strDescription
mskAmountSpent.Text = CStr(expDetailParam.curAmountSpent)
txtPurchaseDate.Text = CStr(expDetailParam.dtmDatePurchased)
txtSubmitDate.Text = CStr(expDetailParam.dtmDateSubmitted)
End Sub
Private Sub Form_Load()
` Get the ActiveX object to open its database and position
` to the first record
Dim strDbName As String
Dim strResponse As String
On Error GoTo LoadError
strDbName = App.Path
strDbName = strDbName & "\Expense.mdb"
expDetailParam.strDbName = strDbName
strResponse = expDetailParam.MoveFirst
If "OK" <> strResponse Then
MsgBox strResponse
Else
Call ReadObjectValues
End If
Exit Sub
LoadError:
MsgBox Err.Description & Chr(13) & "from " & _
Err.Source & " -- Number: " & CStr(Err.Number)
Unload Me
End Sub
Private Sub Form_Unload(Cancel As Integer)
Set expDetailParam = Nothing
End Sub
Private Sub mnuFileExit_Click()
Unload Me
End Sub
How It Works
When the form loads, the application sets the database name of the class using the Property Let strDBName procedure (step 5). This first reference to an Access.Application object causes a new Access process to start for our work on behalf of the class. The Access application is made invisible to minimize confusion on the application screen. The query parameter is set to retrieve an employee, and the recordset is created within the class. The class's navigation methods are, in turn, connected to the navigation buttons on the form.
When the cmdSetEmployee button is clicked, the class's employee name property is set from the current record on the grid. The class is notified of the employee name change through the strEmpToQuery Property Let procedure. The query parameter is changed, and the recordset is reopened to display expenses for a different employee.
This How-To illustrates a generic programming technique frequently used to logically "partition" data displays on forms. For example, you might want to display payment histories for multiple customers in a service bureau application. The use of a grid to display possible customer choices with a detail form for the payments is an example of a partitioning form.
Comments
More and more complex Visual Basic applications are being designed with n-tier architectures relying on different tiers to perform different functions. In this How-To, we are using a classic three-tier architecture consisting of the form, the class, and the Access queries. This approach helps make program code maintenance easier over the long term because interfaces are clear. The use of the Access ExpEmployee query to show only one row per employee uses the power inherent in the database engine to preprocess data before using precious bandwidth sending multiple rows and forcing the client to eliminate duplicates.
Problem
I have a table with numeric results on which I need to perform some statistical analyses to make the data meaningful. Visual Basic doesn't have an easy way to analyze complex data, nor does it have many statistical analysis functions. How can I do the analyses that I need using a spreadsheet so that I can massage the data?
Technique
Although Visual Basic is missing many of the standard statistical and financial functions that many business and scientific applications need, Microsoft Excel has a rich source of such functions. Using ActiveX Automation, it is relatively easy to create an Excel spreadsheet, populating it with the data from a database, and entering whatever Excel formulas are needed for analysis.
You will need Excel for this How-To, although this same technique can be used with most of the popular spreadsheet applications available for Windows. All that any such spreadsheet needs is support for OLE 2 or later, as well as some way of discovering the objects that the application makes visible to OLE Automation. Microsoft provides a program with many of its other products, including the OLE SDK and some of its programming languages, called OLE2VIEW, that examines an application and presents a list of the objects available and their properties and methods.
Steps
Open the Visual Basic DataAnal.VBP project. Start the application by selecting Run | Start from the Visual Basic main menu, by pressing F5, or by clicking the Start button on the Visual Basic toolbar. Click the Select Database button, and select any Access .MDB file. Select a table from the Table combo box, and then click Load Spreadsheet to select the numeric fields from the table and enter them into an Excel spreadsheet. When the spreadsheet is finished loading (see Figure 12.13), click the down arrow on the Results combo box to examine the average, median, and standard deviation for each field in the table. Double-click the spreadsheet to edit it or examine a cell's contents.
Figure 12.13. The Data Analysis result screen for the DataAnal.vbp project.
Figure 12.14. Setting object references for DataAnal.vbp.
Table 12.14. Objects and properties for DATAANAL.FRM.
OBJECT Property Setting Form Name frmDataAnal Caption "Data Analysis" NegotiateMenus True ComboBox Name lstResults CommandButton Name cmdLoadSS Caption "&Load Spreadsheet" Enabled 0 `False ComboBox Name lstTables CommandButton Name cmdQuit Caption "&Quit" Default -1 `True CommandButton Name cmdSelectDB Caption "&Select Database" TextBox Name txtFileName BackColor &H00C0C0C0& (Light gray) Label Name Label3 Alignment 1 `Right Justify Caption "Results:" OLE Name oleExcel OLETypeAllowed 1 `Embedded Label Name Label2 Alignment 1 `Right Justify Caption "Table:" CommonDialog Name cdSelectFile DefaultExt "MDB" DialogTitle "Open Database File" Filter "Access Db (*.mdb)|*.mdb|All Files (*.*)|*.*" Label Name Label1 Alignment 1 `Right Justify Caption "Database:" Menu Name mnuRaisan Caption "Raisan" Visible 0 `False
`This project makes use of an Excel 5.0 worksheet, `so the Excel 5.0 Object Library must be specified `in the VB Tools Reference menu. Dim dbSS As Database Const OLE_CreateEmbed As Integer = 0 Const OLE_Activate As Integer = 7
Private Sub cmdSelectDB_Click()
`Select a new database file to analyze
Dim strFileName As String
Dim X As TableDef
Dim saveCursor
`Open the file open common dialog
cdSelectFile.InitDir = App.Path
cdSelectFile.ShowOpen
If Len(cdSelectFile.filename) Then
saveCursor = Me.MousePointer
Me.MousePointer = vbHourglass
txtFileName = cdSelectFile.filename
`Open the database
Set dbSS = OpenDatabase(txtFileName)
`Load the lstTables combo box
lstTables.Clear
If dbSS.TableDefs.Count Then
For Each X In dbSS.TableDefs
`Exclude system tables
If Not X.Name Like "MSys*" Then
lstTables.AddItem X.Name
End If
Next
lstTables.ListIndex = 0
End If
Me.MousePointer = saveCursor
Else
MsgBox "No file selected."
End If
End Sub
Private Sub cmdLoadSS_Click()
`If button is enabled, we can start
Dim rsTable As Recordset
Dim fld As Field
Dim fieldTypes() As String
Dim i As Integer, j As Integer
Dim rowNo As Integer
Dim cellRange As String
Dim cellValue As Variant
Dim cellPlace As String
Dim cellName As String
Dim totalRows As Integer
Dim nameExcel As String
Dim temp As String
Dim ssName As String
Dim saveCursor
saveCursor = Me.MousePointer
Me.MousePointer = vbHourglass
`Create an array of all numerical fields to include in
`the spreadsheet
i = 0
For Each fld In dbSS.TableDefs(lstTables.Text).Fields
If fld.Type = dbInteger Or _
fld.Type = dbLong Or _
fld.Type = dbCurrency Or _
fld.Type = dbSingle Or _
fld.Type = dbDouble Then
i = i + 1
ReDim Preserve fieldTypes(i)
fieldTypes(i) = fld.Name
End If
Next
If i = 0 Then
MsgBox "There are no numeric columns in the table. Exiting
Âprocedure."
Me.MousePointer = saveCursor
Exit Sub
End If
`For convenience, limit the number of columns to 26 so
`we don't have to do anything fancy to columns AA, AB,
`and so on
i = IIf(i > 26, 26, i)
`Open the recordset of the table
Set rsTable = dbSS.OpenRecordset(lstTables.Text)
On Error GoTo OLError
oleExcel.CreateEmbed "", "Excel.Sheet.8"
On Error GoTo 0
ssName = oleExcel.object.Name
Do While Not rsTable.EOF
rowNo = rowNo + 1
For j = 1 To i
cellValue = rsTable(fieldTypes(j))
oleExcel.object.Worksheets(1).Cells(rowNo, j).Value _
= cellValue
Next
rsTable.MoveNext
Loop
`Insert the formulas to calculate the average, median, and
`standard deviation, and name the cells
totalRows = rowNo
rowNo = totalRows + 2
For j = 1 To i
cellRange = ColName(j) & "1:" & ColName(j) _
& Trim(Str(totalRows))
cellValue = "=AVERAGE(" & cellRange & ")"
cellPlace = "=Sheet1!$" & ColName(j) & "$" _
& Trim(Str(rowNo)) _
& ":$" & ColName(j) & "$" & Trim(Str(rowNo))
oleExcel.object.Worksheets(1).Cells(rowNo, j).Value _
= cellValue
cellName = "average" & Trim(Str(j))
oleExcel.object.Parent.Names.Add Name:=cellName, _
RefersTo:=cellPlace
Next
rowNo = rowNo + 1
For j = 1 To i
cellRange = ColName(j) & "1:" & ColName(j) _
& Trim(Str(totalRows))
cellValue = "=MEDIAN(" & cellRange & ")"
cellPlace = "=Sheet1!$" & ColName(j) & "$" _
& Trim(Str(rowNo)) _
& ":$" & ColName(j) & "$" & Trim(Str(rowNo))
oleExcel.object.Worksheets(1).Cells(rowNo, j).Value _
= cellValue
cellName = "median" & Trim(Str(j))
oleExcel.object.Parent.Names.Add Name:=cellName, _
RefersTo:=cellPlace
Next
rowNo = rowNo + 1
For j = 1 To i
cellRange = ColName(j) & "1:" & ColName(j) _
& Trim(Str(totalRows))
cellValue = "=STDEV(" & cellRange & ")"
cellPlace = "=Sheet1!$" & ColName(j) & "$" _
& Trim(Str(rowNo)) _
& ":$" & ColName(j) & "$" & Trim(Str(rowNo))
oleExcel.object.Worksheets(1).Cells(rowNo, j).Value _
= cellValue
cellName = "stdev" & Trim(Str(j))
oleExcel.object.Parent.Names.Add Name:=cellName, _
RefersTo:=cellPlace
Next
`Lastly, put the results in the lstResults control
lstResults.Clear
For j = 1 To i
nameExcel = "average" & Trim(Str(j))
lstResults.AddItem fieldTypes(j) & " Average = " _
& oleExcel.object.Worksheets(1).Range(nameExcel).Value
Next
For j = 1 To i
nameExcel = "median" & Trim(Str(j))
lstResults.AddItem fieldTypes(j) & " Median = " _
& oleExcel.object.Worksheets(1).Range(nameExcel).Value
Next
For j = 1 To i
nameExcel = "stdev" & Trim(Str(j))
lstResults.AddItem fieldTypes(j) _
" & " Standard Deviation = " _
& oleExcel.object.Worksheets(1).Range(nameExcel).Value
Next
lstResults.ListIndex = 0
Me.MousePointer = saveCursor
Exit Sub
OLError:
MsgBox "An OLE error occurred, probably because Excel is not
Âinstalled on this computer."
Unload Me
End Sub
Private Function ColName(colNo As Integer)
Dim alpha As String
alpha = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
ColName = Mid$(alpha, colNo, 1)
End Function
Private Sub lstTables_Click()
If Len(lstTables.Text) Then
cmdLoadSS.Enabled = True
Else
cmdLoadSS.Enabled = False
End If
End Sub
Private Sub cmdQuit_Click()
Set dbSS = Nothing
End
End Sub
How It Works
An ActiveX Automation object can be either linked or embedded in an OLE control. If all you want to do is see the object, linking is the way to go because the object isn't stored in the application. If you want to visually edit your Visual Basic application, however, you must embed the object. Then you can "activate" the object for editing by double-clicking it at runtime. Double-clicking is the default for activation, but the default can be changed by setting the AutoActivate property of the control.
The key to using the OLE control with visual editing is to make sure that it is properly configured for the object, in this case an Excel spreadsheet. For embedded objects, the control's OLETypeAllowed must be either 1 (Embedded) or 2 (Either). The object is then created using this line in cmdLoadSS_Click():
oleExcel.CreateEmbed "", "Excel.Sheet.8"
If you want the embedded object's application menus to appear when you activate the object, you need to have a menu as part of the form. If your application doesn't otherwise need a menu, create a dummy menu as you did here, name it anything you like, and set the Visible property of the single menu item to False. That way, the object's menu will appear. If your application does use a menu, create it as you normally would, but set the NegotiatePosition property of each menu item to None, Left, Middle, or Right, to indicate to Visual Basic how you want to sort the various menu items between the two menus.
Comments
ActiveX Automation is a powerful tool for your programming arsenal, but it might not always be the appropriate tool given the power of the macro languages, such as Visual Basic for Applications, that are now embedded in many applications. For use by an analyst who uses Excel for much of the day, this task might have been better programmed in VBA from Excel. If the analyst later wants to change something, the VBA macro is right there in the spreadsheet. For use as part of an Executive Information System (EIS), where several spreadsheets and Access reports might be required for the complete solution, driving the spreadsheet from Visual Basic might make more sense. Keeping all the custom code for an EIS in one place can simplify application maintenance.
Problem
I want to give the users of my application the ability to edit the appearance of the reports generated by my application. Neither Crystal Reports nor Microsoft Data Report allows that. How can I produce a report based on a database and let the users edit it?
Technique
Using Visual Basic with Microsoft Word and the other Microsoft Office applications gives enormous flexibility to your applications. Instead of taking all the time and effort needed to program a mini-word processor or other application, you can use all the power of Microsoft Word. Even using one of the many custom controls available for Visual Basic works only if you can find one that has the particular features you need at a reasonable cost. Why not use the tools you already have?
This How-To uses a WordBasic object to create a database report, which is then embedded in an OLE custom control on a form. The user can make any changes needed, using Word's own menus and toolbars.
Steps
Open the Visual Basic RPTWRITE.VBP project. Start the application by selecting Run | Start from the Visual Basic main menu, by pressing F5, or by clicking the Start button on the Visual Basic toolbar. Click the Create Report button, and select any Access .MDB file. After the data is processed and the report is created, the file is presented in the OLE control, as shown in Figure 12.15. The report is saved to a temporary file, TEMPRPT.DOC, in the application directory. Double-click the report window to activate visual editing and make any changes required. Because a toolbar is not provided with this application, any active Word toolbars appear as floating toolbars. When you are finished editing, click the Save File button to save the report as a Word document of your choice.
Figure 12.15. The Visual Report Writer form.
Table 12.15. Objects and properties for RPTWRITE.FRM.
OBJECT Property Setting Form Name frmReportWriter Caption "Visual Report Writer" NegotiateMenus True PictureBox Name picHead Align 1 `Align Top Appearance 0 `Flat BackColor &H00C0C0C0& BorderStyle 0 `None CommandButton Name cmdSave Caption "&Save File" CommandButton Name cmdQuit Caption "&Quit" CommandButton Name cmdReport Caption "&Create Report" Default -1 `True Label Name lblStatus Alignment 2 `Center BorderStyle 1 `Fixed Single CommonDialog Name cdBiblio CancelError -1 `True DefaultExt "MDB" DialogTitle "BIBLIO.MDB Location" FileName "biblio.mdb" Filter "BIBLIO Database (biblio.mdb)|biblio.mdb|All Files (*.*)|*.*|" OLE Name oleWord OLETypeAllowed 1 `Embedded Menu Name mnuFratsaBlatz Caption "&FratsaBlatz" NegotiatePosition 1 `Left Visible 0 `False
Option Explicit Dim mobjWord As Object Dim strColumnTabs(6) As String Dim strColumnHeaders(7) As String Dim strColumnWidths(7) As String `OLE Control Constants Const OLE_Activate As Integer = 7 Const OLE_Deactivate As Integer = 9
Status "Creating a Word object"
Me.Show
Me.Refresh
`Create a Microsoft Word object
Set mobjWord = GetObject("", "Word.Basic")
mobjWord.AppMinimize ("Microsoft Word")
cmdReport.Enabled = True
cmdQuit.Enabled = True
`Set up standard layout information
Call SetColumns
Status "Click on Create Report to create the report."
End Sub
Private Sub Form_Resize()
Dim intBorder As Integer
Dim intWindowWidth As Integer
intBorder = picHead.Height
intWindowWidth = Me.ScaleWidth
cmdReport.Height = intBorder
cmdQuit.Height = intBorder
cmdQuit.Left = intWindowWidth - cmdQuit.Width - cmdReport.Left
lblStatus.Width = cmdQuit.Left - lblStatus.Left _
- cmdReport.Left
lblStatus.Top = (picHead.Height - lblStatus.Height) / 2
oleWord.Left = intBorder
oleWord.Width = Me.ScaleWidth - 2 * intBorder
oleWord.Height = Me.ScaleHeight - oleWord.Top - intBorder
End Sub
Private Sub cmdReport_Click()
Dim strTitle As String
Dim intIdx As Integer
Dim strInsertText As String
Dim strFileName As String
Dim uexpExpDetail As New ExpenseDetail
Dim strResponse As String
Status "Opening database table"
On Error GoTo ExpDetailError
` Use the common dialog to open a database.
cdExpenseFile.InitDir = App.Path
cdExpenseFile.ShowOpen
uexpExpDetail.strDbName = cdExpenseFile.filename
Status "Creating a new Word document"
mobjWord.FileNew
strTitle = "Expense Details"
Status "Inserting header and footer information"
PrintHeader strTitle, strColumnTabs(), strColumnHeaders()
PrintFooter "Enlighthened Software, Inc."
PrintReportTitle strTitle
PrintColHeaders strColumnTabs(), strColumnHeaders()
`Start printing the report
Status "Adding data to report"
mobjWord.TableInsertTable NumColumns:=7, _
NumRows:=2, _
InitialColWidth:="2 in"
For intIdx = 0 To 7
With mobjWord
.TableSelectColumn
.TableColumnWidth ColumnWidth:=strColumnWidths(intIdx)
.NextCell
.NextCell
End With
Next
`Format the paragraph height
mobjWord.TableSelectTable
mobjWord.FormatParagraph Before:="6 pt"
`Select the first cell in the table
`mobjWord.TableSelectColumn
mobjWord.NextCell
strResponse = uexpExpDetail.MoveFirst
Do While "EOF" <> strResponse
With mobjWord
strInsertText = CStr(uexpExpDetail.lngExpenseId)
.Insert strInsertText
.NextCell
strInsertText = uexpExpDetail.strEmployeeId
.Insert strInsertText
.NextCell
strInsertText = uexpExpDetail.strExpenseType
.Insert strInsertText
.NextCell
strInsertText = _
Format$(uexpExpDetail.curAmountSpent, "Currency")
.Insert strInsertText
.NextCell
strInsertText = uexpExpDetail.strDescription
.Insert strInsertText
.NextCell
strInsertText = _
Format$(uexpExpDetail.dtmDatePurchased, _
"General Date")
.Insert strInsertText
.NextCell
strInsertText = _
Format$(uexpExpDetail.dtmDateSubmitted, _
"General Date")
.Insert strInsertText
.NextCell
.TableInsertRow
End With
strResponse = uexpExpDetail.MoveNext
Loop
`Save the Word document
mobjWord.ToolsOptionsSave SummaryPrompt:=0
strFileName = App.Path & "\TempRpt.doc"
`Word won't let us save a file over an existing document
If Len(Dir(strFileName)) Then
Kill strFileName
End If
mobjWord.FileSaveAs Name:=strFileName
oleWord.CreateEmbed strFileName
oleWord.Refresh
Status "Report complete"
Exit Sub
ExpDetailError:
If Err.Number = 70 Then
Resume Next
Else
MsgBox Err.Description & Chr(13) & "from " & Err.Source _
& " -- Number: " & CStr(Err.Number)
Exit Sub
End If
End Sub
Sub SetColumns()
Dim intIdx As Integer
strColumnHeaders(0) = "ID"
strColumnTabs(0) = "0.5"
strColumnHeaders(1) = "Employee"
strColumnTabs(1) = "1.25"
strColumnHeaders(2) = "Type"
strColumnTabs(2) = "2.0"
strColumnHeaders(3) = "Amount"
strColumnTabs(3) = "2.75"
strColumnHeaders(4) = "Description"
strColumnTabs(4) = "4.0"
strColumnHeaders(5) = "Purchased"
strColumnTabs(5) = "5.0"
strColumnHeaders(6) = "Submitted"
strColumnTabs(6) = "6.5"
For intIdx = LBound(strColumnTabs) To UBound(strColumnTabs)
If intIdx Then
strColumnWidths(intIdx) = _
Str$(Val(strColumnTabs(intIdx)) - _
Val(strColumnTabs(intIdx - 1)))
Else
strColumnWidths(intIdx) = strColumnTabs(intIdx)
End If
Next
End Sub
Sub PrintColHeaders(Tabs() As String, ColHeaders() As String)
Dim intIdx As Integer
`Assumes cursor is at the beginning of the proper location
mobjWord.InsertPara
mobjWord.LineUp
mobjWord.FormatParagraph Before:="12 pt", _
After:="6 pt"
For intIdx = 0 To UBound(Tabs)
mobjWord.FormatTabs Position:=Tabs(intIdx) + Chr$(34), _
Align:=0
Next
For intIdx = 0 To UBound(ColHeaders) - 1
mobjWord.Insert ColHeaders(intIdx) + Chr$(9)
Next
With mobjWord
.StartOfLine
.SelectCurSentence
.CharRight 1, 1
.FormatFont Points:="12", _
Font:="Times New Roman", _
Bold:=1
.FormatBordersAndShading ApplyTo:=0, _
BottomBorder:=2
.LineDown
End With
End Sub
`Insert the report footer
mobjWord.ViewFooter
mobjWord.FormatTabs ClearAll:=1
mobjWord.FormatTabs Position:="7.0" + Chr$(34), _
DefTabs:="0.5" + Chr$(34), _
Align:=2, _
Leader:=0
mobjWord.StartOfLine
mobjWord.Insert Company + Chr$(9) + "Page "
mobjWord.InsertPageField
mobjWord.SelectCurSentence
mobjWord.FormatFont Points:="12", _
Font:="Times New Roman", _
Bold:=1
mobjWord.ViewFooter
End Sub
Sub PrintReportTitle(Title As String)
With mobjWord
.StartOfDocument
.InsertPara
.StartOfDocument
.Insert Title
.StartOfLine
.SelectCurSentence
.FormatFont Points:="18", _
Font:="Times New Roman", _
Bold:=1, _
Italic:=1
.CenterPara
.FormatBordersAndShading ApplyTo:=0, _
Shadow:=0
`Leave the cursor on the following line
.LineDown
End With
End Sub
Sub PrintHeader(Title As String, Tabs() As String, _
ColHeaders() As String)
Dim intIdx As Integer
With mobjWord
`For now, set DifferentFirstPage to no
.FilePageSetup TopMargin:="0.8" + Chr$(34), _
BottomMargin:="0.8" + Chr$(34), _
LeftMargin:="0.75" + Chr$(34), _
RightMargin:="0.75" + Chr$(34), _
ApplyPropsTo:=4, _
DifferentFirstPage:=0
End With
`Insert the report header
With mobjWord
.ViewHeader
.FormatTabs ClearAll:=1
.FormatTabs Position:="7.0" + Chr$(34), _
DefTabs:="0.5" + Chr$(34), _
Align:=2
.StartOfLine
.SelectCurSentence
.CharRight 1, 1
.FormatFont Points:="12", _
Font:="Times New Roman", _
Bold:=1
.StartOfLine
.Insert Title + Chr$(9)
.InsertDateTime DateTimePic:="d' `MMMM', `yyyy", _
InsertAsField:=0
.InsertPara
.InsertPara
End With
PrintColHeaders Tabs(), ColHeaders()
mobjWord.ViewHeader `Closes if it is open
`Now set DifferentFirstPage
mobjWord.FilePageSetup DifferentFirstPage:=1
End Sub
Sub Status(txtCaption)
lblStatus.Caption = txtCaption
lblStatus.Refresh
End Sub
Private Sub cmdQuit_Click()
Status "Ending application"
Unload Me
End Sub
Private Sub Form_Unload(Cancel As Integer)
`Shut down Word
Set objWord = Nothing
End Sub
How It Works
This How-To uses many of the formatting and inserting commands available in WordBasic. If you are going to modify the code in this How-To, you should have a copy of the Word Developer's Kit, which has lots of detailed information about WordBasic and, of course, Word itself.
The easiest way to become familiar with WordBasic is to use the macro recorder in Word. Before creating a document or formatting it, turn the recorder on by selecting Tools | Macro | Record New Macro, enter a unique name for the macro, and then click Record. Word then records all your steps, not as individual keystrokes but as fully formed commands using VBA. When you are finished making changes, simply click the button with the blue square in the floating Macro Recorder toolbar. You can then open the macro using Tools | Macro | Visual Basic Editor, and you can examine or even cut and paste it into your application. You'll need to reformat the code to conform to Visual Basic's named arguments syntax, and you'll need to enclose the code with With <object name>...End With so that Visual Basic knows which object to apply the commands to. Alternatively, you can append the object name to the front of the WordBasic command for individual lines. Both methods are demonstrated throughout the code in this How-To.
A Word table was used to contain the data in the report. Not only does this make it easy to line up the different fields in the report, but it also simplifies the problem of having fields too long to fit in the width allocated on a single line of the report. By changing the paragraph formatting in the table's cells, you can achieve virtually any appearance you want. Alternatively, you could use the ColumnTabs array to put data on the report the same way the column headers were. This approach might be easier if a record's fields will be on multiple lines on the report, but you can also use Word's Merge Cells and other table formatting to achieve different effects on the different lines of a record.
Remember that it is easiest to design the report in Word first and then translate the design into a Visual Basic program, with or without the macro recorder.
If you want the embedded object's application menus to appear when you activate the object, you need to have a menu as part of the form. If your application doesn't otherwise need a menu, create a dummy menu, name it anything you like, and set the Visible property of the single menu item to False. That way, the object's menu will appear. If your application does use a menu, create it as you normally would, but set the NegotiatePosition property of each menu item to None, Left, Middle, or Right to give Visual Basic an indication of how you want to sort the various menu items between the two menus.
Problem
All this work I am doing with ActiveX components means that my development computer is going to require some maintenance. How do I keep my Windows Registry neat and tidy?
Technique
All ActiveX components must be registered in order to work correctly. The Windows Registry contains information about each ActiveX component available on your system and the location of the files required to use the component. ActiveX EXE files created by Visual Basic 6 automatically include the code to register themselves in the system registry. Visual Basic will also register ActiveX DLL files on your development machine. You will need to register your DLLs on machines to which you distribute your programs. The RegSvr32.EXE program is designed to add and remove Registry entries for your components.
Steps
C:\WINDOWS\SYSTEM32> REGSVR32 C:\CODE\CHAPTER12\HOWTO03\ACTIVEX.DLL
Figure 12.16. RegSvr32 run results.
How It Works
Every Windows system has a Registry containing information about nearly everything on the system. The Registry is divided into HKEY classes for the current configuration, current user, users, machine, and root. For the purposes of keeping our ActiveX components running, we are concerned with the HKEY_CLASSES_ROOT section of the Registry. The component object model uses the Registry in two ways to resolve ActiveX component references--by name and CLSID. The name for a component is assigned by you in the Project Properties dialog box. ActiveXDll_For_HowTo_12_3.ExpenseDetail was assigned as the full name for How-To 12.3. Component names are in the form <Application>.<Object> in the event that a single DLL or EXE file contains more than one public object. The CLSID is generated by Windows as a GUID (globally unique identifier). The GUID is a 16-byte unique key presented on the screen by Windows as a formatted hexadecimal string. A typical CLSID might look like {3CF0F563-0DC0-11D1-9AF0-004033373A8F}.
Windows uses the name of a component as a key into the Registry to find the associated CLSID. The CLSID can then be used to find all the required information about the component so that Windows can run it. The information for the ActiveX.DLL from How-To 12.3 includes
You can manually inspect and modify the Windows Registry by invoking the RegEdt32.EXE program from your Windows system directory.
In this How-To, RegSvr32 loads the specified DLL and invokes DllRegisterServer to cause the DLL to be registered on the system. Whenever you use Visual Basic to create an object, the runtime library looks in the Registry for the logical name you supplied, and then loads the associated implementing file. For example, when you request an Access.Application object, the Registry is accessed to determine which program on which drive should be started to provide the required services.
Comments
RegSvr32 can also be used to unload DLL files from the Registry with the following syntax:
REGSVR32 /U <FileName>.DLL
Sometimes, manually unregistering and then reregistering a component can help convince an otherwise balky application to run. Frequently, the cause of application run failure is a missing DLL file called by one of your components. Running RegSvr32 for each component can sometimes help isolate missing DLL files.
In addition to RegSvr32, Microsoft has a program called RegClean available from its Web site. RegClean audits the Registry on a machine and removes entries for which the enabling component is missing. Suppose, for example, that you manually purged all the files for Excel from your system without running the uninstall program. All your registered DLLs would be gone, but the Registry entries would still be there, pointing to non-existent files. ActiveX components for Excel will then fail to run correctly. RegClean cleans up the Registry entries to remove these "dangling" entries pointing to non-existent files. The program also leaves behind an "undo" file when you are finished to help restore mistaken removals.
Problem
I like the power of the Visual Basic 6 Data control, but I want something with more speed and a different user interface. How can I mimic the data control's functions but make it run faster?
Technique
Building a data control is simpler than it sounds, but the debug and test environment is more complex than a form-based project because an ActiveX control must run in both the design-time and the runtime environments. Design-time code runs when controls are dropped onto the form, when objects are resized, and when control properties are changed.
In outline, ActiveX controls are developed in the following general sequence:
Most of the time spent developing an ActiveX control is spent on the visual interface and the design-time requirements of a visual control.
Plan the Control
Control planning is the easiest and hardest part of development--easiest because everyone knows what a data control needs to do, and hardest because we also have to handle "nasty" things that might be thrown up in our development or support paths. Nobody wants to support a control that crashes every time somebody does something unexpected. Fortunately, Visual Basic's object-oriented features help us expect and prevent errors.
The goal of the simple data control is to provide many of the conveniences of the Visual Basic data control with fast performance and complete source code availability. This data control will support four movement operations (first, previous, next, and last) and three data change operations (add new, update, and delete). The visual implementation of all operations will be constituent control buttons placed on the control. A constituent control is one we will place on top of our control to deliver a desired function. Any existing ActiveX control that has been designed to be placed on another control can be a constituent control for another project. All the common controls that shipped with Visual Basic 6 can be used as constituent controls, including text boxes, buttons, frames, list boxes, pictures, labels, and shapes. The OLE Automation control cannot be used as a constituent control. If you plan to distribute your control to others, even at no charge, be sure to check your license agreements and the Visual Basic 6 Books Online carefully.
Build the Development and Test Environment
The development and test environment for an ActiveX control is different from that of standard EXE projects because ActiveX controls have both design-time and runtime code attributes that can be different. The most important distinction is the way in which the control stores design-time property values. Properties such as the captions, data sources, and database names must be stored at design time if they are specified.
The development and test environment is implemented as a project group in order to have the ActiveX control project and the test form project available simultaneously. Whenever the control's object (visual design) window is closed, the control is placed into design-time Run mode, and the design-time code can be debugged within a single Visual Basic programming session.
Develop the Visual and Design-Time Interfaces
Your control's visual interface is the most obvious part of your work because the visual behavior is what everyone will notice. At design time, we deal with the resize event for managing constituent control sizes and control properties that need to be saved with the form. In the case of our private data control, we worry about saving the database location.
Develop the Core Functions
Finally, we can develop the core functions and events for the data control. The core operations displayed by the buttons are directly implemented with the underlying data access object (DAO) methods. The public events notify the form of changes in the underlying data and of validation required prior to new, updated, or deleted records. The validation event is not fired when the data changes through control movement.
Steps
Open the project ExpDataControl.vbg. The form shown in Figure 12.17 appears. Experiment with the form and its buttons to get a feel for how this data control works.
Figure 12.17. The DataControl Test form.
Figure 12.18. The Project Properties window.
Figure 12.19. Expense data control visual elements.
Table 12.16. Objects and properties for the Expense Data control.
OBJECT PROPERTY Setting UserControl Name ExpDataControl Frame Name fraBorder Caption "Expense Data Control" Frame Name fraNavigate Caption "Navigate" CommandButton Name cmdFirst Caption "&First" CommandButton Name cmdPrev Caption "&Prev" CommandButton Name cmdNext Caption "&Next" CommandButton Name cmdLast Caption "&Last" Frame Name fraMaintain Caption "Maintain" CommandButton Name cmdNew Caption "Ne&w" CommandButton Name cmdUpdate Caption "&Update" CommandButton Name cmdDelete Caption "&Delete"
USING DEBUG.PRINT TO TRACE CONTROL BEHAVIOR
One of the most challenging parts of developing an ActiveX control is determining which events will fire and in what order. This How-To employs Debug.Print statements to trace control behavior, especially during design time. The first statement in most of the control's event procedure is usually this:Debug.Print "Event Name" & Extender.Name
At both design time and runtime, this statement causes a debug trace in the immediate window of all control behaviors. The Extender object reflects the control's container into your code in order to access important information about the control's environment. Standard Extender properties for a control include Name, Visible, Enabled, Top, Left, Height, and Width. These properties exist in your container's object but can be of value to your code for resizing and property initialization. You can use the trace information to learn more about design-time events and their effect on your control.
Private Sub UserControl_Resize()
` Resize constituent controls to look "nice"
Dim intMargin As Integer
Dim intHeight As Integer
Dim intWidth As Integer
` Trace our behavior
Static intCountResized As Integer
intCountResized = intCountResized + 1
Debug.Print Extender.Name & " Resized " _
& Str$(intCountResized) & " times"
` Adjust the placement of the border frame
fraBorder.Move 0, 0, ScaleWidth, ScaleHeight
` Calculate the standard margin as a proportion of
` the total control width.
intMargin = ScaleWidth / 36
` Calculate and adjust the sizes of the internal frames.
intHeight = (ScaleHeight - (1.5 * intMargin) - intMargin) / 2
intWidth = ScaleWidth - (2 * intMargin)
fraMaintain.Move intMargin, (intMargin * 2), _
intWidth, intHeight
fraNavigate.Move intMargin, _
(fraMaintain.Top + fraMaintain.Height), _
intWidth, intHeight
` Adjust the maintenance button sizes and locations
` based on the number of buttons and margins required.
` We need an extra margin in the height because the frame
` caption takes about one margin.
intHeight = fraMaintain.Height - (3 * intMargin)
intWidth = (fraMaintain.Width - (4 * intMargin)) / 3
cmdNew.Move intMargin, _
2 * intMargin, _
intWidth, intHeight
cmdUpdate.Move cmdNew.Left + intWidth + intMargin, _
2 * intMargin, _
intWidth, intHeight
cmdDelete.Move cmdUpdate.Left + cmdUpdate.Width + intMargin, _
2 * intMargin, _
intWidth, intHeight
` Adjust the movement button sizes and locations based on
` the number of buttons and margins required.
intHeight = fraNavigate.Height - (3 * intMargin)
intWidth = (fraNavigate.Width - (5 * intMargin)) / 4
cmdFirst.Move intMargin, _
2 * intMargin, _
intWidth, intHeight
cmdPrev.Move cmdFirst.Left + intWidth + intMargin, _
2 * intMargin, _
intWidth, intHeight
cmdNext.Move cmdPrev.Left + intWidth + intMargin, _
2 * intMargin, _
intWidth, intHeight
cmdLast.Move cmdNext.Left + intWidth + intMargin, _
2 * intMargin, _
intWidth, intHeight
End Sub
Figure 12.20. The Visual Basic Toolbox with the user control active.
DEBUGGING AND TESTING USERCONTROL OBJECTS
Debugging UserControl objects is straightforward when all the rules are clear. The Visual Basic development environment automatically runs the control's design-time instance whenever the UserControl's object design window is closed. The UserControl's icon is then activated on the Toolbox palette. Any breakpoints or Debug object statements in the UserControl code are then activated, and you can debug design-time code as you manipulate the UserControl on forms or set properties.
However, you might find the instance of your control on the form hatched over (not running in design mode) when you want to test with no apparent way to get the design-time code running. This turn of events is usually caused by a runtime compile-on-demand error, forcing a project reset and premature (in the programmer's mind) return to the design environment. Try manually compiling all the projects in the group to correct this error. Select File | Make Project Group from the Visual Basic main menu. Usually, recompiling the UserControl's .OCX file clears up the design-time environment. Alternatively, you can turn off the Compile On Demand check box on the General tab of the Options dialog box found on the Tools menu.
Figure 12.21. Use the Visual Basic Add Procedure window to declare the Caption property.
Public Property Get Caption() As String
Caption = fraBorder.Caption
End Property
Public Property Let Caption(ByVal strNewValue As String)
` Place the caption in the border frame.
fraBorder.Caption = strNewValue
` Notify the container so that the property
` window may be updated
PropertyChanged "Caption"
End Property
Private Sub UserControl_InitProperties()
` Trace behavior.
Debug.Print Extender.Name & ": InitProperties"
` Set the Caption property
Caption = Extender.Name
End Sub
Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
` Trace behavior.
Debug.Print Extender.Name & ": WriteProperties"
`Save the caption property to the property bag.
PropBag.WriteProperty "Caption", Caption, _
Extender.Name
End Sub
Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
` Trace behavior.
Debug.Print Extender.Name & ": ReadProperties"
`Retrieve the caption
Caption = PropBag.ReadProperty("Caption", _
Extender.Name)
End Sub
` Variables to define and control the recordset Private mblnRecSetOpen As Boolean Private mdbExpense As Database Private mrecExpense As Recordset Private mstrDbName As String ` Module variables to hold property value(s) Private mlngExpenseId As Long Private mstrEmployeeId As String Private mstrExpenseType As String Private mcurAmountSpent As Currency Private mstrDescription As String Private mdtmDatePurchased As Date Private mdtmDateSubmitted As Date
Public Property Get strDatabaseName() As String
` Returns the database name to the container
strDatabaseName = mstrDbName
End Property
Public Property Let strDatabaseName(ByVal strNewValue As String)
` Assigns database name to control and closes and opens the
` control's recordset
` Trace behavior.
Debug.Print Extender.Name & ": Let strDatabaseName"
` Don't allow database to be set at design time
If Ambient.UserMode = False Then
Err.Raise Number:=31013, _
Description:= _
"Property is read-only at design time."
Exit Property
End If
On Error GoTo OpenError
If mblnRecSetOpen Then
mrecExpense.Close
mdbExpense.Close
End If
mstrDbName = strNewValue
Set mdbExpense = _
DBEngine.Workspaces(0).OpenDatabase(mstrDbName)
Set mrecExpense = mdbExpense.OpenRecordset("Expenses")
mblnRecSetOpen = True
Exit Property
OpenError:
` Because we are designing this class for potential unattended
` operation, we'll have to raise an error on our own
Err.Raise Number:=Err.Number
Err.Clear
Exit Property
End Property
Private Sub UserControl_Initialize()
` Initialize control's core variables
` Trace behavior, but we can't use the name because
` the extender object is not available
Debug.Print "Initialize"
mblnRecSetOpen = False
End Sub
Private Sub UserControl_Terminate()
` Trace behavior.
Debug.Print "UserControl_Terminate"
` We don't really care about errors when cleaning up.
On Error Resume Next
` Close the recordset
mrecExpense.Close
` Close the expense database
mdbExpense.Close
` Reset the error handler
On Error GoTo 0
Exit Sub
End Sub
` Data changed event for data control movement
` or internally generated change tells the container
` that the control's view of the data has changed
Public Event DataChanged()
` Action enum for validate event eases container
` code development
Public Enum EXP_CHANGE_TYPE
expAddNewValidate
expUpdateValidate
expDeleteValidate
End Enum
` Validate response enum tells the control whether to
` proceed with the data change
Public Enum EXP_RESPONSE_TYPE
expOK
expCancel
End Enum
` Validate event for data control
Public Event ValidateData(ByRef Response As EXP_RESPONSE_TYPE, _
ByVal Change As EXP_CHANGE_TYPE)
Private Sub SetRecordset(recExp As Recordset)
` Copies current values to Recordset
With recExp
!EmployeeId = mvarstrEmployeeId
!ExpenseType = mvarstrExpenseType
!AmountSpent = mvarcurAmountSpent
!Description = mvarstrDescription
!DatePurchased = mvardtmDatePurchased
!DateSubmitted = mvardtmDateSubmitted
End With
End Sub
Private Sub GetRecordset(recExp As Recordset)
` Copies current values to Recordset
With recExp
mvarlngExpenseId = 0 + !ExpenseID
mvarstrEmployeeId = "" & !EmployeeId
mvarstrExpenseType = "" & !ExpenseType
mvarcurAmountSpent = 0 + !AmountSpent
mvarstrDescription = "" & !Description
mvardtmDatePurchased = !DatePurchased
mvardtmDateSubmitted = !DateSubmitted
End With
End Sub
Private Sub ClearObject()
` Clears all object variables
mlngExpenseId = 0
mstrEmployeeId = ""
mstrExpenseType = ""
mcurAmountSpent = 0
mstrDescription = ""
mdtmDatePurchased = CDate("1/1/1980")
mdtmDateSubmitted = CDate("1/1/1980")
End Sub
Private Sub cmdFirst_Click()
` Move to the first record
On Error GoTo MoveError
If mblnRecSetOpen Then
With mrecExpense
If Not (True = .BOF _
And True = .EOF) Then
` Dataset is not empty.
` Move to the first record.
.MoveFirst
Call GetRecordset(mrecExpense)
RaiseEvent DataChanged
End If
End With
End If
Exit Sub
MoveError:
` Return the error description
Err.Raise Number:=Err.Number, Source:=Err.Source, _
Description:=Err.Description
Err.Clear
Exit Sub
End Sub
Private Sub cmdLast_Click()
` Move to the last record
On Error GoTo MoveError
If mblnRecSetOpen Then
With mrecExpense
If Not (True = .BOF _
And True = .EOF) Then
` Dataset is not empty.
` Move to the last record.
.MoveLast
Call GetRecordset(mrecExpense)
RaiseEvent DataChanged
End If
End With
End If
Exit Sub
MoveError:
` Return the error description
Err.Raise Number:=Err.Number, Source:=Err.Source, _
Description:=Err.Description
Err.Clear
Exit Sub
End Sub
Private Sub cmdNext_Click()
` Move to the next record
On Error GoTo MoveError
If mblnRecSetOpen Then
With mrecExpense
If True = .BOF _
And True = .EOF Then
.MoveLast
Else
` Dataset is not empty.
` Move to the previous record.
.MoveNext
If .EOF Then
.MoveLast
End If
End If
Call GetRecordset(mrecExpense)
RaiseEvent DataChanged
End With
End If
Exit Sub
MoveError:
` Return the error description
Err.Raise Number:=Err.Number, Source:=Err.Source, _
Description:=Err.Description
Err.Clear
Exit Sub
End Sub
Private Sub cmdPrev_Click()
` Move to the previous record
On Error GoTo MoveError
If mblnRecSetOpen Then
With mrecExpense
If True = .BOF _
And True = .EOF Then
.MoveFirst
Else
` Dataset is not empty.
` Move to the previous record.
.MovePrevious
If .BOF Then
.MoveFirst
End If
End If
Call GetRecordset(mrecExpense)
RaiseEvent DataChanged
End With
End If
Exit Sub
MoveError:
` Return the error description
Err.Raise Number:=Err.Number, Source:=Err.Source, _
Description:=Err.Description
Err.Clear
Exit Sub
End Sub
Private Sub cmdNew_Click()
` Inserts a brand-new record into the database and leaves the
` newly inserted values as the current object values.
Dim uexpResponse As EXP_RESPONSE_TYPE
On Error GoTo InsertError
RaiseEvent ValidateData(uexpResponse, expAddNewValidate)
If expOk = uexpResponse Then
With mrecExpense
.AddNew
mdtmDateSubmitted = Now
Call SetRecordset(mrecExpense)
.Update
`Move to the most recently modified record
.Bookmark = .LastModified
Call GetRecordset(mrecExpense)
RaiseEvent DataChanged
End With
End If
Exit Sub
InsertError:
` Return the error description
Err.Raise Number:=Err.Number, Source:=Err.Source, _
Description:=Err.Description
Err.Clear
Exit Sub
End Sub
Private Sub cmdUpdate_Click()
` Updates Expenses table from current object values
Dim uexpResponse As EXP_RESPONSE_TYPE
On Error GoTo UpdateError
RaiseEvent ValidateData(uexpResponse, expAddNewValidate)
If expOk = uexpResponse Then
With mrecExpense
.Edit
Call SetRecordset(mrecExpense)
.Update
`Move to the most recently modified record
.Bookmark = .LastModified
Call GetRecordset(mrecExpense)
RaiseEvent DataChanged
End With
End If
Exit Sub
UpdateError:
` Return the error description
Err.Raise Number:=Err.Number, Source:=Err.Source, _
Description:=Err.Description
Err.Clear
Exit Sub
End Sub
Private Sub cmdDelete_Click()
` Deletes the expense detail record whose value is
` current from the database
Dim uexpResponse As EXP_RESPONSE_TYPE
On Error GoTo DeleteError
RaiseEvent ValidateData(uexpResponse, expAddNewValidate)
If expOk = uexpResponse Then
With mrecExpense
.Delete
If 0 = .RecordCount Then
Call ClearObject
Else
.MoveNext
If .EOF Then
Call ClearObject
Else
Call GetRecordset(mrecExpense)
End If
End If
End With
End If
RaiseEvent DataChanged
Exit Sub
DeleteError:
` Return the error description
Err.Raise Number:=Err.Number, Source:=Err.Source, _
Description:=Err.Description
Err.Clear
Exit Sub
End Sub
Public Property Get curAmountSpent() As Currency
` Return the control's current amount
curAmountSpent = mcurAmountSpent
End Property
Public Property Let curAmountSpent(ByVal curNewValue As Currency)
` Set the amount spent
mcurAmountSpent = curNewValue
End Property
Public Property Get dtmDatePurchased() As Date
` Return the control's current purchase date
dtmDatePurchased = mdtmDatePurchased
End Property
Public Property Let dtmDatePurchased(ByVal dtmNewValue As Date)
` Set the purchase date
mdtmDatePurchased = dtmNewValue
End Property
Public Property Get dtmDateSubmitted() As Date
` Return the control's current submitted date.
` There is no property Let procedure because the
` value is set only when the record is created.
dtmDateSubmitted = mdtmDateSubmitted
End Property
Public Property Get lngExpenseId() As Long
` Return the database-assigned ExpenseID.
` Note that there is no Property Let procedure
` because the database makes the key assignment.
lngExpenseId = mlngExpenseId
End Property
Public Property Get strDescription() As String
` Return the control's current description
strDescription = mstrDescription
End Property
Public Property Let strDescription(ByVal strNewValue As String)
` Set the expense description
mstrDescription = strNewValue
End Property
Public Property Get strEmployeeId() As String
` Return the control's current employee ID
strEmployeeId = mstrEmployeeId
End Property
Public Property Let strEmployeeId(ByVal strNewValue As String)
` Set the employee ID
mstrEmployeeId = strNewValue
End Property
Public Property Get strExpenseType() As String
` Return the control's current expense type
strExpenseType = mstrExpenseType
End Property
Public Property Let strExpenseType(ByVal strNewValue As String)
` Sets the expense type to an allowed value
Dim strTemp As String
strTemp = UCase$(strNewValue)
If strTemp = "TRAVEL" _
Or strTemp = "MEALS" _
Or strTemp = "OFFICE" _
Or strTemp = "AUTO" _
Or strTemp = "TOLL/PARK" Then
mstrExpenseType = strTemp
Else
Err.Raise Number:=31013, _
Description:="Expense type must be TRAVEL, MEALS, " _
& "OFFICE, AUTO, or TOLL/PARK"
`Err.Clear
Exit Property
End If
End Property
Figure 12.22. The advanced Procedure Attributes dialog box.
Figure 12.23. Layout of the Test Data Control form.
Table 12.17. Objects and properties for the Test Data Control form.
OBJECT Property Setting Form Name TestDataControl Caption "Test Data Control" ExpDetailControl Name expControl Caption "Expense Control" MaskEdBox Name mskAmountSpent Format "$#,##0.00;($#,##0.00)" PromptChar "_" TextBox Name txtSubmitDate TextBox Name txtPurchaseDate TextBox Name txtDescription TextBox Name txtExpenseType TextBox Name txtEmployeeId TextBox Name txtExpenseId Label Name Label1 Caption "Expense ID:" Label Name Label2 Caption "Employee:" Label Name Label3 Caption "Expense Type:" Label Name Label4 Caption "Amount Spent:" Label Name Label5 Caption "Description:" Label Name Label6 Caption "Purchase Date:" Label Name Label7 Caption "Submission Date:"
Table 12.18. Menu specifications for the Object Library form.
CAPTION Name Shortcut Key &File mnuFile ----E&xit mnuFileExit
Private Sub expControl_DataChanged()
` The data has changed in the control, so update the form
Call ReadObjectValues
End Sub
Private Sub ReadObjectValues()
` Read the object values into the form fields
txtExpenseId.Text = CStr(expControl.lngExpenseId)
txtEmployeeId.Text = expControl.strEmployeeId
txtExpenseType.Text = expControl.strExpenseType
txtDescription.Text = expControl.strDescription
mskAmountSpent.Text = CStr(expControl.curAmountSpent)
txtPurchaseDate.Text = CStr(expControl.dtmDatePurchased)
txtSubmitDate.Text = CStr(expControl.dtmDateSubmitted)
End Sub
Private Sub expControl_ValidateData _
(Response As ExpDetailControl.EXP_RESPONSE_TYPE, _
ByVal Change As ExpDetailControl.EXP_CHANGE_TYPE)
` A command button has been pushed; update the control's
` data if needed
On Error GoTo ValidateError
Select Case Change
Case expAddNewValidate, expUpdateValidate
Call SetObjectValues
Response = expOk
Case expDeleteValidate
Response = expOk
Case Else
Response = expCancel
End Select
Exit Sub
ValidateError:
MsgBox Err.Description & " from " _
& Err.Source & " -- " _
& CStr(Err.Number)
Response = expCancel
Exit Sub
End Sub
Private Sub SetObjectValues()
` Sets related object values from form fields
expControl.strExpenseType = txtExpenseType.Text
expControl.strEmployeeId = txtEmployeeId.Text
expControl.strDescription = txtDescription.Text
expControl.dtmDatePurchased = txtPurchaseDate.Text
expControl.curAmountSpent = CCur(mskAmountSpent.Text)
Exit Sub
End Sub
Private Sub Form_Load()` Get the ActiveX object to open its database Dim strDbName As String Dim strResponse As String On Error GoTo LoadError strDbName = App.Path strDbName = strDbName & "\Expense.mdb" expControl.strDatabaseName = strDbName Exit Sub LoadError: MsgBox Err.Description & Chr(13) & "from " & Err.Source _ & " -- Number: " & CStr(Err.Number) Unload Me End Sub
Private Sub mnuFileExit_Click()
Unload Me
End Sub
How It Works
The hand-crafted data control works by encapsulating recordset movement commands and visual controls in a simple wrapper exposing the database name, two events, and the data value properties (fields). The control itself manages all recordset navigation and the screen interface buttons.
The control begins useful functions when the strDatabaseName property is set and the recordset is opened. The strDatabaseName property is created to be read-only at design time. Changing it at design time results in an error message being displayed in the development environment.
The control's constituent buttons provide the heart of the user control. Whenever a movement button is clicked, the recordset is moved to a valid record, and the DataChanged event is raised to cause the containing application to retrieve current field values from the control's property values. When a database maintenance button is clicked, the control raises the ValidateData event to allow the containing form to update the control's copy of the data and to perform any display operations before the database is changed.
The data values of the control are implemented in runtime only and are hidden from the design-time properties window of the container. The strExpenseType control raises a private error event to indicate an invalid type together with an explanatory message. The Property Let procedure was not implemented for the lngExpenseId property because it is assigned by the database when a new record is inserted in the database.
Constituent Controls
Constituent controls are preexisting ActiveX controls placed onto ActiveX controls being developed. In this How-To, frame and button constituent controls were placed onto the simple data control. The caption of the data control was visually displayed as the caption of the surrounding frame. Although we didn't use the technique here, it is possible to expose individual constituent control events as events of the control. For example, if we wanted to raise a CommandFirstClick event from the control when the constituent cmdFirst button click event occurred, we would declare a new event in the declarations section and add a RaiseEvents call in the button click event.
Option Explicit
Public Event CommandFirstClick()
Private Sub cmdFirst_Click()
` Move to the first record
` ... Useful, productive code
` Tell the container about the click
RaiseEvent CommandFirstClick
End Sub
Debugging ActiveX Controls
Most of the debugging for an ActiveX control project can be accomplished with the simple project group approach shown in this How-To. Unfortunately, errors raised from Property Let procedures cannot be debugged in this way. Visual Basic seems to assume that all errors raised by the Property Let procedure must be handled by the Visual Basic End or Debug dialog box before the calling container gets a chance to handle the error. The workaround for this problem is to compile the control to its .OCX file and open just the test form's project from Visual Basic. Then the error will be trapped in the containing test form.
Comments
This control was built entirely by hand to illustrate the nuts and bolts of making a data control work within the ActiveX control environment. An ActiveX control skeleton can also be built quickly using the ActiveX Control Interface Wizard available as a Microsoft-supplied add-in to the Visual Basic 6 environment. The Wizard generates all the code required for managing most "standard" ActiveX properties and events, which were ignored in this How-To in the interest of keeping the core data control code more readable. You should use this add-in to develop robust controls that might receive wider distribution through your programming team or corporation.
You can also implement a specialized ActiveX data control function by placing a standard data control on an ActiveX control as a constituent control. This approach would certainly provide more rapid development than starting from button pasting, but at a potential cost in performance and complexity.
Problem
I've created a database table for providing code values for list boxes. How can I write a data-bound ActiveX list box control to quickly populate itself from the code value table and be data bound to a control on my form?
Technique
This How-To shows the creation of an enhanced combo box control that fills itself with allowed choices from a code value table contained in the application's database. The CodeValue.mdb database is located in the Chapter12\HowTo10 directory on the CD-ROM. The main Subject data table contains information on criminal suspects, and the Code10 table contains possible values for suspect attributes such as hair color and eye color. The table is called Code10 because it returns 10-character fields based on 10-character code types. Table 12.19 describes the suspect table, and Table 12.20 describes the Code10 table.
| FIELD |
| SuspectId |
| LastName |
| FirstName |
| MiddleName |
| Alias |
| EyeColor |
| HairClr |
| Religion |
| MaritalStatus |
| FIELD | Description |
| CodeType10 | Type of code values to return--for example, HAIRCOLOR. |
| CodeValue10 | Data value to populate in combo boxes for the code type--for example, Blond. |
| CodeDesc | Description of this particular type-value pair. |
The new control will function almost the same as a standard combo box with the addition of a code type to load and an open database object to use for creating the recordset. The ActiveX Control Interface Wizard will write most of the code for this control based on its dialog inputs.
Steps
Figure 12.24. The Test Bound Control form.
Figure 12.25. The ActiveX Control Interface Wizard - Select Interface Members dialog box.
Table 12.21. The properties and method for the Bound Combo control.
TYPE Name Description Property objDatabase Object variable to contain the open database object from which the combo box should be loaded. Property strCodeType Value for code type to select--for example, HAIRCOLOR. Method Reload Reloads the list box from the database.
Figure 12.26. The Control Interface Wizard - Set Mapping dialog box.
Figure 12.27. The Control Interface Wizard - Set Attributes dialog box.
Table 12.22. Members and properties for the Bound Combo control.
MEMBER Data Type Runtime Design-Time Description objDatabase Object Write Only Not Avail. Open database object supplied at runtime by container. strCodeType String Read/Write Read/Write Code value type to retrieve.
Private Sub UserControl_Resize()
` Resize the combo box to the size of the control
` The height can't be changed for certain styles, so
` we won't support any height changes.
Height = cmbCodeValue.Height
` Resize the combo box without using the Move method.
cmbCodeValue.Top = 0
cmbCodeValue.Left = 0
cmbCodeValue.Width = ScaleWidth
End Sub
Figure 12.28. The Procedure Attributes for a data-bound property.
Public Property Let Text(ByVal New_Text As String)
If CanPropertyChange("Text") Then
cmbCodeValue.Text() = New_Text
PropertyChanged "Text"
End If
End Property
Private Sub cmbCodeValue_Change()
` Notify the container of data change
PropertyChanged "Text"
End Sub
Private Sub cmbCodeValue_Click()
RaiseEvent Click
PropertyChanged "Text"
End Sub
Public Sub Reload()
` Reload the combo box
Dim strSql As String
Dim rsCodes As Recordset
cmbCodeValue.Clear
` If the code type has been set
If "" <> strCodeType Then
` Build a SQL statement.
strSql = "SELECT CodeValue10 FROM Code10 WHERE " _
& "CodeType10 = `" & strCodeType _
& "` ORDER BY CodeValue10"
`Get a recordset.
Set rsCodes = objDatabase.OpenRecordset(strSql, _
vbRSTypeSnapShot, dbForwardOnly)
Do While Not rsCodes.EOF
` Add the items.
cmbCodeValue.AddItem "" & rsCodes("CodeValue10")
rsCodes.MoveNext
Loop
End If
`Close the recordset
rsCodes.Close
Exit Sub
End Sub
Public Property Set objDatabase(ByVal New_objDatabase As Object)
Set m_objDatabase = New_objDatabase
PropertyChanged "objDatabase"
` Set the object database and invoke the Reload method to
` put data into the combo box
If "" <> strCodeType Then
Call Reload
End If
End Property
Figure 12.29. Layout for the TestBoundControl form.
Table 12.23. Objects and properties for the Test Bound Control form.
OBJECT Property Setting Form Name frmTestBoundCombo Caption "Test Bound Control" Data Name dtaSuspects Caption "Criminal Suspects" Connect "Access" DatabaseName "C:\Code\Chapter12\Howto10\CodeValues.mdb" RecordSource "Subject" ctlBoundCombo Name usrEyeBound DataField "EyeColor" DataSource "dtaSuspects" strCodeType "EYECOLOR" ctlBoundCombo Name usrHairBound DataField "HairClr" DataSource "dtaSuspects" strCodeType "HAIRCOLOR" ctlBoundCombo Name usrReligionBound DataField "Religion" DataSource "dtaSuspects" strCodeType "RELIGION" ctlBoundCombo Name usrMarStatBound DataField "MaritalStatus" DataSource "dtaSuspects" strCodeType "MAR STAT" TextBox Name txtSuspectId DataField "SuspectId" DataSource "dtaSuspects" Enabled 0 `False TextBox Name txtLastName DataField "LastName" DataSource "dtaSuspects" TextBox Name txtFirstName DataField "FirstName" DataSource "dtaSuspects" TextBox Name txtMiddleName DataField "MiddleName" DataSource "dtaSuspects" TextBox Name txtAlias DataField "Alias" DataSource "dtaSuspects" Label Name Label1 AutoSize -1 `True Caption "SuspectId:" Label Name Label2 AutoSize -1 `True Caption "Last Name:" Label Name Label3 AutoSize -1 `True Caption "First Name:" Label Name Label4 AutoSize -1 `True Caption "Middle Name:" Label Name Label5 AutoSize -1 `True Caption "Alias:" Label Name Label6 AutoSize -1 `True Caption "Eye Color:" Label Name Label7 AutoSize -1 `True Caption "Hair Color:" Label Name Label8 AutoSize -1 `True Caption "Religion:" Label Name Label9 AutoSize -1 `True Caption "Marital Status:"
Private Sub Form_Load()
dtaSuspects.DatabaseName = App.Path & "\CodeValues.mdb"
dtaSuspects.Refresh
` Initialize the bound combo controls
Set usrEyeBound.objDatabase = dtaSuspects.Database
Set usrHairBound.objDatabase = dtaSuspects.Database
Set usrReligionBound.objDatabase = dtaSuspects.Database
Set usrMarStatBound.objDatabase = dtaSuspects.Database
End Sub
How It Works
When the form loads, the Set statements for the bound combo boxes cause the combo boxes to be filled. Any time the combo box contents are changed by a click or change event, PropertyChanged is called to inform the containing form that a bound control has changed. The container, in turn, notifies the dtaSuspects data control. Most of the control code was generated by the ActiveX Control Interface Wizard to propagate constituent control properties to the bound control.
The ActiveX Interface Control Wizard provides a capable tool for building and extending your own component library. This bound combo box control for displaying code values runs faster than a DBCombo control and reduces the visual clutter of its containing form at design time. With a little more work, it could be extended to include a single property page to browse for the Code Types through design-time SQL statements, as well as setting the underlying combo box style.
Comments
The advantage of working with The ActiveX Interface Control Wizard is in the robustness and automated checklist it gives you in the creation of your control. The wizard reminds the developer about all the properties and methods of constituent controls in order to ensure that the properties and methods expected by a developer are seamlessly implemented into the control's behavior.
Problem
I've created a custom data bound control for editing records in the corporate database, but the users want to be able to see and edit multiple records at the same time. How can I give them a multirecord view and still keep my code investment in the custom data bound control?
Technique
This How-To shows you how to use the DataRepeater control with your custom data bound control to create a multirecord view of the data. By keeping your existing custom data bound control, you reuse tested, working code and keep your business rules in one place. The DataRepeater control takes a bound control and repeats it like a list box of controls. Figure 12.30 shows a record set displayed with a DataRepeater and a custom data bound control.
Figure 12.30. The DataRepeater control.
Steps
Figure 12.31. The layout for ctlAddress.
Table 12.24. Objects and properties for the ctlAddress control.
OBJECT Property Setting Text Name txtFirstName Text "" Text Name txtLastName Text "" Text Name txtAddress Text "" Text Name txtCity Text "" Text Name txtState Text "" Text Name txtZip Text "" Label Name lblFirstName Caption "First Name" Label Name lblLastName Caption "Last Name" Label Name lblAddress Caption "Address" Label Name lblCity Caption "City" Label Name lblState Caption "State" Label Name lblZip Caption "Zip Code"
Private Sub UserControl_Resize()
If Height <> 2325 Then
Height = 2325
End If
If Width <> 5445 Then
Width = 5445
End If
End Sub
Figure 12.32. Mapping properties to constituent control properties.
Figure 12.33. Setting the procedure attributes for the Address property.
Table 12.25. Objects and properties for the Data Repeater Test form.
OBJECT Property Setting Form Name frmDataRepeaterTest Caption "Data Repeater How To" DataRepeater Name datarepAddresses Caption "Addresses" DataSource adodcAddresses RepeatedControlName RepeaterTestControl.ctlAddress ADO Data Control Name adodcAddresses Caption "Addresses" ConnectionString "Provider=Microsoft.Jet.OLEDB.3.51; DataSource=Addresses.mdb" RecordSource "Addresses"
How It Works
The aptly named DataRepeater control creates multiple instances of your custom bound control and shows them in a list style view. With this tool you can move a single record view to a multiple record view with little or no code change. This particular use of the DataRepeater allows the user to browse and edit a list of people and addresses in Addresses.mdb. To navigate through the list use the scrollbars on the DataRepeater or the classic data buttons on the ADO Data control.
Comments
The DataRepeater control can only be used with the ADO Data control; unfortunately, it doesn't work with the regular Data control or the RemoteData control. However, for existing applications, conversions should be fairly straightforward. ADO can access all the data sources available to the Data control and the RemoteData control.
© Copyright, Macmillan Computer Publishing. All rights reserved.