Attribute VB_Name = "modDeclare"
Option Explicit

'******** Tooltip tracking of lvw column headers ***************
'Public Const blnHookColumns = False
'***************************************************************
Public Declare Function GetSystemDirectoryB Lib "kernel32" Alias "GetSystemDirectoryA" (ByVal Path As String, ByVal cbBytes As Long) As Long

'Prevent Enter Keydowns on Apply/Next functionality.

Public Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" _
   (ByVal hWndParent As Long, ByVal hwndChildAfter As Long, _
   ByVal lpszClass As String, ByVal lpszWindow As String) As Long

Public blnHookColumns As Boolean

Public mlvwGoalies_HdrHwnd As Long
Public mlvwPlayers_HdrHwnd As Long
Public mlvwTeams_HdrHwnd As Long
Public mlvwLines_HdrHwnd As Long
Public mlvwPlayoffDraws_HdrHwnd As Long
Public mlvwRules_HdrHwnd As Long
'Public mlvwTimers_HdrHwnd As Long

Public Const cHdrHwnd = "msvb_lib_header"
Public Const cForwardSlash = "/"

Public frmGoalieEdit As New frmPlayerEdit 'Goalie window

'NUMLOCK EDITING RELATED
'Private Declare Sub keybd_event Lib "user32" (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)
'Private Declare Function GetKeyState Lib "user32" (ByVal nVirtKey As Long) As Integer
'Private Const VK_NUMLOCK = &H90
'Public blnNumLockRevert As Boolean
'Private Const KEYEVENTF_EXTENDEDKEY = &H1
'Private Const KEYEVENTF_KEYUP = &H2

Public Const apCursors = "cursors\"
Public Const apIcons = "icons\"
Public Const apINI = "ini\"
Public Const apRinks = "rinks\"
Public Const apStrips = "strips\"


Public Const apifROMS = "roms.ini"
Public Const apifHexText = "hextext.ini"
Public Const apifStrips = "strips.ini"
Public Const apifRinks = "rinks.ini"

Public Const vbKeyAsciiCtrlEnter = &HA '10
Public Const vbKeyOEM5Backslash = &HDC

Public Const rvSMD91 = "SMD91"
Public Const rvSG92 = "SG92"
Public Const rvSG93 = "SG93"
Public Const rvSG94 = "SG94"
Public Const rvSG95 = "SG95"
Public Const rvSG96 = "SG96"
Public Const rvSG97 = "SG97"
Public Const rvSG98 = "SG98"
Public Const rvSMD95E = "SMD95E"
Public Const rvSMD96E = "SMD96E"

Public Const vbKeyRightSingleQuoteTilde = 192
Public Const vbKeyMinusUnderscore = 189
Public Const vbKeyEqualsPlus = 187

Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Long) As Long
Private Const CB_GETDROPPEDSTATE = &H157
Private Const CB_SHOWDROPDOWN = &H14F
'Private Const CB_SETDROPPEDWIDTH = &H160
'SendMessage cbxGoalieBytes(0).hwnd, CB_SETDROPPEDWIDTH, 135, 0

Public Const cTeamPositionsAbrev = "G;LD;RD;LW;C;RW;!6;!7;!8;!9;!0xA;!0xB;!0xC;!0xD;!0xE;!0xF;!Del"
Public Const cTeamPositionsFull = "Goalie;Left Defense;Right Defense;Left Wing;Center;Right Wing;!!!! Hex 6;!!!! Hex 7;!!!! Hex 8;!!!! Hex 9;!!!! Hex A;!!!! Hex B;!!!! Hex C;!!!! Hex D;!!!! Hex E;!!!! Hex F;!!!! Delete"

Public Const iniValueDelimiter = ";"

Public Const tiSeparator = "|"
Public Const tiWinGoale = "wingoale"
Public Const tiWinLines = "winlines"
Public Const tiWinMenuD = "winmenud"
Public Const tiWinPlayr = "winplayr"
Public Const tiWinStrip = "winstrip"
Public Const tiWinTeams = "winteams"
'Public Const tiWinPrdLn = "winprdln"
Public Const tiWinTime = "wintime"
Public Const tiWinRink = "winrink"
Public Const tiWinPlyOf = "winplyof"
Public Const tiWinRules = "winrules"

Public Const tiGotoNext = "gotonext"
Public Const tiGotoPrev = "gotoprev"
Public Const tiNextAply = "nextaply"

Public Const tiColSnipr = "colsnipr"
Public Const tiItemCopy = "itemcopy"
Public Const tiItemPste = "itempste"
Public Const tiItemPsta = "itempsta"
Public Const tiItemSelA = "itemsela"
Public Const tiItemUp = "itemup"
Public Const tiItemDown = "itemdown"
Public Const tiItemROrd = "itemrord"
Public Const tiItemProp = "itemprop"
Public Const tiNoIcon = "noicon"
Public Const tiPlayrAdd = "playradd"
Public Const tiPlayrDel = "playrdel"
Public Const tiPlayROrd = "playrord"
Public Const tiResetAll = "resetall"
Public Const tiTeamBmGo = "teambmgo"
Public Const tiTeamNext = "teamnext"
Public Const tiTeamPrev = "teamprev"
Public Const tiByteDown = "bytedown"
Public Const tiByteUp = "byteup"
Public Const tiByteAuto = "byteauto"

Public Const cboLeft = "cbo"

Private Type SELECTEDITEMS
    TeamOffset As Long
    TeamListIndex As Long
    TeamNameOffset As Long
    'TeamNameLocationOffset As Long
    TeamRosterOffset As Long
    TeamRosterPlayers As Long
    TeamColorOffset As Long
    TeamPlayers As Long
    TeamPlayersOffense As Long
    TeamPlayersByteOffset As Long
    TeamGoalies As Long
    TeamGoaliesByteOffset As Long
    TeamLinesOffset As Long
    TeamLinesEndOffset As Long
    TeamFreeBytes As Long
    GoalieOffset As Long
    GoalieJerseyOffset As Long
    GoalieListIndex As Long
    GoalieListProperties As Boolean
    PlayerOffset As Long
    PlayerJerseyOffset As Long
    PlayerListIndex As Long
    LineOffset As Long
    LineListIndex As Long
    TeamPositionsOffset As Long
    TeamPositionsBytes As Long
    
