Because most new applications use OLE, Visual Basic includes a powerful control for hosting embeddable OLE objects in your applications. Here are some of the features of the OLE container control:
The container control gives you the power to create the program shown in , as well as more control of your inserted object. shows a sample application that adds a full-featured word processor to your application with very little code (when you exclude the comments).
OLECONT.VBP demonstrates how to host embeddable OLE objects.
The first file in the OLECONT.VBP is PUBLIC.BAS. It keeps track of all the public constants, variables, and functions for this project. Because this application uses a multiple document interface, you have to maintain variables that keep track of the open forms in a module that all of the project's forms in the project can access. This module also contains a public function, UpdateStatus, which gives any procedure in the project the capability to update the status bar.
Listing 28.2 - PUBLIC.BAS - Public.bas Includes the Shared Code for OLECONT.VBP
'********************************************************************* ' PUBLIC.BAS - Global constants, functions, and variables '********************************************************************* Option Explicit '********************************************************************* ' Creates a new instance of frmWord '********************************************************************* Public Sub CreateNewWindow() Dim WinWord As frmWord Set WinWord = New frmWord With WinWord .Caption = .Caption & " - " & CStr(Forms.Count - 1) .Visible = True End With End Sub '********************************************************************* ' Generic update status bar routine '********************************************************************* Public Sub UpdateStatus(lblStatusBar As Label, _ Optional strStatusText As String = "Ready") lblStatusBar = strStatusText End Sub
The second file in the OLECONT.VBP project is the MDI parent form, mdiOLE. This form is responsible for controlling the status bar, toolbar, and its menu. begins by demonstrating how to maintain its toolbar.
The application stores the toolbar buttons in an image control array called imgTools. You set the picture property and the control's position in the array at design time. The odd controls in the array contain the up picture, and the even (odd number + 1) controls contain the down picture. The imgHoldimage control is a temporary location to store the toolbar picture when the user clicks a toolbar button.
When an odd-numbered image control receives a Mouse_Downevent, the application stores its image in an image control called imgHold. Next, the application sets the imgTools(Index)picture property to the picture of the next control in the array (Index + 1), which should be its down picture. Finally, when the control receives a Mouse_Upevent, the application restores the control's up picture by setting imgTools(Index)to the picture currently stored in imgHold. Listing 28.3 shows how to accomplish this.
Listing 28.3 - MDIOLE.FRM - The MDI Parent Maintains the Code for the Toolbar
'********************************************************************* ' MDIOLE.FRM - MDI Parent Form '********************************************************************* Option Explicit '********************************************************************* ' Saves the button image in imgHold, and inserts the down picture '********************************************************************* Private Sub imgTools_MouseDown(Index As Integer, _ Button As Integer, Shift As Integer, X As Single, _ Y As Single) imgHold.Picture = imgTools(Index).Picture imgTools(Index).Picture = imgTools(Index + 1).Picture End Sub '********************************************************************* ' Restores the graphic, and closes the application '********************************************************************* Private Sub imgTools_MouseUp(Index As Integer, _ Button As Integer, Shift As Integer, _ X As Single, Y As Single) imgTools(Index).Picture = imgHold.Picture Unload Me End Sub
![]()
Because this toolbar has only one tool, you place its code in the Mouse_Downevent. If this toolbar had more than one button, you would place the action code for the imgToolscontrol array in a large Select Casestatement in the Clickevent.
Every time the user moves the mouse over a toolbar button, you should update the status bar to reflect the action that the tool performs. The following code demonstrates how to do this.
'********************************************************************* ' Updates the status bar '********************************************************************* Private Sub imgTools_MouseMove(Index As Integer, _ Button As Integer, _ Shift As Integer, X As Single, _ Y As Single) UpdateStatus lblStatus, "Closes " & Caption End Sub
As demonstrates, the MDIForm_Loadprocedure maximizes the window and tiles all open child windows, and the MouseMoveprocedures set the caption of lblStatusequal to "Ready" whenever the user moves the mouse over the MDI form.
Listing 28.4 - MDIOLE.FRM - The MDI Form Contains Only Code That Applies to All the Child Windows
'********************************************************************* ' Prepares the application for use '********************************************************************* Private Sub MDIForm_Load() BackColor = vb3DFace Toolbar.BackColor = vb3DFace StatusBar.BackColor = vb3DFace WindowState = vbMaximized CreateNewWindow Arrange vbTileHorizontal End Sub '********************************************************************* ' Updates the status bar with the default text '********************************************************************* Private Sub MDIForm_MouseMove(Button As Integer, _ Shift As Integer, _ X As Single, Y As Single) UpdateStatus lblStatus End Sub '********************************************************************* ' Updates the status bar with the default text '********************************************************************* Private Sub Toolbar_MouseMove(Button As Integer, _ Shift As Integer, _ X As Single, Y As Single) UpdateStatus lblStatus End Sub '********************************************************************* ' Updates the status bar with the default text '********************************************************************* Private Sub StatusBar_MouseMove(Button As Integer, _ Shift As Integer, _ X As Single, Y As Single) UpdateStatus lblStatus End Sub
To make the code in Listing 28.4 application-independent, you create separate procedures for Highlightand HighlightBar. You then can use these procedures in OLECONT.VBP but also can copy and paste them into another project. adds a three-dimensional appearance to the status bar and the toolbar using these procedures.
Listing 28.5 - MDIOLE.FRM - The PaintEvent Adds a Custom Three-Dimensional Affect when You Use the HighlightProcedures
'********************************************************************* ' Adds a 3-D appearance to the status bar '********************************************************************* Private Sub StatusBar_Paint() HighlightBar StatusBar Highlight lblStatus End Sub '********************************************************************* ' Adds a 3-D appearance to the toolbar '********************************************************************* Private Sub Toolbar_Paint() HighlightBar Toolbar End Sub
shows two functions that demonstrate how to use a series of line methods to create a three-dimensional effect around controls. Although most controls now come with a 3-D appearance, there still are special cases (like our toolbar and status bar) where you need to perform these 3-D effects yourself.
Listing 28.6 - MDIOLE.FRM - Adding a Three-Dimensional Appearance to Controls
'********************************************************************* ' Adds a 3-D effect to a picture box '********************************************************************* Private Sub HighlightBar(picBar As PictureBox) With picBar If .ScaleMode <> vbTwips Then .ScaleMode = vbTwips picBar.Line (0, 5)-(.ScaleWidth, 5), vb3DHighlight picBar.Line (0, .ScaleHeight - 15)-(.ScaleWidth, _ .ScaleHeight - 15), vb3DShadow End With End Sub '********************************************************************* ' Adds a 3-D border around a control '********************************************************************* Private Sub Highlight(ctl As Control) Const HORIZONTAL_OFFSET = 50 Const VERTICAL_OFFSET = 70 If StatusBar.ScaleMode <> vbTwips Then StatusBar.ScaleMode = vbTwips With ctl '************************************************************* ' Top '************************************************************* StatusBar.Line (.Left - HORIZONTAL_OFFSET, _ .Top - HORIZONTAL_OFFSET)-(.Width, _ .Top - HORIZONTAL_OFFSET), vb3DShadow '************************************************************* ' Left '************************************************************* StatusBar.Line (.Left - HORIZONTAL_OFFSET, _ .Top - HORIZONTAL_OFFSET)-(.Left - HORIZONTAL_OFFSET, _ .Height + VERTICAL_OFFSET), vb3DShadow '************************************************************* ' Bottom '************************************************************* StatusBar.Line (.Left - HORIZONTAL_OFFSET, _ .Height + VERTICAL_OFFSET)-(.Width, _ .Height + VERTICAL_OFFSET), vb3DHighlight '************************************************************* ' Right '************************************************************* StatusBar.Line (.Width, .Top - HORIZONTAL_OFFSET)-(.Width, _ .Height + VERTICAL_OFFSET + 15), vb3DHighlight End With End Sub
shows FRMWORD.FRM, an MDI child form with an OLE container control. This form is the controlling interface for your Word document. With the aid of the OLE container control, it actually is a Word document window. The code in this module demonstrates how to handle such basic operations as cut/copy/paste, printing, saving and reading files, and window and menu management. Although the techniques shown in this form were designed for use with Word, they can be applied easily to any object that is embedded into an OLE container control.
Listing 28.7 - FRMWORD.FRM - An MDI Child Form with an OLE Container
'********************************************************************* ' FRMWORD.FRM - MDI Child form with a OLE container control. '********************************************************************* Option Explicit '********************************************************************* ' This insures that the Word object is always the same size as the ' client area of the window. '********************************************************************* Private Sub Form_Resize() Word.Move 0, 0, ScaleWidth, ScaleHeight End Sub '********************************************************************* ' Handles clicks from the File Submenu '********************************************************************* Private Sub mnuFileItems_Click(Index As Integer) Dim intFile As Integer On Error Resume Next Select Case Index Case 1 'New CreateNewWindow Case 2 'Open... OLEOpenFile Word Case 3 'Save As... OLESaveFile Word Case 5 OLEPrintObject Word Case 7 'Exit Unload mdiOLE End Select End Sub '********************************************************************* ' Updates the Object Submenu's enabled status '********************************************************************* Private Sub mnuObject_Click() With Word mnuObjectItems(1).Enabled = Not (.OLEType = vbOLENone) mnuObjectItems(2).Enabled = Not (.OLEType = vbOLENone) mnuObjectItems(3).Enabled = .PasteOK mnuObjectItems(4).Enabled = .PasteOK mnuObjectItems(5).Enabled = Not (.OLEType = vbOLENone) End With End Sub '********************************************************************* ' Handles clicks from the Object Submenu '********************************************************************* Private Sub mnuObjectItems_Click(Index As Integer) With Word Select Case Index Case 1 'Cut .DoVerb vbOLEShow .Copy .Close .Delete Case 2 'Copy .DoVerb vbOLEShow .Copy .Close Case 3 'Paste .Paste Case 4 'Paste Special... .PasteSpecialDlg Case 5 'Delete .Delete Case 7 'Close Object .Close End Select End With End Sub '********************************************************************* ' Updates the status bar '********************************************************************* Private Sub Word_MouseMove(Button As Integer, Shift As Integer, X As _ Single, Y As Single) UpdateStatus mdiOLE.lblStatus, _ "Double click to edit this object in Word" End Sub '********************************************************************* ' Handles clicks from the Window Submenu '********************************************************************* Private Sub mnuWindowItems_Click(Index As Integer) mdiOLE.Arrange Index - 1 End Sub '********************************************************************* ' Displays a Open dialog, and loads the file into a OLE Container '********************************************************************* Private Sub OLEOpenFile(OLEObject As OLE) On Error Resume Next Dim intFile As Integer With mdiOLE.cdlg .InitDir = App.Path .Flags = cdlOFNFileMustExist + cdlOFNHideReadOnly _ + cdlOFNNoChangeDir .ShowOpen If Err = cdlCancel Then Exit Sub intFile = FreeFile Open (.filename) For Binary As intFile OLEObject.ReadFromFile intFile Close intFile End With End Sub '********************************************************************* ' Displays a Save As dialog, and saves the contents of a OLE Container '********************************************************************* Private Sub OLESaveFile(OLEObject As OLE) On Error Resume Next Dim intFile As Integer With mdiOLE.cdlg .Flags = cdlOFNOverwritePrompt + cdlOFNNoChangeDir .ShowSave If Err = cdlCancel Then Exit Sub intFile = FreeFile Open (.filename) For Binary As intFile OLEObject.SaveToFile intFile Close intFile End With End Sub '********************************************************************* ' Prints the contents of an OLE Container Control. '********************************************************************* Private Sub OLEPrintObject(OLEObject As OLE) On Error Resume Next With mdiOLE.cdlg .Flags = cdlPDDisablePrintToFile + cdlPDNoPageNums _ + cdlPDNoSelection .ShowPrinter If Err = cdlCancel Then Exit Sub With OLEObject .DoVerb vbOLEShow Printer.PaintPicture .Picture, 0, 0 .Close Printer.EndDoc End With End With End Sub
As this application demonstrates, the power of the OLE container control can yield amazing results. In addition, you can spare yourself hundreds of hours of coding by using this powerful feature.