Attribute VB_Name = "modCommon"
Option Explicit

Public Const sBoBCoBHomePage = "http://www.frimlin.co.nz/bobcob/"

Public Const ID_PALETTE = 10

Public Const MAX_PATH = 260

Public Const HELP_FINDER = &HB

Public Const DT_BOTTOM = &H8
Public Const DT_CALCRECT = &H400
Public Const DT_CENTER = &H1
Public Const DT_CHARSTREAM = 4
Public Const DT_DISPFILE = 6
Public Const DT_EXPANDTABS = &H40
Public Const DT_EXTERNALLEADING = &H200
Public Const DT_INTERNAL = &H1000
Public Const DT_LEFT = &H0
Public Const DT_METAFILE = 5
Public Const DT_NOCLIP = &H100
Public Const DT_NOPREFIX = &H800
Public Const DT_PLOTTER = 0
Public Const DT_RASCAMERA = 3
Public Const DT_RASDISPLAY = 1
Public Const DT_RASPRINTER = 2
Public Const DT_RIGHT = &H2
Public Const DT_SINGLELINE = &H20
Public Const DT_TABSTOP = &H80
Public Const DT_TOP = &H0
Public Const DT_VCENTER = &H4
Public Const DT_WORDBREAK = &H10

Public Const CF_DIB = 8

Public Type FILETIME
        dwLowDateTime As Long
        dwHighDateTime As Long
End Type

Public Type WIN32_FIND_DATA
        dwFileAttributes As Long
        ftCreationTime As FILETIME
        ftLastAccessTime As FILETIME
        ftLastWriteTime As FILETIME
        nFileSizeHigh As Long
        nFileSizeLow As Long
        dwReserved0 As Long
        dwReserved1 As Long
        cFileName As String * MAX_PATH
        cAlternate As String * 14
End Type

Public Type PaletteEntry
    Red As Byte
    Green As Byte
    Blue As Byte
End Type

Public Const BI_bitfields = 3&
Public Const BI_RGB = 0&
Public Const BI_RLE4 = 2&
Public Const BI_RLE8 = 1&

Type BITMAPFILEHEADER
        bfType As Integer
        bfSize As Long
        bfReserved1 As Integer
        bfReserved2 As Integer
        bfOffBits As Long
End Type

Type BITMAPINFOHEADER '40 bytes
        biSize As Long
        biWidth As Long
        biHeight As Long
        biPlanes As Integer
        biBitCount As Integer
        biCompression As Long
        biSizeImage As Long
        biXPelsPerMeter As Long
        biYPelsPerMeter As Long
        biClrUsed As Long
        biClrImportant As Long
End Type

Type RGBQUAD
        rgbBlue As Byte
        rgbGreen As Byte
        rgbRed As Byte
        rgbReserved As Byte
End Type

Type BITMAPTYPE
    FileHeader As BITMAPFILEHEADER
    InfoHeader As BITMAPINFOHEADER
    ColorTable() As RGBQUAD
    PixelData() As Byte
End Type

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

Public Enum ImageTypes
    imageTypeSPR = 1
    imageTypeS16_555 = 2
    imageTypeS16_565 = 3
    imageTypeBMP24 = 4
End Enum