End Type

'Private Type COPYITEM
'    aryBytes(0 To 15) As Byte
'End Type

'Used to track where a window was last!

Public objSelected As SELECTEDITEMS
Public objDestination As SELECTEDITEMS
Public objFrom As SELECTEDITEMS
Public objTemp As SELECTEDITEMS
Public blnByteShiftOccured As Boolean

'Function HotKeys
'Public Const hkITEMCOPY = vbKeyF2
Public Const hkITEMCOPYCtrl = vbKeyC 'Ctrl+
'Public Const hkITEMPSTE = vbKeyF3
Public Const hkITEMPSTECtrl = vbKeyV 'Ctrl+
'Public Const hkITEMPSTA = vbKeyF4
Public Const hkITEMPSTACtrl = vbKeyB 'Ctrl+
'Public Const hkITEMSELA = vbKeyF5
Public Const hkITEMSELACtrl = vbKeyA 'Ctrl+ Select All
Public Const hkITEMSELICtrl = vbKeyI 'Ctrl+ Invert Selection

'Public Const hkFINDNOSE = vbKeyF6

Public Const hkTEAMPREV = vbKeyF7
Public Const hkTEAMNEXT = vbKeyF8

Public Const hkRESETALLShift = vbKeyEscape
Public Const hkNEXTAPLYAlt = vbKeyN

'F9

Public Const hkTEAMBMRK = vbKeyF11
Public Const hkTEAMBMGO = vbKeyF12


Public Const cColorMultiple = 17
Public Const cCursorInvalid = "X"

Public blnMDIApplicationIsUnloading As Boolean
Public blnMDIOpenFileIsBeingClosed As Boolean
'Public blnColorSniperIsLoaded As Boolean
'Public blnOpenFileHasUnsavedChanges As Boolean
Public blnOpenFileIsReadOnly As Boolean

Public blnPlayerNameBytesLengthChange As Boolean
Public blnTeamNameBytesLengthChange As Boolean

Public lvwTeamsBookmarkItemIndex As Long
Public lvwTeamsSelectedItemIndex As Long

'Public blnOpenFileSupportsPlayerNames As Boolean

Public btyaryOpenFile() As Byte
Public aryPixelsHex() As Byte

'Mouse Click Handlers
Private blnLeftButtonDown As Boolean
Private blnRightButtonDown As Boolean

Public intcmdEditIndex As Integer
Public intpbxTeamColorIndex As Integer
Public intTeamGoalies As Integer
Public blnmnuToolsQuickEditKeysOn As Boolean
Public blnmnuOptionsOffsetHex As Boolean
Public blnmnuOptionsPlayerAttributesHex As Boolean
Public blnmnuOptionsTeamAutoManageFreeBytes As Boolean
Public blnmnuOptionsPlayerMoveReOrderLine As Boolean
Public blnmnuOptionsPlayerDeleteReOrderLine As Boolean

Public lngLastTeamClick As Long
Public lngOffsetStartColors As Long

Public blnApplyNextGoalieEdit As Boolean
Public blnApplyNextPlayerEdit As Boolean
Public blnApplyNextLineEdit As Boolean
Public blnApplyNextPlayoffDrawEdit As Boolean
Public blnApplyNextRuleEdit As Boolean
Public blnApplyNextTeamEdit As Boolean

'XXX Used in startup MENU defaults XXX
'Public intCboTeam1Index As Integer


'Public lngLastSampleColor As Long
Public strLastSampleColor As String

'Public stripHeight As Integer
'Public stripWidth As Integer


'*** INI VARS ***


Public intROMDataStructureVersion As Integer ' not in ini!
Public blnROMPlayerForwardsSupport As Boolean
Public blnROMPlayerNameSupport As Boolean
Public blnROMPlayerPositionSupport As Boolean
Public blnROMTeamNameRedirectSupport As Boolean
Public blnROMTeamHeaderNextTeam As Boolean
Public blnROMCopyrightTextAddressOffsetUsed As Boolean

Public strROMVersion As String
'Public strPlayoffDrawMoveROMProductCode As String
'Public strIntroTextMoveROMProductCode As String

Public strROMProductCode As String
Public strOriginalROMProductCode As String
Public lngTeamDataEndOffset As Long
Public lngPlayoffDrawAddressesOffset(0 To 1) As Long
Public lngROMDataEndOffset As Long


Public lngChecksumRoutineOffset As Long
Public lngChecksumRoutineAddressOffset As Long
Public lngCopyrightTextOffset As Long
Public lngCopyrightTextAddressOffset As Long
Public lngIntroTextOffset As Long
Public lngIntroTextAddressOffset As Long
Public lngIntroTextEndOffset As Long

Public lngPeriodLengthSecondsOffset As Long
Public lngPeriodLengthTextOffset As Long
Public lngOvertimeSecondsOffset As Long
Public lngShootoutSecondsOffset As Long

Public lngTeam0xD0xEAddressesOffset(0 To 1) As Long
Public lngTeam0xD0xEAddressesDefaultOffset(0 To 1) As Long

Public strTeamColumnLabels As String
Public strTeamColumnWidths As String
Public strTeamEditLabels As String
Public strGoalieColumnLabels As String
Public strGoalieColumnWidths As String
Public strGoalieColumnHexText As String
Public strGoalieEditLabels As String
Public strGoalieEditHexText As String
Public strPlayerColumnLabels As String
Public strPlayerColumnWidths As String
Public strPlayerColumnHexText As String
Public strPlayerEditLabels As String
Public strPlayerEditHexText As String
Public strLineColumnLabels As String
Public strLineColumnWidths As String
Public strLineEditLabels As String
Public strLineRowLabels As String
Public strTimerColumnLabels As String
Public strTimerColumnWidths As String
Public strTimerEditLabels As String
Public strStripColorLabels As String
Public strStripTemplates As String
Public strRinkColorLabels As String
Public strRinkTemplates As String
Public strPlayoffDrawColumnLabels As String
Public strPlayoffDrawColumnWidths As String
Public strPlayoffDrawEditLabels As String
Public strRuleColumnLabels As String
Public strRuleColumnWidths As String
Public strRuleEditLabels As String

