VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "clsFunctions"
Attribute VB_GlobalNameSpace = True
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
Option Explicit

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'API calls for OpenWebBrowser
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Const SW_SHOW = 5       ' Displays Window in its current size and position
Private Const SW_SHOWNORMAL = 1 ' Restores Window if Minimized or Maximized
Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hWnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
Private Declare Function FindExecutable Lib "shell32.dll" Alias "FindExecutableA" (ByVal lpFile As String, ByVal lpDirectory As String, ByVal lpResult As String) As Long
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Private Declare Function FormatMessage Lib "kernel32" Alias "FormatMessageA" (ByVal dwFlags As Long, lpSource As Any, ByVal dwMessageId As Long, ByVal dwLanguageId As Long, ByVal lpBuffer As String, ByVal nSize As Long, Arguments As Long) As Long
Private Const FORMAT_MESSAGE_FROM_SYSTEM = &H1000

Private Const g_cVowels = "aeiouy"
Private Const g_cConsan = "bcdfghjklmnpqrstvwxz"

Private Declare Function lstrlenW Lib "kernel32" (ByVal lpString As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (pTo As Any, uFrom As Any, ByVal lSize As Long)

Private Declare Function DeleteFile Lib "kernel32" Alias "DeleteFileA" (ByVal lpFilename As String) As Long

Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Private Declare Function RegCreateKeyEx Lib "advapi32.dll" Alias "RegCreateKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal Reserved As Long, ByVal lpClass As String, ByVal dwOptions As Long, ByVal samDesired As Long, ByVal lpSecurityAttributes As Long, phkResult As Long, lpdwDisposition As Long) As Long
Private Declare Function RegEnumValue Lib "advapi32.dll" Alias "RegEnumValueA" (ByVal hKey As Long, ByVal dwIndex As Long, ByVal lpValueName As String, lpcbValueName As Long, ByVal lpReserved As Long, lpType As Long, ByVal lpData As String, lpcbData As Long) As Long
Private Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, phkResult As Long) As Long

Private Declare Function RegQueryValueExString Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, ByVal lpData As String, lpcbData As Long) As Long
Private Declare Function RegQueryValueExLong Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, lpData As Long, lpcbData As Long) As Long
Private Declare Function RegQueryValueExNULL Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, ByVal lpData As Long, lpcbData As Long) As Long
Private Declare Function RegSetValueExString Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, ByVal lpValue As String, ByVal cbData As Long) As Long
Private Declare Function RegSetValueExLong Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, lpValue As Long, ByVal cbData As Long) As Long

' Reg Data Types...
Private Const REG_NONE = 0                       ' No value type
Private Const REG_SZ = 1                         ' Unicode nul terminated string
Private Const REG_EXPAND_SZ = 2                  ' Unicode nul terminated string
Private Const REG_BINARY = 3                     ' Free form binary
Private Const REG_DWORD = 4                      ' 32-bit number
Private Const REG_DWORD_LITTLE_ENDIAN = 4        ' 32-bit number (same as REG_DWORD)
Private Const REG_DWORD_BIG_ENDIAN = 5           ' 32-bit number
Private Const REG_LINK = 6                       ' Symbolic Link (unicode)
Private Const REG_MULTI_SZ = 7                   ' Multiple Unicode strings
Private Const REG_RESOURCE_LIST = 8              ' Resource list in the resource map
Private Const REG_FULL_RESOURCE_DESCRIPTOR = 9   ' Resource list in the hardware description

Private Const HKEY_CLASSES_ROOT = &H80000000
Private Const HKEY_CURRENT_USER = &H80000001
Private Const HKEY_LOCAL_MACHINE = &H80000002
Private Const HKEY_USERS = &H80000003

Private Const ERROR_NONE = 0
Private Const ERROR_BADDB = 1
Private Const ERROR_BADKEY = 2
Private Const ERROR_CANTOPEN = 3
Private Const ERROR_CANTREAD = 4
Private Const ERROR_CANTWRITE = 5
Private Const ERROR_OUTOFMEMORY = 6
Private Const ERROR_INVALID_PARAMETER = 7
Private Const ERROR_ACCESS_DENIED = 8
Private Const ERROR_INVALID_PARAMETERS = 87
Private Const ERROR_NO_MORE_ITEMS = 259

Private Const KEY_ALL_ACCESS = &H3F

Private Const SYNCHRONIZE = &H100000
Private Const STANDARD_RIGHTS_ALL = &H1F0000
' Reg Key Security Options
Private Const KEY_QUERY_VALUE = &H1
Private Const KEY_SET_VALUE = &H2
Private Const KEY_CREATE_SUB_KEY = &H4
Private Const KEY_ENUMERATE_SUB_KEYS = &H8
Private Const KEY_NOTIFY = &H10
Private Const KEY_CREATE_LINK = &H20
'private const KEY_ALL_ACCESS = ((STANDARD_RIGHTS_ALL Or KEY_QUERY_VALUE Or KEY_SET_VALUE Or KEY_CREATE_SUB_KEY Or KEY_ENUMERATE_SUB_KEYS Or KEY_NOTIFY Or KEY_CREATE_LINK) And (Not SYNCHRONIZE))

Private Const REG_OPTION_NON_VOLATILE = 0

Public Enum AngDiff
    ENUM_ANGDIFF_SHORTEST = 1
    ENUM_ANGDIFF_LONGEST = 2
    ENUM_ANGDIFF_CLOCKWISE = 3
    ENUM_ANGDIFF_CNTCLOCKWISE = 4
End Enum


''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'Windows type used to call the Net API
Private Const MAX_PREFERRED_LENGTH As Long = -1
Private Const NERR_SUCCESS As Long = 0&
Private Const ERROR_MORE_DATA As Long = 234&

Private Const SV_TYPE_WORKSTATION         As Long = &H1
Private Const SV_TYPE_SERVER              As Long = &H2
Private Const SV_TYPE_SQLSERVER           As Long = &H4
Private Const SV_TYPE_DOMAIN_CTRL         As Long = &H8
Private Const SV_TYPE_DOMAIN_BAKCTRL      As Long = &H10
Private Const SV_TYPE_TIME_SOURCE         As Long = &H20
Private Const SV_TYPE_AFP                 As Long = &H40
Private Const SV_TYPE_NOVELL              As Long = &H80
Private Const SV_TYPE_DOMAIN_MEMBER       As Long = &H100
Private Const SV_TYPE_PRINTQ_SERVER       As Long = &H200
Private Const SV_TYPE_DIALIN_SERVER       As Long = &H400
Private Const SV_TYPE_XENIX_SERVER        As Long = &H800
Private Const SV_TYPE_SERVER_UNIX         As Long = SV_TYPE_XENIX_SERVER
Private Const SV_TYPE_NT                  As Long = &H1000
Private Const SV_TYPE_WFW                 As Long = &H2000
Private Const SV_TYPE_SERVER_MFPN         As Long = &H4000
Private Const SV_TYPE_SERVER_NT           As Long = &H8000
Private Const SV_TYPE_POTENTIAL_BROWSER   As Long = &H10000
Private Const SV_TYPE_BACKUP_BROWSER      As Long = &H20000
Private Const SV_TYPE_MASTER_BROWSER      As Long = &H40000
Private Const SV_TYPE_DOMAIN_MASTER       As Long = &H80000
Private Const SV_TYPE_SERVER_OSF          As Long = &H100000
Private Const SV_TYPE_SERVER_VMS          As Long = &H200000
Private Const SV_TYPE_WINDOWS             As Long = &H400000  'Windows95 and above
Private Const SV_TYPE_DFS                 As Long = &H800000  'Root of a DFS tree
Private Const SV_TYPE_CLUSTER_NT          As Long = &H1000000 'NT Cluster
Private Const SV_TYPE_TERMINALSERVER      As Long = &H2000000 'Terminal Server
Private Const SV_TYPE_DCE                 As Long = &H10000000 'IBM DSS
Private Const SV_TYPE_ALTERNATE_XPORT     As Long = &H20000000 'rtn alternate transport
Private Const SV_TYPE_LOCAL_LIST_ONLY     As Long = &H40000000 'rtn local only
Private Const SV_TYPE_DOMAIN_ENUM         As Long = &H80000000
Private Const SV_TYPE_ALL                 As Long = &HFFFFFFFF

Private Const SV_PLATFORM_ID_OS2       As Long = 400
Private Const SV_PLATFORM_ID_NT        As Long = 500

'Mask applied to svX_version_major in
'order to obtain the major version number.
Private Const MAJOR_VERSION_MASK        As Long = &HF

Private Type SERVER_INFO_100
  sv100_platform_id As Long
  sv100_name As Long
End Type

Private Declare Function NetServerEnum Lib "netapi32" (ByVal servername As Long, ByVal level As Long, buf As Any, ByVal prefmaxlen As Long, entriesread As Long, totalentries As Long, ByVal servertype As Long, ByVal domain As Long, resume_handle As Long) As Long
Private Declare Function NetApiBufferFree Lib "netapi32" (ByVal buffer As Long) As Long


'This is the public constant for the TAB key.
'Use the API Text Viewer to find the key you want to use.
Public Enum ENUM_ASCII_KEYS
     'WM_KEYUP/DOWN/CHAR HIWORD(lParam) flags
     KF_EXTENDED = &H100
     KF_DLGMODE = &H800
     KF_MENUMODE = &H1000
     KF_ALTDOWN = &H2000
     KF_REPEAT = &H4000
     KF_UP = &H8000
    
     'Virtual Keys, Standard Set
     VK_LBUTTON = &H1
     VK_RBUTTON = &H2
     VK_CANCEL = &H3
     VK_MBUTTON = &H4 'NOT contiguous with L RBUTTON
    
     VK_BACK = &H8
     VK_TAB = &H9
    
     VK_CLEAR = &HC
     VK_RETURN = &HD
    
     VK_SHIFT = &H10
     VK_CONTROL = &H11
     VK_MENU = &H12
     VK_PAUSE = &H13
     VK_CAPITAL = &H14
    
     VK_ESCAPE = &H1B
    
     VK_SPACE = &H20
     VK_PRIOR = &H21
     VK_NEXT = &H22
     VK_END = &H23
     VK_HOME = &H24
     VK_LEFT = &H25
     VK_UP = &H26
     VK_RIGHT = &H27
     VK_DOWN = &H28
     VK_SELECT = &H29
     VK_PRINT = &H2A
     VK_EXECUTE = &H2B
     VK_SNAPSHOT = &H2C
     VK_INSERT = &H2D
     VK_DELETE = &H2E
     VK_HELP = &H2F
    
     'VK_A thru VK_Z are the same as their ASCII equivalents: 'A' thru 'Z'
     'VK_0 thru VK_9 are the same as their ASCII equivalents: '0' thru '9'
     VK_NUMPAD0 = &H60
     VK_NUMPAD1 = &H61
     VK_NUMPAD2 = &H62
     VK_NUMPAD3 = &H63
     VK_NUMPAD4 = &H64
     VK_NUMPAD5 = &H65
     VK_NUMPAD6 = &H66
     VK_NUMPAD7 = &H67
     VK_NUMPAD8 = &H68
     VK_NUMPAD9 = &H69
     VK_MULTIPLY = &H6A
     VK_ADD = &H6B
     VK_SEPARATOR = &H6C
     VK_SUBTRACT = &H6D
     VK_DECIMAL = &H6E
     VK_DIVIDE = &H6F

     VK_TILDIE = 192
     VK_BACKSLASH = 220
     
     VK_F1 = &H70
     VK_F2 = &H71
     VK_F3 = &H72
     VK_F4 = &H73
     VK_F5 = &H74
     VK_F6 = &H75
     VK_F7 = &H76
     VK_F8 = &H77
     VK_F9 = &H78
     VK_F10 = &H79
     VK_F11 = &H7A
     VK_F12 = &H7B
     VK_F13 = &H7C
     VK_F14 = &H7D
     VK_F15 = &H7E
     VK_F16 = &H7F
     VK_F17 = &H80
     VK_F18 = &H81
     VK_F19 = &H82
     VK_F20 = &H83
     VK_F21 = &H84
     VK_F22 = &H85
     VK_F23 = &H86
     VK_F24 = &H87
    
     VK_NUMLOCK = &H90
     VK_SCROLL = &H91
    
     'VK_L VK_R - left and right Alt, Ctrl and Shift virtual keys.
     'Used only as parameters to GetAsyncKeyState() and GetKeyState().
     'No other API or message will distinguish left and right keys in this way.
     VK_LSHIFT = &HA0
     VK_RSHIFT = &HA1
     VK_LCONTROL = &HA2
     VK_RCONTROL = &HA3
     VK_LMENU = &HA4
     VK_RMENU = &HA5
    
     VK_ATTN = &HF6
     VK_CRSEL = &HF7
     VK_EXSEL = &HF8
     VK_EREOF = &HF9
     VK_PLAY = &HFA
     VK_ZOOM = &HFB
     VK_NONAME = &HFC
     VK_PA1 = &HFD
     VK_OEM_CLEAR = &HFE
End Enum


'Windows type used to call the Net API
Private Const LB_SETTABSTOPS As Long = &H192


'shi2_current_uses: number of current connections to the resource
'shi2_max_uses    : max concurrent connections resource can accommodate
'shi2_netname     : share name of a resource
'shi2_passwd      : share's password when
'                  (server running with share-level security)
'shi2_path        : local path for the shared resource
'shi2_permissions : shared resource's permissions
'                  (servers running with share-level security)
'shi2_remark      : string containing optional comment about the resource
'shi2_type        : the type of the shared resource
Private Type SHARE_INFO_2
  shi2_netname       As Long
  shi2_type          As Long
  shi2_remark        As Long
  shi2_permissions   As Long
  shi2_max_uses      As Long
  shi2_current_uses  As Long
  shi2_path          As Long
  shi2_passwd        As Long
End Type

Private Type SHARE_INFO_0
  shi2_netname       As Long
End Type

Private Declare Function WNetAddConnection2 Lib "mpr" Alias "WNetAddConnection2A" (lpNetResource As NETRESOURCE, ByVal lpPassword As String, ByVal lpUserName As String, ByVal dwFlags As Long) As Long
Private Declare Function WNetCancelConnection2 Lib "mpr" Alias "WNetCancelConnection2A" (ByVal lpName As String, ByVal dwFlags As Long, ByVal fForce As Long) As Long
       
Private Type NETRESOURCE
   dwScope       As Long
   dwType        As Long
   dwDisplayType As Long
   dwUsage       As Long
   lpLocalName   As String
   lpRemoteName  As String
   lpComment     As String
   lpProvider    As String
End Type

