Advanced Visual Basic Techniques
(Publisher: John Wiley & Sons, Inc.)
Author(s): Rod Stephens
ISBN: 0471188816
Publication Date: 06/01/97

The ScrollerHandler class contains the AfterClick subroutine triggered by the Create Scrolling Area menu command. ScrollerHandler.AfterClick, which actually creates the scrolling area, is described in the next section.

‘ The environment instance.
Dim VBInstance As VBIDE.Application

‘ The Add-Ins submenu.
Dim ScrollerMenu As VBIDE.SubMenu

‘ The command lines.
Dim AboutLine As VBIDE.MenuLine
Dim ScrollerLine As VBIDE.MenuLine

‘ The event connection IDs. These represent the
‘ event handler to menu line connections.
Dim AboutID As Long
Dim ScrollerID As Long

Sub ConnectAddIn(vb_instance As VBIDE.Application)
‘ Command event handler objects.
Dim scroller_handler As New ScrollerHandler

    ‘ Save the Visual Basic instance for later.
    Set VBInstance = vb_instance
    
    ‘ Add the submenu to the Add-Ins menu.
    Set ScrollerMenu = _
        VBInstance.AddInMenu.MenuItems.AddMenu _
            (“&Scroller”)
        
    ‘ Add the submenu’s commands.
    Set ScrollerLine = _
        ScrollerMenu.MenuItems.Add(“&Create Scrolling Area”)
    Set AboutLine = ScrollerMenu.MenuItems.Add(“About...”)
    
    ‘ Connect event handler objects to the menu
    ‘ commands. Event handler objects have Public
    ‘ AfterClick subroutines.
    ScrollerID = ScrollerLine.ConnectEvents(scroller_handler)
    ‘ This object will handle the About AfterClick.
    AboutID = AboutLine.ConnectEvents(Me)
    
    ‘ Give the scroller event handler object
    ‘ the handle to the Visual Basic environment.
    Set scroller_handler.VBInstance = VBInstance
End Sub

Sub DisconnectAddIn(mode As Integer)
    ‘ Disconnect the event handlers.
    ScrollerLine.DisconnectEvents ScrollerID
    AboutLine.DisconnectEvents AboutID
    
    ‘ Remove the submenu commands from the submenu.
    ScrollerMenu.MenuItems.Remove ScrollerLine
    ScrollerMenu.MenuItems.Remove AboutLine
    
    ‘ Remove the submenu.
    VBInstance.AddInMenu.MenuItems.Remove ScrollerMenu
End Sub

FIGURE 6.3  Scroller creates its own submenu in the Add-ins menu.

Creating the Scrolling Area

When the developer selects the Create Scrolling Area command from the Add-Ins menu, the system invokes a ScrollerHandler object’s AfterClick event handler. This routine must perform two tasks to create the scrolling area. First, it must create the new picture boxes and scroll bars that make up the scrolling area. Second, it must properly arrange the containments of the controls. For example, the controls selected by the developer must be contained by the inner scroll_area picture box. The following sections describe these two tasks.

Creating Controls

The first thing the ScrollerHandler object’s AfterClick event handler must do is create new controls. The ControlTemplates collection provides an Add method that creates new controls and adds them to the active form. This method takes as its only parameter the name of the class of control that it should create. For example, the following code creates a new picture box control:

Set scroll_area = frm.ControlTemplates.Add(“PictureBox”)

Setting Control Containment

A control template’s Container property indicates the template of the form or control that contains the control. Scroller moves each of the controls selected by the developer into the picture box scroll_area using code similar to the following:

Set ctl.Container = scroll_area

The AfterClick subroutine also writes event handler code for the package picture box’s Resize event, and for the two scroll bars’ Change and Scroll events. It begins by creating a temporary file. Next, using Print statements, it writes the event handlers into the file. It then uses the active form’s InsertFile method to add the contents of the file to the form’s source code. Finally, AfterClick uses the Kill command to delete the temporary file.