Public lngPlayoffDrawOffset As Long
Public intPlayoffDraws As Integer
Public lngRinkPaletteOffset As Long
Public lngRulesStartOffset As Long
Public intRules As Integer

Public lngTeamsStartOffset As Long
Public intTeamCount As Long
Public intROMLines As Integer
Public lngTeamFreeBytes As Long
Public lngPlayoffDrawBytesUsed As Integer
Public lngTeamLastPositionBytes As Long

Public lngMenuDefaultsAddressOffset As Long
Public lngMenuCaptionsAddressOffset As Long
Public lngMenuOptionsAddressOffset As Long

Public arystrGoalieColumnHexText(0 To 13, 0 To 15) As String
Public arystrGoalieEditHexText(0 To 13, 0 To 15) As String
Public arystrPlayerColumnHexText(0 To 13, 0 To 15) As String
Public arystrPlayerEditHexText(0 To 13, 0 To 15) As String

Public Declare Function GetPixel Lib "gdi32" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long) As Long

Private Declare Function InitCommonControls Lib "comctl32" () As Long

Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)

Public arystrSniperPalette(0 To 15) As String
Public lngSniperPalettePreview As Long

'Load the image using LoadPicture() then call GetDIBits() on it's handle
'to extract the image data and perform the edits you want,
'then finally SetDIBits() the data back and display where you wish:

'Private Declare Function GetObject Lib "gdi32" Alias "GetObjectA" (ByVal hObject As Long, ByVal nCount As Long, lpObject As Any) As Long
Public Declare Function GetDIBits Lib "gdi32" (ByVal aHDC As Long, ByVal hBitmap As Long, ByVal nStartScan As Long, ByVal nNumScans As Long, lpBits As Any, lpBI As BITMAPINFO, ByVal wUsage As Long) As Long
Public Declare Function SetDIBits Lib "gdi32" (ByVal hdc As Long, ByVal hBitmap As Long, ByVal nStartScan As Long, ByVal nNumScans As Long, lpBits As Any, lpBI As BITMAPINFO, ByVal wUsage As Long) As Long
Public Declare Function StretchDIBits Lib "gdi32" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long, ByVal Width As Long, ByVal Height As Long, ByVal X2 As Long, ByVal Y2 As Long, ByVal sWidth As Long, ByVal sHeight As Long, ByVal PointerToBits As Long, lpBitsInfo As BITMAPINFO, ByVal wUsage As Long, ByVal dwRop As Long) As Long

Public Type BITMAP '14 bytes
    bmType As Long
    bmWidth As Long
    bmHeight As Long
    bmWidthBytes As Long
    bmPlanes As Integer
    bmBitsPixel As Integer
    bmBits As Long
End Type
Public 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
Public Type RGBQUAD
    rgbBlue As Byte
    rgbGreen As Byte
    rgbRed As Byte
    rgbReserved As Byte
End Type
Public Type BITMAPINFO
    bmiHeader As BITMAPINFOHEADER
    bmiColors As RGBQUAD
End Type
Public Const DIB_RGB_COLORS = 0&
'Public Const IMAGE_BITMAP = 0&
Public Const BI_RGB = 0&

Public Const pixR As Integer = 2
Public Const pixG As Integer = 1
Public Const pixB As Integer = 0


Public BMInf As BITMAPINFO
Public btyaryStripPixels() As Byte
Public btyaryStripPixelsHome() As Byte
Public btyaryStripPixelsVisitor() As Byte

Public Type STRIP_IMAGE
    BMPInfo As BITMAPINFO
    btyaryStripPixels() As Byte
    strColorLabels As String
End Type

Public Type STRIP_ARRAY
    btyaryStripPixels() As Byte
End Type

Public Strips() As STRIP_IMAGE
Public StripsCurrent(0 To 1) As STRIP_ARRAY

Public Rinks() As STRIP_IMAGE
Public RinksCurrent As STRIP_ARRAY

Public Enum BUTTONDOWNMODE
    Neutral = 0
    PaintBrush = 1
    EyeDropper = 2
End Enum

Public objButtonDownMode As BUTTONDOWNMODE

'Clipboard Global
Public objClipboardID As Long
Public Const cClipboardLines = "Line"
Public Const cClipboardPlayers = "Player"
Public Const cClipboardGoalies = "Goalie"
Public Const cClipboardPlayoffDraws = "Playoff Draw"

'Public objClipboard As New clsCustomClipboard
'Public strClipboard As String
'Public strClipboardObject As String 'used to audit if lines, or player etc. data is loaded into the clipboard
'Public strClipboardBytes As String
'Public arybtyClipboard() As Byte
'Public Const cClipboardName = "NOSEDEV0"
'Public Const cClipboardDelimiter = "|"
'Public Const cClipboardSubDelimiter = ";"

Public blnSpashAbout As Boolean 'Is splash screen being used for about request?


'Tooltip stuff
'Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
   (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long

'Public Const LVM_FIRST As Long = &H1000
'Public Const LVM_HITTEST As Long = (LVM_FIRST + 18)
'Public Const LVM_SUBITEMHITTEST As Long = (LVM_FIRST + 57)
'Public Const LVHT_ONITEMICON As Long = &H2
'Public Const LVHT_ONITEMLABEL As Long = &H4
'Public Const LVHT_ONITEMSTATEICON As Long = &H8
'Public Const LVHT_ONITEM As Long = (LVHT_ONITEMICON Or _
                                    LVHT_ONITEMLABEL Or _
                                    LVHT_ONITEMSTATEICON)
