Visual Basic Source Code/Visual Basic Source Code.iso/vbsource/library/library.bas

BASIC Source File | 1995-11-09 | 24.2 KB | 712 lines

Option Explicit

Type PointAPI
    x As Integer
    y As Integer
End Type

Global Const WM_USER = &H400

Global Const EM_SETREADONLY = (WM_USER + 31)
Global Const HTCAPTION = 2
Global Const LB_SELECTSTRING = (WM_USER + 13)
Global Const WM_NCLBUTTONDOWN = &HA1

Declare Function ExitWindows Lib "User" (ByVal dwReturnCode As Long, ByVal wReserved As Integer) As Integer
Declare Function ExitWindowsExec Lib "User" (ByVal DosExe As String, ByVal Params As String) As Integer
     Declare Sub GetCursorPos Lib "User" (lpPoint As PointAPI)
Declare Function GetDriveType Lib "kernel" (ByVal nDrive As Integer) As Integer
Declare Function GetFreeSystemResources Lib "User" (ByVal fuSysResource As Integer) As Integer
Declare Function GetSystemDirectory Lib "Kernel" (ByVal lpBuffer As String, ByVal nSize As Integer) As Integer
Declare Function GetWindowsDirectory Lib "Kernel" (ByVal lpBuffer As String, ByVal nSize As Integer) As Integer
     Declare Sub HideCaret Lib "User" (ByVal hWnd As Integer)
     Declare Sub ReleaseCapture Lib "User" ()
Declare Function SendMessage Lib "User" (ByVal hWnd As Integer, ByVal wMsg As Integer, ByVal wParam As Integer, lParam As Any) As Long
Declare Function SetWindowPos Lib "user" (ByVal h%, ByVal hb%, ByVal x%, ByVal y%, ByVal cx%, ByVal cy%, ByVal F%) As Integer
     Declare Sub SetWindowWord Lib "User" (ByVal hWnd%, ByVal nCmd%, ByVal nVal%)
Declare Function ShowCursor Lib "User" (ByVal bShow%)
Declare Function ShowWindow% Lib "User" (ByVal hWnd%, ByVal nCmdShow%)
Declare Function WinHelp% Lib "User" (ByVal hWnd%, ByVal HelpFile$, ByVal HelpCode%, ByVal HelpData&)
Declare Function GetVersion& Lib "Kernel" ()

Sub AlwaysOnTop (frmID As Form, OnTop As Integer)
' Pass any non-zero value to Place on top
' Pass zero to remove top-mostness
    Const SWP_NOMOVE = 2
    Const SWP_NOSIZE = 1
    Const FLAGS = SWP_NOMOVE Or SWP_NOSIZE
    Const HWND_TOPMOST = -1
    Const HWND_NOTOPMOST = -2
    If OnTop Then
    OnTop = SetWindowPos(frmID.hWnd, HWND_TOPMOST, 0, 0, 0, 0, FLAGS)
    Else
    OnTop = SetWindowPos(frmID.hWnd, HWND_NOTOPMOST, 0, 0, 0, 0, FLAGS)
    End If
End Sub

Function AnotherInstance () As Integer
'   This routine determines if the currently running program is already
'   running (running twice).  It shifts the focus to the previous app
'   and returns true.  It does NOT close the duplicated instance.

    Dim AppTitle$
    If App.PrevInstance Then
    AppTitle$ = App.Title
    App.Title = "No longer want this app running..."
    AppActivate AppTitle$   ' Activate the previous instance
    AnotherInstance = True
    Else
    AnotherInstance = False
    End If
End Function

Sub CenterForm (frm As Form)
'Center A Form On The Screen
'Centers form on the screen (before showing it works best)
    Dim x As Integer
    Dim y As Integer
    x = (Screen.Width - frm.Width) / 2
    y = (Screen.Height - frm.Height) / 2
    frm.Move x, y       'Change the location of the form
End Sub