It is important that the new controls’ event handlers be created using the controls’ correct names. The variable hscroll, for example, is merely a template describing a control, not the control itself. That means the control’s Scroll event handler is not called hscroll_Scroll. It is more probably named something similar to HScroll1_Scroll. The AfterClick subroutine uses each control template’s Name property to determine the actual name of the control that was created. For example, the true name of the control represented by the hscroll variable is given by hscroll.Properties.Item(“Name”).

When it has finished creating controls and adding event handler code, AfterClick presents a message box reminding the developer to perform a few final tasks. The developer must add Scroller.BAS to the project, invoke the package control’s Resize event handler when it is first created, and optionally resize the package control when the form is resized.

Public Sub AfterClick()
Const MARGIN = 60
Dim min_x As Single
Dim max_x As Single
Dim min_y As Single
Dim max_y As Single
Dim x As Single
Dim y As Single
Dim ctl As Object
Dim controls As VBIDE.SelectedControlTemplates
Dim frm As Object
Dim scroll_area As Object
Dim viewport As Object
Dim hscroll As Object
Dim vscroll As Object
Dim package As Object
Dim scroll_area_name As String
Dim viewport_name As String
Dim hscroll_name As String
Dim vscroll_name As String
Dim package_name As String
Dim scroll_area_wid As Single
Dim scroll_area_hgt As Single
Dim viewport_wid As Single
Dim viewport_hgt As Single
Dim package_wid As Single
Dim package_hgt As Single
Dim filename As String
Dim fp As Integer

    If NoControls() Then Exit Sub
    
    Set frm = VBInstance.ActiveProject.ActiveForm
    Set controls = frm.SelectedControlTemplates
    
    ‘ Find the largest and smallest coordinates.
    Set ctl = controls.Item(0)
    min_x = ctl.Properties(“Left”)
    max_x = min_x
    min_y = ctl.Properties(“Top”)
    max_y = min_y
    
    For Each ctl In controls
        On Error Resume Next
        x = ctl.Properties(“Left”)
        If Err.Number = 0 Then
            If min_x > x Then min_x = x
            If max_x < x Then max_x = x
            y = ctl.Properties(“Top”)
            If min_y > y Then min_y = y
            If max_y < y Then max_y = y
        End If
        x = x + ctl.Properties(“Width”)
        If Err.Number = 0 Then
            If min_x > x Then min_x = x
            If max_x < x Then max_x = x
            y = y + ctl.Properties(“Height”)
            If min_y > y Then min_y = y
            If max_y < y Then max_y = y
        End If
        On Error GoTo 0
    Next ctl
   
    ‘ Create the scrolling area.
    Set scroll_area = frm.ControlTemplates.Add(“PictureBox”)
    With scroll_area.Properties
        .Item(“Left”) = 0
        .Item(“Top”) = 0
        scroll_area_wid = max_x - min_x + 2 * MARGIN
        scroll_area_hgt = max_y - min_y + 2 * MARGIN
        .Item(“Width”) = scroll_area_wid
        .Item(“Height”) = scroll_area_hgt
        .Item(“BorderStyle”) = vbTransparent
    End With
    
    ‘ Move the items into the scrolling area.
    For Each ctl In controls
        Set ctl.Container = scroll_area
        With ctl.Properties
            .Item(“Left”) = .Item(“Left”) - min_x + MARGIN
            .Item(“Top”) = .Item(“Top”) - min_y + MARGIN
        End With
    Next ctl
    
    ‘ Create the scrolling area controls.
    Set viewport = frm.ControlTemplates.Add(“PictureBox”)
    Set hscroll = frm.ControlTemplates.Add(“HScrollBar”)
    Set vscroll = frm.ControlTemplates.Add(“VScrollBar”)
    Set package = frm.ControlTemplates.Add(“PictureBox”)
    
    Set viewport.Container = package
    Set hscroll.Container = package
    Set vscroll.Container = package
    Set scroll_area.Container = viewport
    
    With viewport.Properties
        .Item(“Left”) = 0
        .Item(“Top”) = 0
        viewport_wid = .Item(“Width”) - _
            .Item(“ScaleWidth”) + scroll_area_wid
        viewport_hgt = .Item(“Height”) - _
            .Item(“ScaleHeight”) + scroll_area_hgt
        .Item(“Width”) = viewport_wid
        .Item(“Height”) = viewport_hgt
        .Item(“BorderStyle”) = vbBSSolid
    End With
    With hscroll.Properties
        .Item(“Left”) = 0
        .Item(“Top”) = viewport_hgt
        .Item(“Width”) = viewport_wid
    End With
    With vscroll.Properties
        .Item(“Left”) = viewport_wid
        .Item(“Top”) = 0
        .Item(“Height”) = viewport_hgt
    End With
    With package.Properties
        .Item(“Left”) = min_x
        .Item(“Top”) = min_y
        package_wid = viewport_wid + _
            vscroll.Properties.Item(“Width”)
        package_hgt = viewport_hgt + _
            hscroll.Properties.Item(“Height”)
        .Item(“Width”) = package_wid
        .Item(“Height”) = package_hgt
        .Item(“BorderStyle”) = vbTransparent
    End With
    
    ‘ Create a file containing code for the
    ‘ scrolling area.
    scroll_area_name = scroll_area.Properties.Item(“Name”)
    viewport_name = viewport.Properties.Item(“Name”)
    hscroll_name = hscroll.Properties.Item(“Name”)
    vscroll_name = vscroll.Properties.Item(“Name”)
    package_name = package.Properties.Item(“Name”)
    
    fp = FreeFile
    filename = App.Path & “\Scroller.TMP”
    Open filename For Output As fp
    Print #fp, “Private Sub “ & package_name & “_Resize()”
    Print #fp, “    ‘ Call ArrangeScrollingArea to”
    Print #fp, “    ‘ set scroll bar parameters.”
    Print #fp, “    ArrangeScrollingArea _”
    Print #fp, “        “ & package_name & “, _”
    Print #fp, “        “ & viewport_name & ”, _“
    Print #fp, “        “ & hscroll_name & ”, _”
    Print #fp, “        “ & vscroll_name & ”, _”
    Print #fp, “        “ & scroll_area_name
    Print #fp, “End Sub”
    Print #fp, “Private Sub ” & hscroll_name & “_Change()”
    Print #fp, “    ‘ Move the scrolling area.”
    Print #fp, “    ” & scroll_area_name & _
        “.Left = -” & hscroll_name & ”.Value”
    Print #fp, “End Sub”
    Print #fp, “Private Sub “ & hscroll_name & “_Scroll()”
    Print #fp, “    ‘ Move the scrolling area.”
    Print #fp, “    “ & scroll_area_name & _
        ”.Left = -“ & hscroll_name & ”.Value”
    Print #fp, “End Sub”
    Print #fp, “Private Sub “ & vscroll_name & ”_Change()”
    Print #fp, “    ‘ Move the scrolling area.”
    Print #fp, “    “ & scroll_area_name & _
        ”.Top = -“ & vscroll_name & ”.Value”
    Print #fp, “End Sub”
    Print #fp, “Private Sub “ & vscroll_name & ”_Scroll()”
    Print #fp, “    ‘ Move the scrolling area.”
    Print #fp, “    “ & scroll_area_name & _
        ”.Top = -“ & vscroll_name & ”.Value”
    Print #fp, “End Sub”
    Close fp
    
    ‘ Insert the file into the Form’s code.
    frm.InsertFile filename
    
    ‘ Delete the file.
    Kill filename

    ‘ Give the user a reminder popup.
    MsgBox “Remember to:” & vbCrLf & vbCrLf & _
        “1. Add file Scroller.BAS to your project.” & vbCrLf & _
        “2. Invoke ” & package_name & _
        “_Resize in this form’s Load event handler.” & vbCrLf & _
        “3. (Optional) Add code to resize ” & _
        package_name & “ when the form resizes.”, _
        vbOKOnly + vbInformation, “Reminder”
End Sub