Glue42 Enterprise is now io.Connect Desktop! The new documentation site for all interop.io products is located at docs.interop.io.

Windows

Glue42 Windows

In order for windows of VBA apps to become Glue42 Windows, they must be registered as Glue42 Windows after the Glue42 COM library has been initialized.

Registering VBA UserForms

Registering a VBA UserForm as a Glue42 Window will decorate it with a "sticky" frame allowing it to be visually integrated with other Glue42 enabled apps.

Note that registering a VBA UserForm as a Glue42 Window imposes some restrictions on it (for more details, see VBA UserForm Restrictions). You can still use Glue42 functionality in the UserForm without registering it as a Glue42 Window.

To register a VBA UserForm as a Glue42 Window with default settings, use the RegisterGlueWindow method:

Dim WithEvents GlueWin As GlueWindow

Private Sub RegisterGlueWindow()
    On Error GoTo HandleErrors

    If Not GlueWin Is Nothing Then
        ' The Glue42 Window has already been registered (or registration is still in progress).
        Exit Sub
    End If

    Set GlueWin = Glue.RegisterGlueWindow(GetFormHwnd(Me), Nothing)
    Exit Sub

    HandleErrors:
    ' Handle exceptions.

End Sub

The example uses the GetFormHwnd helper function in order to retrieve the window handle (HWND) of the VBA UserForm.

You can also initiate the window registration with custom settings by using RegisterGlueWindowWithSettings instead:

' Create default window settings.
Dim WinSettings As GlueWindowSettings
Set WinSettings = Glue.CreateDefaultVBGlueWindowSettings

' Specify custom window settings.

' Must always be set to `True` in VBA.
WinSettings.SynchronousDestroy = True
' Disable Glue42 Channels.
WinSettings.ChannelSupport = False
' Set custom title.
WinSettings.Title = "Custom Title"

Set GlueWin = Glue.RegisterGlueWindowWithSettings(GetFormHwnd(Me), WinSettings, Nothing)

Window Events

You must provide implementations for the events that will be raised as a result of the interaction with the registered Glue42 Window.

The events HandleChannelChanged and HandleChannelData are described in the Channels documentation.

Window Ready

The HandleWindowReady event of a GlueWindow instance is raised when the registration of the window has completed. You can use its handler to indicate that the registration has completed and is safe to perform other operations with the Glue42 Window instance (changing the title, visibility, etc.):

Dim FormRegistered As Boolean

Private Sub GlueWin_HandleWindowReady(ByVal window As IGlueWindow)
    ' Indicate that the Glue42 Window registration has completed.
    FormRegistered = True
    ' Perform additional Glue42 Window operations here.
End Sub

Window Destroyed

The HandleWindowDestroyed event is raised when the Glue42 Window is being destroyed. The purpose for raising this event is to provide an opportunity for the VBA app to gracefully unload the VBA UserForm (see also VBA UserForm Restrictions):

Private Sub GlueWin_HandleWindowDestroyed(ByVal window As IGlueWindow)
    ' Unload the VBA `UserForm`.
    Unload Me
End Sub

Additional Window Events

You may optionally implement a handler for HandleWindowEvent which will be executed for various events related to the Glue42 Window, e.g. when the window is activated, moved, etc.

Private Sub GlueWin_HandleWindowEvent(ByVal window As IGlueWindow, ByVal eventType As GlueWindowEventType, ByVal eventData As GlueDynamicValue)
    If eventType = GlueWindowEventType_BoundsChanged Then
        ' Window was moved or resized, examine `eventData` for details.
        ...
    End If
End Sub

Window Operations

Once the VBA window has been registered as a Glue42 Window, you can perform different operations on it.

Title

To get the current window title, use the GetTitle method of a window instance:

Dim WinTitle as String

WinTitle = GlueWin.GetTitle()

To change the window title, use the SetTitle method of a window instance:

GlueWin.SetTitle "New Title"

Visibility

To check whether the window is visible, use IsVisible. To hide or show a window, use SetVisible and pass a Boolean value as an argument:

If GlueWin.IsVisible() Then
    GlueWin.SetVisible False
Else
    GlueWin.SetVisible True
End If

Activation

To activate the window, use the Activate subroutine:

GlueWin.Activate

VBA UserForm Restrictions

The following restrictions apply to a VBA UserForm when it has been registered as a Glue42 Window:

  • The app must provide a mandatory implementation of the HandleWindowDestroyed event in order to properly unload the VBA UserForm. Failing to unload the VBA UserForm will lead to deadlocks in the VBA execution thread.
  • If implementing a handler for the UserForm_QueryClose, the app must not make any blocking calls (e.g., use I/O operations, display close confirmation popups to the user) or prevent the UserForm from unloading by setting a non-zero value to the Cancel parameter.
  • The app shouldn't change directly the VBA UserForm visibility or position (e.g., with Show, Hide, Move).
  • After a UserForm has been closed/unloaded, it can be displayed again by using Show. In this case you will need to repeat the Glue42 initialization and Glue42 Window registration for the UserForm.