Private Const ERROR_SUCCESS = 0
Private Const CONNECT_UPDATE_PROFILE = &H1
Private Const RESOURCETYPE_DISK = &H1
Private Const RESOURCETYPE_PRINT = &H2
Private Const RESOURCETYPE_ANY = &H0
Private Const RESOURCE_GLOBALNET = &H2
Private Const RESOURCEDISPLAYTYPE_SHARE = &H3
Private Const RESOURCEUSAGE_CONNECTABLE = &H1

Private Declare Function NetShareEnum Lib "netapi32" (ByVal servername As Long, ByVal level As Long, bufptr As Long, ByVal prefmaxlen As Long, entriesread As Long, totalentries As Long, resume_handle As Long) As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Private Declare Function GetExitCodeProcess Lib "kernel32" (ByVal hProcess As Long, lpExitCode As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long

Private Const PROCESS_QUERY_INFORMATION = &H400
Private Const STATUS_PENDING = &H103&


'For IsNT & Install Font
Private Type OSVERSIONINFO
    dwOSVersionInfoSize As Long
    dwMajorVersion As Long
    dwMinorVersion As Long
    dwBuildNumber As Long
    dwPlatformId As Long
    szCSDVersion As String
    ' Maintenance string for PSS usage
End Type

Private Declare Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Declare Function AddFontResource32 Lib "gdi32" Alias "AddFontResourceA" (ByVal lpFilename As String) As Long
Private Declare Function CreateScalableFontResource32 Lib "gdi32" Alias "CreateScalableFontResourceA" (ByVal fHidden As Long, ByVal lpszResourceFile As String, ByVal lpszFontFile As String, ByVal lpszCurrentPath As String) As Long
Private Declare Function RemoveFontResource Lib "gdi32" Alias "RemoveFontResourceA" (ByVal lpFilename As String) As Long
Private Declare Function GetWindowsDirectory Lib "kernel32" Alias "GetWindowsDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
Private Declare Function GetSystemDirectory32 Lib "kernel32" Alias "GetWindowsDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
Private Declare Function RegSetValueEx Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, lpData As Any, ByVal cbData As Long) As Long
Private Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Private Declare Function RegDeleteValue Lib "advapi32.dll" Alias "RegDeleteValueA" (ByVal hKey As Long, ByVal lpValueName As String) As Long
Private Declare Function GetVersionEx Lib "kernel32" Alias "GetVersionExA" (lpVersionInformation As OSVERSIONINFO) As Long
Private Declare Function CopyFile Lib "kernel32" Alias "CopyFileA" (ByVal lpExistingFileName As String, ByVal lpNewFileName As String, ByVal bFailIfExists As Long) As Long
        
Private Const VER_PLATFORM_WIN32_NT = 2
Private Const HWND_BROADCAST = &HFFFF&
Private Const WM_FONTCHANGE = &H1D


Private Const HWND_TOPMOST& = -1
Private Const HWND_NOTOPMOST = -2
Private Const SWP_NOMOVE& = &H2
Private Const SWP_NOSIZE& = &H1
Private 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)


''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Graphic mipulation functions
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    'Background pasting API
    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    Private Declare Function GetDC Lib "user32" (ByVal hWnd As Long) As Long
    Private Declare Function GetDesktopWindow Lib "user32" () As Long
    Private Declare Function ReleaseDC Lib "user32" (ByVal hWnd As Long, ByVal hdc As Long) As Long

    ' ------------------------
    ' Bitmap Array Information
    ' ------------------------
    Private Type RGBTriplet
        rgbBlue As Byte
        rgbGreen As Byte
        rgbRed As Byte
    End Type

    Private Declare Function GetBitmapBits Lib "gdi32" (ByVal hBitmap As Long, ByVal dwCount As Long, lpBits As Any) As Long
    Private Declare Function SetBitmapBits Lib "gdi32" (ByVal hBitmap As Long, ByVal dwCount As Long, lpBits As Any) As Long
    Private Declare Function GetObject Lib "gdi32" Alias "GetObjectA" (ByVal hObject As Long, ByVal nCount As Long, lpObject As Any) As Long

    Public Enum bmphErrors
        bmphInvalidBitmapBits = vbObjectError + 1001
        bmphPaletteError
    End Enum

    ' -------------------
    ' Palette Information
    ' -------------------
    Private Type PALETTEENTRY
        peRed As Byte
        peGreen As Byte
        peBlue As Byte
        peFlags As Byte
    End Type
    Private Declare Function GetNearestPaletteIndex Lib "gdi32" (ByVal hPalette As Long, ByVal crColor As Long) As Long
    Private Declare Function GetPaletteEntries Lib "gdi32" (ByVal hPalette As Long, ByVal wStartIndex As Long, ByVal wNumEntries As Long, lpPaletteEntries As PALETTEENTRY) As Long
    Private Declare Function RealizePalette Lib "gdi32" (ByVal hdc As Long) As Long
    Private Declare Function GetSystemPaletteEntries Lib "gdi32" (ByVal hdc As Long, ByVal wStartIndex As Long, ByVal wNumEntries As Long, lpPaletteEntries As PALETTEENTRY) As Long
    Private Declare Function ResizePalette Lib "gdi32" (ByVal hPalette As Long, ByVal nNumEntries As Long) As Long
    Private Declare Function SetPaletteEntries Lib "gdi32" (ByVal hPalette As Long, ByVal wStartIndex As Long, ByVal wNumEntries As Long, lpPaletteEntries As PALETTEENTRY) As Long
    Private Const MAX_PALETTE_SIZE = 256
    Private Const PC_NOCOLLAPSE = &H4    ' Do not match color existing entries.
    
    ' -------------------------------
    ' System Capabilities Information
    ' -------------------------------
    Private Declare Function GetDeviceCaps Lib "gdi32" (ByVal hdc As Long, ByVal nIndex As Long) As Long
    Private Const NUMRESERVED = 106  ' Number of reserved entries in system palette.
    Private Const SIZEPALETTE = 104  ' Size of system palette.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''




'EX: Call StayOnTop(Me)
Function StayOnTop(oForm As Object, Optional bOnTop As Boolean = True)

    Dim lFlags As Long
    Dim lStay As Long

    lFlags = SWP_NOSIZE Or SWP_NOMOVE
    
    If bOnTop = True Then
        lStay = SetWindowPos(oForm.hWnd, HWND_TOPMOST, 0, 0, 0, 0, lFlags)
    Else
        lStay = SetWindowPos(oForm.hWnd, HWND_NOTOPMOST, 0, 0, 0, 0, lFlags)
    End If

End Function

Public Sub Copy(sSourceFileName As String, sTargetFilename As String, Optional bFailIfExists As Boolean = True)
    Dim nVal As Long
    If bFailIfExists = True Then
        nVal = 1
    Else
        nVal = 0
    End If
    Call CopyFile(sSourceFileName, sTargetFilename, nVal)
End Sub

