PC World Komputer 1999 January/pcwk_01_1999.iso/Wtestowe/Vistdstd/Install/Data.Z/Visreg.BAS

BASIC Source File | 1996-08-13 | 15KB | 441 lines

Attribute VB_Name = "VISREG"
' VISREG.BAS - Visio Instance Registration Utilites
' Copyright (C) 1991-1996 Visio Corporation. All rights reserved.
'
'
' Abstract      Contains helper functions for working with Visio instances.
'               To use this module include it into your project and use one
'               of the three levels available.  For more information see
'               below.
'
'               The registration utility offers an easy way get and create
'               Visio instance objects.  It offers three levels of instancing
'               from simple get/create/release to registration where the
'               library maintains the "signature" of a Visio instance and
'               warns you when the active instance changes.
'
'               The library maintains a static global g_appVisio which
'               is called the global instance object (GIO).  Use GIO in
'               your code when refering to the working instance of Visio.
'               Never apply the Set operator to GIO yourself (unless you
'               really know what your doing).
'
'               To use the library, include it in your project and refer the
'               visio application object through g_appVisio (GIO).
'               Read the sections below to find the level of functionality
'               you want.
'
'               Low Level Routines
'
'               The low level routines are almost identical to what you
'               would use normally with GetObject and CreateObject.
'               However they encapsulate the error handling.
'
'                   vaoGetGIO()     Retrieves active, running instances.
'                   vaoCreateGIO()  Creates a new instance.
'                   vaoReleaseGIO() Release the GIO instance if Set.
'                   vaoIsGIOValid() Verifies that GIO is Set and loaded.
'
'               Registration/Release Level
'
'                   Use this level when you need the registration functions
'                   to maintain the GIO but want control over how it is
'                   obtained.  The procedures are:
'
'                       vaoRegisterGIO()
'                       vaoUnRegistrGIO()
'                       vaoReSetGIO()
'                       (vaoReleaseGIO()    [From low level])
'
'                   To begin you register your instance and choose how to
'                   retrieve the GIO (Get/Create/Both) with
'                   vaoRegisterGIO() and use vaoUnRegisterGIO to release
'                   it.  This gives a good amount of flexibility but leaves
'                   it up to you to handle the conditions where Visio is shut
'                   down or a new instance is loaded.  At this level you keep
'                   the instance registered but release the GIO using
'                   vaoReleaseGIO.  To get back GIO use vaoReSetGIO.
'
'               Most Common Level
'
'                   This is highest, most abstract level.  It's called Most
'                   Common level because most scripts will probably use it
'                   to get instance objects.  There is one function:
'
'                       vaoGetObject()
'
'                   When called it will check to see if the GIO is already
'                   registered.  If not it will first attempt a GetObject
'                   and, if that fails, will use CreateObject.  Unless Visio
'                   is not installed, you will get visOK back.  On subsequent
'                   calls it checks that it is still valid (not UnSet and
'                   still running).  If so it returns visOK, otherwise it
'                   tries to register the GIO again.  If that fails you
'                   receive visError.  The nice thing about this is that one
'                   call maintains the GIO for you.
'

Option Explicit                                 '-- All Variable Explicit!

' Declare the global Application object using the type library reference.
' Change this to Global g_appVisio As Object if you choose not to use the
' type library.
Global g_appVisio As Visio.Application

Const REG_GET_HWND = 1
Const REG_SET_HWND = 2

Global Const visDiffInst = 1
Global Const visGet = 2
Global Const visCreate = 3
Global Const visVisioQuit = 4
Global Const visError = 5
Global Const visRegistered = 6
Global Const visOK = 7

Private Function GetHWND()
'-------------------------------
'--- GetHWND -------------------
'--
'--   Returns the registered Visio Window Handle.
'--

    Dim iTemp As Integer

    VisWindowHandle REG_GET_HWND, iTemp

    GetHWND = iTemp
End Function

Private Function Registered() As Integer
'-------------------------------
'--- RegisterVisio -------------
'--
'--   Returns boolean integer indicating if we are registered or not.
'--

    Registered = (GetHWND() <> 0)
End Function

Private Sub SetHWND(ByVal iNewHWND As Integer)
'-------------------------------
'--- SetHWND -------------------
'--
'--   Sets the registered Visio Window Handle.
'--

    VisWindowHandle REG_SET_HWND, iNewHWND
End Sub

Function vaoCreateGIO() As Integer
'-------------------------------
'--- vaoCreateGIO --------------
'--
'--   Uses CreateObject to create a new instance of Visio.  If it fails
'-- False is returned, otherwise the GIO is set to the instance created
'-- and True is returned.
'--

    On Error GoTo vaoCreateGIOErrorHandler

    Debug.Print "VISREG.BAS vaoCreateGIO() - Creating new Visio instance."

    Set g_appVisio = CreateObject("visio.application")

    If Not (g_appVisio Is Nothing) Then
        vaoCreateGIO = True
    End If

    Exit Function