'Public Type POINTAPI
'    X As Long
'    Y As Long
'End Type
'Public Type LVHITTESTINFO
'   pt As POINTAPI
'   flags As Long
'   iItem As Long
'   iSubItem As Long
'End Type


Sub Main()
On Error GoTo Err_

Const cCaption = "Fatal Error"
Const cFolderErrorPrefix = vbNewLine & "The required folder:" & vbNewLine & vbNewLine
Const cFileErrorPrefix = vbNewLine & "The required file:" & vbNewLine & vbNewLine
Const cPathErrorSuffix = vbTab & vbNewLine & vbNewLine & "does not exist!"

Dim intFor As Integer
Dim strAppPath As String

If Not fFileDIRExists(fWindowsSystemFolderPath() & "msvbvm60.dll") Then 'INI file
    MsgBox vbNewLine & "Please install the ""Visual Basic 6.0 SP5: Run-Time Redistribution Pack""." & vbTab & cPathErrorSuffix, vbCritical, cCaption
    GoTo Halt_
ElseIf Not fFileDIRExists(fWindowsSystemFolderPath() & "mscomctl.ocx") Then 'INI file
    MsgBox vbNewLine & "Please install and register the ""Windows Common Controls ActiveX Control DLL"" (mscomctl.ocx)." & vbTab & cPathErrorSuffix, vbCritical, cCaption
    GoTo Halt_
End If

Call InitCommonControls

blnHookColumns = fblnVBExecutable()

strAppPath = AppPath()

'Check for all assumed folders and file!
If Not fFileDIRExists(strAppPath & apINI, vbDirectory) Then 'folder
    MsgBox cFolderErrorPrefix & strAppPath & apINI & cPathErrorSuffix, vbCritical, cCaption
    GoTo Halt_
ElseIf Not fFileDIRExists(strAppPath & apINI & apifROMS) Then 'INI file
    MsgBox cFileErrorPrefix & strAppPath & apINI & apifROMS & cPathErrorSuffix, vbCritical, cCaption
    GoTo Halt_
ElseIf Not fFileDIRExists(strAppPath & apINI & apifHexText) Then 'INI file
    MsgBox cFileErrorPrefix & strAppPath & apINI & apifHexText & cPathErrorSuffix, vbCritical, cCaption
    GoTo Halt_
ElseIf Not fFileDIRExists(strAppPath & apINI & apifStrips) Then 'INI file
    MsgBox cFileErrorPrefix & strAppPath & apINI & apifStrips & cPathErrorSuffix, vbCritical, cCaption
    GoTo Halt_
ElseIf Not fFileDIRExists(strAppPath & apINI & apifRinks) Then 'INI file
    MsgBox cFileErrorPrefix & strAppPath & apINI & apifRinks & cPathErrorSuffix, vbCritical, cCaption
    GoTo Halt_
ElseIf Not fFileDIRExists(strAppPath & apINI & apifRinks) Then 'INI file
    MsgBox cFileErrorPrefix & strAppPath & apINI & apifRinks & cPathErrorSuffix, vbCritical, cCaption
    GoTo Halt_
ElseIf Not fFileDIRExists(strAppPath & apCursors, vbDirectory) Then 'folder
    MsgBox cFolderErrorPrefix & strAppPath & apCursors & cPathErrorSuffix, vbCritical, cCaption
    GoTo Halt_
ElseIf Not fFileDIRExists(strAppPath & apIcons, vbDirectory) Then 'folder
    MsgBox cFolderErrorPrefix & strAppPath & apIcons & cPathErrorSuffix, vbCritical, cCaption
    GoTo Halt_
ElseIf Not fFileDIRExists(strAppPath & apRinks, vbDirectory) Then 'folder
    MsgBox cFolderErrorPrefix & strAppPath & apRinks & cPathErrorSuffix, vbCritical, cCaption
    GoTo Halt_
ElseIf Not fFileDIRExists(strAppPath & apStrips, vbDirectory) Then 'folder
    MsgBox cFolderErrorPrefix & strAppPath & apStrips & cPathErrorSuffix, vbCritical, cCaption
    GoTo Halt_
End If

For intFor = LBound(arystrSniperPalette) To UBound(arystrSniperPalette)
    arystrSniperPalette(intFor) = vbNullString
Next intFor
lngSniperPalettePreview = vbBlack


'Reset all form positions
For intFor = fdiGoalies To fdiTeams
    objfdi(intFor).UseValues = False
Next intFor


blnApplyNextGoalieEdit = False
blnApplyNextPlayerEdit = False
blnApplyNextLineEdit = False
blnApplyNextPlayoffDrawEdit = False
blnApplyNextRuleEdit = False
blnApplyNextTeamEdit = False

Load frmMDI
blnSpashAbout = False
Load frmAbout
Unload frmAbout
Call frmMDI.psFileMenuEnabled(True)

objButtonDownMode = Neutral

'blnColorSniperIsLoaded = False
'Load frmMain

Exit_:
    Exit Sub

Halt_:
    End
    
Err_:
    MsgBox Err.Number, vbExclamation, Err.Number
    Resume Exit_


End Sub

'Public Function fNumlockOn() As Boolean
'On Error GoTo Err_:

'Dim intNumLockKeyState As Integer

'intNumLockKeyState = GetKeyState(VK_NUMLOCK)

'fNumlockOn = (intNumLockKeyState = 1 Or intNumLockKeyState = -127) 'On
'fNumlockOn = (intNumLockKeyState = 0 Or intNumLockKeyState = -128) 'OFF

'Exit_:
'    Exit Function
    
'Err_:
'    MsgBox Err.Description, vbExclamation, Err.Number
'    Resume Next
    
'End Function

'Public Sub sNumLockStateChange()
'On Error GoTo Err_:

'keybd_event VK_NUMLOCK, 0, KEYEVENTF_EXTENDEDKEY, 0
'keybd_event VK_NUMLOCK, 0, KEYEVENTF_EXTENDEDKEY Or KEYEVENTF_KEYUP, 0
'blnNumLockRevert = True
'keybd_event VK_NUMLOCK, 0, KEYEVENTF_EXTENDEDKEY, 0
'keybd_event VK_NUMLOCK, 0, KEYEVENTF_EXTENDEDKEY Or KEYEVENTF_KEYUP, 0
'blnNumLockRevert = False

'Exit_:
'    Exit Sub
    
'Err_:
'    MsgBox Err.Description, vbExclamation, Err.Number
'    Resume Next

'End Sub

'Public Sub sNumLockStateChangeAuto()
'On Error GoTo Err_:

'If blnmnuOptionsQuickEditingOn And Not fNumlockOn() Then
'    Call sNumLockStateChange
'End If

'Exit_:
'    Exit Sub
    
'Err_:
'    MsgBox Err.Description, vbExclamation, Err.Number
'    Resume Next

'End Sub


'Public Sub psDrawBit(pspbx As PictureBox, psBitmapGrid As tBitmapGridMap, psBGRColor As Long, Optional flip As Boolean = False)
'On Error GoTo Err_


'Dim intStep As Integer
'Dim intZoom As Integer

'intZoom = CInt(pspbx.Tag)

'For intStep = 0 To (psBitmapGrid.Boxes - 1) Step 1
'    With psBitmapGrid.BitmapGrid(intStep)
'        If flip Then
'            'pspbx.Line ((54 - .x1) * 2, .y1 * 2)-(((54 - .x2) * 2) - 1, (.y2 * 2) + 1), psBGRColor, BF
'            pspbx.Line ((54 - .X) * intZoom, .Y * intZoom)-(((54 - .x2) * intZoom) - (intZoom - 1), (.y2 * intZoom) + (intZoom - 1)), psBGRColor, BF
'        Else
'            'pspbx.Line (.x1 * 2, .y1 * 2)-((.x2 * 2) + 1, (.y2 * 2) + 1), psBGRColor, BF
'            pspbx.Line (.X * intZoom, .Y * intZoom)-((.x2 * intZoom) + (intZoom - 1), (.y2 * intZoom) + (intZoom - 1)), psBGRColor, BF
'        End If
'    End With
'Next intStep

'Exit_:
'    Exit Sub

'Err_:
    'MsgBox vbNewLine & "Oh fucketti!" & vbNewLine & vbNewLine & Err.Description & vbTab, vbCritical, Err.Number
    'Resume Exit_
 '   Resume Next


'End Sub

Sub psExtractRGBFromColor(ByVal lngColor As Long, ByRef Red As Byte, ByRef Green As Byte, ByRef Blue As Byte)

'replace LSet RGBWrapper method ?faster?

If Not lngColor < 0 Then
    Red = lngColor Mod 256
    Green = (lngColor \ &H100) Mod 256
    Blue = (lngColor \ &H10000) Mod 256
End If


End Sub

Sub sSelectedItemsNil(ByRef objSelectedItem As SELECTEDITEMS)
On Error Resume Next

Const cNil = 0

With objSelectedItem
    .TeamOffset = cNil
    .TeamListIndex = cNil
    .TeamNameOffset = cNil
    '.TeamNameLocationOffset = cNil
    .TeamRosterOffset = cNil
    .TeamRosterPlayers = cNil
    .TeamColorOffset = cNil
    .TeamPlayers = cNil
    .TeamPlayersOffense = cNil
    .TeamPlayersByteOffset = cNil
    .TeamGoalies = cNil
    .TeamGoaliesByteOffset = cNil
    .TeamLinesOffset = cNil
    .TeamLinesEndOffset = cNil
    .TeamFreeBytes = cNil
    .GoalieOffset = cNil
    .GoalieJerseyOffset = cNil
    .GoalieListIndex = cNil
    .GoalieListProperties = False
    .PlayerOffset = cNil
    .PlayerJerseyOffset = cNil
    .PlayerListIndex = cNil
    .LineOffset = cNil
    .LineListIndex = cNil
    .TeamPositionsOffset = cNil
    .TeamPositionsBytes = cNil
End With

End Sub

Sub sSelectedItemsPopulate(ByRef objSelectedItem As SELECTEDITEMS, ByVal lngTeamOffset As Long)

Dim intFor As Integer
Dim lngPlayerOffset As Long
Dim lngPlayerNameOffset As Long
Dim intPlayerCount As Integer

