Attribute VB_Name = "DECLARES"
'****************************************************************************************
'
'   File:       DECLARES.BAS
'
'   Author:     Roberto Raso
'   Date:       19th August 1994
'
'****************************************************************************************
'
'   Purpose:    Declarations of external functions and sub-routines.
'
'****************************************************************************************

'****************************************************************************************
'
'  Constant/Global declarations.
'
'****************************************************************************************

'Const CONST1 = 1  '1 TAB away description.

'****************************************************************************************
'
'   Data type declarations.
'
'****************************************************************************************

'***
'*** RECT ***
'***
Type RECT
  Left As Long
  Top As Long
  Right As Long
  Bottom As Long
End Type

'***
'*** WINDOWLINK ***
'***
Type WINDOWLINK
    hWnd As Long         'Handle of window.
    hParent As Long      'Handle of parent.
    strCaption As String    'Window caption.
    strClass As String      'Window class.
    nID As Long          'Control ID of window.
    sRect As RECT
End Type

Type METAFILEPICT
  mm As Integer
  xExt As Integer
  yExt As Integer
  hMF As Long
End Type

'Declaration of new type SIZE for 32-bit functions.

Type Size
        cx As Long
        cy As Long
End Type


'****************************************************************************************
'
'   Function declarations.
'
'****************************************************************************************


Declare Function BringWindowToTop Lib "user32" (ByVal hWnd As Long) As Long

Declare Function CheckDlgButton Lib "user32" (ByVal hDlg As Long, ByVal nIDButton As Long, ByVal wCheck As Long) As Long

Declare Function CheckRadioButton Lib "user32" (ByVal hDlg As Long, ByVal nIDFirstButton As Long, ByVal nIDLastButton As Long, ByVal nIDCheckButton As Long) As Long
Declare Function ClipCursor Lib "user32" (lpRect As Any) As Long
Declare Function CloseClipboard Lib "user32" () As Long


'Declare Sub EnableMassLynx Lib "util.DLL" (ByVal bEnable As Integer)

Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long

'Declare Function GetMessage Lib "User" (lpMsg As msg, ByVal hWnd As Long, ByVal wMsgFilterMin As Integer, ByVal wMsgFilterMax As Integer) As Integer
Declare Function GetWindow Lib "user32" (ByVal hWnd As Long, ByVal wCmd As Long) As Long

Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hWnd As Long, ByVal lpClassName As Long, ByVal nMaxCount As Long) As Long

Declare Function GetActiveWindow Lib "user32" () As Long

Declare Function GetNextWindow Lib "user32" Alias "GetWindow" (ByVal hWnd As Long, ByVal wFlag As Long) As Long

Declare Function GetParent Lib "user32" (ByVal hWnd As Long) As Long

Declare Function GetPrivateProfileInt Lib "kernel32" Alias "GetPrivateProfileIntA" (ByVal lpApplicationName As String, ByVal lpKeyName As String, ByVal nDefault As Long, ByVal lpFileName As String) As Long

Declare Function GetPrivateProfileString Lib "kernel32" Alias "GetPrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Long, ByVal lpFileName As String) As Long

Declare Function GetSysColor Lib "user32" (ByVal nIndex As Long) As Long

Declare Function GetWindowsDirectory Lib "kernel32" Alias "GetWindowsDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long



Declare Function GetClientRect Lib "user32" (ByVal hWnd As Long, lpRect As RECT) As Long

Declare Function GetWindowRect Lib "user32" (ByVal hWnd As Long, lpRect As RECT) As Long

Declare Function GetMenu Lib "user32" (ByVal hWnd As Long) As Long

Declare Function GetMenuItemID Lib "user32" (ByVal hMenu As Long, ByVal nPos As Long) As Long

Declare Function GetMenuItemCount Lib "user32" (ByVal hMenu As Long) As Long

Declare Function GetSubMenu Lib "user32" (ByVal hMenu As Long, ByVal nPos As Long) As Long

Declare Function GetMenuState Lib "user32" (ByVal hMenu As Long, ByVal wID As Long, ByVal wFlags As Long) As Long

Declare Function GetMenuString Lib "user32" Alias "GetMenuStringA" (ByVal hMenu As Long, ByVal wIDItem As Long, ByVal lpString As String, ByVal nMaxCount As Long, ByVal wFlag As Long) As Long

Declare Function GetDlgItem Lib "user32" (ByVal hDlg As Long, ByVal nIDDlgItem As Long) As Long

Declare Function GlobalAlloc Lib "kernel32" (ByVal wFlags As Long, ByVal dwBytes As Long) As Long

Declare Function GlobalFree Lib "kernel32" (ByVal hMem As Long) As Long

Declare Function GlobalLock Lib "kernel32" (ByVal hMem As Long) As Long

Declare Function GlobalUnlock Lib "kernel32" (ByVal hMem As Long) As Long

Declare Function GlobalSize Lib "kernel32" (ByVal hMem As Long) As Long

Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hWnd As Long, ByVal lpString As String, ByVal cch As Long) As Long

Declare Function GetDlgCtrlID Lib "user32" (ByVal hWnd As Long) As Long

Declare Function GetDlgItemText Lib "user32" Alias "GetDlgItemTextA" (ByVal hDlg As Long, ByVal nIDDlgItem As Long, ByVal lpString As String, ByVal nMaxCount As Long) As Long

Declare Function GetClipboardData Lib "user32" Alias "GetClipboardDataA" (ByVal wFormat As Long) As Long

Declare Function GetClipboardFormatName Lib "user32" Alias "GetClipboardFormatNameA" (ByVal wFormat As Long, ByVal lpString As String, ByVal nMaxCount As Long) As Long

Declare Function GetTempDrive Lib "kernel32" (ByVal cDriveLetter As Integer) As Integer
Declare Function GetTempFileName Lib "kernel32" Alias "GetTempFileNameA" (ByVal lpszPath As String, ByVal lpPrefixString As String, ByVal wUnique As Long, ByVal lpTempFileName As String) As Long

Declare Function GetDesktopWindow Lib "user32" () As Long

'Declare Function GetSystemDirectory Lib "kernel32" Alias "GetSystemDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long

'Declare Function GetViewportExtEx Lib "gdi32" (ByVal hdc As Long, lpSize As Size) As Long

Declare Sub hmemcpy Lib "Ml_vb32" Alias "_CopyMemVB@12" (dest As Any, src As Any, ByVal Size As Long)
Declare Sub hmemcpyTolp Lib "Ml_vb32" Alias "_CopyMemVB@12" (lpDest As Any, ByVal dwSource As Long, ByVal dwBytes As Long)
Declare Sub hmemcpyFromLp Lib "Ml_vb32" Alias "_CopyMemVB@12" (ByVal dwDest As Long, lpSource As Any, ByVal dwBytes As Long)

Declare Function IsDlgButtonChecked Lib "user32" (ByVal hDlg As Long, ByVal nIDButton As Long) As Long

Declare Function IsWindow Lib "user32" (ByVal hWnd As Long) As Long

Declare Function IsWindowEnabled Lib "user32" (ByVal hWnd As Long) As Long

Declare Function IsWindowVisible Lib "user32" (ByVal hWnd As Long) As Long



Declare Function LoadLibrary Lib "kernel32" Alias "LoadLibraryA" (ByVal lpLibFileName As String) As Long
 
Declare Function lstrcpyn Lib "kernel32" Alias "lstrcpynA" (ByVal lpString1 As String, ByVal lpString2 As String, ByVal iMaxLength As Long) As Long


Declare Function MoveWindow Lib "user32" (ByVal hWnd As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal bRepaint As Long) As Long


Declare Function OpenClipboard Lib "user32" (ByVal hWnd As Long) As Long

Declare Function PostMessageAPI Lib "user32" Alias "PostMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Declare Function PostMessageVB Lib "user32" Alias "PostMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Declare Function PlayMetaFile Lib "gdi32" (ByVal hdc As Long, ByVal hMF As Long) As Long
Declare Function MassLynxCommand Lib "Ml_vb32" (ByVal strCommand As String, ByVal nTimeout As Long) As Long

Declare Function SendMessageAPI Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Declare Function SendMessageVB Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long