Declare Function BrowseForFolder Lib "BoBCoBUtils" (ByVal hwndOwner As Long, ByVal sCaption As String, ByVal sPath As String) As Long
Declare Sub DrawBitmapXY Lib "BoBCoBUtils" (ByVal hDC As Long, ByVal destX As Long, ByVal destY As Long, ByVal nImageType As Byte, ByVal nImageWidth As Long, ByVal nImageHeight As Long, pPixels As Any)
Declare Sub DrawBitmapXYScale Lib "BoBCoBUtils" (ByVal hDC As Long, ByVal destX As Long, ByVal destY As Long, ByVal destWidth As Long, ByVal destHeight As Long, ByVal nImageType As Byte, ByVal nImageWidth As Long, ByVal nImageHeight As Long, pPixels As Any)
Declare Function MatchRGB Lib "BoBCoBUtils" (ByVal nRGB As Long) As Byte
Declare Sub ConvertImage Lib "BoBCoBUtils" (ByVal nImageWidth As Long, ByVal nImageHeight As Long, ByVal nSourceType As Byte, pSourcePixels As Any, ByVal nDestType As Byte, pDestPixels As Any)
Declare Function GZipFile Lib "BoBCoBUtils" (ByVal sFilename As String, ByVal nLevel As Long) As Long
Declare Function StartClipboardCopy Lib "BoBCoBUtils" (ByVal sFormat As String, ByVal nFormat As Long) As Long
Declare Function AddToClipboard Lib "BoBCoBUtils" (ByRef pData As Any, ByVal nLen As Long) As Long
Declare Function AddImageToClipboard Lib "BoBCoBUtils" (ByVal nImageType As Byte, ByVal nImageWidth As Long, ByVal nImageHeight As Long, ByRef pPixels As Any) As Long
Declare Function FinishClipboardCopy Lib "BoBCoBUtils" () As Long
Declare Function StartClipboardPaste Lib "BoBCoBUtils" (ByVal sFormat As String, ByVal nFormat As Long) As Long
Declare Function GetFromClipboard Lib "BoBCoBUtils" (ByRef pData As Any, ByVal nLen As Long) As Long
Declare Function GetImageInfoFromClipboard Lib "BoBCoBUtils" (nImageType As Byte, nImageWidth As Long, nImageHeight As Long) As Long
Declare Function GetImagePaletteFromClipboard Lib "BoBCoBUtils" (ByRef pPalette As Any) As Long
Declare Function GetImagePixelsFromClipboard Lib "BoBCoBUtils" (ByRef pPixels As Any) As Long
Declare Function FinishClipboardPaste Lib "BoBCoBUtils" () As Long

Declare Function FindFirstFile Lib "kernel32" Alias "FindFirstFileA" (ByVal lpFileName As String, lpFindFileData As WIN32_FIND_DATA) As Long
Declare Function PlaySound Lib "winmm.dll" Alias "PlaySoundA" (ByVal lpszName As String, ByVal hModule As Long, ByVal dwFlags As Long) As Long
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
Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal X As Long, ByVal Y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
Declare Function DrawText Lib "user32" Alias "DrawTextA" (ByVal hDC As Long, ByVal lpStr As String, ByVal nCount As Long, lpRect As RECT, ByVal wFormat As Long) As Long
Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Public Const HWND_NOTOPMOST = -2
Public Const HWND_TOPMOST = -1
Public Const SWP_NOACTIVATE = &H10
Public Const SWP_SHOWWINDOW = &H40
Public Const SWP_NOSIZE = &H1
Public Const SWP_NOMOVE = &H2

Public Const sPictureImportFilter = "All Picture Files (*.spr;*.s16;*.bmp)|*.spr;*.s16;*.bmp|Sprite Files (*.spr;*.s16)|*.spr;*.s16|Windows Bitmap Files (*.bmp)"
Public Const sPictureExportFilter = "C1 Sprite Files (*.spr)|*.spr|C2 Sprite Files (*.s16)|*.s16|Windows Bitmap Files (*.bmp)|*.bmp"

Public sPalettePath As String

Public aCreaturesPalette(0 To 255) As PaletteEntry

Private nLastRed As Long
Private nLastGreen As Long
Private nLastBlue As Long
Private nLastIndex As Integer

Public Sub GetCommonSettings()
    sPalettePath = App.Path & "\Raw.pal"
End Sub