With objSelectedItem
    .TeamOffset = lngTeamOffset
    '.TeamListIndex
    .TeamNameOffset = .TeamOffset + fHexToDecimal(fHexBytes(btyaryOpenFile(), .TeamOffset + 4, 1))
    .TeamRosterOffset = .TeamOffset + fHexToDecimal(fHexBytes(btyaryOpenFile(), .TeamOffset, 1))
    .TeamColorOffset = .TeamOffset + fHexToDecimal(fHexBytes(btyaryOpenFile(), (.TeamOffset + 2), 1))
    '.TeamPlayers
    
    If blnROMPlayerNameSupport Then
        .TeamGoaliesByteOffset = .TeamOffset + fHexToDecimal(fHexBytes(btyaryOpenFile(), .TeamOffset + 10, 1))
        .TeamGoalies = fTeamGoalieCount(fHexBytes(btyaryOpenFile(), .TeamGoaliesByteOffset, 1))
        .TeamPlayersByteOffset = .TeamOffset + fHexToDecimal(fHexBytes(btyaryOpenFile(), .TeamOffset + 8, 1)) + 3
        .TeamPlayersOffense = fHexToDecimal(Left(fHexBytes(btyaryOpenFile(), .TeamPlayersByteOffset, 0), 1))
        .TeamLinesOffset = .TeamOffset + fHexToDecimal(fHexBytes(btyaryOpenFile(), .TeamOffset + 6, 1))
        '.TeamNameLocationOffset = .TeamNameOffset + fHexToDecimal(fHexBytes(btyaryOpenFile(), .TeamNameOffset, 1))
        
        .TeamRosterPlayers = 0
        lngPlayerOffset = .TeamRosterOffset
        lngPlayerNameOffset = lngPlayerOffset + fHexToDecimal(fHexBytes(btyaryOpenFile(), lngPlayerOffset, 1))
        Do While lngPlayerNameOffset < .TeamNameOffset
            .TeamRosterPlayers = .TeamRosterPlayers + 1
            lngPlayerOffset = lngPlayerNameOffset + 8
            lngPlayerNameOffset = lngPlayerOffset + fHexToDecimal(fHexBytes(btyaryOpenFile(), lngPlayerOffset, 1))
        Loop
        
        'MsgBox intPlayerCount
    Else
        .TeamGoalies = 2
        .TeamLinesOffset = .TeamOffset + fHexToDecimal(fHexBytes(btyaryOpenFile(), .TeamOffset + 8, 1))
        '.TeamNameLocationOffset = .TeamNameOffset
        'intPlayerCount = 0
        'lngPlayerOffset = .TeamRosterOffset
        'Do While lngPlayerOffset < .TeamNameOffset
        '    intPlayerCount = intPlayerCount + 1
        '    lngPlayerOffset = lngPlayerOffset + 8
        'Loop
        'MsgBox intPlayerCount
        .TeamRosterPlayers = (.TeamNameOffset - .TeamRosterOffset) / 8

    End If
    
    .TeamPlayers = .TeamRosterPlayers - .TeamGoalies
    
    .TeamLinesEndOffset = .TeamLinesOffset + (8 * intROMLines)
    
    .TeamFreeBytes = lvwTeams_SelectedItemFreeBytes(.TeamOffset, btyaryOpenFile())
    
    If blnROMPlayerPositionSupport Then
        .TeamPositionsOffset = .TeamNameOffset
        For intFor = 0 To 3 'cycle all names
            .TeamPositionsOffset = .TeamPositionsOffset + fHexToDecimal(fHexBytes(btyaryOpenFile(), .TeamPositionsOffset, 1)) 'Location
        Next intFor
       .TeamPositionsBytes = fTeamPositionBytes(.TeamPositionsOffset)
    End If
    '.GoalieOffset
    '.GoalieListIndex
    '.PlayerOffset
    '.PlayerListIndex
    '.LineOffset
    '.LineListIndex
End With

End Sub

Public Function fComboBoxDroppedDown(ByVal lngcboHwnd As Long) As Boolean

If SendMessage(lngcboHwnd, CB_GETDROPPEDSTATE, 0, 0) = 0 Then
    fComboBoxDroppedDown = False
Else
    fComboBoxDroppedDown = True
End If

End Function

Public Sub sComboBoxDrop(ByVal lngcboHwnd As Long)
    If Not fComboBoxDroppedDown(lngcboHwnd) Then
        Call SendMessage(lngcboHwnd, CB_SHOWDROPDOWN, True, 0&)
    End If
End Sub

Public Sub sComboBoxRetract(ByVal lngcboHwnd As Long)
    If fComboBoxDroppedDown(lngcboHwnd) Then
        Call SendMessage(lngcboHwnd, CB_SHOWDROPDOWN, False, 0&)
    End If
End Sub

Function fINISplitFix(ByVal strINIValue As String, ByVal intExpectedValues As Integer, ByVal strDelimiter As String) As String

Dim strOutput As String
Dim intFor As Integer
Dim intUbound As Integer

intUbound = UBound(Split(strINIValue, strDelimiter))
strOutput = vbNullString

For intFor = 0 To intExpectedValues - 1
    If intFor > intUbound Then
        strOutput = strOutput & strDelimiter
    Else
        strOutput = strOutput & Split(strINIValue, strDelimiter)(intFor) & strDelimiter
    End If
Next intFor

fINISplitFix = Left(strOutput, Len(strOutput) - Len(strDelimiter))

End Function

Function fTeamPositionBytes(ByVal lngTeamPositionOffset) As Long
On Error GoTo Err_

Dim intFor As Integer
Dim lngNextClosestOffset As Long
Dim lngTeamOffset As Long

lngNextClosestOffset = lngTeamDataEndOffset  'last team/ or draw start offset

intFor = 0

Do While intFor < intTeamCount
    lngTeamOffset = fHexToDecimal(fHexBytes(btyaryOpenFile(), lngTeamsStartOffset + (intFor * 4), 3))
    
    If lngTeamOffset > lngTeamPositionOffset And lngTeamOffset < lngNextClosestOffset Then
        lngNextClosestOffset = lngTeamOffset
    End If
    
    intFor = intFor + 1
Loop

fTeamPositionBytes = lngNextClosestOffset - lngTeamPositionOffset

Exit_:
    Exit Function

Err_:
    MsgBox Err.Number, vbExclamation, Err.Number
    Resume Next

End Function

Public Function fROMPlayerNameSupport(ByVal ROMVersion As String) As Boolean

Select Case ROMVersion
    Case rvSMD91, rvSG92:
        fROMPlayerNameSupport = False
    Case Else: 'rvSG93, rvSG94, rvSG95, rvSMD95E, rvSG96, rvSMD96E, rvSG97, rvSG98:
        fROMPlayerNameSupport = True
End Select

End Function

Public Function fROMPlayerPositionSupport(ByVal ROMVersion As String) As Boolean

Select Case ROMVersion
    Case rvSG96, rvSMD96E, rvSG97, rvSG98:
        fROMPlayerPositionSupport = True
    Case Else:
        fROMPlayerPositionSupport = False
End Select

End Function


Public Function fROMPlayerForwardsSupport() As Boolean

Select Case strROMVersion
    Case rvSG93, rvSG94, rvSG95, rvSMD95E:
        fROMPlayerForwardsSupport = True
    Case Else:
        fROMPlayerForwardsSupport = False
End Select

End Function

Public Function fROMTeamNameRedirectSupport() As Boolean

