Attribute VB_Name = "modColors"
Global Const COLOR_LGRAY = &HE0E0E0
Global Const COLOR_TBOUTLINE = 14212574
Global Const COLOR_DGRAY = 10526880
Global Const COLOR_HLBG = 14203830
Global Const COLOR_HLBORDER = 4268824

Public lngForeColor As Long
Public lngBackColor As Long

Public Type RGB
    r As Integer
    g As Integer
    B As Integer
End Type

Public Colors(99) As RGB
Public DefinedColors As Integer

Function ColorTable() As String
    Dim i As Integer, strTable As String
    Dim r As Integer, B As Integer, g As Integer
    strTable = "{\colortbl ;"
    'MsgBox DefinedColors
    For i = 0 To DefinedColors - 1
        r = Colors(i).r
        g = Colors(i).g
        B = Colors(i).B
        strTable = strTable & "\red" & r & "\green" & g & "\blue" & B & ";"
    Next i
    strTable = strTable & "}"
    ColorTable = strTable
End Function

Sub LoadColors()
    Dim i As Integer, strFile As String
    strFile = PATH & "colors.inf"
    
    On Error GoTo errorHandler
    DefinedColors = 0
    Open strFile For Input As #1
        Do
            Input #1, Colors(DefinedColors).r
            Input #1, Colors(DefinedColors).g
            Input #1, Colors(DefinedColors).B
            DefinedColors = DefinedColors + 1
        Loop Until EOF(1) Or DefinedColors >= 99
    Close #1
    Exit Sub
    
errorHandler:
    Select Case Err
        Case 53:
            MsgBox "(ERROR 53) The color information file does not exist, and therefore could not be loaded.  Please check the manual on how to fix this problem.  The program will now exit.", vbCritical
            End
        Case 76:
            MsgBox "(ERROR 76) The color information file does not exist, and therefore could not be loaded.  Please check the manual on how to fix this problem.  The program will now exit.", vbCritical
            End
        Case 62:
            MsgBox "(ERROR 62) The color information file is not complete.  Please check the manual for more information.", vbCritical
            End
        Case Else:
            MsgBox "An unknown error has occured.  The following information has been obtained, but is not documented in the manual." & vbCrLf & vbCrLf & "Error #" & Err & " : " & Error, vbCritical
    End Select

End Sub

Function RAnsiColor(lngColor As Long) As Integer

    Dim i As Integer
    For i = 0 To 15
        If RGB(Colors(i).r, Colors(i).g, Colors(i).B) = lngColor Then
            RAnsiColor = i
            Exit Function
        End If
    Next i
    
    If lngColor = lngForeColor Then
        RAnsiColor = 1
    ElseIf lngColor = lngBackColor Then
        RAnsiColor = 0
    Else
        RAnsiColor = 99
    End If
    
End Function


Sub ConvertToGrayscale(picColor As PictureBox, picBW As PictureBox)
    Dim x As Integer, y As Integer, AvgCol As Integer, lngColor As Long
    For x = 0 To picColor.ScaleWidth
        For y = 0 To picColor.ScaleHeight
            lngColor = picColor.point(x, y)
            If lngColor = 13160660 Then
            Else
                AvgCol = (Red(lngColor) + Green(lngColor) + Blue(lngColor)) / 3
                picBW.ForeColor = RGB(AvgCol, AvgCol, AvgCol)
                picBW.PSet (x, y)
            End If
        Next y
    Next x
End Sub

Function Red(ByVal Color As Long)
    Red = Color Mod 256
End Function


Function Green(ByVal Color As Long)
    Green = (Color / 256) Mod 256
End Function


Function Blue(ByVal Color As Long)
    Blue = Color / 65536
End Function

Sub SetRGB(lngColor As Long, ByRef r As Integer, ByRef g As Integer, ByRef B As Integer)
    
    r = Red(lngColor)
    g = Green(lngColor)
    B = Blue(lngColor)
    Exit Sub
End Sub