'Public Function LoadBitmap(sFilename As String, ByRef tBitmap As BITMAPTYPE) As Boolean
'    Dim nFile As Integer
'    Dim I As Integer
'
'    LoadBitmap = False
'
'    nFile = FreeFile
'
'    On Error Resume Next
'
'    FileLen sFilename
'
'    If Err <> 0 Then
'        MsgBox "Error loading '" & sFilename & "': " & Err.Description, vbOKOnly + vbExclamation
'        Err.Clear
'        Exit Function
'    End If
'
'    On Error GoTo 0
'
'    Open sFilename For Binary Access Read As nFile
'
'    Get nFile, , tBitmap.FileHeader
'    Get nFile, , tBitmap.InfoHeader
'
'    If tBitmap.FileHeader.bfType <> &H4D42 Then
'        MsgBox "Error loading '" & sFilename & "': Not a Windows Bitmap.", vbOKOnly + vbExclamation
'        Exit Function
'    End If
'
'    If tBitmap.InfoHeader.biBitCount <> 8 Then
'        MsgBox "Error loading '" & sFilename & "': Unsupported bit depth. Only 8 bits supported.", vbOKOnly + vbExclamation
'        Exit Function
'    End If
'
'    If tBitmap.InfoHeader.biClrUsed > 0 Then
'        ReDim tBitmap.ColorTable(0 To tBitmap.InfoHeader.biClrUsed - 1)
'    Else
'        ReDim tBitmap.ColorTable(0 To (2 ^ tBitmap.InfoHeader.biBitCount) - 1)
'    End If
'
'    For I = 0 To UBound(tBitmap.ColorTable)
'        Get nFile, , tBitmap.ColorTable(I)
'    Next
'
'    ReDim tBitmap.PixelData(0 To tBitmap.InfoHeader.biWidth * Abs(tBitmap.InfoHeader.biHeight) - 1)
'
'    If tBitmap.InfoHeader.biCompression = BI_RGB Then
'        Get nFile, , tBitmap.PixelData
'    ElseIf tBitmap.InfoHeader.biCompression = BI_RLE4 Then
'        MsgBox "Error loading '" & sFilename & "': Unsupported compression RLE4.", vbOKOnly + vbExclamation
'        Exit Function
'    ElseIf tBitmap.InfoHeader.biCompression = BI_RLE8 Then
'        MsgBox "Error loading '" & sFilename & "': Unsupported compression RLE8.", vbOKOnly + vbExclamation
'        Exit Function
'    End If
'
'    Close nFile
'
'    LoadBitmap = True
'End Function
'
'Public Function SaveBitmap(sFilename As String, tBitmap As BITMAPTYPE) As Boolean
'    Dim nFile As Integer
'    Dim I As Integer
'
'    SaveBitmap = False
'
'    nFile = FreeFile
'
'    On Error Resume Next
'
'    Open sFilename For Binary Access Write As nFile
'
'    If Err <> 0 Then
'        MsgBox "An error occurred while trying to open '" & sFilename & "' for writing:" & vbCrLf & _
'               "Error " & Err & ": " & Err.Description
'        Err.Clear
'        Exit Function
'    End If
'
'    Put nFile, , tBitmap.FileHeader
'    Put nFile, , tBitmap.InfoHeader
'
'    For I = 0 To UBound(tBitmap.ColorTable)
'        Put nFile, , tBitmap.ColorTable(I)
'    Next
'
'    Put nFile, , tBitmap.PixelData
'
'    Close nFile
'
'    SaveBitmap = True
'End Function

'Public Function MatchColour(nPixel As Byte, aSourcePalette() As RGBQUAD, aDestPalette() As PaletteEntry)
'    Dim I As Integer
'    Dim nDistance As Long
'    Dim nBestDistance As Long
'    Dim nBestIndex As Integer
'    Dim nSourceRed As Integer
'    Dim nSourceGreen As Integer
'    Dim nSourceBlue As Integer
'
'    If (nPixel >= 0 And nPixel <= 10) Or (nPixel >= 243 And nPixel <= 255) Then
'        MatchColour = nPixel
'        Exit Function
'    End If
'
'    nSourceRed = aSourcePalette(nPixel).rgbRed
'    nSourceGreen = aSourcePalette(nPixel).rgbGreen
'    nSourceBlue = aSourcePalette(nPixel).rgbBlue
'
'    nBestDistance = 768
'    nBestIndex = -1
'
'    For I = 11 To 242
'        nDistance = Abs(aDestPalette(I).Red - nSourceRed) + Abs(aDestPalette(I).Green - nSourceGreen) + Abs(aDestPalette(I).Blue - nSourceBlue) / 3
'        If nDistance = 0 Then
'            MatchColour = I
'            Exit Function
'        ElseIf nDistance < nBestDistance Then
'            nBestDistance = nDistance
'            nBestIndex = I
'        End If
'    Next
'
'    MatchColour = nBestIndex
'End Function