vaoCreateGIOErrorHandler:
    Debug.Print "VISREG.BAS vaoCreateGIO() - Failed."
    Exit Function
    Resume Next
End Function

Function vaoGetGIO() As Integer
'-------------------------------
'--- vaoGetGIO -----------------
'--
'--   Uses GetObject to get the active instance of Visio.  If GetObject fails
'-- False is returned, otherwise the GIO is set and True is returned.
'--

    On Error GoTo vaoGetErrorHandler

    Debug.Print "VISREG.BAS vaoGetGIO() - Retrieving active Visio instance."

    Set g_appVisio = GetObject(, "visio.application")

    If Not (g_appVisio Is Nothing) Then
        vaoGetGIO = True
    End If

    Exit Function

vaoGetErrorHandler:
    Debug.Print "VISREG.BAS vaoGetGIO() - Failed."
    Exit Function
    Resume Next
End Function

Function vaoGetObject() As Integer
'-------------------------------
'--- vaoGetObject --------------
'--
'--   Uses registration procedures to maintain the GIO.  This funciton makes
'-- up the Common Use Layer (most commonly used procedure) for using the GIO.
'-- Just call it every time you need to work with Visio and it will make sure
'-- you have a valid working copy.
'--
'-- Return Values:
'--  visOK        - The GIO is set to a valid working instance of Visio.
'--  visError     - Visio or OLE not installed or some other serious
'--                 error occurred.
'--

    Dim iRetVal As Integer, iTemp As Integer, l_appVisio As Object

    iRetVal = visOK                             '-- Default To OK

    If Registered() Then                        '-- When Registerd...
        If Not vaoIsGIOValid() Then             '--   If GIO Is Valid...
            Debug.Print "VISREG.BAS vaoGetObject() - Re-registering instance."

            '-- Somehow the GIO is no longer valid, either because it was
            '-- vaoReleaseGIO'd or is no longer running.  Therefore we just
            '-- try to re-register and if the same instance is active, we
            '-- get that one again.  Otherwise we end up with the active
            '-- instance of Visio or a newly created one.
            '--
            '-- In future versions of Visio we will iterate through the
            '-- instance collection and retrieve the instance we originally
            '-- registered to if it still exists.

            vaoUnRegisterGIO                    '--   Oops, Its Bad Now...

            If vaoRegisterGIO(True, True) = visError Then
                iRetVal = visError
            End If
        End If
    Else
        If vaoRegisterGIO(True, True) = visError Then
            iRetVal = visError
        End If
    End If

    vaoGetObject = iRetVal
End Function

Function vaoGetVisio(bGet As Integer, bCreate As Integer) As Integer
'-------------------------------
'--- vaoGetVisio ---------------
'--
'--   Identical to vaoRegisterGIO except doesn't use registration functions.
'--
'-- Parameters : bUseExisting - Boolean - Use vaoGetGIO() first.
'--              bCreate      - Boolean - Use vaoCreateGIO().
'--
'--    Returns : visError     - If an error occurred and the GIO could not be
'--                             set.  Either the flags were invalid or
'--                             Get & Create failed.
'--              visGet       - When a vaoGetGIO() retrieved the GIO.
'--              visCreate    - When a vaoCreateGIO() retrieved the GIO.
'--              visRegisterd - Failed - GIO is registered.  Use
'--                             vaoUnRegisterGIO().
'--

    Dim iRetVal As Integer

    ' If registered we fail.
    '
    If Registered() Then
        iRetVal = visRegistered
        GoTo lblGetVisioCleanUp
    End If

    iRetVal = visError

    ' If the Get flag was set we first try vaoGetGIO()
    '
    If bGet Then
        If vaoGetGIO() Then iRetVal = visGet
    End If

    ' If the Create flag is on and the return value doesn't indicate that
    ' a get worked then we use create.
    '
    If bCreate And (iRetVal <> visGet) Then
        If vaoCreateGIO() Then iRetVal = visCreate
    End If

    ' If the GIO isn't set at this point we output an error message.
    '
    If g_appVisio Is Nothing Then
        Debug.Print "VISREG.BAS vaoGetVisio() - Error registering GIO."
    End If

lblGetVisioCleanUp:
    vaoGetVisio = iRetVal
End Function