Select Case strROMVersion
    Case rvSG94, rvSG95:
        fROMTeamNameRedirectSupport = True
    Case Else:
        fROMTeamNameRedirectSupport = False
End Select

End Function


Public Function fROMTeamHeaderNextTeam() As Boolean

Select Case strROMVersion
    Case rvSMD91, rvSG92:
        fROMTeamHeaderNextTeam = True
    Case Else:
        fROMTeamHeaderNextTeam = False
End Select

End Function

Public Function fROMTeamLines() As Integer

Select Case strROMVersion
    Case rvSMD91, rvSG92, rvSG93:
        fROMTeamLines = 7
    Case Else: 'rvSG94, rvSG95, rvSMD95E, rvSG96, rvSMD96E, rvSG97, rvSG98:
        fROMTeamLines = 8
End Select

End Function


Public Function fROMDataStructureVersion() As Integer
'this is to change!
Select Case strROMVersion
    Case rvSMD91, rvSG92:
        fROMDataStructureVersion = 1
    Case rvSG93:
        fROMDataStructureVersion = 2
    Case rvSG94, rvSG95, rvSMD95E:
        fROMDataStructureVersion = 3
    Case rvSG96, rvSMD96E, rvSG97, rvSG98:
        fROMDataStructureVersion = 4
    Case Else:
        fROMDataStructureVersion = 0
End Select

End Function

Public Function fROMCopyrightTextAddressOffsetUsed() As Boolean

Select Case strROMVersion
    Case rvSMD91, rvSG92, rvSG96, rvSMD96E, rvSG97, rvSG98:
        fROMCopyrightTextAddressOffsetUsed = False
    Case Else: 'rvSG93, rvSG94, rvSG95, rvSMD95E:
        fROMCopyrightTextAddressOffsetUsed = True
End Select

End Function


Public Function fROMDataEndOffset() As Long
On Error Resume Next

Const cDataEndBytePrefix = &H60
Const cDataEndByteSuffix = &HFE

Dim lngLBound As Long
Dim lngUBound As Long
Dim lngFor As Long

lngLBound = LBound(btyaryOpenFile)
lngUBound = UBound(btyaryOpenFile)

For lngFor = lngUBound To lngLBound Step -1
    If btyaryOpenFile(lngFor) = cDataEndBytePrefix Then
        If btyaryOpenFile(lngFor + 1) = cDataEndByteSuffix Then
            fROMDataEndOffset = lngFor + 2 'found end '60FE
            Exit For
        End If
    End If
Next lngFor

End Function

Public Function fChecksumRoutineOffset(ByVal lngAddressOffset As Long, ByVal lngEOFOffset As Long) As Long
On Error GoTo Err_

Const cChecksumEnabled = &H4EB9
Const cChecksumEnabledHeader = &H700091C8
Const cChecksumDisabled = &H4E71

Dim lngChecksumRoutineOffset As Long
Dim lngValue As Long

lngValue = fHexToDecimal(fHexBytes(btyaryOpenFile(), lngAddressOffset - 2, 1))

Select Case lngValue
    Case cChecksumDisabled:
        If fHexToDecimal(fHexBytes(btyaryOpenFile(), lngAddressOffset, 1)) = cChecksumDisabled And _
           fHexToDecimal(fHexBytes(btyaryOpenFile(), lngAddressOffset + 2, 1)) = cChecksumDisabled Then
            lngChecksumRoutineOffset = 0 'Not Used
        Else
            GoTo Err_
        End If
    Case cChecksumEnabled:
        lngChecksumRoutineOffset = fHexToDecimal(fHexBytes(btyaryOpenFile(), lngAddressOffset, 3))
        If lngChecksumRoutineAddressOffset <= LBound(btyaryOpenFile) Or _
           lngChecksumRoutineAddressOffset >= UBound(btyaryOpenFile) Then
            GoTo Err_ 'Outside of ROM size
        ElseIf Not fHexToDecimal(fHexBytes(btyaryOpenFile(), lngChecksumRoutineOffset, 3)) = cChecksumEnabledHeader Then
            GoTo Err_ 'Outside of ROM size
        ElseIf Not lngChecksumRoutineAddressOffset < lngEOFOffset Then
            GoTo Err_ 'EOF Appears before the checksum routine... not possible!
        End If
    Case Else
        GoTo Err_ 'Outside of ROM size
End Select

Exit_:
fChecksumRoutineOffset = lngChecksumRoutineOffset
Exit Function

Err_:
lngChecksumRoutineOffset = -1
GoTo Exit_

End Function



'Public Function Nz(Value As Variant, Optional ValueIfNull As Variant) As Variant
'On Error Resume Next

'If IsNull(Value) Then
'    Nz = ValueIfNull
'Else
'    Nz = Value
'End If

'End Function

Public Function Ez(Value As String, Optional ValueIfNull As String) As String
On Error Resume Next

If Value = vbNullString Then
    Ez = ValueIfNull
Else
    Ez = Value
End If

End Function

Public Function AppPath() As String
On Error Resume Next

Const Backslash = "\"

With App
    If Right(.Path, 1) = Backslash Then
        AppPath = .Path 'Pass as is, do not alter
    Else
        AppPath = .Path & Backslash
    End If
End With

End Function

Public Function AppVersionDisplay() As String

Const cDot = "."

'AppVersionDisplay = "v" & cDot & App.Major & cDot & App.Minor & "b"
'AppVersionDisplay = App.Major & Dot & App.Minor & "a"

'AppVersionDisplay = App.Major & cDot & App.Minor & "b"
AppVersionDisplay = App.Major & cDot & App.Minor & "b"

End Function
Public Function AppBuildDisplay() As String

Const Dot = "."

'AppBuildDisplay = "[" & Format(App.Revision, "0000") & "]"
AppBuildDisplay = "[060617]"

End Function

Private Function fblnVBExecutable() As Boolean
'Visual Basic Integrated Development Environment
On Error GoTo Err_