Public Sub Add32Font(sFileName As String, Optional bCopyFont As Boolean = True)

    Dim lResult As Long
    Dim strFontPath As String, strFontname As String
    Dim hKey As Long
    Dim nMaxPath As Long
    
    nMaxPath = 260
    
    'This is the font name and path
    strFontPath = Space$(nMaxPath)
    strFontname = right(sFileName, Len(sFileName) - InStrRev(sFileName, "\"))

    If IsNT() Then
        'Windows NT - Call and get the path to the \windows\system directory
        lResult = GetWindowsDirectory(strFontPath, nMaxPath)
        If lResult <> 0 Then Mid$(strFontPath, lResult + 1, 1) = "\"
        strFontPath = RTrim$(strFontPath) & "Fonts\"
    Else
        'Win95 - Call and get the path to the \windows\fonts directory
        lResult = GetWindowsDirectory(strFontPath, nMaxPath)
        If lResult <> 0 Then
            Mid$(strFontPath, lResult + 1) = "\fonts\"
        End If
        strFontPath = RTrim$(strFontPath)
    End If
    
    'Copy the font to the specified directory
    If bCopyFont = True Then
        Call CopyFile(sFileName, strFontPath + strFontname, 1)
    End If
    
    'This Actually adds the font to the system's available fonts for this windows session
    lResult = AddFontResource32(strFontPath + strFontname)
    If lResult = 0 Then
        Call Err.Raise(-1, "FOTATools.clsFunctions.Add32Font", "Error Occured Calling AddFontResource")
    End If
    
    'Write the registry value to permanently install the font
    lResult = RegOpenKey(HKEY_LOCAL_MACHINE, "software\microsoft\windows\currentversion\fonts", hKey)
    lResult = RegSetValueEx(hKey, "Proscape Font " & strFontname & " (TrueType)", 0, REG_SZ, ByVal strFontname, Len(strFontname))
    lResult = RegCloseKey(hKey)
    'This call broadcasts a message to let all top-level
    'windows know that a font change has occured so they can reload their font list
    lResult = PostMessage(HWND_BROADCAST, WM_FONTCHANGE, 0, 0)
    
End Sub

Public Function IsNT() As Boolean

    Dim lResult As Long
    Dim vi As OSVERSIONINFO
    
    vi.dwOSVersionInfoSize = Len(vi)
    lResult = GetVersionEx(vi)

    IsNT = (vi.dwPlatformId And VER_PLATFORM_WIN32_NT)
    
End Function

Public Function TimerToTime(dTimer As Double) As String
    
    Dim nH As Long
    Dim nM As Long
    Dim nS As Long
    
    nH = Fix(dTimer / 3600)
    nM = Fix((dTimer - nH * 3600) / 60)
    nS = dTimer - nH * 3600 - nM * 60
    
    TimerToTime = TimeSerial(nH, nM, nS)

End Function

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' DB Functions
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Public Function GetDBVersion(oDB As ADODB.Connection, _
                Optional sColumnName As String = "nDBVersion", Optional sTableName As String = "DBInfo") As Long

    Dim i As Long
    Dim rstTmp As ADODB.Recordset
    Dim bFound As Boolean
    
    'Now we setup error checking for trying to read the version
    Set rstTmp = OpenMyRset(oDB, "SELECT " & sColumnName & " FROM " & sTableName)
    
    bFound = False
    For i = 0 To rstTmp.Fields.Count
        If rstTmp.Fields(i).Name = sColumnName Then
            GetDBVersion = rstTmp.Fields(i).Value
            bFound = True
            Exit For
        End If
    Next i
    If bFound = False Then
        Call Err.Raise(-1, "GetDBVersion", "Unable to locate " & sColumnName & " in " & sTableName & ".  Ordinal referance failed.")
    End If

End Function

Public Function OpenDB(sFileName As String) As ADODB.Connection
    
    Dim nErrNum As Long
    Dim b351Errored As Boolean
    Dim sErrSource As String
    Dim sErrDesc As String
    Dim sConnectionString As String
    Dim rstTmp As ADODB.Recordset
    Dim nUpgradeFrom As Long
    nUpgradeFrom = 1
    Set OpenDB = New ADODB.Connection

    'Ok this gets confusing....  First of all we will try to open the DB as a Jet 3.51 DB.
    On Error GoTo Jet351_Failed
    'Try to open it
    sConnectionString = "Provider=Microsoft.JET.OLEDB.3.51;Data Source=" & sFileName
    Call OpenDB.Open(sConnectionString)
    'We only get to this goto if the open command worked
    GoTo DBOpened
    'Oops, this means we got an error
Jet40:
    'Setup a normal error handler so if an error happens we don't jump back to Jet 4.0
    On Error GoTo Jet40_Failed
    'Now try to open the DB with Jet 4.0
    sConnectionString = "Provider=Microsoft.JET.OLEDB.4.0;Data Source=" & sFileName
    Call OpenDB.Open(sConnectionString)
    
    'Yea we got the damn db open!
DBOpened:
        
    Exit Function
Jet351_Failed:
    If Err.Number = 3706 Then 'This is the provider not found message.
        GoTo Jet40
    Else
        nErrNum = Err.Number
        sErrSource = Err.Source
        sErrDesc = Err.Description
        b351Errored = True
        GoTo Jet40
    End If

    Exit Function
Jet40_Failed:
    If b351Errored = False Then
        Call Err.Raise(Err.Number, Err.Source, Err.Description)
    Else
        Call Err.Raise(nErrNum, sErrSource, sErrDesc)
    End If

End Function

Public Function OpenMyRset(dbDatabase As ADODB.Connection, sSQL As String) As ADODB.Recordset

    Dim oRSetReturn As New ADODB.Recordset

    oRSetReturn.CursorLocation = ADODB.adUseClient
    oRSetReturn.CursorType = ADODB.adOpenKeyset

    oRSetReturn.LockType = ADODB.adLockOptimistic
    Call oRSetReturn.Open(sSQL, dbDatabase, oRSetReturn.CursorType, ADODB.adLockUnspecified, ADODB.adCmdText)
    Set OpenMyRset = oRSetReturn

End Function
Public Function GetTableIndex(dbDatabase As ADODB.Connection, sTableName As String) As Long

    Dim rstSchema As ADODB.Recordset
    Dim nIndex As Long
    GetTableIndex = -1
    
    Set rstSchema = dbDatabase.OpenSchema(adSchemaTables)
        
    nIndex = 0
    While rstSchema.EOF() = False
        If rstSchema![TABLE_NAME] = sTableName Then
            GetTableIndex = nIndex
        End If
            
        nIndex = nIndex + 1
        Call rstSchema.MoveNext
    Wend

End Function
Public Function GetFieldIndex(dbDatabase As ADODB.Connection, sTableName As String, sFieldName As String) As Long

    Dim rstSchema As ADODB.Recordset
    Dim nIndex As Long
    GetFieldIndex = -1
    
    If GetTableIndex(dbDatabase, sTableName) > -1 Then
    
        Set rstSchema = OpenMyRset(dbDatabase, "SELECT * FROM " & sTableName)
        For nIndex = 0 To rstSchema.Fields.Count - 1
            If rstSchema.Fields(nIndex).Name = sFieldName Then
                GetFieldIndex = nIndex
            End If
        Next nIndex
    Else
        GetFieldIndex = -1
    End If
    
End Function
Public Function GetFieldIndexFromRecordset(rstTable As ADODB.Recordset, sFieldName As String) As Long

    Dim nIndex As Long
    GetFieldIndexFromRecordset = -1
    
    nIndex = 0
    For nIndex = 0 To rstTable.Fields.Count
        If rstTable.Fields(nIndex).Name = sFieldName Then
            GetFieldIndexFromRecordset = nIndex
            Exit For
        End If
    Next nIndex

End Function

Public Function SaveToRecordSet(oObject As Object, rstRecordset As ADODB.Recordset, _
                                Optional nTrimOffFirstXCharsOfDBColumnName As Long = 0)
    
    On Error Resume Next
    
    Dim nIndex As Long
    Dim sName As String
    Dim vValue As Variant
    
    For nIndex = 0 To rstRecordset.Fields.Count - 1
        sName = rstRecordset.Fields(nIndex).Name
        sName = Mid(sName, nTrimOffFirstXCharsOfDBColumnName + 1)
        If CBool(rstRecordset.Fields(nIndex).Attributes And adFldUpdatable) = True Then
            vValue = CallByName(oObject, sName, VbGet)
            rstRecordset.Fields(nIndex).Value = vValue
        End If
    Next nIndex

End Function

Public Function LoadFromRecordSet(oObject As Object, rstRecordset As ADODB.Recordset, Optional nTrimOffFirstXCharsOfDBColumnName As Long = 0)
    
    On Error GoTo ErrorHandler
    
    Dim nIndex As Long
    Dim sName As String
    Dim sValue As String
    
    For nIndex = 0 To rstRecordset.Fields.Count - 1
        sName = rstRecordset.Fields(nIndex).Name
        sName = Mid(sName, nTrimOffFirstXCharsOfDBColumnName + 1)
        sValue = IfNotNull(rstRecordset.Fields(nIndex).Value, "")
        
        'Boolean values
        If rstRecordset.Fields(nIndex).Type = adBoolean Then  'A Boolean value (DBTYPE_BOOL).
            Call CallByName(oObject, sName, VbLet, CBool(sValue))
        'Double values
        ElseIf rstRecordset.Fields(nIndex).Type = adDouble Or _
               rstRecordset.Fields(nIndex).Type = adDecimal Or _
               rstRecordset.Fields(nIndex).Type = adSingle Then
                    Call CallByName(oObject, sName, VbLet, CDbl(sValue))
        'Integer values
        ElseIf rstRecordset.Fields(nIndex).Type = adInteger Or _
               rstRecordset.Fields(nIndex).Type = adSmallInt Or _
               rstRecordset.Fields(nIndex).Type = adTinyInt Or _
               rstRecordset.Fields(nIndex).Type = adUnsignedBigInt Or _
               rstRecordset.Fields(nIndex).Type = adUnsignedInt Or _
               rstRecordset.Fields(nIndex).Type = adUnsignedSmallInt Or _
               rstRecordset.Fields(nIndex).Type = adUnsignedTinyInt Or _
               rstRecordset.Fields(nIndex).Type = adBigInt Then
                    Call CallByName(oObject, sName, VbLet, CInt(sValue))
        'String values
        ElseIf rstRecordset.Fields(nIndex).Type = adVarChar Or _
               rstRecordset.Fields(nIndex).Type = adChar Or _
               rstRecordset.Fields(nIndex).Type = adLongVarChar Or _
               rstRecordset.Fields(nIndex).Type = adLongVarWChar Or _
               rstRecordset.Fields(nIndex).Type = adBSTR Then
                    Call CallByName(oObject, sName, VbLet, sValue)
        'Unknown values
        ElseIf rstRecordset.Fields(nIndex).Type = adBinary Or _
               rstRecordset.Fields(nIndex).Type = adCurrency Or _
               rstRecordset.Fields(nIndex).Type = adDate Or _
               rstRecordset.Fields(nIndex).Type = adDBDate Or _
               rstRecordset.Fields(nIndex).Type = adDBTime Or _
               rstRecordset.Fields(nIndex).Type = adDBTimeStamp Or _
               rstRecordset.Fields(nIndex).Type = adEmpty Or _
               rstRecordset.Fields(nIndex).Type = adError Or _
               rstRecordset.Fields(nIndex).Type = adGUID Or _
               rstRecordset.Fields(nIndex).Type = adIDispatch Or _
               rstRecordset.Fields(nIndex).Type = adIUnknown Or _
               rstRecordset.Fields(nIndex).Type = adLongVarBinary Or _
               rstRecordset.Fields(nIndex).Type = adNumeric Or _
               rstRecordset.Fields(nIndex).Type = adUserDefined Or _
               rstRecordset.Fields(nIndex).Type = adVarBinary Or _
               rstRecordset.Fields(nIndex).Type = adVariant Or _
               rstRecordset.Fields(nIndex).Type = adVarWChar Or _
               rstRecordset.Fields(nIndex).Type = adWChar Then
                    Call Err.Raise(-1, "FOTATools.LoadFromRecordSet", "data type returned from recordset is not currently supported")
        Else
            Call Err.Raise(-1, "FOTATools.LoadFromRecordSet", "Unknown data type returned from recordset")
        End If
    Next nIndex

    Exit Function
ErrorHandler:
    If Err.Number = -1 Then
        Call Err.Raise(Err.Number, Err.Source, Err.Description)
    ElseIf Err.Number = 438 Then
        Call Err.Raise(Err.Number, Err.Source, "Object doesn't support method '" & sName & "'")
    Else
        Resume Next
    End If

End Function

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Public Function RandomDbl(nMin As Double, nMax As Double) As Double
    If nMax < nMin Then
        Call Err.Raise(-1, "FOTATools.Random", "Min value must be smaller than max value")
    Else
        RandomDbl = ((nMax - nMin) * Rnd) + nMin
    End If
End Function

Public Function Random(nMin As Long, nMax As Long, Optional bRandomize As Boolean = True) As Long

    Static bBeenHereBefore As Boolean
    
    If bBeenHereBefore = False And bRandomize = True Then
        Call Randomize
    End If

    If nMax < nMin Then
        Call Err.Raise(-1, "FOTATools.Random", "Min value must be smaller than max value")
    Else
        Random = Int(((nMax - nMin + 1) * Rnd) + nMin)
    End If
End Function

Public Function Ping(sAddress As String) As Boolean
    Ping = SystemPing(sAddress)
End Function

Public Sub RestoreFormBackgroundColors(oForm As Object, oOriginalColors As Object)
    
    Dim i As Long
    Dim sTemp As String
    
    For i = 0 To oForm.Controls.Count - 1

        If TypeOf oForm.Controls(i) Is CommandButton Or _
           TypeOf oForm.Controls(i) Is Label Or _
           TypeOf oForm.Controls(i) Is CheckBox Or _
           TypeOf oForm.Controls(i) Is SSTab Or _
           TypeOf oForm.Controls(i) Is Frame Then
                sTemp = oForm.Controls(i).Name & GetControlsIndex(oForm.Controls(i))
                If oOriginalColors.KeyInList("Index:" & sTemp) = True Then
                    oForm.Controls(i).BackColor = oOriginalColors.GetTextForKey("Index:" & sTemp)
                End If
        End If
    Next i
    
    oForm.BackColor = oOriginalColors.GetTextForKey("Index: <FormBackColor>")
    
End Sub

Public Function AlterFormBackgroundColors(oForm As Object, nDeltaRed As Long, nDeltaGreen As Long, nDeltaBlue As Long) As Object
    
    Dim oOldBackColors As clsFOTAArray
    Dim i As Long
    Dim sTemp As String
    Dim nRed As Long, nGreen As Long, nBlue As Long
    
    Set oOldBackColors = New clsFOTAArray
    For i = 0 To oForm.Controls.Count - 1
        If TypeOf oForm.Controls(i) Is CommandButton Or _
           TypeOf oForm.Controls(i) Is Label Or _
           TypeOf oForm.Controls(i) Is CheckBox Or _
           TypeOf oForm.Controls(i) Is SSTab Or _
           TypeOf oForm.Controls(i) Is Frame Then
                sTemp = oForm.Controls(i).Name & GetControlsIndex(oForm.Controls(i))
                Call oOldBackColors.Add(oForm.Controls(i).BackColor, "Index:" & sTemp)
                Call RGBToRedGreenBlue(oForm.Controls(i).BackColor, nRed, nGreen, nBlue)
                oForm.Controls(i).BackColor = RGB(Min(nRed + nDeltaRed, 255), _
                                                  Min(nGreen + nDeltaGreen, 255), _
                                                  Min(nBlue + nDeltaBlue, 255))
        End If
    Next i
    
    Call oOldBackColors.Add(oForm.BackColor, "Index: <FormBackColor>")
    Call RGBToRedGreenBlue(oForm.BackColor, nRed, nGreen, nBlue)
    oForm.BackColor = RGB(Min(nRed + nDeltaRed, 255), _
                          Min(nGreen + nDeltaGreen, 255), _
                          Min(nBlue + nDeltaBlue, 255))
    
    Set AlterFormBackgroundColors = oOldBackColors
    
End Function

Public Function GetControlsIndex(oControl As Object) As Long

    GetControlsIndex = -1
    On Error Resume Next
    GetControlsIndex = oControl.Index
            
End Function

'If the high-order bit is 1, the key is down; otherwise, it is up.
'If the low-order bit is 1, the key is toggled. A key, such as the CAPS LOCK key, is toggled if it is turned on. The key is off and untoggled if the low-order bit is 0. A toggle key’s indicator light (if any) on the keyboard will be on when the key is toggled, and off when the key is untoggled.
Public Function KeyPressed(nKey As ENUM_ASCII_KEYS, _
                           Optional ByRef rbKeyIsToggled As Boolean) As Boolean
                    
    Dim nResult As Long
    'nResult = GetAsyncKeyState(nKey)
    nResult = GetKeyState(nKey)
    
    rbKeyIsToggled = ((nResult And &H1) = &H1)
    KeyPressed = ((nResult And &H80) = &H80)

End Function


Public Function IsBoolean(vValue As Variant) As Boolean
    IsBoolean = (Trim(UCase(vValue)) = "TRUE" Or Trim(UCase(vValue)) = "FALSE")
End Function
Public Function IsAlpha(sValue As String) As Boolean

    Dim i As Long
    Dim sChar As String
    IsAlpha = True
    
    For i = 1 To Len(sValue)
        sChar = Mid(sValue, i, 1)
        IsAlpha = (IsAlpha And _
                    ( _
                     (Asc(sChar) >= Asc("A") And Asc(sChar) <= Asc("Z")) Or _
                     (Asc(sChar) >= Asc("a") And Asc(sChar) <= Asc("z")) _
                    ) _
                  )
    Next i

End Function

Public Function Vec(nX As Double, nY As Double) As clsFOTAVector2D
    Set Vec = New clsFOTAVector2D
    Vec.X = nX
    Vec.Y = nY
End Function

Public Sub Rotate(nAngleInDegrees As Double, nXRelativeToCenterOfRotation As Double, nYRelativeToCenterOfRotation As Double, _
                  ByRef nRotatedX As Double, ByRef nRotatedY As Double)

'tX2 = X+vertx*Cos(Angle) - verty*Cos(Angle-90);
'tY2 = Y+vertx*Sin(Angle) - verty*Sin(Angle-90);

    'nRotatedX = DegCos(nAngleInDegrees) * nXRelativeToCenterOfRotation - DegSin(nAngleInDegrees + 90) * nYRelativeToCenterOfRotation
    'nRotatedY = DegSin(nAngleInDegrees) * nYRelativeToCenterOfRotation + DegCos(nAngleInDegrees + 90) * nXRelativeToCenterOfRotation
    nRotatedX = nXRelativeToCenterOfRotation * DegCos(nAngleInDegrees) - _
                nYRelativeToCenterOfRotation * DegCos(nAngleInDegrees - 90)
    nRotatedY = nXRelativeToCenterOfRotation * DegSin(nAngleInDegrees) - _
                nYRelativeToCenterOfRotation * DegSin(nAngleInDegrees - 90)

End Sub
Public Function ParseString(sString As String, sDivider As String, nOneBasedSegmentYouWant As Long) As String

    Dim sRemStr As String
    Dim nWhere As Long
    Dim nCountDown As Long
    
    nWhere = InStr(1, sString, sDivider)
    nCountDown = nOneBasedSegmentYouWant
    sRemStr = sString
    
    While nCountDown > 0
    
        If nCountDown = 1 And nWhere = 0 Then
            ParseString = sRemStr
            sRemStr = ""
        Else
            If nWhere = 0 Then
                ParseString = ""
                sRemStr = ""
                nCountDown = 0
            Else
                ParseString = left(sRemStr, nWhere - 1)
                sRemStr = Mid(sRemStr, nWhere + Len(sDivider))
                nWhere = InStr(1, sRemStr, sDivider)
            End If
        End If
        
        nCountDown = nCountDown - 1
    Wend

End Function

Public Function VKeyToString(nKey As Long) As String
    
    Dim sTemp As String

    Select Case nKey
        'WM_KEYUP/DOWN/CHAR HIWORD(lParam) flags
        Case KF_EXTENDED
            sTemp = "Extended"
        Case KF_DLGMODE
            sTemp = "DlgMode"
        Case KF_MENUMODE      ' &H1000
            sTemp = "MenuMode"
        Case KF_ALTDOWN ' &H2000
            sTemp = "Alt"
        Case KF_REPEAT ' &H4000
            sTemp = "Repeat"
        Case KF_UP ' &H8000
            sTemp = "Up"

        'Virtual Keys, Standard Set
        Case VK_LBUTTON ' &H1
            sTemp = "Left Mouse Button"
        Case VK_RBUTTON ' &H2
            sTemp = "Right Mouse Button"
        Case VK_CANCEL ' &H3
            sTemp = "Cancel"
        Case VK_MBUTTON ' &H4 'NOT contiguous with L RBUTTON
            sTemp = "Middle Mouse Button"

        Case VK_BACK ' &H8
            sTemp = "Backspace"
        Case VK_TAB ' &H9
            sTemp = "Tab"

        Case VK_CLEAR ' &HC
            sTemp = "Center"
        Case VK_RETURN ' &HD
            sTemp = "Return"

        Case VK_SHIFT ' &H10
            sTemp = "Shift"
        Case VK_CONTROL ' &H11
            sTemp = "Ctrl"
        Case VK_MENU ' &H12
            sTemp = "Alt"
        Case VK_PAUSE ' &H13
            sTemp = "Pause"
        Case VK_CAPITAL ' &H14
            sTemp = "Caps Lock"

        Case VK_ESCAPE ' &H1B
            sTemp = "Esc"

        Case VK_SPACE ' &H20
            sTemp = "Spacebar"
        Case VK_PRIOR ' &H21
            sTemp = "Page Up"
        Case VK_NEXT ' &H22
            sTemp = "Page Down"
        Case VK_END ' &H23
            sTemp = "End"
        Case VK_HOME ' &H24
            sTemp = "Home"
        Case VK_LEFT ' &H25
            sTemp = "Left Arrow"
        Case VK_UP ' &H26
            sTemp = "Up Arrow"
        Case VK_RIGHT ' &H27
            sTemp = "Right Arrow"
        Case VK_DOWN ' &H28
            sTemp = "Down Arrow"
        Case VK_SELECT ' &H29
            sTemp = "Select"
        Case VK_PRINT ' &H2A
            sTemp = "Print"
        Case VK_EXECUTE ' &H2B
            sTemp = "Execute"
        Case VK_SNAPSHOT ' &H2C
            sTemp = "Snapshot"
        Case VK_INSERT ' &H2D
            sTemp = "Insert"
        Case VK_DELETE ' &H2E
            sTemp = "Delete"
        Case VK_HELP ' &H2F
            sTemp = "Help"

        'VK_A thru    VK_Z are the same as their ASCII equivalents: 'A' thru 'Z'
        'VK_0 thru    VK_9 are the same as their ASCII equivalents: '0' thru '9'
        Case Asc("A") To Asc("Z")
            sTemp = Chr(nKey)
        Case Asc("0") To Asc("9")
            sTemp = Chr(nKey)
            
        Case VK_NUMPAD0 ' &H60
            sTemp = "Numpad0"
        Case VK_NUMPAD1 ' &H61
            sTemp = "Numpad1"
        Case VK_NUMPAD2 ' &H62
            sTemp = "Numpad2"
        Case VK_NUMPAD3 ' &H63
            sTemp = "Numpad3"
        Case VK_NUMPAD4 ' &H64
            sTemp = "Numpad4"
        Case VK_NUMPAD5 ' &H65
            sTemp = "Numpad5"
        Case VK_NUMPAD6 ' &H66
            sTemp = "Numpad6"
        Case VK_NUMPAD7 ' &H67
            sTemp = "Numpad7"
        Case VK_NUMPAD8 ' &H68
            sTemp = "Numpad8"
        Case VK_NUMPAD9 ' &H69
            sTemp = "Numpad9"
        Case VK_MULTIPLY ' &H6A
            sTemp = "Multiply"
        Case VK_ADD ' &H6B
            sTemp = "Add"
        Case VK_SEPARATOR ' &H6C
            sTemp = "Seperator"
        Case VK_SUBTRACT ' &H6D
            sTemp = "Subtract"
        Case VK_DECIMAL ' &H6E
            sTemp = "Period"
        Case VK_DIVIDE ' &H6F
            sTemp = "Divide"

        Case VK_TILDIE ' 192
            sTemp = "Tildie"
        Case VK_BACKSLASH ' 220
            sTemp = "Backslash"

        Case VK_F1 ' &H70
            sTemp = "F1"
        Case VK_F2 ' &H71
            sTemp = "F2"
        Case VK_F3 ' &H72
            sTemp = "F3"
        Case VK_F4 ' &H73
            sTemp = "F4"
        Case VK_F5 ' &H74
            sTemp = "F5"
        Case VK_F6 ' &H75
            sTemp = "F6"
        Case VK_F7 ' &H76
            sTemp = "F7"
        Case VK_F8 ' &H77
            sTemp = "F8"
        Case VK_F9 ' &H78
            sTemp = "F9"
        Case VK_F10 ' &H79
            sTemp = "F10"
        Case VK_F11 ' &H7A
            sTemp = "F11"
        Case VK_F12 ' &H7B
            sTemp = "F12"
        Case VK_F13 ' &H7C
            sTemp = "F13"
        Case VK_F14 ' &H7D
            sTemp = "F14"
        Case VK_F15 ' &H7E
            sTemp = "F15"
        Case VK_F16 ' &H7F
            sTemp = "F16"
        Case VK_F17 ' &H80
            sTemp = "F17"
        Case VK_F18 ' &H81
            sTemp = "F18"
        Case VK_F19 ' &H82
            sTemp = "F19"
        Case VK_F20 ' &H83
            sTemp = "F20"
        Case VK_F21 ' &H84
            sTemp = "F21"
        Case VK_F22 ' &H85
            sTemp = "F22"
        Case VK_F23 ' &H86
            sTemp = "F23"
        Case VK_F24 ' &H87
            sTemp = "F24"

        Case VK_NUMLOCK ' &H90
            sTemp = "Num Lock"
        Case VK_SCROLL ' &H91
            sTemp = "Scroll Lock"

        'VK_L, VK_R - left and right Alt, Ctrl and Shift virtual keys.
        'Used only as parameters to GetAsyncKeyState() and GetKeyState().
        'No other API or message will distinguish left and right keys in this way.
        Case VK_LSHIFT ' &HA0
            sTemp = "Left Shift"
        Case VK_RSHIFT ' &HA1
            sTemp = "Right Shift"
        Case VK_LCONTROL ' &HA2
            sTemp = "Left Ctrl"
        Case VK_RCONTROL ' &HA3
            sTemp = "Right Ctrl"
        Case VK_LMENU ' &HA4
            sTemp = "Left Alt"
        Case VK_RMENU ' &HA5
            sTemp = "Right Alt"

        Case VK_ATTN ' &HF6
            sTemp = "ATTN"
        Case VK_CRSEL ' &HF7
            sTemp = "CRSEL"
        Case VK_EXSEL ' &HF8
            sTemp = "EXSEL"
        Case VK_EREOF ' &HF9
            sTemp = "EREOF"
        Case VK_PLAY ' &HFA
            sTemp = "Play"
        Case VK_ZOOM ' &HFB
            sTemp = "Zoom"
        Case VK_NONAME ' &HFC
            sTemp = "NoName"
        Case VK_PA1 ' &HFD
            sTemp = "PA1"
        Case VK_OEM_CLEAR ' &HFE
            sTemp = "Clear"
        Case Else
            Call Err.Raise(-1, "FOTATools.VKeyToString", "Key <" & nKey & "> is not recognized")
    End Select

    VKeyToString = sTemp

End Function


'Full RTF text from a standard RichTextBox.  [ and ] are not part of it.
'[{\fonttbl{\f0\fswiss MS Sans Serif;}{\f1\froman\fcharset2 Symbol;}{\f2\fmodern Courier New;}{\f3\fswiss Arial;}{\f4\fnil\fcharset2 MS Sans Serif;}{\f5\fnil\fcharset2 Times New Roman;}{\f6\fswiss Arial;}}
'{\colortbl\red0\green0\blue0;\red0\green0\blue255;}
'\deflang1033\pard\plain\f3\fs18\cf1 hi\plain\f3\fs18
'\par }
']
Public Function TextToRTF(stext As String, nColor As Long, _
            Optional oFont As StdFont = Nothing, Optional bNewLine As Boolean = True) As String
    
    Dim bWasAtEnd As Boolean
    Dim nStartSel As Long
    Dim nRed As Long
    Dim nGreen As Long
    Dim nBlue As Long
    Dim sTemp As String
    Dim sNewText As String
    Dim oFunc As New clsFunctions
    
    If oFont Is Nothing Then
        Set oFont = New StdFont
    End If

    'Now add the message
    Call RGBToRedGreenBlue(nColor, nRed, nGreen, nBlue)
    
    sTemp = "{\rtf1\ansi\deff0\deftab720" & _
            "{\fonttbl{\f0\fcharset2 " & oFont.Name & ";}}" & _
            "{\colortbl\red" & nRed & "\green" & nGreen & "\blue" & nBlue & ";}" & _
            "\deflang1033\pard\plain\cf0\f0\fs" & CLng(oFont.Size + 9)
    
    If oFont.Bold = True Then sTemp = sTemp & "\b" 'Bold
    If oFont.Italic = True Then sTemp = sTemp & "\i" 'Italic
    If oFont.Strikethrough = True Then sTemp = sTemp & "\strike"  'StrikeThru
    If oFont.Underline = True Then sTemp = sTemp & "\ul" 'Underline
        
    'Swap out all the new lines with the RTF equivilant
    sNewText = oFunc.SearchAndReplace(stext, Chr(13) + Chr(10), "\par ")
    'Now add in the last remaining bit of RTF formatting.
    sTemp = sTemp & " " & sNewText & "\plain\f3\fs18" & Chr(13) + Chr(10) & "\par }" & Chr(13) + Chr(10)
    'Newline or not?
    If bNewLine = True Then
        sTemp = "{" & sTemp & "\par}"
    Else
        sTemp = sTemp
    End If
   
    TextToRTF = sTemp
    
End Function


Public Function BoolToCheckBox(bNewVal As Variant) As Long
    If IsNull(bNewVal) = True Then
        BoolToCheckBox = vbGrayed
    ElseIf bNewVal = True Then
        BoolToCheckBox = vbChecked
    ElseIf bNewVal = False Then
        BoolToCheckBox = vbUnchecked
    Else
        Call Err.Raise(-1, "clsFunctions.BoolToCheckBox", "Illegal value passed in.")
    End If
End Function
Public Function CheckBoxToBool(nVal As Long) As Variant
    If nVal = vbGrayed Then
        CheckBoxToBool = Null
    ElseIf nVal = vbChecked Then
        CheckBoxToBool = True
    ElseIf nVal = vbUnchecked Then
        CheckBoxToBool = False
    Else
        Call Err.Raise(-1, "clsFunctions.CheckBoxToBool", "Illegal value passed in.")
    End If
End Function
Public Sub ShowAboutBox(sHeader As String, Optional bDebugOn As Boolean = False, Optional ByRef sSecret As String = "")
    Dim sSec As String
    Dim bDeb As Boolean
    sSec = sSecret
    bDeb = bDebugOn
    Call frmAbout.DisplayMe(sHeader, bDeb, sSec)
    bDebugOn = bDeb
    sSecret = sSec
End Sub

'Returns true if a file was deleted
Public Function DeleteFileIfExists(sFileName As String) As Boolean
    DeleteFileIfExists = False
    If Len(Dir(sFileName)) > 0 Then
        Call DeleteFile(sFileName)
    End If
End Function

Public Function Between(vMin As Variant, vNumber As Variant, vMax As Variant) As Variant
    Between = Max(vMin, vNumber)
    Between = Min(vMax, Between)
End Function

Public Function Max(vVal1 As Variant, vVal2 As Variant) As Variant
    If vVal1 > vVal2 Then
        Max = vVal1
    Else
        Max = vVal2
    End If
End Function
Public Function Min(vVal1 As Variant, vVal2 As Variant) As Variant
    If vVal1 < vVal2 Then
        Min = vVal1
    Else
        Min = vVal2
    End If
End Function
Public Sub RGBToRedGreenBlue(nRGB As Long, ByRef nRed As Long, ByRef nGreen As Long, ByRef nBlue As Long)
    nRed = nRGB And (2 ^ 0 + 2 ^ 1 + 2 ^ 2 + 2 ^ 3 + 2 ^ 4 + 2 ^ 5 + 2 ^ 6 + 2 ^ 7)
    nGreen = (nRGB And (2 ^ 8 + 2 ^ 9 + 2 ^ 10 + 2 ^ 11 + 2 ^ 12 + 2 ^ 13 + 2 ^ 14 + 2 ^ 15)) / (2 ^ 8)
    nBlue = (nRGB And (2 ^ 16 + 2 ^ 17 + 2 ^ 18 + 2 ^ 19 + 2 ^ 20 + 2 ^ 21 + 2 ^ 22 + 2 ^ 23)) / (2 ^ 16)
End Sub
Public Function GetPath(sFileName As String)

    Dim nWhere As Long
    
    nWhere = InStrRev(sFileName, "\")
    
    If nWhere > 0 Then
        GetPath = left(Trim(sFileName), nWhere - 1)
    Else
        GetPath = sFileName
    End If

End Function
Public Function DoesFileExist(sFileName As String) As Boolean
        
    Dim nFile As Long
    nFile = FreeFile

    On Error GoTo FileDoesNotExist
        
        Open sFileName For Input As #nFile
        Close #nFile

        DoesFileExist = True
        
    Exit Function
FileDoesNotExist:
    DoesFileExist = False
                
End Function

Public Function GetGUID(Optional sPreface As String = "None") As String
    Static nLastIDUsed As Long
    nLastIDUsed = nLastIDUsed + 1
    GetGUID = "<" & sPreface & ":" & Timer & "," & Int((10000 * Rnd) + 1) & "," & nLastIDUsed & ">"
End Function
Public Function CalcAngleDiff(nAngle1 As Double, nAngle2 As Double, Optional nDiffType As AngDiff = ENUM_ANGDIFF_SHORTEST) As Double

    Dim nClkWise As Double, nCntClkWise As Double

    If nAngle2 < nAngle1 Then
        nClkWise = 360 - nAngle1 + nAngle2
    Else
        nClkWise = nAngle2 - nAngle1
    End If
    nCntClkWise = 360 - nClkWise

    If nDiffType = ENUM_ANGDIFF_SHORTEST Then
        CalcAngleDiff = Min(nClkWise, nCntClkWise)
    ElseIf nDiffType = ENUM_ANGDIFF_LONGEST Then
        CalcAngleDiff = Max(nClkWise, nCntClkWise)
    ElseIf nDiffType = ENUM_ANGDIFF_CLOCKWISE Then
        CalcAngleDiff = nClkWise
    ElseIf nDiffType = ENUM_ANGDIFF_CNTCLOCKWISE Then
        CalcAngleDiff = nCntClkWise
    End If

End Function
Public Function CalcLawSinesAng(nA As Double, nB As Double, nDegAngA As Double)
    CalcLawSinesAng = (DegSin(nDegAngA) / nA) * nB
End Function
Public Function CalcLawSinesSide(nA As Double, nDegAngA As Double, nDegAngB As Double)
    CalcLawSinesSide = DegSin(nDegAngB) / (DegSin(nDegAngA) / nA)
End Function
Public Function CalcAngle(nX1 As Variant, nY1 As Variant, nX2 As Variant, nY2 As Variant) As Variant

   Dim nDx As Double
   Dim nDy As Double

   nDx = nX1 - nX2
   nDy = nY1 - nY2

       If nDx = 0 Then
           If nDy < 0 Then
               CalcAngle = 0
           Else
               CalcAngle = 180
           End If
   ElseIf nDy = 0 Then
           If nDx < 0 Then
               CalcAngle = 270
           Else
               CalcAngle = 90
           End If
   ElseIf nDx > 0 And nDy < 0 Then
           CalcAngle = DegArcTan(nDx / Abs(nDy)) 'Quadrent 1
   ElseIf nDx > 0 And nDy > 0 Then
           CalcAngle = DegArcTan(nDy / nDx) + 90 'Quadrent 2
   ElseIf nDx < 0 And nDy > 0 Then
           CalcAngle = DegArcTan(Abs(nDx) / nDy) + 180 'Quadrent 3
   ElseIf nDx < 0 And nDy < 0 Then
           CalcAngle = DegArcTan(Abs(nDy) / Abs(nDx)) + 270 'Quadrent 4
   End If
   
End Function
Public Sub SetFormEnabled(bEnabled As Boolean, oForm As Object)
    'Some controls may not have enabled properties
    On Error Resume Next
    
    Dim i As Long
    For i = 0 To oForm.Controls.Count
        Call SetAttributes(oForm.Controls(i), bEnabled)
        oForm.Controls(i).Enabled = bEnabled
    Next i
End Sub
Public Function IfNotNull(vNullCheck As Variant, vIsNull As Variant) As Variant
    If IsNull(vNullCheck) = False Then
        IfNotNull = vNullCheck
    Else
        IfNotNull = vIsNull
    End If
End Function
Public Function IfNumeric(vNumericCheck As Variant, vIsNotNumeric As Variant) As Variant
    If IsNumeric(vNumericCheck) = True Then
        IfNumeric = vNumericCheck
    Else
        IfNumeric = vIsNotNumeric
    End If
End Function
Public Function Distance(vX1 As Variant, vY1 As Variant, vX2 As Variant, vY2 As Variant) As Double
    Distance = Sqr(Square(vX1 - vX2) + Square(vY1 - vY2))
End Function
Public Function HexDistance(vX1 As Variant, vY1 As Variant, vX2 As Variant, vY2 As Variant) As Double
    HexDistance = Sqr(Square(vX1 - vX2) + Square(vY1 - vY2))
    If Abs(vX2 - vX1) <= Abs(vY2 - vY1) And vY2 <= vY1 And vX1 <> vX2 Then
        HexDistance = HexDistance + 1
    End If
End Function
Public Function Square(vVal As Variant) As Variant
    Square = vVal * vVal
End Function
Public Function ArcCos(vX As Variant) As Variant
    If Sqr(-vX * vX + 1) > -0.00001 And Sqr(-vX * vX + 1) < 0.00001 Then
        ArcCos = Atn(0) + 2 * Atn(1)
    Else
        ArcCos = Atn(-vX / Sqr(-vX * vX + 1)) + 2 * Atn(1)
    End If
End Function
Public Function DegArcCos(vX As Variant) As Variant
    If Sqr(-vX * vX + 1) > -0.00001 And Sqr(-vX * vX + 1) < 0.00001 Then
        DegArcCos = Atn(0) + 2 * Atn(1)
    Else
        DegArcCos = Atn(-vX / Sqr(-vX * vX + 1)) + 2 * Atn(1)
    End If
    DegArcCos = DegArcCos * (180 / PI)
End Function
Public Function DegArcTan(vX As Variant) As Variant
    DegArcTan = Atn(vX) * (180 / PI)
End Function
Public Function DegCos(degree As Variant) As Variant
    DegCos = Cos(degree * (PI / 180))
End Function
Public Function DegSin(vDegree As Variant) As Variant
    DegSin = sIn(vDegree * (PI / 180))
End Function
Public Function DegTan(vDegree As Variant) As Variant
    DegTan = Tan(vDegree * (PI / 180))
End Function

Public Function SearchAndReplace(sIn As String, sFind As String, sRepl As String, Optional bCaseInsensative As Boolean = False) As String
    
    Dim sRetVal As String
    Dim nWhere As Long
    Dim nFound As Long
    
    sRetVal = sIn
    nWhere = 1
    
    If Len(sFind) > 0 Then
    
        If bCaseInsensative = False Then
        
            'Now replace them all
            While InStr(nWhere, sRetVal, sFind) > 0
                nFound = InStr(nWhere, sRetVal, sFind)
                sRetVal = left(sRetVal, nFound - 1) & _
                          sRepl & _
                          Mid(sRetVal, nFound + Len(sFind))
                nWhere = nFound + Len(sRepl)
            Wend
            
        Else
        
            'Now replace them all
            While InStr(nWhere, UCase(sRetVal), UCase(sFind)) > 0
                nFound = InStr(nWhere, UCase(sRetVal), UCase(sFind))
                sRetVal = left(sRetVal, nFound - 1) & _
                          sRepl & _
                          Mid(sRetVal, nFound + Len(sFind))
                nWhere = nFound + Len(sRepl)
            Wend
            
        End If
    End If

    SearchAndReplace = sRetVal

End Function
    
Public Function IsFormOpen(colForms As Object, sFormName As String) As Boolean
    
    Dim i As Long
    IsFormOpen = False

    'Add the player to the dm listing if it is open!
    For i = 0 To colForms.Count - 1
        If colForms(i).Name = sFormName Then
            IsFormOpen = True
            Exit Function
        End If
    Next i

End Function

'Convert a False True value to 1 or 0
Public Function BoolToInt(bValue As Boolean) As Long
    BoolToInt = Abs(CInt(bValue))
End Function 'End of BoolToInt

'This function takes a number and padds it.  Thats because out messages are
'field length delimited, not comma delmited.
Public Function Pad(vVal As Variant, sPad As String, nLen As Long, Optional bLeftPad As Long = True) As String

    'Is the pad length zero?  Crash the program.
    If Len(sPad) = 0 Then
        'Raise an error... though this is a programmer fault
        Call Err.Raise(1000, "Pad:Programmer", "Pad Length Zero")
    Else
        'Turn the number into a string
        Pad = Trim(vVal)
        'As long as we have more space concatinate more pads
        While Len(Pad) < nLen
            'Add a pad
            If bLeftPad = True Then
                Pad = sPad & Pad
            Else
                Pad = Pad & sPad
            End If
        Wend
        
    End If 'End of Pad length check

End Function ' End of Pad
Public Function GetTabs(nCount As Long) As String

    Dim i As Long
    
    If nCount > 0 Then
        GetTabs = Chr(9)
        For i = 2 To nCount
            GetTabs = GetTabs & Chr(9)
        Next i
    End If

End Function
Public Function DeSerializeFont(sFont As String) As StdFont
    
    On Error GoTo ErrorHandler

    Set DeSerializeFont = New StdFont
    DeSerializeFont.Bold = (Mid(sFont, 1, 1) = 1)
    DeSerializeFont.Italic = (Mid(sFont, 2, 1) = 1)
    DeSerializeFont.Size = Mid(sFont, 3, 2)
    DeSerializeFont.Strikethrough = (Mid(sFont, 5, 1) = 1)
    DeSerializeFont.Underline = (Mid(sFont, 6, 1) = 1)
    DeSerializeFont.Name = Mid(sFont, 7)
    
    Exit Function
ErrorHandler:
    
End Function
Public Function SerializeFont(oFont As StdFont) As String
    
    SerializeFont = BoolToInt(oFont.Bold) & _
                    BoolToInt(oFont.Italic) & _
                    Pad(oFont.Size, " ", 2) & _
                    BoolToInt(oFont.Strikethrough) & _
                    BoolToInt(oFont.Underline) & _
                    oFont.Name
                    
End Function
Public Function GetFont(sName As String, Optional nSize As Double, _
                        Optional bBold As Boolean = False, _
                        Optional bItalic As Boolean = False, _
                        Optional bStrikeThru As Boolean = False, _
                        Optional bUnderline As Boolean = False) As StdFont

    Set GetFont = New StdFont
    GetFont.Name = sName
    GetFont.Size = nSize
    GetFont.Bold = bBold
    GetFont.Italic = bItalic
    GetFont.Strikethrough = bStrikeThru
    GetFont.Underline = bUnderline

End Function
Private Sub CreateNewKey(sNewKeyName As String, lPredefinedKey As Long)

    Dim hNewKey As Long         'handle to the new key
    Dim lRetVal As Long         'result of the RegCreateKeyEx function
    
    lRetVal = RegCreateKeyEx(lPredefinedKey, sNewKeyName, 0&, _
              "", REG_OPTION_NON_VOLATILE, KEY_ALL_ACCESS, _
              0&, hNewKey, lRetVal)
    RegCloseKey (hNewKey)
    
End Sub

Private Sub SetKeyValue(sKeyName As String, sValueName As String, vValueSetting As Variant, lValueType As Long)

    Dim Zero As Long, IRetVal As Long, hKey As Long, OrigKeyNam As String
    
'    OrigKeyNam = Left$(sKeyName, InStr(sKeyName + "\", "\") - 1)
    
     'open the specified key
    IRetVal = RegOpenKeyEx(HKEY_CURRENT_USER, sKeyName, Zero, KEY_ALL_ACCESS, hKey)
    If IRetVal Then MsgBox "RegOpenKey error - " & IRetVal
    IRetVal = SetValueEx(hKey, sValueName, lValueType, vValueSetting)
    If IRetVal Then MsgBox "SetValue error - " & IRetVal
    RegCloseKey (hKey)
    
End Sub

Private Sub QueryValue(sKeyName As String, sValueName As String)

    Dim lRetVal As Long         'result of the API functions
    Dim hKey As Long         'handle of opened key
    Dim vValue As Variant      'setting of queried value

    lRetVal = RegOpenKeyEx(HKEY_CURRENT_USER, sKeyName, 0, KEY_ALL_ACCESS, hKey)
    lRetVal = QueryValueEx(hKey, sValueName, vValue)
    Call MsgBox(vValue)
    Call RegCloseKey(hKey)

End Sub
Private Function SetValueEx(ByVal hKey As Long, sValueName As String, lType As Long, vValue As Variant) As Long

    Dim lValue As Long
    Dim sValue As String
    
    Select Case lType
        Case REG_SZ
            sValue = vValue & Chr$(0)
            SetValueEx = RegSetValueExString(hKey, sValueName, 0&, lType, sValue, Len(sValue))
        Case REG_DWORD
            lValue = vValue
            SetValueEx = RegSetValueExLong(hKey, sValueName, 0&, lType, lValue, 4)
    End Select
    
End Function
Private Function QueryValueEx(ByVal lhKey As Long, ByVal szValueName As String, vValue As Variant) As Long

    Dim cch As Long
    Dim lrc As Long
    Dim lType As Long
    Dim lValue As Long
    Dim sValue As String

    On Error GoTo QueryValueExError

    ' Determine the size and type of data to be read
    lrc = RegQueryValueExNULL(lhKey, szValueName, 0&, lType, 0&, cch)
    'If lrc <> ERROR_NONE Then Error 5
    Select Case lType
        ' For strings
        Case REG_SZ:
            sValue = String(cch, 0)
            lrc = RegQueryValueExString(lhKey, szValueName, 0&, lType, sValue, cch)
            If lrc = ERROR_NONE Then
                vValue = left$(sValue, cch)
            Else
                vValue = Empty
            End If
        ' For DWORDS
        Case REG_DWORD:
            lrc = RegQueryValueExLong(lhKey, szValueName, 0&, lType, lValue, cch)
            If lrc = ERROR_NONE Then vValue = lValue
        Case Else
            'all other data types not supported
            lrc = -1
    End Select
QueryValueExExit:
    QueryValueEx = lrc
    Exit Function
QueryValueExError:
    Resume QueryValueExExit
    
End Function
'Get the value from the registry, if its not there set it to the default
Public Function GetRegistryValue(sKey As String, strWhich As String, Optional strDefault As String = "") As String
    
    Dim hKey As Long
    Dim sValue As String

    'Open the key
    Call RegOpenKeyEx(HKEY_CURRENT_USER, "SOFTWARE\FOTA\" & sKey, 0, KEY_ALL_ACCESS, hKey)
        'Query the value
        Call QueryValueEx(hKey, strWhich, sValue)
        sValue = Trim(SearchAndReplace(sValue, Chr(0), " "))
    'Close the key
    Call RegCloseKey(hKey)
            
    'Did they return anything?
    If Len(sValue) = 0 And Len(strDefault) > 0 Then
        GetRegistryValue = strDefault
    Else
        GetRegistryValue = sValue
    End If
    
End Function ' End of GetRegistryValue
Public Sub SetRegistryValue(sDirKey As String, strWhich As String, strValue As String)
    
    Dim sKey As String
    Dim hKey As Long

    'Create key structure in case it doesn't exist
    sKey = "SOFTWARE\FOTA"
        Call CreateNewKey(sKey, HKEY_CURRENT_USER)
    sKey = sKey & "\" & sDirKey
        Call CreateNewKey(sKey, HKEY_CURRENT_USER)
        
    'Open the registry key
    Call RegOpenKeyEx(HKEY_CURRENT_USER, sKey, 0, KEY_ALL_ACCESS, hKey)
        'Set the new key value
        Call SetValueEx(hKey, strWhich, REG_SZ, strValue)
    'Close the registry key
    Call RegCloseKey(hKey)

End Sub 'End of SetRegistryValue
'''Is this text in the list box?
''Public Function IsInListBox(lstBox As Control, sStr As String) As Boolean
''
''    '''''On Error GoTo ErrorHandler
''    Dim sRoutineName As String
''    sRoutineName = cFRMNAME & ".IsInListBox"
''    Call WriteProcStart(sRoutineName, lstBox.Name, sStr)
''
''
''    Dim i As Long
''    'Tell them by default we found nothing
''    IsInListBox = False
''
''    'Are their any enteries?
''    If lstBox.ListCount > 0 Then
''        'Step through every player in the list box
''        For i = 0 To lstBox.ListCount - 1
''            'Does this players ID match the one were deleting?
''            If sStr = lstBox.List(i) Then
''                'Record that we removed them
''                IsInListBox = True
''                'Exit Function
''            End If
''        Next i 'Move to the next player
''    End If
''
''
''    Call WriteProcStop(sRoutineName, IsInListBox)
''    'Exit the sub... on an error we will jump over this function
''    Exit Function
''ErrorHandler:
''    Call ErrorTrapper(sRoutineName)
''
''End Function
''
'''Remove a name from a list box where the id matches the item data.  Return weather
'''or not we removed anyone.
''Public Function ListViewRemove(lstView As Control, nIDToRemove As Long) As Boolean
''
''    '''''On Error GoTo ErrorHandler
''    Dim sRoutineName As String
''    sRoutineName = cFRMNAME & ".ListViewRemove"
''    Call WriteProcStart(sRoutineName, lstView.Name, nIDToRemove)
''
''
''    Dim i As Long
''    'Tell them by default we found nothing
''    ListViewRemove = False
''
''    'Are their any enteries?
''    If lstView.ListItems.Count > 0 Then
''
''        'Step through every player in the list box
''        For i = 0 To lstView.ListItems.Count - 1
''
''            'If we remove items... the list box count will be off
''            If i >= lstView.ListItems.Count Then Exit For
''
''            'Does this players ID match the one were deleting?
''            If nIDToRemove = CLng(lstView.ListItems.Item(i).Key) Then
''                'Remove the now dead player from the game
''                lstView.ListItems.RemoveItem (i)
''                'Record that we removed them
''                ListViewRemove = True
''                i = i - 1
''            End If
''
''        Next i 'Move to the next player
''
''    End If
''
''
''    Call WriteProcStop(sRoutineName, ListViewRemove)
''    'Exit the sub... on an error we will jump over this function
''    Exit Function
''ErrorHandler:
''    Call ErrorTrapper(sRoutineName)
''
''End Function





''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''
'' Name generation functions
''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'Get a new random name
Public Function GenerateNewName(Optional bRandomize As Boolean = True) As String

    Dim nChance As Long
    Static bBeenHereBefore As Boolean
    
    If bBeenHereBefore = False And bRandomize = True Then
        Call Randomize
    End If
    
    'Calcualte a new vowel segment...  (100,33,11,4,1,0....)
    nChance = 100
    While Int((100 * Rnd) + 1) <= nChance
        GenerateNewName = GenerateNewName & GenNewSylabol
        nChance = nChance / 3
    Wend
    'Combine things
    GenerateNewName = UCase(GenNewCon) & GenerateNewName
End Function

'Get a new random sylabol
Private Function GenNewSylabol() As String
    Dim sVowel As String
    Dim sTrailer As String
    Dim nChance As Long
    
    'Calcualte a new vowel segment...  (100,25,6,1,0,0....)
    nChance = 100
    While Int((100 * Rnd) + 1) <= nChance
        sVowel = sVowel & GenNewVowel
        nChance = nChance / 4
    Wend
                    
    'Calcualte a new consanite segment...  (100,10,3,1,0,0....)
    nChance = 100
    While Int((100 * Rnd) + 1) <= nChance
        sTrailer = sTrailer & GenNewCon
        nChance = Sqr(nChance)
    Wend
                    
    'Combine them
    GenNewSylabol = sVowel & sTrailer
End Function
'Get a new random Vowel  a(97) e(101) i(105) o(111) u(117) y(121)
Private Function GenNewVowel() As String
    GenNewVowel = Mid(g_cVowels, Int((6 * Rnd) + 1), 1)
End Function
'Get a new random consanit
Private Function GenNewCon() As String
    GenNewCon = Mid(g_cConsan, Int((20 * Rnd) + 1), 1)
End Function

Public Function GetByteStringWFromPointer(ByVal dwData As Long) As String
  
   Dim tmp() As Byte
   Dim tmplen As Long
   
   If dwData <> 0 Then
      tmplen = lstrlenW(dwData) * 2
      If tmplen <> 0 Then
         ReDim tmp(0 To (tmplen - 1)) As Byte
         Call CopyMemory(tmp(0), ByVal dwData, tmplen)
         GetByteStringWFromPointer = tmp
     End If
   End If
    
End Function

' Convert an API error number to a descriptive string
' If any error it returns an empty string, in which case
' the Err.LastDllError property can be use to retrieve
' extended error information
Function SystemErrorDescription(ByVal ErrCode As Long) As String
    Dim buffer As String * 1024
    Dim ret As Long
    ' return value is the length of the result message
    ret = FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM, 0, ErrCode, 0, buffer, Len(buffer), 0)
    SystemErrorDescription = left$(buffer, ret)
End Function


'lists all servers of the specified type that are visible in a domain.
Public Function GetServers(sDomain As String, ByRef saServers() As String) As Long
  
   Dim bufptr          As Long
   Dim dwEntriesread   As Long
   Dim dwTotalentries  As Long
   Dim dwResumehandle  As Long
   Dim se100           As SERVER_INFO_100
   Dim success         As Long
   Dim nStructSize     As Long
   Dim cnt             As Long
   Dim saTemp() As String
   Dim i As Long

   nStructSize = LenB(se100)
   success = NetServerEnum(0&, _
                           100, _
                           bufptr, _
                           MAX_PREFERRED_LENGTH, _
                           dwEntriesread, _
                           dwTotalentries, _
                           SV_TYPE_ALL, _
                           StrPtr(sDomain), _
                           dwResumehandle)

    'if all goes well
    If success = NERR_SUCCESS And success <> ERROR_MORE_DATA Then
        ReDim saTemp(0 To dwEntriesread - 1) As String
        'loop through the returned data, adding each machine to the list
        For cnt = 0 To dwEntriesread - 1
            'get one chunk of data and cast into an SERVER_INFO_100 struct in order to add the name to a list
            Call CopyMemory(se100, ByVal bufptr + (nStructSize * cnt), nStructSize)
            saTemp(cnt) = GetByteStringWFromPointer(se100.sv100_name)
        Next
    End If
   
    'clean up regardless of success
    Call NetApiBufferFree(bufptr)
   
    'return entries as sign of success
    saServers = saTemp
    GetServers = success

End Function

Public Function GetShares(sComputer As String, ByRef saShares() As String) As Long

    Dim oFunc As New clsFunctions
    Dim bufptr          As Long  'output
    Dim dwServer        As Long  'pointer to the server
    Dim dwEntriesread   As Long  'out
    Dim dwTotalentries  As Long  'out
    Dim dwResumehandle  As Long  'out
    Dim success         As Long
    Dim nStructSize     As Long
    Dim cnt             As Long
    Dim usrname         As String
    Dim shi2            As SHARE_INFO_0
    Dim saTemp()      As String
     
   'create pointer to the machine name
   dwServer = StrPtr(sComputer)
   
   success = NetShareEnum(dwServer, _
                          0, _
                          bufptr, _
                          MAX_PREFERRED_LENGTH, _
                          dwEntriesread, _
                          dwTotalentries, _
                          dwResumehandle)
   
   If success = NERR_SUCCESS And success <> ERROR_MORE_DATA Then
      nStructSize = LenB(shi2)
      ReDim saTemp(0 To dwEntriesread - 1) As String
      For cnt = 0 To dwEntriesread - 1
        'get one chunk of data and cast into an SHARE_INFO_2 type, and
        'add the data to a list
         Call CopyMemory(shi2, ByVal bufptr + (nStructSize * cnt), nStructSize)
         saTemp(cnt) = GetByteStringWFromPointer(shi2.shi2_netname)
      Next
   End If
   
    Call NetApiBufferFree(bufptr)

    saShares = saTemp
    GetShares = success

End Function


Public Function ConnectNetworkDrive(sServerpath As String, sDriveLetter As String) As Long
   
    Dim NETR As NETRESOURCE
   
    NETR.dwScope = RESOURCE_GLOBALNET
    NETR.dwType = RESOURCETYPE_DISK
    NETR.dwDisplayType = RESOURCEDISPLAYTYPE_SHARE
    NETR.dwUsage = RESOURCEUSAGE_CONNECTABLE
    NETR.lpRemoteName = sServerpath
    NETR.lpLocalName = sDriveLetter
   
    ConnectNetworkDrive = WNetAddConnection2(NETR, vbNullString, vbNullString, 0)

End Function
Public Function DisconnectNetworkDrive(sDriveLetter As String) As Long
    DisconnectNetworkDrive = WNetCancelConnection2(sDriveLetter, CONNECT_UPDATE_PROFILE, True)
End Function

Public Sub RunShell(sCmdLine As String, Optional nWindowStatus As Long = vbNormalFocus)

    Dim hProcess As Long
    Dim ProcessId As Long
    Dim exitCode As Long

    ProcessId = Shell(sCmdLine, nWindowStatus)
    hProcess = OpenProcess(PROCESS_QUERY_INFORMATION, False, ProcessId)

    Do

        Call GetExitCodeProcess(hProcess, exitCode)
        DoEvents
   
    Loop While exitCode = STATUS_PENDING

    Call CloseHandle(hProcess)

End Sub
'(nIntersectX, nIntersectY) is the point where the lines defined by the segments intersect.
'(nLine1ClosestToX, nLine1ClosestToY) is the point on segment 1 that is closest to segment 2.
'(nLine2ClosestToX, nLine2ClosestToY) is the point on segment 2 that is closest to segment 1.
'
' If the lines are parallel function returns false.
' -------
' Method:
'
' Treat the lines as parametric where line 1 is:
'   X = nX11 + nDx1 * nT1
'   Y = nY11 + nDY1 * nT1
' and line 2 is:
'   X = nX21 + nDx2 * nT2
'   Y = nY21 + nDY2 * nT2
' Setting these equal gives:
'   nX11 + nDx1 * nT1 = nX21 + nDx2 * nT2
'   nY11 + nDY1 * nT1 = nY21 + nDY2 * nT2
' Rearranging:
'   nX11 - nX21 + nDx1 * nT1 = nDx2 * nT2
'   nY11 - nY21 + nDY1 * nT1 = nDY2 * nT2
'   (nX11 - nX21 + nDx1 * nT1) *   nDY2  = nDx2 * nT2 *   nDY2
'   (nY11 - nY21 + nDY1 * nT1) * (-nDx2) = nDY2 * nT2 * (-nDx2)
' Adding the equations gives:
'   (nX11 - nX21) * nDY2 + ( nDx1 * nDY2) * nT1 +
'   (nY21 - nY11) * nDx2 + (-nDY1 * nDx2) * nT1 = 0
' Solving for nT1 gives:
'   nT1 * (nDY1 * nDx2 - nDx1 * nDY2) = (nX11 - nX21) * nDY2 + (nY21 - nY11) * nDx2
'   nT1 = ((nX11 - nX21) * nDY2 + (nY21 - nY11) * nDx2) / (nDY1 * nDx2 - nDx1 * nDY2)
' Now solve for nT2.
' ----------
' Notes:
' If 0 <= nT1 <= 1, then the point lies on segment 1.
' If 0 <= nT2 <= 1, then the point lies on segment 1.
' If nDY1 * nDx2 - nDx1 * nDY2 = 0 then the lines are parallel.
'
' If the point of intersection is not on both segments, then this is almost certainly not the point where the two segments are closest.
'04/11/2002 Chris Hill  If this returns true they intersect
Public Function LineIntersect(ByVal nX11 As Double, ByVal nY11 As Double, _
                              ByVal nX12 As Double, ByVal nY12 As Double, _
                              ByVal nX21 As Double, ByVal nY21 As Double, _
                              ByVal nX22 As Double, ByVal nY22 As Double, _
                         ByRef nIntersectX As Double, ByRef nIntersectY As Double, _
                     Optional ByRef nLine1ClosestToX As Double, Optional ByRef nLine1ClosestToY As Double, _
                     Optional ByRef nLine2ClosestToX As Double, Optional ByRef nLine2ClosestToY As Double)

    Dim nDX1 As Double, nDY1 As Double
    Dim nDX2 As Double, nDY2 As Double
    Dim nT1 As Double, nT2 As Double
    Dim nDenominator As Double

    ' Get the segments' parameters.
    nDX1 = nX12 - nX11
    nDY1 = nY12 - nY11
    nDX2 = nX22 - nX21
    nDY2 = nY22 - nY21

    'Solve for nT1 and nT2.
    nDenominator = (nDY1 * nDX2 - nDX1 * nDY2)
    If nDenominator = 0 Then
        'The lines are parallel.
        LineIntersect = False
    Else
        LineIntersect = True
        
        nT1 = ((nX11 - nX21) * nDY2 + (nY21 - nY11) * nDX2) / nDenominator
        nT2 = ((nX21 - nX11) * nDY1 + (nY11 - nY21) * nDX1) / -nDenominator
    
        'Find the point of intersection.
        nIntersectX = nX11 + nDX1 * nT1
        nIntersectY = nY11 + nDY1 * nT1
    
        'Find the closest points on the segments.
        nT1 = Max(0, nT1) 'If nT1 < 0 Then nT1 = 0
        nT1 = Min(1, nT1) 'ElseIf nT1 > 1 Then nT1 = 1
        nT2 = Max(0, nT2) 'If nT2 < 0 Then nT2 = 0
        nT2 = Min(1, nT2) 'ElseIf nT2 > 1 Then nT2 = 1
        
        nLine1ClosestToX = nX11 + nDX1 * nT1
        nLine1ClosestToY = nY11 + nDY1 * nT1
        nLine2ClosestToX = nX21 + nDX2 * nT2
        nLine2ClosestToY = nY21 + nDY2 * nT2
        
    End If
    
End Function
Public Function DegToRad(vDegrees As Variant) As Variant
    DegToRad = vDegrees * (PI / 180)
End Function
Public Function RadToDeg(vRadians As Variant) As Variant
    RadToDeg = vRadians * (180 / PI)
End Function
Public Sub OpenWebBrowser(nFormHWND As Long, sURL As String)
      
    Dim sFileName As String, sDummy As String
    Dim sBrowserExec As String * 255
    Dim nRetVal As Long
    Dim nFreeFile As Integer

    'First, create a known, temporary HTML file
    sBrowserExec = Space(255)
    sFileName = App.Path & "\_TempHTM.HTM"
    nFreeFile = FreeFile                    ' Get unused file number
    Open sFileName For Output As #nFreeFile  ' Create temp HTML file
        Write #nFreeFile, "<HTML> <\HTML>"  ' Output text
    Close #nFreeFile                        ' Close file
    
    'Then find the application associated with it
    nRetVal = FindExecutable(sFileName, sDummy, sBrowserExec)
    sBrowserExec = Trim(sBrowserExec)
    
    ' If an application is found, launch it!
    If nRetVal <= 32 Or IsEmpty(sBrowserExec) Then ' Error
        Call Err.Raise(-1, "FOTATools.clsFunctions.OpenWebBrowser", "Could not find associated Browser")
    Else
        nRetVal = ShellExecute(nFormHWND, "open", sBrowserExec, sURL, sDummy, SW_SHOWNORMAL)
        If nRetVal <= 32 Then        ' Error
            Call Err.Raise(-1, "FOTATools.clsFunctions.OpenWebBrowser", "Web Page not Opened:" & Err.Description)
        End If
    End If
    Call Kill(sFileName)                    ' delete temp HTML file
    
End Sub

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'  SQL minipulation
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'0   = Null
'39  = ' (Escapeable with ')
'124 = | (Escapeable with \)
Public Function PrepareSQLValue(sValue As String, Optional bIsWrappedInTicks As Boolean = False) As String

    Dim sTempValue As String
    
    sTempValue = sValue
    If bIsWrappedInTicks = True Then
        sTempValue = Mid(sTempValue, 2, Len(sTempValue) - 2)
    End If
    
    sTempValue = SearchAndReplace(sTempValue, Chr(124), "\" & Chr(124))
    sTempValue = SearchAndReplace(sTempValue, Chr(39), Chr(39) & Chr(39))
    sTempValue = "'" & sTempValue & "'"
    
    PrepareSQLValue = sTempValue
    
End Function

Public Function Twords(nValue As Double, nChange As Double, nTargetValue As Double) As Double

    Dim nTemp As Double
    
    nTemp = nValue
    
    If nTemp < nTargetValue Then
        nTemp = Between(nTemp, nTemp + Abs(nChange), nTargetValue)
    Else
        nTemp = Between(nTargetValue, nTemp - Abs(nChange), nTemp)
    End If
    
    Twords = nTemp
    
End Function


Public Sub SetAttributes(oObj As Object, bValue As Boolean)
    
    On Error GoTo ErrorHandler
    Dim sRoutineName As String
    sRoutineName = "FOTATools.SetAttributes"
    '''''Call WriteProcStart(sRoutineName)
    

    oObj.Enabled = bValue
    
    If TypeOf oObj Is CheckBox Or _
       TypeOf oObj Is OptionButton Or _
       TypeOf oObj Is Frame Or _
       TypeOf oObj Is Label Or _
       TypeOf oObj Is SSTab Then
    Else
        If bValue = True Then
            oObj.BackColor = &H80000005
        Else
            oObj.BackColor = &H8000000F
        End If
    End If

    
    '''''Call WriteProcStop(sRoutineName)
    'Exit the sub... on an error we will jump over this function
    Exit Sub
ErrorHandler:
    Call Err.Raise(Err.Number, sRoutineName, Err.Description)
    
End Sub









'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Graphic minipulatioin functions
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Load the control's palette so it matches the system palette.
Private Sub MatchColorPalette(ByVal pic As PictureBox)
                                                                                                                        '<FOTA_ScreenSaver_Life_ADDER>
    Dim log_hpal As Long
    Dim sys_pal(0 To MAX_PALETTE_SIZE - 1) As PALETTEENTRY
    Dim orig_pal(0 To MAX_PALETTE_SIZE - 1) As PALETTEENTRY
    Dim i As Integer
    Dim sys_pal_size As Long
    Dim num_static_colors As Long
    Dim static_color_1 As Long
    Dim static_color_2 As Long

    ' Make sure pic has the foreground palette.
    pic.ZOrder
    RealizePalette pic.hdc
    DoEvents

    ' Get system palette size and # static colors.
    sys_pal_size = GetDeviceCaps(pic.hdc, SIZEPALETTE)
    num_static_colors = GetDeviceCaps(pic.hdc, NUMRESERVED)
    static_color_1 = num_static_colors \ 2 - 1
    static_color_2 = sys_pal_size - num_static_colors \ 2

    ' Get the system palette entries.
    GetSystemPaletteEntries pic.hdc, 0, _
        sys_pal_size, sys_pal(0)

    ' Make the logical palette as big as possible.
    log_hpal = pic.Picture.hpal
    If ResizePalette(log_hpal, sys_pal_size) = 0 Then
        Err.Raise bmphPaletteError, _
            "DDBHelper.MatchColorPalette", _
            "Error matching bitmap palette"
    End If

    ' Blank the non-static colors.
    For i = 0 To static_color_1
        orig_pal(i) = sys_pal(i)
    Next i
    For i = static_color_1 + 1 To static_color_2 - 1
        With orig_pal(i)
            .peRed = 0
            .peGreen = 0
            .peBlue = 0
            .peFlags = PC_NOCOLLAPSE
        End With
    Next i
    For i = static_color_2 To 255
        orig_pal(i) = sys_pal(i)
    Next i
    SetPaletteEntries log_hpal, 0, sys_pal_size, orig_pal(0)

    ' Insert the non-static colors.
    For i = static_color_1 + 1 To static_color_2 - 1
        orig_pal(i) = sys_pal(i)
        orig_pal(i).peFlags = PC_NOCOLLAPSE
    Next i
    SetPaletteEntries log_hpal, static_color_1 + 1, static_color_2 - static_color_1 - 1, orig_pal(static_color_1 + 1)

    ' Realize the new palette.
    RealizePalette pic.hdc

End Sub
' Return a binary representation of the byte.  This helper function is useful for understanding  byte values.
Private Function BinaryByte(ByVal Value As Byte) As String

    Dim i As Integer
    Dim txt As String

    For i = 1 To 8
        If Value And 1 Then
            txt = "1" & txt
        Else
            txt = "0" & txt
        End If
        Value = Value \ 2
    Next i

    BinaryByte = txt

End Function

' Load the bits from this PictureBox into a two-dimensional array of RGB values. Set
' bits_per_pixel to be the number of bits per pixel.
Private Sub GetBitmapPixels(ByVal pic As PictureBox, ByRef pixels() As RGBTriplet, ByRef bits_per_pixel As Integer)

' Uncomment the following to make the routine
' display information about the bitmap.
' #Const DEBUG_PRINT_BITMAP = True

Dim hbm As Long
Dim bm As BITMAP
Dim l As Single
Dim T As Single
Dim old_color As Long
Dim bytes() As Byte
Dim num_pal_entries As Long
Dim pal_entries(0 To MAX_PALETTE_SIZE - 1) As PALETTEENTRY
Dim pal_index As Integer
Dim wid As Integer
Dim hgt As Integer
Dim X As Integer
Dim Y As Integer
Dim two_bytes As Long

    ' Get the bitmap information.
    hbm = pic.Image
    GetObject hbm, Len(bm), bm
    bits_per_pixel = bm.bmBitsPixel

    ' If bits_per_pixel is 16, see if it's really
    ' 15 or 16 bits per pixel.
    If bits_per_pixel = 16 Then
        ' Make the upper left pixel white.
        l = pic.ScaleLeft
        T = pic.ScaleTop
        old_color = pic.Point(l, T)
        pic.PSet (l, T), vbWhite

        ' See what color was set.
        ReDim bytes(0 To 0, 0 To 0)
        GetBitmapBits hbm, 2, bytes(0, 0)
        If (bytes(0, 0) And &H80) = 0 Then
            ' It's really a 15-bit image.
            bits_per_pixel = 15
        End If

        ' Restore the pixel's original color.
        pic.PSet (l, T), old_color
    End If

    #If DEBUG_PRINT_BITMAP Then
        Debug.Print "*** BITMAP Data ***"
        Debug.Print "bmType       "; bm.bmType
        Debug.Print "bmWidth      "; bm.bmWidth
        Debug.Print "bmHeight     "; bm.bmHeight
        Debug.Print "bmWidthBytes "; bm.bmWidthBytes
        Debug.Print "bmPlanes     "; bm.bmPlanes
        Debug.Print "bmBitsPixel  "; bm.bmBitsPixel
        Debug.Print "BitsPerPixel "; bits_per_pixel
    #End If

    ' Get the bits.
    If (bits_per_pixel = 8) Or _
       (bits_per_pixel = 15) Or _
       (bits_per_pixel = 16) Or _
       (bits_per_pixel = 24) Or _
       (bits_per_pixel = 32) _
    Then
        ' Get the bits.
        ReDim bytes(0 To bm.bmWidthBytes - 1, 0 To bm.bmHeight - 1)
        GetBitmapBits hbm, bm.bmWidthBytes * bm.bmHeight, bytes(0, 0)
    Else
        ' We don't know how to read this format.
        Err.Raise bmphInvalidBitmapBits, _
            "DDBHelper.GetBitmapPixels", _
            "Invalid number of bits per pixel: " _
            & Format$(bits_per_pixel)
    End If

    ' Create the pixels array.
    wid = bm.bmWidth
    hgt = bm.bmHeight
    ReDim pixels(0 To wid - 1, 0 To hgt - 1)
    Select Case bits_per_pixel
        Case 8
            ' Match pic's palette to the system palette.
            MatchColorPalette pic

            ' Get the image's palette entries.
            num_pal_entries = GetPaletteEntries( _
                pic.Picture.hpal, 0, _
                MAX_PALETTE_SIZE, pal_entries(0))

            ' Get the RGB color components.
            For Y = 0 To hgt - 1
                For X = 0 To wid - 1
                    With pixels(X, Y)
                        pal_index = bytes(X, Y)
                        .rgbRed = pal_entries(pal_index).peRed
                        .rgbGreen = pal_entries(pal_index).peGreen
                        .rgbBlue = pal_entries(pal_index).peBlue
                    End With
                Next X
            Next Y

        Case 15
            For Y = 0 To hgt - 1
                For X = 0 To wid - 1
                    With pixels(X, Y)
                        ' Get the combined 2 bytes for this pixel.
                        two_bytes = bytes(X * 2, Y) + bytes(X * 2 + 1, Y) * 256&

                        ' Separate the pixel's components.
                        .rgbBlue = two_bytes Mod 32
                        two_bytes = two_bytes \ 32
                        .rgbGreen = two_bytes Mod 32
                        two_bytes = two_bytes \ 32
                        .rgbRed = two_bytes
                    End With
                Next X
            Next Y

        Case 16
            For Y = 0 To hgt - 1
                For X = 0 To wid - 1
                    With pixels(X, Y)
                        ' Get the combined 2 bytes for this pixel.
                        two_bytes = bytes(X * 2, Y) + bytes(X * 2 + 1, Y) * 256&

                        ' Separate the pixel's components.
                        .rgbBlue = two_bytes Mod 32
                        two_bytes = two_bytes \ 32
                        .rgbGreen = two_bytes Mod 64
                        two_bytes = two_bytes \ 64
                        .rgbRed = two_bytes
                    End With
                Next X
            Next Y

        Case 24
            ' Blast the data from the pixels array
            ' to the bytes array using CopyMemory.
            For Y = 0 To hgt - 1
                CopyMemory pixels(0, Y), bytes(0, Y), wid * 3
            Next Y

        Case 32
            For Y = 0 To hgt - 1
                For X = 0 To wid - 1
                    With pixels(X, Y)
                        .rgbBlue = bytes(X * 4, Y)
                        .rgbGreen = bytes(X * 4 + 1, Y)
                        .rgbRed = bytes(X * 4 + 2, Y)
                    End With
                Next X
            Next Y

    End Select

End Sub
' Set the bits in this PictureBox using a 0-based
' two-dimensional array of RGBTriplets. The pixels must
' have the right dimensions to match the picture.
Private Sub SetBitmapPixels(ByVal pic As PictureBox, ByVal bits_per_pixel As Integer, pixels() As RGBTriplet)

Dim wid_bytes As Long
Dim wid As Integer
Dim hgt As Integer
Dim X As Integer
Dim Y As Integer
Dim bytes() As Byte
Dim hpal As Long
Dim two_bytes As Long

    ' See how big the image must be.
    wid = UBound(pixels, 1) + 1
    hgt = UBound(pixels, 2) + 1

    ' See how many bytes per row we need.
    Select Case bits_per_pixel
        Case 8
            wid_bytes = wid
        Case 15, 16
            wid_bytes = wid * 2
        Case 24
            wid_bytes = wid * 3
        Case 32
            wid_bytes = wid * 4
        Case Else
            ' We don't understand this format.
            Err.Raise bmphInvalidBitmapBits, _
                "DDBHelper.GetBitmapPixels", _
                "Invalid number of bits per pixel: " _
                & Format$(bits_per_pixel)
    End Select

    ' Make sure it's even.
    If wid_bytes Mod 2 = 1 Then wid_bytes = wid_bytes + 1

    ' Create the bitmap bytes array.
    ReDim bytes(0 To wid_bytes - 1, 0 To hgt - 1)

    ' Set the bitmap byte values.
    Select Case bits_per_pixel
        Case 8
            ' Use the nearest palette entries.
            hpal = pic.Picture.hpal

            ' Get the RGB color components.
            For Y = 0 To hgt - 1
                For X = 0 To wid - 1
                    With pixels(X, Y)
                        bytes(X, Y) = (&HFF And _
                            GetNearestPaletteIndex(hpal, _
                                RGB(.rgbRed, .rgbGreen, .rgbBlue) _
                            + &H2000000))
                    End With
                Next X
            Next Y

        Case 15
            For Y = 0 To hgt - 1
                For X = 0 To wid - 1
                    With pixels(X, Y)
                        ' Keep the values in bounds.
                        If .rgbRed > &H1F Then .rgbRed = &H1F
                        If .rgbGreen > &H1F Then .rgbGreen = &H1F
                        If .rgbBlue > &H1F Then .rgbBlue = &H1F

                        ' Combine the values in 2 bytes.
                        two_bytes = .rgbBlue + 32 * (.rgbGreen + CLng(.rgbRed) * 32)

                        ' Set the byte values.
                        bytes(X * 2, Y) = (two_bytes Mod 256) And &HFF
                        bytes(X * 2 + 1, Y) = (two_bytes \ 256) And &HFF
                    End With
                Next X
            Next Y

        Case 16
            For Y = 0 To hgt - 1
                For X = 0 To wid - 1
                    With pixels(X, Y)
                        ' Keep the values in bounds.
                        If .rgbRed > &H1F Then .rgbRed = &H1F
                        If .rgbGreen > &H3F Then .rgbGreen = &H3F
                        If .rgbBlue > &H1F Then .rgbBlue = &H1F

                        ' Combine the values in 2 bytes.
                        two_bytes = .rgbBlue + 32 * (.rgbGreen + CLng(.rgbRed) * 64)

                        ' Set the byte values.
                        bytes(X * 2, Y) = (two_bytes Mod 256) And &HFF
                        bytes(X * 2 + 1, Y) = (two_bytes \ 256) And &HFF

                    End With
                Next X
            Next Y

        Case 24
            ' Blast the data from the bytes array
            ' to the pixels array using CopyMemory.
            For Y = 0 To hgt - 1
                CopyMemory bytes(0, Y), pixels(0, Y), wid * 3
            Next Y

        Case 32
            For Y = 0 To hgt - 1
                For X = 0 To wid - 1
                    With pixels(X, Y)
                        bytes(X * 4, Y) = .rgbBlue
                        bytes(X * 4 + 1, Y) = .rgbGreen
                        bytes(X * 4 + 2, Y) = .rgbRed
                    End With
                Next X
            Next Y

    End Select

    ' Set the picture's bitmap bits.
    SetBitmapBits pic.Image, wid_bytes * hgt, _
        bytes(0, 0)
    pic.Refresh

End Sub

' Return the arctan of dy/dx.
Private Function ATan2(ByVal dy As Single, ByVal DX As Single) As Single

Const PI = 3.14159265

Dim theta As Single

    If Abs(DX) < 0.01 Then
        If dy < 0 Then
            theta = -PI / 2
        Else
            theta = PI / 2
        End If
    Else
        theta = Atn(dy / DX)
        If DX < 0 Then theta = PI + theta
    End If

    ATan2 = theta

End Function
Public Sub TransparentPaint(picboxSource As Object, picboxTemp As Object, picboxTarget As Object, _
                            Optional nTargetX As Long = -99999999, Optional nTargetY As Long = -99999999, _
                            Optional nTargetWidth As Long = -99999999, Optional nTargetHeight As Long = -99999999, _
                            Optional nSourceX As Long = -99999999, Optional nSourceY As Long = -99999999, _
                            Optional nSourceWidth As Long = -99999999, Optional nSourceHeight As Long = -99999999)

    Call MakeMask(picboxSource, picboxTemp)

    Dim nTx As Long, nTy As Long, nTW As Long, nTH As Long
    Dim nSX As Long, nSY As Long, nSW As Long, nSH As Long

    If nTargetX = -99999999 Then
        nTx = 0
    Else
        nTx = nTargetX
    End If

    If nTargetY = -99999999 Then
        nTy = 0
    Else
        nTy = nTargetY
    End If

    If nTargetWidth = -99999999 Then
        nTW = picboxTarget.Width()
    Else
        nTW = nTargetWidth
    End If

    If nTargetHeight = -99999999 Then
        nTH = picboxTarget.Height()
    Else
        nTH = nTargetHeight
    End If

    If nSourceX = -99999999 Then
        nSX = 0
    Else
        nSX = nSourceX
    End If

    If nSourceY = -99999999 Then
        nSY = 0
    Else
        nSY = nSourceY
    End If

    If nSourceWidth = -99999999 Then
        nSW = picboxSource.Width()
    Else
        nSW = nSourceWidth
    End If

    If nSourceHeight = -99999999 Then
        nSH = picboxSource.Height()
    Else
        nSH = nSourceHeight
    End If

    Call picboxTarget.PaintPicture(picboxTemp.Picture, _
                        nTx, nTy, nTW, nTH, nSX, nSY, nSW, nSH, _
                        vbSrcAnd)
    Call picboxTarget.PaintPicture(picboxSource.Picture, _
                        nTx, nTy, nTW, nTH, nSX, nSY, nSW, nSH, _
                        vbSrcPaint)

End Sub

' Rotate the image.
Public Sub MakeMask(ByVal picboxFrom As Object, ByVal picboxTo As Object, Optional nTransparentColor As Long = 0)

    Dim white_pixel As RGBTriplet
    Dim transparent_pixel As RGBTriplet
    Dim black_pixel As RGBTriplet
    Dim input_pixels() As RGBTriplet
    Dim result_pixels() As RGBTriplet
    Dim bits_per_pixel As Integer
    Dim ix_out As Integer, iy_out As Integer
    Dim nR As Long, nG As Long, nB As Long

    If picboxFrom.AutoSize = False Or picboxTo.AutoSize = False Then
        Call Err.Raise(-1, "FOTATools.clsFunctions.MakeMask", "Picture boxes " & picboxFrom.Name & " and " & picboxTo.Name & " must have their AutoSize properties set to true.")
    End If
    If Not picboxFrom.ScaleMode = 3 Or Not picboxTo.ScaleMode = 3 Then
        Call Err.Raise(-1, "FOTATools.clsFunctions.MakeMask", "Picture boxes " & picboxFrom.Name & " and " & picboxTo.Name & " must have their ScaleMode properties set to 3-Pixel.")
    End If
    If Not picboxFrom.BorderStyle = picboxTo.BorderStyle Then
        Call Err.Raise(-1, "FOTATools.clsFunctions.MakeMask", "Picture boxes " & picboxFrom.Name & " and " & picboxTo.Name & " must be set the same for their BorderStyle properties.")
    End If

    picboxTo.Width = picboxFrom.Width
    picboxTo.Height = picboxFrom.Height

    white_pixel.rgbRed = 255
    white_pixel.rgbGreen = 255
    white_pixel.rgbBlue = 255

    black_pixel.rgbRed = 0
    black_pixel.rgbGreen = 0
    black_pixel.rgbBlue = 0

    Call RGBToRedGreenBlue(nTransparentColor, nR, nG, nB)
    transparent_pixel.rgbRed = nR
    transparent_pixel.rgbGreen = nG
    transparent_pixel.rgbBlue = nB

    'Get the pixels from picboxFrom.
    Call GetBitmapPixels(picboxFrom, input_pixels, bits_per_pixel)
    'Get the pixels from picboxTo.
    Call GetBitmapPixels(picboxTo, result_pixels, bits_per_pixel)

    ' Calculate the output pixel values.
    For iy_out = 0 To picboxFrom.ScaleHeight - 1
        For ix_out = 0 To picboxFrom.ScaleWidth - 1
            If input_pixels(ix_out, iy_out).rgbBlue = transparent_pixel.rgbBlue And _
               input_pixels(ix_out, iy_out).rgbGreen = transparent_pixel.rgbGreen And _
               input_pixels(ix_out, iy_out).rgbRed = transparent_pixel.rgbRed Then
                    result_pixels(ix_out, iy_out) = white_pixel
            Else
                    result_pixels(ix_out, iy_out) = black_pixel
            End If
        Next ix_out
    Next iy_out

    ' Set picboxTo's pixels.
    Call SetBitmapPixels(picboxTo, bits_per_pixel, result_pixels)
    picboxTo.Picture = picboxTo.Image

End Sub
' Rotate the image.
Public Sub ReplaceColors(ByVal picboxFrom As Object, ByVal picboxTo As Object, nColorToFind As Long, nColorToReplace As Long)

    Dim replace_pixel As RGBTriplet
    Dim find_pixel As RGBTriplet
    Dim input_pixels() As RGBTriplet
    Dim result_pixels() As RGBTriplet
    Dim bits_per_pixel As Integer
    Dim ix_out As Integer, iy_out As Integer
    Dim nR As Long, nG As Long, nB As Long

    If picboxFrom.AutoSize = False Or picboxTo.AutoSize = False Then
        Call Err.Raise(-1, "FOTATools.clsFunctions.MakeMask", "Picture boxes " & picboxFrom.Name & " and " & picboxTo.Name & " must have their AutoSize properties set to true.")
    End If
    If Not picboxFrom.ScaleMode = 3 Or Not picboxTo.ScaleMode = 3 Then
        Call Err.Raise(-1, "FOTATools.clsFunctions.MakeMask", "Picture boxes " & picboxFrom.Name & " and " & picboxTo.Name & " must have their ScaleMode properties set to 3-Pixel.")
    End If
    If Not picboxFrom.BorderStyle = picboxTo.BorderStyle Then
        Call Err.Raise(-1, "FOTATools.clsFunctions.MakeMask", "Picture boxes " & picboxFrom.Name & " and " & picboxTo.Name & " must be set the same for their BorderStyle properties.")
    End If

    picboxTo.Width = picboxFrom.Width
    picboxTo.Height = picboxFrom.Height

    Call RGBToRedGreenBlue(nColorToFind, nR, nG, nB)
    find_pixel.rgbRed = nR
    find_pixel.rgbGreen = nG
    find_pixel.rgbBlue = nB

    Call RGBToRedGreenBlue(nColorToReplace, nR, nG, nB)
    replace_pixel.rgbRed = nR
    replace_pixel.rgbGreen = nG
    replace_pixel.rgbBlue = nB


    'Get the pixels from picboxFrom.
    Call GetBitmapPixels(picboxFrom, input_pixels, bits_per_pixel)
    'Get the pixels from picboxTo.
    Call GetBitmapPixels(picboxTo, result_pixels, bits_per_pixel)

    ' Calculate the output pixel values.
    For iy_out = 0 To picboxFrom.ScaleHeight - 1
        For ix_out = 0 To picboxFrom.ScaleWidth - 1
            If input_pixels(ix_out, iy_out).rgbBlue = find_pixel.rgbBlue And _
               input_pixels(ix_out, iy_out).rgbGreen = find_pixel.rgbGreen And _
               input_pixels(ix_out, iy_out).rgbRed = find_pixel.rgbRed Then
                    result_pixels(ix_out, iy_out) = replace_pixel
            Else
                    result_pixels(ix_out, iy_out) = input_pixels(ix_out, iy_out)
            End If
        Next ix_out
    Next iy_out

    ' Set picboxTo's pixels.
    Call SetBitmapPixels(picboxTo, bits_per_pixel, result_pixels)
    picboxTo.Picture = picboxTo.Image

End Sub

'Rotate the image.
Public Sub RotateImage(ByVal picboxFrom As Object, ByVal picboxTo As Object, ByVal nAngle As Single, Optional nRGBNullColor As Long = -1)

    Dim white_pixel As RGBTriplet
    Dim input_pixels() As RGBTriplet
    Dim result_pixels() As RGBTriplet
    Dim bits_per_pixel As Integer
    Dim xmax_in As Integer, ymax_in As Integer
    Dim CxIn As Single, CyIn As Single
    Dim CxOut As Single, CyOut As Single
    Dim x_in As Single, y_in As Single
    Dim ix_in As Integer, iy_in As Integer
    Dim ix_out As Integer, iy_out As Integer
    Dim DX As Single, dy As Single
    Dim radius As Single
    Dim theta As Single
    Dim dx1 As Single, dx2 As Single
    Dim dy1 As Single, dy2 As Single
    Dim v11 As Integer, v12 As Integer
    Dim v21 As Integer, v22 As Integer
    Dim nRed As Long, nBlue As Long, nGreen As Long
    Dim oFunc As New clsFunctions

    With white_pixel
        If nRGBNullColor = -1 Then
            'Set the white pixel's value.
            .rgbRed = 255
            .rgbGreen = 255
            .rgbBlue = 255
        Else
            Call oFunc.RGBToRedGreenBlue(nRGBNullColor, nRed, nGreen, nBlue)
            .rgbRed = nRed
            .rgbBlue = nBlue
            .rgbGreen = nGreen
        End If
    End With

    'Get the pixels from picboxFrom.
    Call GetBitmapPixels(picboxFrom, input_pixels, bits_per_pixel)
    'Get the pixels from picboxTo.
    Call GetBitmapPixels(picboxTo, result_pixels, bits_per_pixel)
    'Get the centers of both images.
    CxIn = picboxFrom.ScaleWidth / 2
    CyIn = picboxFrom.ScaleHeight / 2
    CxOut = picboxTo.ScaleWidth / 2
    CyOut = picboxTo.ScaleHeight / 2

    ' Get the size of the original image.
    xmax_in = picboxFrom.ScaleWidth - 1
    ymax_in = picboxFrom.ScaleHeight - 1

    ' Calculate the output pixel values.
    For iy_out = 0 To picboxTo.ScaleHeight - 1
        For ix_out = 0 To picboxTo.ScaleWidth - 1
            ' Map the pixel value from
            ' (ix_out, iy_out) to (x_in, y_in).
            DX = ix_out - CxOut
            dy = iy_out - CyOut
            radius = Sqr(DX * DX + dy * dy)
            theta = ATan2(dy, DX)
            x_in = CxIn + radius * Cos(theta + nAngle)
            y_in = CyIn + radius * sIn(theta + nAngle)

            ' Find the nearest integral position.
            ix_in = Int(x_in)
            iy_in = Int(y_in)

            ' See if this is in bounds.
            If (ix_in >= 0) And (ix_in < xmax_in) And _
               (iy_in >= 0) And (iy_in < ymax_in) _
            Then
                ' The point lies within the image.
                ' Calculate its value.
                dx1 = x_in - ix_in
                dy1 = y_in - iy_in
                dx2 = 1# - dx1
                dy2 = 1# - dy1

                With result_pixels(ix_out, iy_out)
                    ' Calculate the red value.
                    v11 = input_pixels(ix_in, iy_in).rgbRed
                    v12 = input_pixels(ix_in, iy_in + 1).rgbRed
                    v21 = input_pixels(ix_in + 1, iy_in).rgbRed
                    v22 = input_pixels(ix_in + 1, iy_in + 1).rgbRed

                    .rgbRed = _
                        v11 * dx2 * dy2 + v12 * dx2 * dy1 + _
                        v21 * dx1 * dy2 + v22 * dx1 * dy1

                    ' Calculate the green value.
                    v11 = input_pixels(ix_in, iy_in).rgbGreen
                    v12 = input_pixels(ix_in, iy_in + 1).rgbGreen
                    v21 = input_pixels(ix_in + 1, iy_in).rgbGreen
                    v22 = input_pixels(ix_in + 1, iy_in + 1).rgbGreen
                    .rgbGreen = _
                        v11 * dx2 * dy2 + v12 * dx2 * dy1 + _
                        v21 * dx1 * dy2 + v22 * dx1 * dy1

                    ' Calculate the blue value.
                    v11 = input_pixels(ix_in, iy_in).rgbBlue
                    v12 = input_pixels(ix_in, iy_in + 1).rgbBlue
                    v21 = input_pixels(ix_in + 1, iy_in).rgbBlue
                    v22 = input_pixels(ix_in + 1, iy_in + 1).rgbBlue
                    .rgbBlue = _
                        v11 * dx2 * dy2 + v12 * dx2 * dy1 + _
                        v21 * dx1 * dy2 + v22 * dx1 * dy1
                End With
            Else
                ' The point is outside the image.
                ' Use white.
                result_pixels(ix_out, iy_out) = white_pixel
            End If
        Next ix_out
    Next iy_out

    ' Set picboxTo's pixels.
    SetBitmapPixels picboxTo, bits_per_pixel, result_pixels
    picboxTo.Picture = picboxTo.Image

End Sub


Public Function FlipString(sString As String) As String
    
    Dim i As Long
    Dim sRemainingTotal As String
    
    sRemainingTotal = sString
    
    For i = Len(sRemainingTotal) To 1 Step -1
        FlipString = FlipString & Mid(sRemainingTotal, i, 1)
    Next i

End Function

Public Function Bin2Char(sBin As String) As String

    Dim sRoutineName As String
    sRoutineName = "Bin2Char"

    Dim i As Long
    Dim sChunk As String
    Dim sRemainingTotal As String
    
    sRemainingTotal = sBin
    
    If Not Len(sRemainingTotal) Mod 8 = 0 Then
        Call Err.Raise(-1, sRoutineName, "Number is not divisible by 8, it is not a char binary array.")
    End If
    
    
    While Len(sRemainingTotal) > 0
        sChunk = left(sRemainingTotal, 8)
        sRemainingTotal = Mid(sRemainingTotal, 8 + 1)
        
        Bin2Char = Bin2Char & Chr(Bin2Dec(sChunk))
    Wend

End Function

Public Function Char2Bin(sString As String) As String

    Dim i As Long
    Dim nNum As Integer
    Dim sBin As String
    
    For i = 1 To Len(sString)
        nNum = Asc(Mid(sString, i, 1))
        sBin = Dec2Bin(nNum)
        sBin = right(String(8, "0") & sBin, 8)
        Char2Bin = Char2Bin & sBin
    Next i

End Function

Public Function Dec2Bin(nNum As Variant) As String

    Dim nLoopCounter As Integer

    If nNum >= 2 ^ 31 Then
        Dec2Bin = "Number too big"
        Exit Function
    End If

    Do
        If (nNum And 2 ^ nLoopCounter) = 2 ^ nLoopCounter Then
            Dec2Bin = "1" & Dec2Bin
        Else
            Dec2Bin = "0" & Dec2Bin
        End If
    
        nLoopCounter = nLoopCounter + 1
    Loop Until 2 ^ nLoopCounter > nNum

End Function
Public Function Bin2Dec(sBin As String) As Integer
    
    Dim nLoopCounter As Integer
    Dim i As Long

    nLoopCounter = Len(sBin) - 1

    For i = 1 To Len(sBin)
        Bin2Dec = Bin2Dec + (2 ^ nLoopCounter) * Mid(sBin, i, 1)
        nLoopCounter = nLoopCounter - 1
    Next i

End Function