'Public Function MatchRGB(nRGB As Long, aPalette() As PaletteEntry) As Byte
'    Dim I As Integer
'    Dim nDistance As Long
'    Dim nBestDistance As Long
'    Dim nBestIndex As Integer
'    Dim nRed As Long
'    Dim nGreen As Long
'    Dim nBlue As Long
'
'    nRed = nRGB And 255
'    nGreen = Int(nRGB / 256) And 255
'    nBlue = Int(nRGB / 65536) And 255
'
'    If nLastIndex <> 0 Then
'        If nRed <> 0 Or nGreen <> 0 Or nBlue <> 0 Then
'            nDistance = Abs(nLastRed - nRed) + Abs(nLastGreen - nGreen) + Abs(nLastBlue - nBlue) / 3
'            If nDistance < 8 Then
'                MatchRGB = nLastIndex
'                Exit Function
'            End If
'        Else
'            MatchRGB = 0
'            Exit Function
'        End If
'    End If
'
'    nBestDistance = 768
'    nBestIndex = -1
'
'    For I = 11 To 242
'        nDistance = (Abs(aPalette(I).Red - nRed) + Abs(aPalette(I).Green - nGreen) + Abs(aPalette(I).Blue - nBlue)) / 3
'        If nDistance = 0 Then
'            nBestIndex = I
'            Exit For
'        ElseIf nDistance < nBestDistance Then
'            nBestDistance = nDistance
'            nBestIndex = I
'        End If
'    Next
'
'    nLastRed = nRed
'    nLastGreen = nGreen
'    nLastBlue = nBlue
'    nLastIndex = nBestIndex
'    MatchRGB = nBestIndex
'End Function

Public Sub CheckNumeric(KeyAscii As Integer)
    If Not IsNumeric(Chr(KeyAscii)) And KeyAscii <> 8 Then
        KeyAscii = 0
    End If
End Sub

Public Sub SelectText(ByVal oControl As Control)
    oControl.SelStart = 0
    oControl.SelLength = Len(oControl.Text)
End Sub

Public Sub OpenBoBCoBHomePage()
    ShellExecute 0, "open", sBoBCoBHomePage, "", "", 0
End Sub

Public Sub LoadCreaturesPalette()
    Dim nFile As Integer
    Dim I As Integer
    Dim nRed As Byte
    Dim nGreen As Byte
    Dim nBlue As Byte
    
    nFile = FreeFile
    
    On Error Resume Next
    
    FileLen sPalettePath
    If Err Then
        Err.Clear
        
        MsgBox "File not found: '" & sPalettePath & "'", vbOKOnly + vbExclamation, "Loading Creatures Palette"
        Exit Sub
    End If
    
    Open sPalettePath For Binary Access Read As nFile
    
    On Error GoTo 0
    
    For I = 0 To 255
        Get nFile, I * 3 + 1, nRed
        Get nFile, I * 3 + 2, nGreen
        Get nFile, I * 3 + 3, nBlue
        aCreaturesPalette(I).Red = Fix((nRed * 255) / 63)
        aCreaturesPalette(I).Green = Fix((nGreen * 255) / 63)
        aCreaturesPalette(I).Blue = Fix((nBlue * 255) / 63)
    Next
    
    Close nFile
End Sub

Public Function HelpStringSearch(textString As Object) As String
    Dim I As Integer
    Dim IStart As Integer
    Dim J As Integer
    Dim sChar As String
    
    If textString.SelLength = 0 Then
        I = textString.SelStart + 1
        
        sChar = Mid(textString.Text, I, 1)
        Do While sChar = " " Or sChar = "," Or sChar = vbCr Or sChar = vbTab
            I = I - 1
            sChar = Mid(textString.Text, I, 1)
        Loop
        IStart = I

        Do
            sChar = Mid(textString.Text, I, 1)
            If sChar = " " Or sChar = vbLf Or sChar = "," Or sChar = vbTab Then
                Exit Do
            End If
            I = I - 1
        Loop While I > 0
        
        
        J = IStart + 1
        Do
            sChar = Mid(textString.Text, J, 1)
            If sChar = " " Or sChar = vbCr Or sChar = "," Or sChar = vbTab Then
                Exit Do
            End If
            J = J + 1
        Loop While J <= Len(textString.Text)
        
        If I = J Then
            Exit Function
        Else
            sChar = Mid(textString.Text, I + 1, J - I - 1)
        End If
        
    Else
        sChar = Trim(textString.SelText)
    End If
    
    HelpStringSearch = sChar
End Function

Public Function StripPath(ByVal sFilename As String) As String
    Dim I As Integer
    Dim sChar As String
    
    For I = Len(sFilename) To 1 Step -1
        sChar = Mid(sFilename, I, 1)
        If sChar = "\" Or sChar = ":" Then
            StripPath = Mid(sFilename, I + 1)
            Exit Function
        End If
    Next
    
    StripPath = sFilename
End Function
