Attribute VB_Name = "GlobalRoutines"
'GlobalRoutines.bas
'
' Just a collection of useful routines
'
'  1-08-01 by Robert Clemenzi
'
'  ConvertColor(color$)
'      Converts a string to a color value
'  RemoveDoubleQuotes(Parameter$)
'      Removes double quotes from a string
'  Set_UICombo(UICombo As ComboBox, Param$)
'      Loads a ComboBox list
'  Close_Application(f As Form)
'      Generic routine to close an application
'

Option Explicit


' This routine allows colors to be entered as
' strings in ini files
'
' Recognizes those strings in the case statement
' as well as hex numbers similar to
'   &Hcc4422
'
' All input strings are case insensitive
'
Function ConvertColor(color$) As Long
Dim temp As Long
Dim tempstr$

  tempstr$ = LCase(color$)
  Select Case tempstr$
    Case "black":   temp = vbBlack
    Case "red":     temp = vbRed
    Case "green":   temp = vbGreen
    Case "yellow":  temp = vbYellow
    Case "blue":    temp = vbBlue
    Case "magenta": temp = vbMagenta
    Case "cyan":    temp = vbCyan
    Case "white":   temp = vbWhite
    Case "gray":    temp = &HC0C0C0
    Case Else:      temp = vbBlack
  End Select
  
  If Left(tempstr$, 2) = "&h" Then
    temp = CLng(tempstr$)
  End If

  ConvertColor = temp
End Function

' When parameters are entered, some users include double quotes
' This routine removes them
'
'  1-08-01 Added RemoveDoubleQuotes (not tested)

Function RemoveDoubleQuotes(Parameter$) As String
Dim temp$, i
  temp$ = Trim(Parameter$)
  If Left(temp$, 1) = """" And Right(temp$, 1) = """" Then
    temp$ = Mid(temp$, 2, Len(temp$) - 2)
    ' Change pairs of double quotes into a single double quote
    Do
      i = InStr(temp$, """""") ' This searches for 2 double quotes - ""
      If i > 0 Then
       temp$ = Mid(temp$, 1, i - 1) & """" & Mid(temp$, i + 2)
      Else
       Exit Do
      End If
    Loop
  End If
  RemoveDoubleQuotes = Trim(temp$)
End Function

' This routine parses a semicolon delimited list of options
' and adds them to a ComboBox list
'
'  Example:  "red;blue;green"
'
Sub Set_UICombo(UICombo As ComboBox, Param$)
Dim i As Integer, j As Integer
Dim temp$
  
  i = 1
  UICombo.Clear
  If Param$ = "" Then Exit Sub
  
  Do
    j = InStr(i, Param$, ";")
    If j = 0 Then             ' get the last (or only) option
      UICombo.AddItem (Mid(Param$, i))
      UICombo.ListIndex = 0
      Exit Sub
    End If
    temp$ = Mid(Param$, i, j - i)
    UICombo.AddItem (temp$)
    i = j + 1
  Loop
End Sub

  ' I think it is easier to find and call this than it is to
  ' try and figure out how to do this for each project
Sub Close_Application(f As Form)
' Sub Close_UIButton_Click()  Won't work, the close button won't call it
' Unload Me  ' This won't work in a subroutine - me is not known
  Unload f ' Normal way to quit
           ' If there are no problems,
           '   this stops this application
           '   and triggers code in the
           '   Unload, QueryUnload, and Terminate events
  End      ' Otherwise, this forces the application to quit

End Sub