Declare Function SendDlgItemMessage Lib "user32" Alias "SendDlgItemMessageA" (ByVal hDlg As Long, ByVal nIDDlgItem As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long

'Declare Function SetFocusAPI Lib "User" Alias "SetFocus" (ByVal hwnd As Integer) As Integer
Declare Function SetKeyboardState Lib "user32" (lppbKeyState As Byte) As Long


Declare Function SetWindowText Lib "user32" Alias "SetWindowTextA" (ByVal hWnd As Long, ByVal lpString As String) As Long

Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long

Declare Function SetViewportExtEx Lib "gdi32" (ByVal hdc As Long, ByVal nX As Long, ByVal nY As Long, lpSize As Size) As Long
Declare Function SetMapMode Lib "gdi32" (ByVal hdc As Long, ByVal nMapMode As Long) As Long

Declare Function SetWindowExtEx Lib "gdi32" (ByVal hdc As Long, ByVal nX As Long, ByVal nY As Long, lpSize As Size) As Long
Declare Function SetViewportOrgEx Lib "gdi32" (ByVal hdc As Long, ByVal nX As Long, ByVal nY As Long, lpPoint As POINTAPI) As Long
Declare Function SetWindowOrgEx Lib "gdi32" (ByVal hdc As Long, ByVal nX As Long, ByVal nY As Long, lpPoint As POINTAPI) As Long
Declare Function SetWindowPos Lib "user32" (ByVal hWnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long

Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long


Declare Function WritePrivateProfileString Lib "kernel32" Alias "WritePrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpString As Any, ByVal lpFileName As String) As Long
Declare Function SetForegroundWindow Lib "user32" (ByVal hWnd As Long) As Byte



'________________________________________________________________________________________
'
'   Process:    CheckDlgButton32
'
'   Author:     Roberto Raso
'   Date:       5th October 1995
'
'   Purpose:    Checks a dialogue box check box control.
'               This has been wrapped to prevent any problems
'               with NT.
'
'   Parameters: hDlg is the handle of the dialogue box.
'               nIDCheckBox is the ID for the check box control.
'               bCheck is the state of the button.
'
'   Return:     Void.
'________________________________________________________________________________________
Sub CheckDlgButton32(hDlg As Long, nIDCheckBox As Long, bCheck As Long)

    If DlgItemValidate(hDlg, nIDCheckBox) = 0 Then
        Call ThrowError(USER_ERR, "Unable to find dlg item #" + CStr(nIDCheckBox))
    End If

    Call CheckDlgButton(hDlg, nIDCheckBox, bCheck)
End Sub

'________________________________________________________________________________________
'
'   Process:    ClassName
'
'   Author:     Roberto Raso
'   Date:       9th October 1995
'
'   Purpose:    Gets the Window Class name for the specified window handle.
'
'   Parameters: hWnd the window handle.
'
'   Return:     The class name, or Chr$(0) if invalid handle.
'________________________________________________________________________________________
Function ClassName(hWnd As Long) As String

Dim nNameLen As Integer
Dim szName As String
Dim nBuffer As Long

If IsWindow(hWnd) = 0 Then
    ClassName = Chr$(0)
End If

'Set buffer to receive class name
szName = String$(CLASS_NAME_LEN, 0)
nBuffer = GlobalAlloc(GMEM_FIXED + GMEM_ZEROINIT, MAX_STRING)
nBuffer = GlobalLock(nBuffer)

'Get the class name
nNameLen = GetClassName(hWnd, nBuffer, MAX_STRING)
Call CpyBuffToStr(szName, nBuffer, MAX_STRING)

If nNameLen = 0 Then
    ClassName = Chr$(0)
Else
    ClassName = Left$(szName, nNameLen)
End If

'Clear memory
Call GlobalUnlock(nBuffer)
Call GlobalFree(nBuffer)

End Function

'****************************************************************************************
'
'   Process:    CountSeps
'
'   Author:     Roberto Raso
'   Date:       5th September 1994
'
'   Purpose:    Counts the number of separators in a string lpIniString.
'               The positions in the string are stored in array awSepPos().
'
'   Return:     Number of seperators.
'
'****************************************************************************************
Function CountSeps(lpIniString As String, lpSep As String, awSepPos() As Integer) As Integer
Dim bNoMoreSeps As Integer
Dim wIniStrLen As Integer
Dim wSepPos As Integer
Dim wNumSeps As Integer

wIniStrLen = Len(lpIniString)
wNumSeps = 0

If wIniStrLen Then
  bNoMoreSeps = False
  wSepPos = 0

  Do Until bNoMoreSeps
    wSepPos = InStr(wSepPos + 1, lpIniString, lpSep)
    
    If wSepPos Then
      ReDim Preserve awSepPos(wNumSeps)
      awSepPos(wNumSeps) = wSepPos
      wNumSeps = wNumSeps + 1
    Else
      bNoMoreSeps = True
    End If
   
  Loop

End If

CountSeps = wNumSeps
End Function

'****************************************************************************************
'
'   Process:    DirFromPath
'
'   Author:     Roberto Raso
'   Date:       5th September 1994
'
'   Purpose:    Extracts an embedded string from lpPath.
'               The positions of the seperators are stored in array awSepPos().
'               wDirNum is string number to extract, starting from 1.
'               Format of lpPath is like; "qasad,qweee,qee,qwewe"
'
'   Return:     Sub-string or "" if nothing found.
'
'****************************************************************************************
Function DirFromPath(lpPath As String, wDirNum As Integer, awSepPos() As Integer) As String
Dim wNumStrings As Integer
Dim wLenPath As Integer

wNumStrings = UBound(awSepPos) + 2
wLenPath = Len(lpPath)

If (wNumStrings >= wDirNum) And (wDirNum > 0) And (wLenPath > awSepPos(wNumStrings - 2)) Then
  
  If wDirNum = 1 Then
    DirFromPath = Left$(lpPath, awSepPos(wDirNum - 1) - 1)
  ElseIf wDirNum = wNumStrings Then
    DirFromPath = Right$(lpPath, wLenPath - awSepPos(wDirNum - 2))
  Else
    DirFromPath = Mid$(lpPath, awSepPos(wDirNum - 2) + 1, awSepPos(wDirNum - 1) - awSepPos(wDirNum - 2) - 1)
  End If

Else
  DirFromPath = ""
End If

End Function

'----------------------------------------------------------------------------------------
'
'   Process:    DlgBoxClose
'
'   Author:     Roberto Raso
'   Date:       28th April 1995
'
'   Purpose:    Closes down a dialogue box either with an OK or a Cancel.
'
'   Parameters: hDlg is the window handle of the dialogue  box.
'               nID is the ID of the control to close down the dialogue box.
'               dfTimeOut is the time wait for the window to disapear.
'                   If it is -1 then there is an indefinite wait.
'                   Make dfTimeOut do Cdbl(CVDate("hh:mm:ss"))
'
'   Return:     True if box is closed down.
'
'----------------------------------------------------------------------------------------
Function DlgBoxClose(hDlg As Long, nID As Long, dfTimeOut As Double) As Integer
    Const DWL_DLGPROC = 4

    Dim bGone As Integer
    Dim hCtrl As Long
    Dim lMsgRtn As Long
    Dim strClassName As String
    Dim dfStartTime As Double

    bGone = False
    

    If IsWindow(hDlg) Then
        strClassName = ClassName(hDlg)

        If GetDlgItem32(hDlg, nID) Then
            dfStartTime = CDbl(Now)
            lMsgRtn = SendMessage(hDlg, WM_COMMAND, nID, 0)

            Do Until bGone
                DoEvents

                If IsWindow(hDlg) = 0 Or ClassName(hDlg) <> strClassName Then
                    bGone = True
                ElseIf CDbl(Now) - dfStartTime > dfTimeOut And dfTimeOut <> -1 Then
                    Exit Do
                End If

            Loop

            If IsWindow(hDlg) = 0 Or GetWindowLong(hDlg, DWL_DLGPROC) <> lDlgProc Then
                bGone = True
            End If

        End If

    End If

    DlgBoxClose = bGone
End Function

'________________________________________________________________________________________
'
'   Process:    DlgItemValidate
'
'   Author:     Roberto Raso
'   Date:       5th October 1995
'
'   Purpose:    Checks that a dialogue control is valid
'
'   Parameters: hDlg is the handle of the dialogue box.
'               nID is the ID for the control.
'
'   Return:     Returns handle of dialogue item.
'________________________________________________________________________________________
Function DlgItemValidate(hDlg As Long, nID As Long) As Long
    Const MAX_WAIT = "00:00:05"

    Dim hCtrl As Long
    Dim dfTimeEntry As Double

    hCtrl = 0
    dfTimeEntry = CDbl(Now)

    Do
        hCtrl = GetDlgItem(hDlg, nID)

        If dfTimeEntry + CDbl(CVDate(MAX_WAIT)) < CDbl(Now) Then
            Exit Do
        End If

    Loop While hCtrl = 0

    DlgItemValidate = hCtrl
End Function

'****************************************************************************************
'
'   Purpose:    Finds the window with the best fit to the caption, that
'               has the parent with window handle hParent.
'
'****************************************************************************************
Function FindChildWindow(hParent As Long, lpChildCaption As String) As Long
Dim bMatched As Integer
Dim w1st As Integer
Dim wLst As Integer
Dim wCur As Integer
Dim wBst As Integer
Dim wBstMatch As Integer
Dim wLstMatch As Integer
Dim lpWindows() As WINDOWLINK

FindChildWindow = 0
bMatched = False

If GetAllWindows(lpWindows()) Then
  w1st = LBound(lpWindows)
  wLst = UBound(lpWindows)
  
  For wCur = w1st To wLst          'Perfect non-case sensitive match.

    If (UCase$(SZToVB(lpWindows(wCur).strCaption)) = UCase$(lpChildCaption)) And (hParent = lpWindows(wCur).hParent) Then
      FindChildWindow = lpWindows(wCur).hWnd
      bMatched = True
      Exit For
    End If

  Next wCur

  If Not bMatched Then                                                  'lpChildCaption in caption. Non-case sensitive.
    wBstMatch = &H7FFF                                                  'Caption that has lpChildCaption closest to
                                                                        'start of caption.
    For wCur = w1st To wLst
  
      wLstMatch = InStr(1, SZToVB(lpWindows(wCur).strCaption), lpChildCaption, 1)

      If (wLstMatch > 0) And (wLstMatch < wBstMatch) And (hParent = lpWindows(wCur).hParent) Then
        wBst = wCur
        wBstMatch = wLstMatch
        bMatched = True
      End If

    Next wCur

    If (wBstMatch > 0) And bMatched Then
      FindChildWindow = lpWindows(wBst).hWnd
    Else
      FindChildWindow = 0
    End If
      
  End If

Else
  FindChildWindow = 0
End If

End Function

'****************************************************************************************
'
'   Purpose:    Finds the window with the best fit to the caption.
'               lpCaption does not have to be complete window caption.
'               Returns the window handle if found, else zero.
'               The window found, if found, will be the first one with a
'               matching caption in the window manager's list.
'
'****************************************************************************************
Function FindWindowCaption(lpCaption As String) As Long
Dim bMatched As Integer
Dim w1st As Integer
Dim wLst As Integer
Dim wCur As Integer
Dim wBst As Integer
Dim wBstMatch As Integer
Dim wLstMatch As Integer
Dim lpWindows() As WINDOWLINK

FindWindowCaption = 0
bMatched = False

If GetAllWindows(lpWindows()) Then
  w1st = LBound(lpWindows)
  wLst = UBound(lpWindows)
  
  For wCur = w1st To wLst                                               'Perfect non-case sensitive match.

    If UCase$(SZToVB(lpWindows(wCur).strCaption)) = UCase$(lpCaption) Then
      FindWindowCaption = lpWindows(wCur).hWnd
      bMatched = True
      Exit For
    End If

  Next wCur

  If Not bMatched Then                                                  'lpCaption in caption. Non-case sensitive.
    wBstMatch = &H7FFF                                                  'Caption that has lpCaption closest to
                                                                        'start of caption.
    For wCur = w1st To wLst
  
      wLstMatch = InStr(1, SZToVB(lpWindows(wCur).strCaption), lpCaption, 1)

      If (wLstMatch > 0) And (wLstMatch < wBstMatch) Then
        wBst = wCur
        wBstMatch = wLstMatch
        bMatched = True
      End If

    Next wCur

    If (wBstMatch > 0) And bMatched Then
      FindWindowCaption = lpWindows(wBst).hWnd
    Else
      FindWindowCaption = 0
    End If
      
  End If

Else
  FindWindowCaption = 0
End If

End Function

'________________________________________________________________________________________
'
'   Process:    Form_AutoPos
'
'   Author:     Roberto Raso
'   Date:       18th August 1995
'
'   Purpose:    Positions a window automatically relative to
'               a calling/parent window.
'
'   Parameters: frmParent the Form that is calling.
'               frmChild the Form that will be displayed.
'
'   Return:     Void.
'________________________________________________________________________________________
Sub Form_AutoPos(frmParent As Form, frmChild As Form)
    Dim fOffSet As Single
    Dim fLeft As Single
    Dim fTop As Single
    Dim fLeftMax As Single
    Dim fTopMax As Single

    fOffSet = 40 * GetSystemMetrics(4)
    fLeftMax = Screen.Width - frmChild.Width
    fTopMax = Screen.Height - frmChild.Height
    fLeft = frmParent.Left + fOffSet
    fTop = frmParent.Top + fOffSet

    If fLeft > fLeftMax Then
        fLeft = fLeftMax
    End If

    If fTop > fTopMax Then
        fTop = fTopMax
    End If

    frmChild.Left = fLeft
    frmChild.Top = fTop
End Sub

'****************************************************************************************
'
'   Process:    FormPosGet
'
'   Author:     Roberto Raso
'   Date:       5th September 1994
'
'   Purpose:    Gets the VB window position and writes it to
'               the RECT parameter lpFormPos.
'
'   Return:     Void.
'
'****************************************************************************************
Sub FormPosGet(frm As Form, lpFormPos As RECT)
Dim wWindowState As Integer

wWindowState = frm.WindowState

If wWindowState <> 0 Then
  frm.WindowState = 0
End If

Call GetWindowRect(CLng(frm.hWnd), lpFormPos)
lpFormPos.Right = lpFormPos.Right - lpFormPos.Left
lpFormPos.Bottom = lpFormPos.Bottom - lpFormPos.Top

If wWindowState <> 0 Then
  frm.WindowState = wWindowState
End If

End Sub

'****************************************************************************************
'
'   Process:    FormPosRead
'
'   Author:     Roberto Raso
'   Date:       5th September 1994
'
'   Purpose:    Reads the form positioning and sizing information
'               from the initialisation file.
'               Format is: [lpFormSection]
'                          ...
'                          lpForm=Left,Top,Width,Height
'   Return:     Void.
'
'****************************************************************************************
Sub FormPosRead(lpFormSection As String, lpForm As String, lpFormIniFile As String, lpFormPos As RECT)
Dim lpSepPos() As Integer
Dim wNumSeps As Integer
Dim wNumLen As Integer
Dim lpSep As String
Dim lpFormPosStr As String

If Len(lpForm) = 0 Then
    lpForm = "Window"
End If

lpSep = ","
lpFormPosStr = GetPrivateProfileStr(lpFormSection, lpForm, lpFormIniFile)
wNumSeps = CountSeps(lpFormPosStr, lpSep, lpSepPos())

If wNumSeps = 3 Then
lpFormPos.Left = Val(DirFromPath(lpFormPosStr, 1, lpSepPos()))
lpFormPos.Top = Val(DirFromPath(lpFormPosStr, 2, lpSepPos()))
lpFormPos.Right = Val(DirFromPath(lpFormPosStr, 3, lpSepPos()))
lpFormPos.Bottom = Val(DirFromPath(lpFormPosStr, 4, lpSepPos()))
End If

End Sub

'****************************************************************************************
'
'   Process:    FormPosSet
'
'   Author:     Roberto Raso
'   Date:       5th September 1994
'
'   Purpose:    Sets the VB form position.
'
'   Return:     Void.
'
'****************************************************************************************
Sub FormPosSet(frm As Form, lpFormPos As RECT)
Dim lpOldPos As RECT
Dim hWnd As Long

Call FormPosGet(frm, lpOldPos)

If (lpFormPos.Right = 0) Or (frm.BorderStyle <> 2) Then
  lpFormPos.Right = lpOldPos.Right
End If

If (lpFormPos.Bottom = 0) Or (frm.BorderStyle <> 2) Then
  lpFormPos.Bottom = lpOldPos.Bottom
End If

Call SetWindowLayout(CLng(frm.hWnd), lpFormPos)
End Sub

'****************************************************************************************
'
'   Process:    FormPosWrite
'
'   Author:     Roberto Raso
'   Date:       5th September 1994
'
'   Purpose:    Writes the form positioning and sizing information
'               from the initialisation file.
'               Format is: [lpFormSection]
'                          ...
'                          lpForm=Left,Top,Width,Height
'   Return:     Void.
'
'****************************************************************************************
Sub FormPosWrite(lpFormSection As String, lpForm As String, lpFormIniFile As String, lpFormPos As RECT)
Dim lpSep As String
Dim lpFormPosStr As String

lpSep = ","
If Len(lpForm) = 0 Then
    lpForm = "Window"
End If
lpFormPosStr = CStr(lpFormPos.Left) + lpSep + CStr(lpFormPos.Top) + lpSep + CStr(lpFormPos.Right) + lpSep + CStr(lpFormPos.Bottom)
Call WritePrivateProfileStr(lpFormSection, lpForm, lpFormPosStr, lpFormIniFile)
End Sub

'****************************************************************************************
'
'   Process:    GetAllChildren
'
'   Author:     Roberto Raso
'   Date:       31st January 1995
'
'   Purpose:    Gets all the child windows of a particular window.
'
'   Parameters: hParent is the handle of the parent window.
'               asWindowLink() is an array of child windows of hParent.
'
'   Return:     Number of child window found.
'
'****************************************************************************************
'Function GetAllChildren (hParent As Long, asWindowLink() As WINDOWLINK) As Integer
Function GetAllChildren(hParent As Long) As Integer
Dim asWindowLink() As WINDOWLINK
    Dim hWnd As Long
    Dim h1stChild As Long
    Dim hLstChild As Long
    Dim nBuff As Integer
    Dim nReturn As Integer
    Dim strBuff As String

    nReturn = 0
    hWnd = GetWindow(hParent, GW_CHILD)
    If hWnd Then
        nReturn = 1
        ReDim asWindowLink(nReturn - 1)
        Call WindowInfo_Get(hWnd, asWindowLink(nReturn - 1))
        h1stChild = hWnd
        hWnd = GetWindow(h1stChild, GW_HWNDLAST)
        hLstChild = hWnd
        hWnd = h1stChild
        Do Until hWnd = hLstChild
            hWnd = GetWindow(hWnd, GW_HWNDNEXT)
            If hWnd Then
                ReDim Preserve asWindowLink(nReturn)
                Call WindowInfo_Get(hWnd, asWindowLink(nReturn))
                nReturn = nReturn + 1
            End If
        Loop
        For I% = LBound(asWindowLink) To UBound(asWindowLink)
            Call WindowInfo_Dump(asWindowLink(I%))
        Next I%
    End If
    GetAllChildren = nReturn
End Function

'****************************************************************************************
'
'   Purpose:    Finds all windows and their associated parents, if any.
'               Returns the number of windows found.
'
'****************************************************************************************
Function GetAllWindows(lpWindows() As WINDOWLINK) As Integer
Dim h1st As Long
Dim hLst As Long
Dim w1st As Long
Dim wCur As Long
Dim hParent As Long
Dim wCaption As Integer
Dim lpCaption As String

w1st = 0
wCur = w1st
h1st = FindWindow(vbNullString, Chr$(0))
hLst = h1st
lpCaption = Space(80)
wCaption = GetWindowText(hLst, lpCaption, Len(lpCaption))

Do While hLst
  h1st = hLst
  lpCaption = Space(80)
  hLst = GetNextWindow(h1st, GW_HWNDPREV)
Loop

hLst = h1st

Do While hLst
  h1st = hLst
  lpCaption = Space(80)
  hLst = GetNextWindow(h1st, GW_HWNDNEXT)
  wCaption = GetWindowText(hLst, lpCaption, Len(lpCaption))
  lpCaption = Trim$(lpCaption)
  hParent = GetParent(hLst)

  If hLst <> 0 Then
    ReDim Preserve lpWindows(w1st To (w1st + wCur))
    lpWindows(wCur).hWnd = hLst
    lpWindows(wCur).hParent = hParent
    lpWindows(wCur).strCaption = lpCaption + Chr$(0)
    wCur = wCur + 1
  End If

Loop

GetAllWindows = wCur
End Function

'****************************************************************************************
'
'   Process:    GetATempFile
'
'   Author:     Roberto Raso
'   Date:       4th August 1994
'
'   Purpose:    Gets the next available windows TMP file name.
'   Return:     Next file name.
'
'****************************************************************************************
Function GetATempFile(lpPrefix As String) As String
Dim wDrive As Integer
Dim wChars As Integer
Dim lpFile As String * 144

wDrive = GetTempDrive(&H0)
wDrive = (wDrive And &HFF)
wChars = GetTempFileName(wDrive, lpPrefix, 0, lpFile)
GetATempFile = SZToVB(lpFile)
End Function

'________________________________________________________________________________________
'
'   Process:    GetDlgItem32
'
'   Author:     Roberto Raso
'   Date:       5th October 1995
'
'   Purpose:    Gets the handle for a dialogue item.
'               This has been wrapped to prevent any problems
'               with NT.
'
'   Parameters: hDlg is the handle of the dialogue box.
'               nIDDlgItem is the ID for the check box control.
'
'   Return:     Dialogue handle.
'________________________________________________________________________________________
Function GetDlgItem32(hDlg As Long, nIDDlgItem As Long) As Long
    GetDlgItem32 = DlgItemValidate(hDlg, nIDDlgItem)
End Function

'****************************************************************************************
'
'   Process:    GetIniSectionEntries
'
'   Author:     Roberto Raso
'   Date:       1st August 1994
'
'   Purpose:    Get the entries in the named section of an INI type file.
'   Return:     Number of entries in section.
'
'****************************************************************************************
Function GetIniSectionEntries(lpIniFile As String, lpSection As String, lpEntries() As String) As Integer
Dim wChar As Integer
Dim wNumChars As Integer
Dim wCurSep As Integer
Dim wLstSep As Integer
Dim wNumEntries As Integer
Dim lpszEntries As String

wNumEntries = 0
wLstSep = 0
wChar = 1
lpszEntries = GetPrivateProfileStr(lpSection, "", lpIniFile)
wNumChars = Len(lpszEntries)

Do While wChar < wNumChars
  wCurSep = InStr((wLstSep + 1), lpszEntries, Chr$(0))

  If wCurSep Then
    ReDim Preserve lpEntries(0 To wNumEntries)
    lpEntries(wNumEntries) = Mid$(lpszEntries, (wLstSep + 1), (wCurSep - wLstSep - 1)) + Chr$(0)
    wLstSep = wCurSep
    wNumEntries = wNumEntries + 1
  End If

  wChar = wLstSep + 1
Loop

GetIniSectionEntries = wNumEntries
End Function

'________________________________________________________________________________________
'
'   Process:    GetMenuText
'
'   Author:     Roberto Raso
'   Date:       16th October 1995
'
'   Purpose:    Gets the text associated with a menu item from a window.
'
'   Parameters: hWnd is the window handle to use.
'               nID is the menu item ID.
'
'   Return:     The text for the menu item, or Chr$(0) if there is
'               no text or an error.
'________________________________________________________________________________________
Function GetMenuText(hWnd As Long, nID As Long) As String
    Const MENU_TEXT_MAX_LEN = 81

    Dim hMenu As Long
    Dim nMenuText As Integer
    Dim strMenuText As String
    
    strMenuText = String$(MENU_TEXT_MAX_LEN, 0)
    hMenu = GetMenu(hWnd)

    If hMenu = 0 Then
        GetMenuText = Chr$(0)
        Exit Function
    End If

    nMenuText = GetMenuString(hMenu, nID, strMenuText, MENU_TEXT_MAX_LEN, MF_BYCOMMAND)

    If nMenuText = 0 Then
        GetMenuText = Chr$(0)
        Exit Function
    End If

    GetMenuText = Left$(strMenuText, nMenuText)
End Function

'****************************************************************************************
'
'   Purpose:    Get integer information from INI type file.
'
'****************************************************************************************
Function GetPrivateProfileInteger(lpSection As String, lpEntry As String, lpIniFile As String) As Integer
GetPrivateProfileInteger = GetPrivateProfileInt(lpSection, ByVal lpEntry, 0, lpIniFile)
End Function

'****************************************************************************************
'
'   Purpose:    Get string information from INI type file.
'
'****************************************************************************************
Function GetPrivateProfileStr(lpSection As String, lpEntry As String, lpIniFile As String) As String
Dim wBytes As Integer
Dim lpIniBuff As String

lpIniBuff = Space(1024)

If Len(lpEntry) Then
  wBytes = GetPrivateProfileString(lpSection, ByVal lpEntry, "", lpIniBuff, Len(lpIniBuff), lpIniFile)
Else
  wBytes = GetPrivateProfileString(lpSection, ByVal 0&, "", lpIniBuff, Len(lpIniBuff), lpIniFile)
End If

If wBytes > 0 Then
  GetPrivateProfileStr = Left$(lpIniBuff, wBytes)
Else
  GetPrivateProfileStr = ""
End If

End Function

'----------------------------------------------------------------------------------------
'
'   Process:    GetSystemDirectory
'
'   Author:     Roberto Raso
'   Date:       3rd January 1996
'
'   Purpose:    Gets the Windows system diretory.
'
'   Parameters: None.
'
'   Return:     The windows system directory.
'
'----------------------------------------------------------------------------------------
'Function GetSystemDirectory32() As String
    'Dim nNumChars As Integer
    'Dim strSystemDirectory As String * 144

   ' nNumChars = GetSystemDirectory32(strSystemDirectory, Len(strSystemDirectory))
    'GetSystemDirectory32 = Left$(strSystemDirectory, nNumChars)
'End Function

'****************************************************************************************
'
'   Purpose:    Returns the caption/title/text associated with
'               a given window handle.
'               Returns Chr$(0) if handle is invalid.
'
'****************************************************************************************
Function GetWindowCaption(hWnd As Long) As String
Dim wCaptionLen As Integer
Dim lpCaption As String

lpCaption = Space$(1024)
wCaption = GetWindowText(hWnd, lpCaption, Len(lpCaption))

If wCaption Then
  GetWindowCaption = Left$(lpCaption, wCaption)
Else
  GetWindowCaption = Chr$(0)
End If

End Function

'****************************************************************************************
'
'   Purpose:    Gets the Left, Top, Width and Height of the window, with handle hWnd.
'               The information is stored in lpWinRect.
'
'****************************************************************************************
Sub GetWindowLayout(hWnd As Long, lpWinRect As RECT)
Call GetWindowRect(hWnd, lpWinRect)
lpWinRect.Right = lpWinRect.Right - lpWinRect.Left
lpWinRect.Bottom = lpWinRect.Bottom - lpWinRect.Top
End Sub

'****************************************************************************************
'
'   Process:    IniEntry_Remove
'
'   Author:     Roberto Raso
'   Date:       24th January 1995
'
'   Purpose:    Removes an entry line from an INI type file
'               section.
'
'   Parameters: strSect is the INI file section where strEntry is found.
'               strEntry is the INI file entry to be removed.
'               strIniFile is the INI file to be used.
'
'   Return:     Void.
'
'****************************************************************************************
Sub IniEntry_Remove(strSect As String, strEntry As String, strIniFile As String)
    Dim bInSect As Integer
    Dim nInFile As Integer
    Dim nOutFile As Integer
    Dim strOutFile As String
    Dim strLine As String

    If FileExists(strIniFile) Then
        strOutFile = GetDOSFilePath(strIniFile) + "\" + Format$(Now, "ddhhmmss") + "." + GetDOSFileExt(strIniFile)
        If FileExists(strOutFile) Then
            Kill strOutFile
        End If
        nInFile = FreeFile
        Open strIniFile For Input Access Read As #nInFile
        nOutFile = FreeFile
        Open strOutFile For Output Access Write As #nOutFile
        bInSect = False
        Do Until EOF(nInFile)
            Line Input #nInFile, strLine
            If bInSect Then
                If InStr(strLine, strEntry + "=") = 0 Then
                    Print #nOutFile, strLine
                Else
                    bInSect = False
                End If
            Else
                Print #nOutFile, strLine
            End If
            If strLine = "[" + strSect + "]" Then
                bInSect = True
            End If
        Loop
        Close #nOutFile
        Close #nInFile
        Kill strIniFile
        FileCopy strOutFile, strIniFile
        Kill strOutFile
    End If
End Sub

'----------------------------------------------------------------------------------------
'
'   Process:    IniMultiEntryStr
'
'   Author:     Roberto Raso
'   Date:       20th March 1995
'
'   Purpose:    Reads a multi-value ini file entry.
'                   e.g.    [strSect]
'                           strEntry=strVal1,strVal2,strVal3, ... ,strValn
'               The string values are written to the array.
'
'   Parameters: strSect is the ini file section.
'               strEntry is the ini file entry.
'               strIniFile is the ini file.
'               strSep is the seperator between each string value.
'               astrValue() is the array where the string values are stored.
'                   Note: Embedded zero length strings will be included.
'
'   Return:     The number of values for the required entry.
'
'----------------------------------------------------------------------------------------
Function IniMultiEntryStr(strSect As String, strEntry As String, strIniFile As String, strSep As String, astrValue() As String) As Integer
    Dim nSep As Integer, nSeps As Integer
    Dim nLstSep As Integer, nCurSep As Integer
    Dim nSepLen As Integer
    Dim nValues As Integer
    Dim anSep() As Integer
    Dim strValues As String

    nValues = 0
    strValues = GetPrivateProfileStr(strSect, strEntry, strIniFile)
    If Len(strValues) Then
        nSeps = CountSeps(strValues, strSep, anSep())
        ReDim astrValue(nSeps)
        nSepLen = Len(strSep)
        nLstSep = 1 - nSepLen
        For nSep = 0 To nSeps
            If nSep < nSeps Then
                nCurSep = anSep(nSep)
            Else
                nCurSep = Len(strValues) + 1
            End If
            astrValue(nSep) = MidStr(strValues, nLstSep + nSepLen, nCurSep - 1)
            nLstSep = nCurSep
        Next nSep
        nValues = nSeps + 1
    End If
    IniMultiEntryStr = nValues
End Function

'****************************************************************************************
'
'   Process:    IniSect_Remove
'
'   Author:     Roberto Raso
'   Date:       25th January 1995
'
'   Purpose:    Removes a section from an INI type file.
'
'   Parameters: strSect is the INI file section where strEntry is found.
'               strIniFile is the INI file to be used.
'
'   Return:     Void.
'
'****************************************************************************************
Sub IniSect_Remove(strSect As String, strIniFile As String)
    Dim bInSect As Integer
    Dim nInFile As Integer
    Dim nOutFile As Integer
    Dim strOutFile As String
    Dim strLine As String

    If FileExists(strIniFile) Then
        strOutFile = GetDOSFilePath(strIniFile) + "\" + Format$(Now, "ddhhmmss") + "." + GetDOSFileExt(strIniFile)
        If FileExists(strOutFile) Then
            Kill strOutFile
        End If
        nInFile = FreeFile
        Open strIniFile For Input Access Read As #nInFile
        nOutFile = FreeFile
        Open strOutFile For Output Access Write As #nOutFile
        bInSect = False
        Do Until EOF(nInFile)
            Line Input #nInFile, strLine
            If strLine = "[" + strSect + "]" Then
                bInSect = True
            ElseIf bInSect And Left$(strLine, 1) = "[" And Right$(strLine, 1) = "]" Then
                bInSect = False
            End If
            If Not bInSect Then
                Print #nOutFile, strLine
            End If
        Loop
        Close #nOutFile
        Close #nInFile
        Kill strIniFile
        FileCopy strOutFile, strIniFile
        Kill strOutFile
    End If
End Sub

'****************************************************************************************
'
'   Process:    Inst1stInst
'
'   Author:     Roberto Raso
'   Date:       23rd August 1994
'
'   Purpose:    Get instance of current active window. The lowest/first one in list.
'   Return:     Instance number.
'
'****************************************************************************************
Function Inst1stInst(lpCaptionStub As String, lpCaptionSep As String, lpInstCaption As String) As Integer
Dim wSepStart As Integer
Dim wStubLen As Integer
Dim w1stInst As Integer
Dim lp1stInst As String

wStubLen = Len(lpCaptionStub)
wSepStart = InStr(lpInstCaption, lpCaptionSep)

If wSepStart > (wStubLen + 1) Then
  lp1stInst = Mid$(lpInstCaption, wStubLen + 1, (wSepStart - (wStubLen + 1)))
  w1stInst = CInt(Val(lp1stInst))
End If

Inst1stInst = w1stInst
End Function

'****************************************************************************************
'
'   Process:    InstLstInst
'
'   Author:     Roberto Raso
'   Date:       23rd August 1994
'
'   Purpose:    Get instance of the last instance of application,
'               that is ready to run.
'   Return:     Instance number.
'
'****************************************************************************************
Function InstLstInst(lpCaptionStub As String, lpCaptionSep As String, lpInstCaption As String) As Integer
Dim wSepStart As Integer
Dim wStubLen As Integer
Dim wSepEnd As Integer
Dim wLstInst As Integer
Dim lpLstInst As String

wStubLen = Len(lpCaptionStub)
wSepStart = InStr(lpInstCaption, lpCaptionSep)

If wSepStart > (wStubLen + 1) Then
  wSepEnd = (wSepStart - 1) + Len(lpCaptionSep)
  lpLstInst = Right$(lpInstCaption, (Len(lpInstCaption) - wSepEnd))
  wLstInst = CInt(Val(lpLstInst))
End If

InstLstInst = wLstInst
End Function

'****************************************************************************************
'
'   Process:    InstVisibleCaption
'
'   Author:     Roberto Raso
'   Date:       23rd August 1994
'
'   Purpose:    Gets the window caption of running instance.
'               lpInstCaption is filled with the running window caption
'   Return:     Window handle, if active.
'
'****************************************************************************************
Function InstVisibleCaption(lpCaptionStub As String, lpInstCaption As String) As Integer
Dim hRunInstance As Long

hRunInstance = FindWindowCaption(lpCaptionStub)

If hRunInstance Then
  lpInstCaption = GetWindowCaption(hRunInstance)
End If

InstVisibleCaption = hRunInstance
End Function

'****************************************************************************************
'
'   Process:    InstWaitPrevInst
'
'   Author:     Roberto Raso
'   Date:       23rd August 1994
'
'   Purpose:    Waits for a previous instance to finish.
'   Return:     Number of instance.
'
'****************************************************************************************
Sub InstWaitPrevInst(frm As Form)
Dim hInstAct As Long
Dim w1stInst As Integer
Dim wLstInst As Integer
Dim wThisInst As Integer
Dim lpCaptionStub As String
Dim lpCaptionSep As String
Dim lpInstCaption As String

w1stInst = 1
wThisInst = 1
lpCaptionStub = App.Title + " #"
lpCaptionSep = " of "
hInstAct = InstVisibleCaption(lpCaptionStub, lpInstCaption)

If hInstAct Then
  w1stInst = Inst1stInst(lpCaptionStub, lpCaptionSep, lpInstCaption)
  wLstInst = InstLstInst(lpCaptionStub, lpCaptionSep, lpInstCaption)
  wThisInst = wLstInst + 1
  lpInstCaption = lpCaptionStub + CStr(w1stInst) + lpCaptionSep + CStr(wThisInst)
  Call SetWindowText(hInstAct, lpInstCaption)

  Do Until w1stInst = wLstInst
    hInstAct = InstVisibleCaption(lpCaptionStub, lpInstCaption)
    w1stInst = Inst1stInst(lpCaptionStub, lpCaptionSep, lpInstCaption)
    DoEvents
  Loop

  Do While IsWindow(hInstAct)
    lpInstCaption = GetWindowCaption(hInstAct)
    wLstInst = InstLstInst(lpCaptionStub, lpCaptionSep, lpInstCaption)
    DoEvents
  Loop

End If

frm.Caption = lpCaptionStub + CStr(wThisInst) + lpCaptionSep + CStr(wLstInst)
frm.Show
End Sub

'----------------------------------------------------------------------------------------
'
'   Process:    LTrimWS
'
'   Author:     Roberto Raso
'   Date:       14th March 1995
'
'   Purpose:    Removes white space characters from the beginning of a string.
'               White space characters are TABS and SPACES.
'
'   Parameters: strString is the string to tidy up.
'
'   Return:     The tidied string .
'
'----------------------------------------------------------------------------------------
Function LTrimWS(strString As String) As String
    Dim bWS As Integer
    Dim nChar As Integer, nChars As Integer
    Dim cChar As String * 1
    Dim strReturn As String
    
    strReturn = ""
    nChars = Len(strString)
    If nChars Then
        bWS = True
        nChar = 1
        Do While bWS And nChar = nChars
            cChar = Mid$(strString, nChar, 1)
            Select Case cChar
                Case Chr$(32)   'Space
                    bWS = True
                    nChar = nChar + 1
                Case Chr$(9)    'Tab
                    bWS = True
                    nChar = nChar + 1
                Case Else
                    bWS = False
            End Select
        Loop
        If nChar Then
            strReturn = Right$(strString, nChars - nChar + 1)
        End If
    End If
    LTrimWS = strReturn
End Function

'----------------------------------------------------------------------------------------
'
'   Process:    MidStr
'
'   Author:     Roberto Raso
'   Date:       17th March 1995
'
'   Purpose:    Similar to Mid$, except that the positions of the sub string are used instead.
'               If there are any errors then nothing is returned i.e. "".
'
'   Parameters: strString is the starting string.
'               n1stChar is the position of the first character of the sub-string.
'               nLstChar is the position of the last character of the sub-string.
'                   if nLstChar is greater than the length then the sub-string from
'                   n1stChar to the end is returned.
'
'   Return:     The sub string.
'
'----------------------------------------------------------------------------------------
Function MidStr(strString As String, n1stChar As Integer, nLstChar As Integer) As String
    Dim nLen As Integer
    Dim nEnd As Integer
    Dim nChar As Integer
    Dim strReturn As String

    strReturn = ""
    If n1stChar > 0 And nLstChar > 0 Then
        nLen = Len(strString)
        If nLstChar > nLen Then
            nEnd = nLen
        Else
            nEnd = nLstChar
        End If
        For nChar = n1stChar To nLstChar
            strReturn = strReturn + Mid$(strString, nChar, 1)
        Next nChar
    End If
    MidStr = strReturn
End Function

'****************************************************************************************
'
'   Process:    MnuDlg_Disp
'
'   Author:     Roberto Raso
'   Date:       15th February 1995
'
'   Purpose:    Makes a dialogue box appear, by posting the WM_COMMAND type menu
'               ID to the parent window. The dialogue box must be a child window
'               of the parent window.
'
'   Parameters: hParent is the window handle that will receive the menu ID message.
'               nID is the menu item ID that will be sent.
'               strCaption is the window caption of the dialogue box.
'               nTimeOut is the time in seconds to wait for the window to appear.
'               bChild decides if the dialogue box is going to be child window of the
'                   parent window or not.
'
'   Return:     The window handle of the dialogue box.
'
'****************************************************************************************
Function MnuDlg_Disp(hParent As Long, nID As Long, strCaption As String, nTimeout As Integer, bChild As Integer) As Long
    Dim hDlg As Long
    Dim dwMsgRtn As Long

    hDlg = 0

    If IsWindow(hParent) Then

        If bChild Then
            hDlg = FindChildWindow(hParent, strCaption)
        Else
            hDlg = FindWindowCaption(strCaption)
        End If

        If hDlg = 0 Then
            dwMsgRtn = PostMessage(hParent, WM_COMMAND, nID, 0)

            If bChild Then
                hDlg = WaitForChildWindow(hParent, strCaption, nTimeout)
            Else
                hDlg = WaitForWindow(strCaption, nTimeout)
            End If

        End If

    End If

    MnuDlg_Disp = hDlg
End Function

'----------------------------------------------------------------------------------------
'
'   Process:    NthString
'
'   Author:     Roberto Raso
'   Date:       23rd March 1995
'
'   Purpose:    Gets the nth item from the supplied string with format;
'                   &jjjj&jj&nmhfh&H0034, where & seperates items.
'
'   Parameters: strConcat is the whole concatenated string.
'               nIndex is the required item number, starting at 0.
'               strSep is the seperator used.
'
'   Return:     The nth sub-string.
'
'----------------------------------------------------------------------------------------
Function NthString(strConcat As String, nIndex As Integer, strSep As String) As String
    Dim nLstPos As Integer, nCurPos As Integer
    Dim nCurIndex As Integer, nSepLen As Integer
    Dim strSubString As String

    strSubString = ""
    nSepLen = Len(strSep)
    If nIndex >= 0 And nSepLen > 0 Then
        nCurIndex = 0
        nLstPos = 0
        Do While nCurIndex < nIndex
            nCurPos = InStr(nLstPos + 1, strConcat, strSep)
            If nCurPos Then
                nLstPos = nCurPos
                nCurIndex = nCurIndex + 1
            Else
                Exit Do
            End If
        Loop
        If nCurIndex = nIndex Then
            nCurPos = InStr(nLstPos + 1, strConcat, strSep)
            If nCurPos Then
                nCurPos = nCurPos - 1
            Else
                nCurPos = Len(strConcat)
            End If
            strSubString = MidStr(strConcat, nLstPos + nSepLen, nCurPos)
        End If
    End If
    NthString = strSubString
End Function

'________________________________________________________________________________________
'
'   Process:    PostMessage
'
'   Author:     Roberto Raso
'   Date:       11th October 1995
'
'   Purpose:    Posts a message to a window. Calls API PostMessage.
'               Note: lParam must be a Long.
'               If a structure/string variable is required for lParam use
'               function PostMessageAPI.
'
'   Parameters: Same as API PostMessage.
'
'   Return:     Depends on wMsg.
'________________________________________________________________________________________
Function PostMessage(hWnd As Long, wMsg As Long, wParam As Long, lParam As Long) As Long
    'Dim strMsg As String

    'strMsg = CStr(hWnd) + ", " + CStr(wMsg) + ", " + CStr(wParam) + ", " + CStr(lParam) + ", " + GetWindowCaption(hWnd) + ", " + ClassName(hWnd)
    'Call LogMsg(strMsg)
    PostMessage = PostMessageVB(hWnd, wMsg, wParam, lParam)
End Function

Function ProcessActive(Process As String) As Long
ProcessActive = FindWindow(vbNullString, Process)
End Function

'****************************************************************************************
'
'   Purpose:    From a supplied list of window captions (lpzProcess),
'               the window handle is stored on the list lpHWnd.
'               If the window does not exist then it is zero.
'               Each process must be terminated by ASCII code 0,
'               in the lpzProcess() array.
'               An error in caption name returns -1.
'
'****************************************************************************************
Sub ProcsActive(lpzProcess() As String * 81, lpHWnd() As Integer)
Dim wProcess As Integer
Dim wStartIndex As Integer
Dim wEndIndex As Integer
Dim wCaptionLen As Integer
Dim lpCaption As String

wStartIndex = LBound(lpzProcess)
wEndIndex = UBound(lpzProcess)
ReDim lpHWnd(wStartIndex To wEndIndex)

For wProcess = wStartProcess To wEndIndex
  wCaptionLen = InStr(1, lpzProcess(wProcess), Chr$(0)) - 1

  If wCaptionLen >= 1 Then
    lpCaption = Left$(lpzProcess(wProcess), wCaptionLen)
    lpHWnd(wProcess) = ProcessActive(lpCaption)
  Else
    lpHWnd(wProcess) = -1
  End If

Next wProcess
End Sub

'****************************************************************************************
'
'   Purpose:    Get the supplied window layout, from the INI type file.
'               lpSection is the section heading where entries WinLeft, WinTop,
'               WinWidth and WinHeight can be found.
'
'****************************************************************************************
Sub ReadWindowLayout(lpIniFile As String, lpSection As String, lpWinRect As RECT)
lpWinRect.Left = GetPrivateProfileInteger(lpSection, "WinLeft", lpIniFile)
lpWinRect.Top = GetPrivateProfileInteger(lpSection, "WinTop", lpIniFile)
lpWinRect.Right = GetPrivateProfileInteger(lpSection, "WinWidth", lpIniFile)
lpWinRect.Bottom = GetPrivateProfileInteger(lpSection, "WinHeight", lpIniFile)
End Sub

'****************************************************************************************
'
'   Purpose:    Function to render metafile to a device.
'               All measurements units need to be set.
'
'****************************************************************************************
Function RndrMetaFile(hdc As Long, lpMetaFile As METAFILEPICT, fLeft As Single, fTop As Single, fWidth As Single, fHeight As Single) As Integer
Dim dwOK As Long
Dim lpSize As Size
Dim lpPoint As POINTAPI

wOK = SetMapMode(hdc, lpMetaFile.mm)
wOK = SetWindowExtEx(hdc, lpMetaFile.xExt, lpMetaFile.yExt, lpSize)
wOK = SetViewportExtEx(hdc, fWidth, fHeight, lpSize)
wOK = SetViewportOrgEx(hdc, fLeft, fTop, lpPoint)
RndrMetaFile = PlayMetaFile(hdc, lpMetaFile.hMF)
End Function

'----------------------------------------------------------------------------------------
'
'   Process:    RTrimWS
'
'   Author:     Roberto Raso
'   Date:       14th March 1995
'
'   Purpose:    Removes white space characters from the end of a string.
'               White space characters are TABS and SPACES.
'
'   Parameters: strString is the string to tidy up.
'
'   Return:     The tidied string .
'
'----------------------------------------------------------------------------------------
Function RTrimWS(strString As String) As String
    Dim bWS As Integer
    Dim nChar As Integer, nChars As Integer
    Dim cChar As String * 1
    Dim strReturn As String
    
    strReturn = ""
    nChars = Len(strString)
    If nChars Then
        bWS = True
        nChar = nChars
        Do While bWS And nChar
            cChar = Mid$(strString, nChar, 1)
            Select Case cChar
                Case Chr$(32)   'Space
                    bWS = True
                    nChar = nChar - 1
                Case Chr$(9)    'Tab
                    bWS = True
                    nChar = nChar - 1
                Case Else
                    bWS = False
            End Select
        Loop
        If nChar Then
            strReturn = Left$(strString, nChar)
        End If
    End If
    RTrimWS = strReturn
End Function

'________________________________________________________________________________________
'
'   Process:    SendMessage
'
'   Author:     Roberto Raso
'   Date:       11th October 1995
'
'   Purpose:    Sends a message to a window. Calls API SendMessage.
'               Note: lParam must be a Long.
'               If a structure/string variable is required for lParam use
'               function SendMessageAPI.
'
'   Parameters: Same as API SendMessage.
'
'   Return:     Depends on wMsg.
'________________________________________________________________________________________
Function SendMessage(hWnd As Long, wMsg As Long, wParam As Long, lParam As Long) As Long
    'Dim strMsg As String

    'strMsg = CStr(hWnd) + ", " + CStr(wMsg) + ", " + CStr(wParam) + ", " + CStr(lParam) + ", " + GetWindowCaption(hWnd) + ", " + ClassName(hWnd)
    'Call LogMsg(strMsg)
    SendMessage = SendMessageVB(hWnd, wMsg, wParam, lParam)
End Function

'****************************************************************************************
'
'   Purpose:    Sets the Left, Top, Width and Height of the window, with handle hWnd.
'               The information is stored in lpWinRect.
'
'****************************************************************************************
Sub SetWindowLayout(hWnd As Long, lpWinRect As RECT)
Call MoveWindow(hWnd, lpWinRect.Left, lpWinRect.Top, lpWinRect.Right, lpWinRect.Bottom, CLng(True))
End Sub

'----------------------------------------------------------------------------------------
'
'   Process:    StringToArray
'
'   Author:     Roberto Raso
'   Date:       29th April 1995
'
'   Purpose:    Creates an array of strings from the separated string
'
'   Parameters: strString is the string to seperate out.
'               strSep is the separator that is used in the string.
'               astrString() is the array that will hold the separated out strings.
'
'   Return:     The number of strings found.
'
'----------------------------------------------------------------------------------------
Function StringToArray(strString As String, strSep As String, astrString() As String) As Integer
    Dim nSeps As Integer
    Dim nSep As Integer
    Dim nSepPos As Integer
    Dim nPrevPos As Integer
    Dim nStrings As Integer
    Dim anSep() As Integer
    Dim strToNth As String

    nStrings = 0
    If Len(strString) > 0 And Len(strSep) > 0 Then
        nSeps = CountSeps(strString, strSep, anSep())
        ReDim astrString(nSeps)
        nSepLen = Len(strSep)
        nPrevPos = 1 - nSepLen
        For nSep = 0 To nSeps
            If nSep < nSeps Then
                nSepPos = anSep(nSep)
            Else
                nSepPos = Len(strString) + 1
            End If
            astrString(nSep) = MidStr(strString, nPrevPos + nSepLen, nSepPos - 1)
            nPrevPos = nSepPos
            nStrings = nStrings + 1
        Next nSep
    End If
    StringToArray = nStrings
End Function

'----------------------------------------------------------------------------------------
'
'   Process:    StringToFloats
'
'   Author:     Roberto Raso
'   Date:       29th April 1995
'
'   Purpose:    Creates an array of floats from the separated string
'
'   Parameters: strString is the string to separate out.
'               strSep is the separator that is used in the string.
'               afNum() is the array that will hold the separated out floats.
'
'   Return:     The number of floats found.
'
'----------------------------------------------------------------------------------------
Function StringToFloats(strString As String, strSep As String, adfNum() As Double) As Integer
    Dim nString As Integer
    Dim nStrings As Integer
    Dim astrString() As String

    nStrings = StringToArray(strString, strSep, astrString())
    If nStrings Then
        ReDim adfNum(nStrings - 1)
        For nString = 0 To nStrings - 1
            adfNum(nString) = Val(astrString(nString))
        Next nString
    End If
    StringToFloats = nStrings
End Function

'****************************************************************************************
'
'   Purpose:    Convert a null terminated string to a standard VB string.
'
'****************************************************************************************
Function SZToVB(lpSzString As String) As String
Dim wNull As Integer

wNull = InStr(lpSzString, Chr$(0))

If wNull > 1 Then
  SZToVB = Left$(lpSzString, wNull - 1)
ElseIf wNull = 1 Then
  SZToVB = ""
Else
  SZToVB = lpSzString
End If

End Function

'----------------------------------------------------------------------------------------
'
'   Process:    TrimWS
'
'   Author:     Roberto Raso
'   Date:       14th March 1995
'
'   Purpose:    Removes white space characters from the begining and end of a string.
'               White space characters are TABS and SPACES.
'
'   Parameters: strString is the string to tidy up.
'
'   Return:     The tidied string .
'
'----------------------------------------------------------------------------------------
Function TrimWS(strString As String) As String
    TrimWS = RTrimWS(LTrimWS(strString))
End Function

'****************************************************************************************
'
'   Purpose:    Waits for a window to appear with the caption (whole or part) lpCaption
'               to appear, within the wTimeOut period (in second), that is a child window
'               of hParent.
'
'****************************************************************************************
Function WaitForChildWindow(hParent As Long, lpChildCaption As String, wTimeout As Integer) As Long
Dim bEndWait As Integer
Dim hWnd As Long
Dim wWait As Integer
Dim lpEntryTime As Variant

lpEntryTime = Now

Do Until bEndWait
  wWait = Second(Now - lpEntryTime)
  hWnd = FindChildWindow(hParent, lpChildCaption)

  If hWnd Then
    bEndWait = True
  ElseIf wWait > wTimeout Then
    bEndWait = True
  Else
    DoEvents
  End If

Loop

WaitForChildWindow = hWnd
End Function

'****************************************************************************************
'
'   Purpose:    Waits for a window to appear with the caption (whole or part) lpCaption
'               to appear, within the wTimeOut period (in second).
'
'****************************************************************************************
Function WaitForWindow(lpCaption As String, wTimeout As Integer) As Long
Dim bEndWait As Integer
Dim hWnd As Long

Dim wWait As Integer
Dim lpEntryTime As Variant

lpEntryTime = Now

Do Until bEndWait
  wWait = Second(Now - lpEntryTime)
  hWnd = FindWindowCaption(lpCaption)

  If hWnd Then
    bEndWait = True
  ElseIf wWait > wTimeout Then
    bEndWait = True
  Else
    DoEvents
  End If

Loop

WaitForWindow = hWnd
End Function

'****************************************************************************************
'
'   Process:    WindowInfo_Dump
'
'   Author:     Roberto Raso
'   Date:       31st January 1995
'
'   Purpose:    Dumps window information to debug window.
'
'   Parameters: sWindowLink is structure that holds the window information.
'
'****************************************************************************************
Sub WindowInfo_Dump(sWindowLink As WINDOWLINK)
    Debug.Print sWindowLink.hWnd;
    Debug.Print sWindowLink.hParent;
    Debug.Print sWindowLink.strCaption;
    Debug.Print sWindowLink.strClass;
    Debug.Print sWindowLink.nID
    Debug.Print sWindowLink.sRect.Left; sWindowLink.sRect.Top; sWindowLink.sRect.Right; sWindowLink.sRect.Bottom
End Sub

'****************************************************************************************
'
'   Process:    WindowInfo_Get
'
'   Author:     Roberto Raso
'   Date:       31st January 1995
'
'   Purpose:    The information about a window.
'
'   Parameters: hWnd is the handle of the window.
'               asWindowLink is structure to hold the window information.
'
'   Return:     Void.
'
'****************************************************************************************
Sub WindowInfo_Get(hWnd As Long, sWindowLink As WINDOWLINK)

Dim nReturn As Integer
Dim nBuff As Long
Dim strBuff As String
Dim nNameLen As Integer

nReturn = 0
sWindowLink.hWnd = hWnd
sWindowLink.hParent = GetParent(hWnd)
sWindowLink.strCaption = GetWindowCaption(hWnd)

'Set buffer to receive class name
strBuff = Space$(MAX_STRING)
nBuff = GlobalAlloc(GMEM_FIXED + GMEM_ZEROINIT, MAX_STRING)
nBuff = GlobalLock(nBuff)

'Get the class name
nNameLen = GetClassName(hWnd, nBuff, MAX_STRING)
Call CpyBuffToStr(strBuff, nBuff, MAX_STRING)

sWindowLink.strClass = Left$(strBuff, nBuff)
sWindowLink.nID = GetDlgCtrlID(hWnd)
Call GetWindowRect(hWnd, sWindowLink.sRect)

'Clear memory
Call GlobalUnlock(nBuff)
Call GlobalFree(nBuff)

End Sub

'****************************************************************************************
'
'   Purpose:    Write integer information to INI type file.
'
'****************************************************************************************
Sub WritePrivateProfileInteger(lpSection As String, lpEntry As String, wInt As Long, lpIniFile As String)
Dim wBytes As Integer

wBytes = WritePrivateProfileString(lpSection, ByVal lpEntry, ByVal CStr(wInt), lpIniFile)
End Sub

'****************************************************************************************
'
'   Purpose:    Write string information to INI type file.
'
'****************************************************************************************
Sub WritePrivateProfileStr(lpSection As String, lpEntry As String, lpString As String, lpIniFile As String)
Dim wBytes As Integer

wBytes = WritePrivateProfileString(lpSection, ByVal lpEntry, ByVal lpString, lpIniFile)
End Sub

'****************************************************************************************
'
'   Purpose:    Saves the supplied window layout, to the INI type file.
'               lpSection is the section heading where entries WinLeft, WinTop,
'               WinWidth and WinHeight can be found.
'
'****************************************************************************************
Sub WriteWindowLayout(lpIniFile As String, lpSection As String, lpWinRect As RECT)
Call WritePrivateProfileInteger(lpSection, "WinLeft", lpWinRect.Left, lpIniFile)
Call WritePrivateProfileInteger(lpSection, "WinTop", lpWinRect.Top, lpIniFile)
Call WritePrivateProfileInteger(lpSection, "WinWidth", lpWinRect.Right, lpIniFile)
Call WritePrivateProfileInteger(lpSection, "WinHeight", lpWinRect.Bottom, lpIniFile)
End Sub