fblnVBExecutable = True
Debug.Print 1 / 0
    
Exit_:
Exit Function

Err_:
fblnVBExecutable = False
Resume Exit_

End Function

Private Function fWindowsSystemFolderPath() As String
On Error Resume Next

Const cMAX_LENGTH = 512
Const cBACKSLASH = "\"

Dim s As String
Dim c As Long

s = String$(cMAX_LENGTH, 0)
c = GetSystemDirectoryB(s, cMAX_LENGTH)
If c > 0 Then
    If c > Len(s) Then
        s = Space$(c + 1)
        c = GetSystemDirectoryB(s, cMAX_LENGTH)
    End If
End If

If c > 0 Then
    fWindowsSystemFolderPath = Left$(s, c)
    If Not Right(fWindowsSystemFolderPath, 1) = cBACKSLASH Then
        fWindowsSystemFolderPath = fWindowsSystemFolderPath & cBACKSLASH
    End If
Else
    fWindowsSystemFolderPath = vbNullString
End If

End Function

Public Function fExtractPathFilename(ByVal strPath As String, Optional ByVal blnFormatForSavePrompt As Boolean = False) As String
Dim strOut As String

strOut = Right(strPath, Len(strPath) - InStrRev(strPath, "\"))

Exit_:

If blnFormatForSavePrompt Then
    strOut = vbNewLine & "Save changes to """ & strOut & """?" & vbTab
End If

fExtractPathFilename = strOut
Exit Function

Err_:
strOut = vbNullString
Resume Exit_

End Function

Public Function fExtractPathDirectory(ByVal strPath As String) As String
Dim strOut As String

strOut = Left(strPath, InStrRev(strPath, "\"))

Exit_:
fExtractPathDirectory = strOut
Exit Function

Err_:
strOut = vbNullString
Resume Exit_

End Function


Public Function fSegaChecksumCalc() As Long
On Error GoTo Err_

Dim checksum As Long
Dim lngFor As Long
Dim Value As Long

Dim lngEndOffset As Long

lngEndOffset = fHexToDecimal(fHexBytes(btyaryOpenFile(), &H1A4, 3))

checksum = 0

'For lngFor = 512 To UBound(btyaryOpenFile) 'skip header/512 bytes
For lngFor = 512 To lngEndOffset
    Value = btyaryOpenFile(lngFor)
    If lngFor Mod 2 = 0 Then
        Value = Value * 256 'shift left << 8
    End If
    checksum = checksum + Value
    If checksum > 65535 Then
         checksum = checksum Mod 65536   'simulate unsigned avoiding overflow? 0 - 65535
    End If
Next lngFor

' *** unsigned short Calculate_Checksum(void) // Example below taken from GENS source
' *** {
' ***     unsigned short checksum = 0;
' ***     unsigned int i;
' ***
' ***     if (!Game) return(0);
' ***
' ***     for (i = 512; i < Rom_Size; i += 2)
' ***     {
' ***         checksum += (unsigned short)(Rom_Data[i + 0]);
' ***         checksum += (unsigned short)(Rom_Data[i + 1] << 8);
' ***     }
' ***
' ***     return checksum;
' *** }

'Debug.Print checksum & " : " & Hex(checksum)

Exit_:
fSegaChecksumCalc = checksum
Exit Function

Err_:
checksum = 0
Resume Exit_

End Function

Public Sub sSegaChecksumWrite()
On Error GoTo Err_

Dim checksum As Long

checksum = fSegaChecksumCalc

btyaryOpenFile(&H18E) = CByte(checksum \ &H100&) ' >> 8
btyaryOpenFile(&H18F) = checksum And &HFF

Exit_:
Exit Sub

Err_:
Resume Exit_

End Sub


Public Sub sROMSizeBytesWrite()
On Error Resume Next

Const cROMDataEndAddressOffset = &H1A4 '420

Call sHexBytesWriteByte(btyaryOpenFile, cROMDataEndAddressOffset, 3, 0) 'Reset to 0
Call sHexBytesAdjust(btyaryOpenFile, cROMDataEndAddressOffset, 3, UBound(btyaryOpenFile)) 'Reset to 0

End Sub


Public Function fTeamDataEndOffsetHex() As Long

Dim lngOffset As Long
Dim lngForTeamOffset As Long
Dim intFor As Integer

lngOffset = 0

For intFor = 0 To intTeamCount - 1
    lngForTeamOffset = fHexToDecimal(fHexBytes(btyaryOpenFile(), lngTeamsStartOffset + (intFor * 4), 3))   'Start of Name Offset
    If lngForTeamOffset > lngOffset Then 'Find Highest Offset Team
        lngOffset = lngForTeamOffset
    End If
Next intFor

'Goto Name Byte Start
lngOffset = lngOffset + fHexToDecimal(fHexBytes(btyaryOpenFile(), lngOffset + 4, 1)) 'Start of Name Offset

'Add Name Bytes
lngOffset = lngOffset + fHexToDecimal(fHexBytes(btyaryOpenFile(), lngOffset, 1))

'Not using intROMDataStructureVersion as not determined yet?

If intROMDataStructureVersion > 1 Then 'rvSG93 +
    lngOffset = lngOffset + fHexToDecimal(fHexBytes(btyaryOpenFile(), lngOffset, 1)) 'Team Initials
End If

If intROMDataStructureVersion > 2 Then 'rvSG94, rvSG95, rvSMD95E +
    lngOffset = lngOffset + fHexToDecimal(fHexBytes(btyaryOpenFile(), lngOffset, 1)) 'Team Slogan
    lngOffset = lngOffset + fHexToDecimal(fHexBytes(btyaryOpenFile(), lngOffset, 1)) 'Arena Name
End If

If intROMDataStructureVersion > 3 Then 'rvSG96, rvSMD96E, rvSG97, rvSG98
    lngOffset = lngOffset + lngTeamLastPositionBytes
End If

fTeamDataEndOffsetHex = lngOffset

End Function