Function CreatePath (ByVal DestPath$) As Integer
'   Note - This function returns false if not successful

' Create the path contained in DestPath$
' First char must be drive letter, followed by
' a ":\" followed by the path, if any.

    Dim BackPos As Integer
    Dim forePos As Integer
    Dim Temp$

    Screen.MousePointer = 11

    '---------------------------------------------
    ' Add slash to end of path if not there already
    '---------------------------------------------
    If Right$(DestPath$, 1) <> "\" Then DestPath$ = DestPath$ + "\"

    '-----------------------------------
    ' Change to the root dir of the drive
    '-----------------------------------
    On Error Resume Next
    ChDrive DestPath$
    If Err <> 0 Then GoTo errorOut
    ChDir "\"

    '-------------------------------------------------
    ' Attempt to make each directory, then change to it
    '-------------------------------------------------
    BackPos = 3
    forePos = InStr(4, DestPath$, "\")
    Do While forePos <> 0
    Temp$ = Mid$(DestPath$, BackPos + 1, forePos - BackPos - 1)

    Err = 0
    MkDir Temp$
    If Err <> 0 And Err <> 75 Then GoTo errorOut

    Err = 0
    ChDir Temp$
    If Err <> 0 Then GoTo errorOut

    BackPos = forePos
    forePos = InStr(BackPos + 1, DestPath$, "\")
    Loop

    CreatePath = True
    Screen.MousePointer = 0
    Exit Function

errorOut:
    MsgBox "Error While Attempting to Create Directories on Destination Drive.", 48, "SETUP"
    CreatePath = False
    Screen.MousePointer = 0

End Function

Sub CreateProgManGroup (x As Form, GroupName$, GroupPath$)
'-------------------------------------------------------------
' Procedure: CreateProgManGroup
' Arguments: X           The Form where a Label1 exist
'            GroupName$  A string that contains the group name
'            GroupPath$  A string that contains the group file
'                        name  ie 'myapp.grp'
'-------------------------------------------------------------
    Dim i%, z%

    Screen.MousePointer = 11

    '----------------------------------------------------------------------
    ' Windows requires DDE in order to create a program group and item.
    ' Here, a Visual Basic label control is used to generate the DDE messages
    '----------------------------------------------------------------------
    On Error Resume Next

    '--------------------------------
    ' Set LinkTopic to PROGRAM MANAGER
    '--------------------------------
    x.Label1.LinkTopic = "ProgMan|Progman"
    x.Label1.LinkMode = 2
    For i% = 1 To 10                                         ' Loop to ensure that there is enough time to
      z% = DoEvents()                                        ' process DDE Execute.  This is redundant but needed
    Next                                                     ' for debug windows.
    x.Label1.LinkTimeout = 100

    '---------------------
    ' Create program group
    '---------------------
    x.Label1.LinkExecute "[CreateGroup(" + GroupName$ + Chr$(44) + GroupPath$ + ")]"

    '-----------------
    ' Reset properties
    '-----------------
    x.Label1.LinkTimeout = 50
    x.Label1.LinkMode = 0
    Screen.MousePointer = 0
End Sub

Sub CreateProgManItem (x As Form, CmdLine$, IconTitle$)
'----------------------------------------------------------
' Procedure: CreateProgManItem
'
' Arguments: X           The form where Label1 exists
'
'            CmdLine$    A string that contains the command
'                        line for the item/icon.
'                        ie 'c:\myapp\setup.exe'
'
'            IconTitle$  A string that contains the item's
'                        caption
'----------------------------------------------------------

    Dim i%, z%
    Screen.MousePointer = 11

    '----------------------------------------------------------------------
    ' Windows requires DDE in order to create a program group and item.
    ' Here, a Visual Basic label control is used to generate the DDE messages
    '----------------------------------------------------------------------
    On Error Resume Next

    '---------------------------------
    ' Set LinkTopic to PROGRAM MANAGER
    '---------------------------------
    x.Label1.LinkTopic = "ProgMan|Progman"
    x.Label1.LinkMode = 2
    For i% = 1 To 10                                         ' Loop to ensure that there is enough time to
      z% = DoEvents()                                        ' process DDE Execute.  This is redundant but needed
    Next                                                     ' for debug windows.
    x.Label1.LinkTimeout = 100

    '------------------------------------------------
    ' Create Program Item, one of the icons to launch
    ' an application from Program Manager
    '------------------------------------------------
    x.Label1.LinkExecute "[AddItem(" + CmdLine$ + Chr$(44) + IconTitle$ + Chr$(44) + ",,)]"

    '-----------------
    ' Reset properties
    '-----------------
    x.Label1.LinkTimeout = 50
    x.Label1.LinkMode = 0

    Screen.MousePointer = 0
End Sub

Function DecimalValue (BinaryByte As String) As Integer
'   This routine is called from the GetWindowsVersion routine

    Dim x As Integer
    Dim v As Integer
    Dim TempVal As Integer

    v = 128
    For x = 1 To 8
    If Mid$(BinaryByte, x, 1) = "1" Then TempVal = TempVal + v
    v = v / 2
    Next x
    DecimalValue = TempVal
End Function

Sub FloatingWindow (FrmChildhWnd%, FrmParenthWnd%)
    Call SetWindowWord(FrmChildhWnd%, -8, FrmParenthWnd%)
End Sub

Function FreeDrive () As String
'   This function returns the drive letter of the next available drive
    Dim DriveNum As Integer
    Dim FirstDrive As Integer
    DriveNum = -1
    Do
    DriveNum = DriveNum + 1   ' start at drive zero.
    FirstDrive% = GetDriveType(DriveNum)  ' Requires API declaration
    ' GetDriveType returns zero if it cannot determine drive
    ' type or returns 1 if the specified drive does not exist.
    Loop Until FirstDrive% = 0
    ' DriveNum of 0 means Drive A, 1=B, 2=C, 3=D, 4=E, 5=F, and so on:
    FreeDrive = Chr$(DriveNum + 65) + ":"
End Function

Function GetSystemDir ()
    Dim Sys As String * 256
    Dim x As Integer
    x = GetSystemDirectory(Sys, Len(Sys))
    x = InStr(1, Sys, Chr$(0))
    GetSystemDir = Left$(Sys, InStr(Sys, Chr$(0)) - 1)
End Function

Function GetWindowsDir () As String
'   Calls the windows API to get the windows directory
    Dim Temp$, x As Integer

    Temp$ = String$(145, 0)              ' Size Buffer
    x = GetWindowsDirectory(Temp$, 145)  ' Make API Call
    Temp$ = Left$(Temp$, x)              ' Trim Buffer

    If Right$(Temp$, 1) <> "\" Then      ' Add \ if necessary
    GetWindowsDir$ = Temp$ + "\"
    Else
    GetWindowsDir$ = Temp$
    End If

End Function

Function GetWindowsVersion () As String
'   This routine determines what version of Windows is being used
'   This routine also requires the following two functions:
'       MakeNybble()
'       DecimalValue()

    Dim x As Long
    Dim y As String
    Dim z As Integer
    Dim t As String
    Dim HN As String
    Dim LN As String

    x = GetVersion()
    x = x - 117440512     ' Don't need High Word returned for Windows version
    t = Hex$(x)           ' Make the numeric value a Hexadecimal string
    y = Str$(Val(Right$(t, 2))) + "."' Hold the Major release # (ie  3.xx)
    HN = MakeNybble(Left$(t, 1))
    LN = MakeNybble(Mid$(t, 2, 1))
    z = DecimalValue(HN + LN)
    If z = 95 Then
    GetWindowsVersion = "Windows 95"
    Else
    GetWindowsVersion = "Windows " + y + Trim$(Str$(z))
    End If
End Function

Sub Help_Click (HelpFile As String, frm As Form)
  '<HelpFile> is the name of the application's helpfile
  '<frm> is simply the form calling this function (pass ME)

  MsgBox "This routine would activate Help if a help file existed", 48, "VB Library"
  Exit Sub
  Dim i As Integer
  i = WinHelp(frm.hWnd, App.HelpFile, 3, 0&)        'for Contents
  i = WinHelp(frm.hWnd, App.HelpFile, &H105, 0&)    'for Search
  i = WinHelp(frm.hWnd, App.HelpFile, 4, 0&)        'for HelponHelp
End Sub

Sub HideMDIChild (frmID As Form)
    Dim HiddenMDIChild As Integer
    HiddenMDIChild = ShowWindow(frmID.hWnd, 0)
End Sub

Sub HighlightText ()
'   This routine will automatically highlight all text in a given textbox
'   whenever called  (ie at GotFocus or when validating entries, etc)
    Screen.ActiveForm.ActiveControl.SelStart = 0
    Screen.ActiveForm.ActiveControl.SelLength = Len(Screen.ActiveForm.ActiveControl.Text)
End Sub

Function IfFileExists (FileName As String) As Integer
' This function attempts to determine whether or not a
' given file exists based on the file's length
    Dim x As Long
    On Error Resume Next
    x = FileLen(FileName)
    If x Then IfFileExists = True Else IfFileExists = False
End Function

Function IsPathValid (DestPath$, ByVal DefaultDrive$) As Integer
'------------------------------------------------------
' Function:   IsPathValid as integer
' arguments:  DestPath$         a string that is a full path
'             DefaultDrive$     the default drive.  eg.  "C:"
'
'  If DestPath$ does not include a drive specification,
'  IsValidPath uses Default Drive
'
'  When IsValidPath is finished, DestPath$ is reformated
'  to the format "X:\dir\dir\dir\"
'
' Result:  True (-1) if path is valid.
'          False (0) if path is invalid
'-------------------------------------------------------
    Dim tmp$
    Dim drive$
    Dim legalChar$
    Dim BackPos As Integer
    Dim forePos As Integer
    Dim Temp$
    Dim i As Integer
    Dim periodPos As Integer
    Dim length As Integer

    '----------------------------
    ' Remove left and right spaces
    '----------------------------
    DestPath$ = Trim$(DestPath$)

    '-----------------------------
    ' Check Default Drive Parameter
    '-----------------------------
    If Right$(DefaultDrive$, 1) <> ":" Or Len(DefaultDrive$) <> 2 Then
    MsgBox "Bad default drive parameter specified in IsValidPath Function.  You passed,  """ + DefaultDrive$ + """.  Must be one drive letter and "":"".  For example, ""C:"", ""D:""...", 64, "Setup Kit Error"
    GoTo parseErr
    End If

    '-------------------------------------------------------
    ' Insert default drive if path begins with root backslash
    '-------------------------------------------------------
    If Left$(DestPath$, 1) = "\" Then DestPath$ = DefaultDrive + DestPath$

    '-----------------------------
    ' check for invalid characters
    '-----------------------------
    On Error Resume Next
    tmp$ = Dir$(DestPath$)
    If Err <> 0 Then GoTo parseErr

    '-----------------------------------------
    ' Check for wildcard characters and spaces
    '-----------------------------------------
    If (InStr(DestPath$, "*") <> 0) GoTo parseErr
    If (InStr(DestPath$, "?") <> 0) GoTo parseErr
    If (InStr(DestPath$, " ") <> 0) GoTo parseErr

    '------------------------------------------
    ' Make Sure colon is in second char position
    '------------------------------------------
    If Mid$(DestPath$, 2, 1) <> Chr$(58) Then GoTo parseErr

    '-------------------------------
    ' Insert root backslash if needed
    '-------------------------------
    If Len(DestPath$) > 2 Then
      If Right$(Left$(DestPath$, 3), 1) <> "\" Then
    DestPath$ = Left$(DestPath$, 2) + "\" + Right$(DestPath$, Len(DestPath$) - 2)
      End If
    End If

    '-------------------------
    ' Check drive to install on
    '-------------------------
    drive$ = Left$(DestPath$, 1)
    ChDrive (drive$)                                                        ' Try to change to the dest drive
    If Err <> 0 Then GoTo parseErr

    '-----------
    ' Add final \
    '-----------
    If Right$(DestPath$, 1) <> "\" Then DestPath$ = DestPath$ + "\"

    '-------------------------------------
    ' Root dir is a valid dir
    '-------------------------------------
    If Len(DestPath$) = 3 Then
    If Right$(DestPath$, 2) = ":\" Then GoTo ParseOK
    End If

    '------------------------
    ' Check for repeated Slash
    '------------------------
    If InStr(DestPath$, "\\") <> 0 Then GoTo parseErr

    '--------------------------------------
    ' Check for illegal directory names
    '--------------------------------------
    legalChar$ = "!#$%&'()-0123456789@ABCDEFGHIJKLMNOPQRSTUVWXYZ^_`{}~."
    BackPos = 3
    forePos = InStr(4, DestPath$, "\")
    Do
    Temp$ = Mid$(DestPath$, BackPos + 1, forePos - BackPos - 1)

    '----------------------------
    ' Test for illegal characters
    '----------------------------
    For i = 1 To Len(Temp$)
        If InStr(legalChar$, UCase$(Mid$(Temp$, i, 1))) = 0 Then GoTo parseErr
    Next i

    '-------------------------------------------
    ' Check combinations of periods and lengths
    '-------------------------------------------
    periodPos = InStr(Temp$, ".")
    length = Len(Temp$)
    If periodPos = 0 Then
        If length > 8 Then GoTo parseErr                         ' Base too long
    Else
        If periodPos > 9 Then GoTo parseErr                      ' Base too long
        If length > periodPos + 3 Then GoTo parseErr             ' Extension too long
        If InStr(periodPos + 1, Temp$, ".") <> 0 Then GoTo parseErr' Two periods not allowed
    End If

    BackPos = forePos
    forePos = InStr(BackPos + 1, DestPath$, "\")
    Loop Until forePos = 0

ParseOK:
    IsPathValid = True
Exit Function

parseErr:
    IsPathValid = False
End Function

Function LocatePointer ()
'   A way to find out the x and y coordinates of the mouse pointer
'   when the event DblClick or Click is invoked:
'   This routine needs to:
'       A)  Be placed in an event procedure
'                   -- OR --
'       B)  Utilize a GLOBAL variable in place of "Dim Pnt"

'----------------------
'   Dim pnt As PointAPI
'   GetCursorPos Pnt
'----------------------

'   Pnt.x is the x coordinate in pixels, Pnt.y y-coordinate in pixels.
End Function

Function MakeNybble (HexCharacter As String)
'   This routine is called from the GetWindowsVersion routine
    Select Case Left$(HexCharacter, 1)
    Case "0": MakeNybble = "0000"
    Case "1": MakeNybble = "0001"
    Case "2": MakeNybble = "0010"
    Case "3": MakeNybble = "0011"
    Case "4": MakeNybble = "0100"
    Case "5": MakeNybble = "0101"
    Case "6": MakeNybble = "0110"
    Case "7": MakeNybble = "0111"
    Case "8": MakeNybble = "1000"
    Case "9": MakeNybble = "1001"
    Case "A": MakeNybble = "1010"
    Case "B": MakeNybble = "1011"
    Case "C": MakeNybble = "1100"
    Case "D": MakeNybble = "1101"
    Case "E": MakeNybble = "1110"
    Case "F": MakeNybble = "1111"
    End Select

End Function

Sub MakeReadOnly (TextBoxhWnd%)
'   This routine will cause a textbox to become read-only with no cursor
'   but will NOT gray out the text and the scrollbars will still work.
    Dim x As Integer

    x = SendMessage(TextBoxhWnd%, EM_SETREADONLY, 1, 0)
    HideCaret TextBoxhWnd%

End Sub

Sub PaintForm (FormName As Form, Orientation%, RStart%, GStart%, BStart%, RInc%, GInc%, BInc%)
'   This routine does NOT use API calls
    On Error Resume Next
    Dim x As Integer, y As Integer, z As Integer, Cycles As Integer
    Dim R%, G%, B%
    R% = RStart%: G% = GStart%: B% = BStart%
    If Orientation% = 0 Then
    Cycles = FormName.ScaleHeight \ 100
    Else
    Cycles = FormName.ScaleWidth \ 100
    End If
    For z = 1 To 100
    x = x + 1
    Select Case Orientation
        Case 0: 'Top to Bottom
        If x > FormName.ScaleHeight Then Exit For
        FormName.Line (0, x)-(FormName.Width, x + Cycles - 1), RGB(R%, G%, B%), BF
        Case 1: 'Left to Right
        If x > FormName.ScaleWidth Then Exit For
        FormName.Line (x, 0)-(x + Cycles - 1, FormName.Height), RGB(R%, G%, B%), BF
    End Select
    x = x + Cycles
    R% = R% + RInc%: G% = G% + GInc%: B% = B% + BInc%
    If R% > 255 Then R% = 255
    If R% < 0 Then R% = 0
    If G% > 255 Then G% = 255
    If G% < 0 Then G% = 0
    If B% > 255 Then B% = 255
    If B% < 0 Then B% = 0
    Next z
End Sub

Function PurgeNumericInput (StringVal As Variant) As Variant
'   This routine can be used in place of the masked-edit control.
'   It takes a string of text and purges out ALL non-numeric characters
'   (allows periods to remain).  Then returns that string in the form
'   of a variant to the calling procedure.  Use the string to numeric
'   conversion commands of VB to convert the variant into the numeric
'   data type that you would like to process.

    On Local Error Resume Next
    Dim x As Integer
    Dim WorkString As String

    If Len(Trim(StringVal)) = 0 Then Exit Function
    For x = 1 To Len(StringVal)
    Select Case Mid(StringVal, x, 1)
        Case "0" To "9", "."
        WorkString = WorkString + Mid(StringVal, x, 1)
    End Select
    Next x
    PurgeNumericInput = WorkString
End Function

Function PurgeString (Partial As String, Whole As String) As String
'   This routine will search the <Whole> text string for the first
'   occurence of <Partial>.  If it is found, it will be removed from
'   the string.

    On Error Resume Next
    PurgeString = ""
    If Len(Partial) < 1 Then Exit Function
    If Len(Whole) < 1 Then Exit Function
    Dim x As Integer
    Dim WorkStr As String
    WorkStr = Whole
    Do
    x = InStr(WorkStr, Partial)
    If x = 0 Then Exit Do
    WorkStr = Left(WorkStr, x - 1) + Mid(WorkStr, x + Len(Partial))
    Loop
    PurgeString = WorkStr
End Function

Function ReadFileChunk (FileName As String, Action As Integer) As String
'   This routine reads the contents of ANY file (ignoring delimiters)
'   and returns the entire file in the function.  This

'   <Action=0> = From the beginning
'   <Action=1> = Continue from last chunk read
    Dim FBuffer As Integer
    Static CyclesRead As Integer
    Static FullLenString As String * 1000
    Static PartialString As String
    Dim Indicator As Long
    Static Temp As String

    If Action = 0 Then CyclesRead = 0

    FBuffer = FreeFile
    Open FileName For Random As #FBuffer Len = 1000
    If CyclesRead * 1000 > LOF(FBuffer) Then
    Close #FBuffer: Exit Function' You've read all there is
    End If
    CyclesRead = CyclesRead + 1
    Get #FBuffer, CyclesRead, FullLenString
    If LOF(FBuffer) - (CyclesRead * 1000) > -1 Then
    'Not yet gone past end of file - return everything just read
    ReadFileChunk = FullLenString
    Else
    'You just read past the end of file
    'Obtain the portion you want and discard the rest
    ReadFileChunk = Left(FullLenString, LOF(FBuffer) - (CyclesRead * 1000) + 1000)
    End If
    Close #FBuffer
End Function

Function RebootSystem () As Integer
'   Causes the computer to be rebooted
'   If any programs refuse to terminate, then this function
'   will return a ZERO
    Dim i As Integer
    Dim EW_REBOOTSYSTEM As Long
    EW_REBOOTSYSTEM = &H43
    i = ExitWindows(EW_REBOOTSYSTEM, 0)
End Function

Sub ResourceMonitor ()
'   Gets Free System Resources and displays them in a
'   message box as percentages

    Dim FreeSystemResources As String
    Dim FreeGDIResources    As String
    Dim FreeUserResources   As String
    Dim MsgBoxText          As String

    FreeSystemResources = CStr(GetFreeSystemResources(&H0)) & "%"
    FreeGDIResources = CStr(GetFreeSystemResources(&H1)) & "%"
    FreeUserResources = CStr(GetFreeSystemResources(&H2)) & "%"

    MsgBoxText = "Free System Resoruces: " + FreeSystemResources + Chr(13) + Chr(10)
    MsgBoxText = MsgBoxText + "Free GDI Resoruces:    " + FreeGDIResources + Chr(13) + Chr(10)
    MsgBoxText = MsgBoxText + "Free User Resoruces:   " + FreeUserResources + Chr(13) + Chr(10)
    MsgBox MsgBoxText, 48, "Free System Resources"

End Sub

Function RestartWindows () As Integer
'   Causes Windows to Restart
'   If any programs refuse to terminate, then this function
'   will return a ZERO
    Dim i As Integer
    Dim EW_RESTARTWINDOWS As Long
    EW_RESTARTWINDOWS = &H42
    i = ExitWindows(EW_RESTARTWINDOWS, 0)
End Function

Sub SelectListItem (lst As Control, Idx As String)
'   This routine will highlight a given line in a listbox based on the
'   String being searched for.
    Dim i As Integer
    i = SendMessage(lst.hWnd, LB_SELECTSTRING, -1, ByVal Idx)
End Sub

Function Upeach (msg As Variant)
  On Error Resume Next
  Dim length As Integer
  Dim tmpmsg As String
  Dim count As Integer

  length = Len(msg): If length < 1 Then Exit Function
  tmpmsg = UCase$(Left$(msg, 1))
  For count = 2 To length
    If Mid$(msg, count - 1, 1) = " " Or Mid$(msg, count - 1, 1) = "-" Then
      tmpmsg = tmpmsg + UCase$(Mid$(msg, count, 1))
    ElseIf count = 3 Then
      If UCase(Mid$(msg, count - 2, 2)) = "MC" Then
    tmpmsg = tmpmsg + UCase$(Mid$(msg, count, 1))
      Else
    tmpmsg = tmpmsg + Mid$(msg, count, 1)
      End If
    Else
      tmpmsg = tmpmsg + Mid$(msg, count, 1)
    End If
  Next count
  Upeach = tmpmsg
End Function

Function UpFirst (msg As Variant) As String
'Capitalize 1st Letter Of Argument Only
'Capitalizes the first letter of the passed argument (Assumes a string)
    Dim length As Integer
    length = Len(msg)
    Select Case length
    Case 0: UpFirst = ""
    Case 1: UpFirst = UCase(msg)
    Case Else: UpFirst = UCase(Left(msg, 1)) + Right(msg, length - 1)
    End Select
End Function