Function vaoIsGIOValid() As Integer
'-------------------------------
'--- vaoIsGIOValid -------------
'--
'--   Our validity test simply checks to see if the GIO is set and, if so,
'-- checks if it is loaded.
'--
'-- Returns : True if GIO is set and loaded, False otherwise.
'--
    On Error GoTo lblvaoGIOValidErr

    Dim iTemp As Integer

    vaoIsGIOValid = False                           '-- Default To False

    If (g_appVisio Is Nothing) Then Exit Function   '-- Not Set

    iTemp = g_appVisio.Documents.Count              '-- Try A Property

    vaoIsGIOValid = True                            '-- No Error - Valid!
    Exit Function

lblvaoGIOValidErr:
    Exit Function                                   '-- Error - Invalid
    Resume Next
End Function

Function vaoRegisterGIO(bUseExisting As Integer, bCreate As Integer) As Integer
'-------------------------------
'--- vaoRegisterGIO ------------
'--
'--   Registers the GIO using two parameters to decide how the Visio instance
'-- should be created.  Use vaoUnRegisterGIO to reverse the registration.
'--
'-- Parameters : bUseExisting - If True then GetObject will tried first.
'--              bCreate      - If True CreateObject will be called after
'--                             any GetObject calls.
'--
'--    Returns : visError     - If an error occurred and the GIO could not be
'--                             registered because either the flags passed
'--                             were invalid or Get & Create failed.
'--              visGet       - When a GetObject retrieved the GIO.
'--              visCreate    - When a CreateObject retrieved the GIO.
'--              visRegisterd - When already registered.
'--

    Dim iRetVal As Integer

    If Registered() Then
        iRetVal = visRegistered
        GoTo lblRegisterCleanUp
    End If

    iRetVal = visError

    If bUseExisting Then
        If vaoGetGIO() Then iRetVal = visGet
    End If

    If bCreate And (iRetVal <> visGet) Then
        If vaoCreateGIO() Then iRetVal = visCreate
    End If

    If g_appVisio Is Nothing Then
        Debug.Print "VISREG.BAS vaoRegisterGIO() - Error registering GIO."
    Else
        SetHWND g_appVisio.WindowHandle
    End If

lblRegisterCleanUp:
    vaoRegisterGIO = iRetVal
End Function

Sub vaoReleaseGIO()
'-------------------------------
'--- vaoReleaseGIO -------------
'--
'--   Handles releasing the GIO.  Does not unregister the window handle.
'-- If using the registration interfaces use vaoReSetGIO to retrieve the
'-- GIO, otherwise you may use vaoGetGIO or vaoCreateGIO.  This does not
'-- take affect until all other references go out of scope.
'--

    Set g_appVisio = Nothing                '-- Release Resources

    Debug.Print "VISREG.BAS vaoReleaseGIO() - Complete."
End Sub

Function vaoReSetGIO() As Integer
'-------------------------------
'--- vaoReSetGIO ---------------
'--
'--   Tries to re-Set the GIO only if we are registered and the GIO is not
'-- already set.
'--
'-- Return Values :
'--   visError     - If not registered or GIO is already set.
'--   visOK        - If able to reSet the GIO to the registered instance.
'--   visVisioQuit - If Visio is no longer running.  If so then the GIO is
'--                  unregistered because the HWND is no longer valid.
'--   visDiffInst  - If the registered instance is no longer running.  The
'--                  GIO is not set.
'--

    vaoReSetGIO = visError

    If Not Registered() Or Not (g_appVisio Is Nothing) Then Exit Function

    If vaoGetGIO() Then
        If g_appVisio.WindowHandle = GetHWND() Then
            vaoReSetGIO = visOK
        Else
            vaoReleaseGIO
            vaoReSetGIO = visDiffInst       '-- Release GIO
        End If
    Else
        vaoReSetGIO = visVisioQuit
        vaoUnRegisterGIO                    '-- UnRegister
    End If
End Function

Sub vaoUnRegisterGIO()
'-------------------------------
'--- vaoUnRegisterGIO ----------
'--
'--   Unregisters a visio instance by clearing the window handle and releasing
'-- the global instance object.
'--

    SetHWND 0                           '-- Resets HWND
    vaoReleaseGIO                       '-- Releases GIO

    Debug.Print "VISREG.BAS vaoUnRegisterGIO() - Completed."
End Sub

Private Sub VisWindowHandle(ByVal iAction As Integer, iArg As Integer)
'-------------------------------
'--- VisWindowHandle -----------
'--
'--   Maintains the registered window handle in a static variable.
'--
'-- Parameters : iAction - Specifies the action to perform.  REG_GET_HWND
'--                        sets iArg to the handle.  REG_SET_HWND sets the
'--                        handle to iArg.
'--
'--              iArg    - Used in gets/sets.
'--

    Static iHWND As Integer

    Select Case iAction
        Case REG_GET_HWND: iArg = iHWND
        Case REG_SET_HWND: iHWND = iArg
        Case Else:
            Debug.Print "VISREG.BAS VisWindowHandle() - Invalid Action Passed"
    End Select
End Sub