Visual Basic Source Code/Visual Basic Source Code.iso/vbsource/mdishe/error.bas

BASIC Source File | 1994-12-28 | 5.5 KB | 187 lines

' ********************************************************
'        MDI Standard Application Shell
' ********************************************************
'
' SUMMARY
' -------
' This file is part of an MDI application "skeleton"
' created by John Blessing of Leigh Business Enterprises Ltd.
'
' FEATURES
' --------
' Selection of application database.
' Compact/Repair of database.
' 'Helptips' on toolbar items.
' Support for Help files.
' MDI child forms tiling etc.
' Error trapping.
' 'Nag' screen support for shareware authors.
' Support for 3D dialogs (switched off in design mode
'   to prevent GPFs)
'
' USE
' ---
' You need VB Pro to use this shell, although it could be
' modified to run under the standard edition.
'
' You will need to set up some information in APP.BAS,
' particularly in SetAppInfo().  You will also need to add
' your own application specific code to this module.
'
' DISTRIBUTION
' ------------
' This program is "FreeWare" and may be used and distributed
' as you wish.
'
' It incorporates some ideas/code from other authors and these
' are acknowledged in the appropriate module.
'
' We hope that you will find it useful.  If you wish to discuss it
' then please e-mail us on Compuserve 100444,623.
'
' ADVERTISEMENT!
' --------------
' Are you looking for a helpdesk system? Or does your company
' want to track and monitor the progress of any work activity?
' We market a system which could be of interest to you.
'
' PROGRESS is available for download from the Business section
' of the Windows Shareware forum on Compuserve
' (filename PRGRSS10.ZIP).  It's a large program, so in the
' same section you will also find the help files and
' documentation as  PRGSSDOC.ZIP which is quicker to download
' and will give you a good idea of the functionality of PROGRESS.
'
' Dec 1994
'
'
'The routines in this module were adapted from those
'from an article in the July/August 1994 edition of
'VB User
Option Explicit


'======================================================================
'Form/Module:
'   Error.bas
'
'Procedure:
'   bDesignMode
'
'Modifications:
'   23/12/94   JBL     Build
'
'Description:
'   Detects if the program is running in the design environment
'======================================================================
Function bDesignMode () As Integer
    Static bCalled      As Integer  'holds whether or not been called before
    Static bMode        As Integer  'holds VB mode
    Dim hInstanceForm   As Integer
    Dim hInstanceVB     As Integer
    Dim nVBMainWIndow   As Integer



    'errorhandler
    On Error GoTo Error_bDesignMode

    If Not bCalled Then
        'not been called before so calc if in design mode

        'check to see if any forms loaded
        If Forms.Count > 0 Then
            'there are some forms

            'signal that been called
            bCalled = True

            'try and find VB's hidden design window
            nVBMainWIndow = FindWindow("ThunderMain", 0&)
            If nVBMainWIndow = 0 Then
                'not in design mode
                bMode = False
            Else
                'in design mode
                'now check our form's hinstance against VB's
                'run-time window's to make sure that it's US
                'that is being worked on

                'get the hinstance of our first form
                hInstanceForm = GetWindowWord(Forms(0).hWnd, GWW_HINSTANCE)

                'get hinstance of VB's hidden window
                hInstanceVB = GetWindowWord(nVBMainWIndow, GWW_HINSTANCE)

                'check if they match
                If hInstanceForm = hInstanceVB Then
                    'in design mode
                    bMode = True
                Else
                    bMode = False
                End If
            End If  'end of having found ThunderMain

        Else
            'no forms loaded
            MsgBox "bDesignMode () cannot be called if there are no forms currently loaded.", MB_OK Or MB_ICONSTOP, "Error"

        End If  'end of check for any forms

    End If  'end of check if been called before

    'set return value
    bDesignMode = bMode

    Exit Function


Error_bDesignMode:

    MsgBox "Error " & CStr(Err) & ". " & Error$ & ".  At line " & CStr(Erl) & "."
    Resume Exit_bDesignMode

Exit_bDesignMode:
End Function

'======================================================================
'Form/Module:
'   Error.Bas
'
'Procedure:
'   GenErrorHandler
'
'Modifications:
'   23/12/94   JBL     Build
'
'Description:
'   Displays a standard message box and logs error to error file
'   if required
'   Author: Peter J Morris TMS (International) ltd.
'======================================================================
'
Sub GenErrorHandler (Location As String, ErrNum As Integer, ErrorText As String)

    Dim Message As String
    Dim FileNum As Integer

    Message = "Error no. " & CStr(ErrNum) & " in " & Location & "."
    Message = Message & sGNl & ErrorText

    MsgBox Message, MB_OK Or MB_ICONEXCLAMATION

    'write to error file if specified
    If tGApp.sErrorFile <> "" Then
        'add in the date and time
        Message = Message & sGNl & "Date and time: " & Now

        FileNum = FreeFile
        Open tGApp.sErrorFile For Append Access Write As FileNum
        Print #FileNum, Message
        Close #FileNum
    End If


End Sub