' VISREG.BAS - Visio Instance Registration Utilites
' Copyright (C) 1991-1994 Shapeware 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!

Global g_appVisio As object

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 2.0 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

