Attribute VB_Name = "modMDIChild"
Option Explicit

'Private aryBGRtoRGBLong(0 To 15, 0 To 15, 0 To 15) As Long
Private aryBGRRed(0 To 15) As Byte
Private aryBGRBlue(0 To 15) As Byte
Private aryBGRGreen(0 To 15) As Byte

Private arydblRatingXFactor(0 To 1, 0 To 12) As Double '0 for Goalie, 1 for Players
Private intRatingBaseFactor As Integer

Private Type SelectionRetainer
    Items As String
    SelectedItem As Integer
    SelectedItemSelected As Boolean 'Tracks if highlighted!
End Type

Private Declare Function OleTranslateColor Lib "OLEPRO32.dll" ( _
                 ByVal lOleColor As Long, _
                 ByVal lHPalette As Long, _
                 lColorRef As Long) As Long '"OLEPRO32.DLL" or "oleaut32.dll"?
                 
                 Private Const CLR_INVALID = &HFFFF '-1

Sub myFormResize(ByVal lvw As ListView)
On Error Resume Next 'avoid error in resize to ziltch

With lvw
    If Not .Parent.WindowState = vbMinimized Then ' And .Parent.ScaleHeight > 0 And .Parent.ScaleWidth > 0 T
        .Height = .Parent.ScaleHeight - lvw.Top
        .Width = .Parent.ScaleWidth - lvw.Left
        .SelectedItem.EnsureVisible
        '.ColumnHeaders(1).Width = .Width - 60
    End If
End With

End Sub

Sub myListviewLoadColumns(ByVal lvw As ListView, ByVal strColumnLabels As String, ByVal strColumnWidths As String, Optional ByVal strEditLabels As String = vbNullString) ', ByVal intArrayElements As Integer)
On Error GoTo Err_

'Const cintVerticalScrollWidth = 300      '?13095

Dim intFor As Integer
Dim intLbound As Integer
Dim intUbound As Integer
'Dim intDifference As Boolean

strColumnLabels = RTrim(strColumnLabels)
If Right(strColumnLabels, 1) = ";" Then
    strColumnLabels = Left(strColumnLabels, Len(strColumnLabels) - 1)
End If

intLbound = LBound(Split(strColumnLabels, ";"))
intUbound = UBound(Split(strColumnLabels, ";"))

'intDifference = UBound(Split(strColumnLabels, ";")) - UBound(Split(strEditLabels, ";"))

With lvw
    'For intFor = 0 To (intArrayElements - 1) Step 1
    For intFor = intLbound To intUbound
        .ColumnHeaders.Add , , Split(strColumnLabels, ";")(intFor)
        .ColumnHeaders(intFor + 1).Width = CLng(Split(strColumnWidths, ";")(intFor))
        If Not strEditLabels = vbNullString Then
            .ColumnHeaders(intFor + 1).Tag = Split(strEditLabels, ";")(intFor)
        End If
        
    Next intFor
End With
    
'Call sDisplayFileOffset

Exit_:
Exit Sub

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

End Sub


Sub lvwTeams_Update(Optional ByVal blnForceUpdate As Boolean = False, Optional ByVal blnForceComboRefresh As Boolean = False)
On Error GoTo Err_

Dim lvwItem As MSComctlLib.ListItem

Dim intFor As Integer

Dim intPlayerStep As Integer
Dim lngPlayerOffset As Long
'Dim lngPlayerNameLength As Long
Dim lngPlayerNameOffset As Long

Dim intColorStep As Integer
Dim lngColorOffset As Long

Dim intLinesStep As Integer
Dim lngLinesOffset As Long

Dim intGoaliesStep As Integer

Dim lngPlayerEndOffset As Long 'was integer... created overflow

Dim objSelectedPlayers As SelectionRetainer

Screen.MousePointer = vbHourglass

objSelected.TeamListIndex = CLng(frmTeams.lvwTeams.SelectedItem.Index)

If Not blnForceUpdate Then
    If lngLastTeamClick = objSelected.TeamListIndex Then
        GoTo Exit_
    ElseIf lngLastTeamClick > 0 And blnmnuOptionsTeamAutoManageFreeBytes Then
        Call sTeamFreeBytesMerge(CInt(lngLastTeamClick))
    End If
End If

Call sSelectedItemsPopulate(objSelected, CLng(frmTeams.lvwTeams.ListItems(objSelected.TeamListIndex).Tag))

lngLastTeamClick = objSelected.TeamListIndex

'Nicer way? - must do here before disabling toolbars!
If Not Screen.ActiveControl Is Nothing Then
    If frmGoalies.cboGoalieBytes(0).Enabled Then
        If Screen.ActiveControl.Name = "cboGoalieBytes" Then Call sComboBoxRetract(Screen.ActiveControl.hwnd)
    End If

    If frmPlayers.cboPlayerByte.Enabled Then
        If Screen.ActiveControl.Name = "cboPlayerByte" Then Call sComboBoxRetract(Screen.ActiveControl.hwnd)
    End If
End If

'disbled updated toolbars
Call sLoadToolbarState(frmGoalies.tlbIcons, False)
Call sLoadToolbarState(frmPlayers.tlbIcons, False)
Call sLoadToolbarState(frmLines.tlbIcons, False)
Call sLoadToolbarState(frmStrips.tlbIcons, False)

With objSelected
    
    '.TeamFreeBytes = lvwTeams_SelectedItemFreeBytes(.TeamOffset, btyaryOpenFile())

    Call lvwTeams_ButtonItemClick   'Update Bytes Icons on Teams Toolbar ... .TeamFreeBytes

    '.TeamNameOffset = .TeamOffset + fHexToDecimal(fHexBytes(btyaryOpenFile(), .TeamOffset + 4, 1))
    
    intPlayerStep = 0
    lngPlayerOffset = .TeamRosterOffset
    
    If blnROMPlayerNameSupport Then
        
        If Not blnForceUpdate Or blnForceComboRefresh Then
            For intFor = 0 To 3
                With frmGoalies.cboGoalieBytes(intFor)
                    .Tag = vbNullString
                    .ForeColor = vbWindowText
                    .BackColor = vbWindowBackground
                End With
            Next intFor
        
            For intGoaliesStep = 0 To 1
                frmGoalies.cboGoalieBytes(intGoaliesStep * 2).Tag = fHexToDecimal(Left(fHexBytes(btyaryOpenFile(), .TeamGoaliesByteOffset + intGoaliesStep, 0), 1))
                frmGoalies.cboGoalieBytes(intGoaliesStep * 2).ListIndex = CInt(frmGoalies.cboGoalieBytes(intGoaliesStep * 2).Tag)
                frmGoalies.cboGoalieBytes(intGoaliesStep * 2).FontBold = False 'reset if bold
                frmGoalies.cboGoalieBytes((intGoaliesStep * 2) + 1).Tag = fHexToDecimal(Right(fHexBytes(btyaryOpenFile(), .TeamGoaliesByteOffset + intGoaliesStep, 0), 1))
                frmGoalies.cboGoalieBytes((intGoaliesStep * 2) + 1).ListIndex = CInt(frmGoalies.cboGoalieBytes((intGoaliesStep * 2) + 1).Tag)
                'frmGoalies.cboGoalieBytes((intGoaliesStep * 2) + 1).FontBold = False 'reset if bold
            Next intGoaliesStep
        
        End If

        lngPlayerEndOffset = .TeamNameOffset - 2
        lngPlayerNameOffset = lngPlayerOffset + fHexToDecimal(fHexBytes(btyaryOpenFile(), lngPlayerOffset, 1))
        
    Else
        lngPlayerEndOffset = .TeamNameOffset
        lngPlayerNameOffset = lngPlayerOffset
    End If
    
    
    
    
    'Adjust Goalie Items
    With frmGoalies.lvwGoalies
        If objSelected.TeamGoalies > .ListItems.Count Then
            Do While .ListItems.Count < objSelected.TeamGoalies
                .ListItems.Add
            Loop
        Else
            Do While .ListItems.Count > objSelected.TeamGoalies
                .ListItems.Remove .ListItems.Count
            Loop
        End If
    End With
    
    'Adjust Player Items
    With frmPlayers.lvwPlayers
        If objSelected.TeamPlayers > .ListItems.Count Then
            Do While .ListItems.Count < objSelected.TeamPlayers
                .ListItems.Add
            Loop
        Else
            Do While .ListItems.Count > objSelected.TeamPlayers
                .ListItems.Remove .ListItems.Count
            Loop
        End If
    End With
    
    'Adjust Line Items
    With frmLines.lvwLines
        If intROMLines > .ListItems.Count Then
            Do While .ListItems.Count < intROMLines
                .ListItems.Add
            Loop
        Else
            Do While .ListItems.Count > intROMLines
                .ListItems.Remove .ListItems.Count
            Loop
        End If
    End With
        
    Do While lngPlayerNameOffset < .TeamNameOffset
        intPlayerStep = intPlayerStep + 1
        If intPlayerStep <= .TeamGoalies Then
            Set lvwItem = frmGoalies.lvwGoalies.ListItems(intPlayerStep)
            lvwItem.Tag = CStr(lngPlayerOffset)
        Else
            Set lvwItem = frmPlayers.lvwPlayers.ListItems(intPlayerStep - .TeamGoalies)
            lvwItem.Tag = CStr(lngPlayerOffset)
        End If
        
        Call lvwGoaliesPlayers_RequeryLineItem(lvwItem)
    
        lngPlayerOffset = lngPlayerNameOffset + 8
        
        If blnROMPlayerNameSupport Then
            lngPlayerNameOffset = lngPlayerOffset + fHexToDecimal(fHexBytes(btyaryOpenFile(), lngPlayerOffset, 1))
        Else
            lngPlayerNameOffset = lngPlayerOffset
        End If

    Loop
    
    If blnROMPlayerForwardsSupport Then
        If Not blnForceUpdate Or blnForceComboRefresh Then
            With frmPlayers.cboPlayerByte
                .Tag = vbNullString
                .ForeColor = vbWindowText
                .BackColor = vbWindowBackground
                
                .Tag = fHexToDecimal(Left(fHexBytes(btyaryOpenFile(), objSelected.TeamPlayersByteOffset, 0), 1))
                .ListIndex = CInt(frmPlayers.cboPlayerByte.Tag)
                'frmPlayers.cboPlayerByte.FontBold = False 'reset if bold
            End With
        End If
    End If
    
    intLinesStep = 0
    Do While intLinesStep < intROMLines
        lngLinesOffset = .TeamLinesOffset + (intLinesStep * 8)  '8 = bytes per lines
        Set lvwItem = frmLines.lvwLines.ListItems(intLinesStep + 1)
        lvwItem.Tag = CStr(lngLinesOffset)
        'lvwItem.ListSubItems.Add , , Split(strLineRowLabels, ";")(intLinesStep - 1)
        Call lvwLines_RequeryLineItem(lvwItem, frmTeams.lvwTeams.SelectedItem) 'FIX!
        intLinesStep = intLinesStep + 1
    Loop

    If Not blnForceUpdate Then
        With frmStrips
            .cbxSample(0) = vbUnchecked
            .cbxSample(1) = vbUnchecked
            .cmdApplyColors(0).Enabled = (.cbxSample(0) = vbChecked) And .cbxSample(0).Enabled
            .cmdApplyColors(1).Enabled = (.cbxSample(1) = vbChecked) And .cbxSample(1).Enabled
        End With
    End If

    .TeamColorOffset = .TeamOffset + fHexToDecimal(fHexBytes(btyaryOpenFile(), (.TeamOffset + 2), 1))

    For intColorStep = 0 To 31
        lngColorOffset = .TeamColorOffset + (intColorStep * 2)
        With frmStrips.pbxTeamColor(intColorStep)
            .BackColor = fColorHexBGRtoRGB(fHexByte(btyaryOpenFile(lngColorOffset)) & fHexByte(btyaryOpenFile((lngColorOffset + 1))))
            .ToolTipText = fHexByte(btyaryOpenFile(lngColorOffset)) & fHexByte(btyaryOpenFile((lngColorOffset + 1)))
            .Tag = lngColorOffset
        End With
        
        With frmStrips.pbxTeamColorPreview(intColorStep)
            If .BackColor = vb3DFace Then
                .BackColor = fColorHexBGRtoRGB(fHexByte(btyaryOpenFile(lngColorOffset)) & fHexByte(btyaryOpenFile((lngColorOffset + 1))))
                .ToolTipText = fHexByte(btyaryOpenFile(lngColorOffset)) & fHexByte(btyaryOpenFile((lngColorOffset + 1)))
            End If
        End With
        'Me.pbxTeamColorPreview(intColorStep).Tag = lngColorOffset
    Next intColorStep

    Call sDisplayFileOffset(True) 'update strips offsets
    sRedrawStrip 0, Strips(frmStrips.cboStripBitmap(0).ListIndex), StripsCurrent(0).btyaryStripPixels()
    sRedrawStrip 1, Strips(frmStrips.cboStripBitmap(1).ListIndex), StripsCurrent(1).btyaryStripPixels()

    frmMDI.cboTeams.ListIndex = .TeamListIndex - 1

    If blnROMPlayerNameSupport Then
        frmMDI.StatusBar1.SimpleText = fHexBytes(btyaryOpenFile(), .TeamLinesOffset - 6, 1) & "  " & _
                                       fHexBytes(btyaryOpenFile(), .TeamLinesOffset - 4, 1) & "  " & _
                                       fHexBytes(btyaryOpenFile(), .TeamLinesOffset - 2, 1)
    Else
        frmMDI.StatusBar1.SimpleText = fHexBytes(btyaryOpenFile(), .TeamOffset + 10, 1) & "  " & _
                                       fHexBytes(btyaryOpenFile(), .TeamOffset + 12, 1)
    End If

End With

'enable updated toolbars
Call sLoadToolbarState(frmGoalies.tlbIcons, True)
Call sLoadToolbarState(frmPlayers.tlbIcons, True)
Call sLoadToolbarState(frmLines.tlbIcons, True)
Call sLoadToolbarState(frmStrips.tlbIcons, True)

'repopulate new selection
objSelected.GoalieOffset = CLng(frmGoalies.lvwGoalies.SelectedItem.Tag)
If fListViewSelectedItemsCount(frmGoalies.lvwGoalies) = 0 Then
    frmGoalies.lvwGoalies.SelectedItem.Selected = True
End If
Call lvwGoalies_ButtonItemClick

objSelected.PlayerOffset = CLng(frmPlayers.lvwPlayers.SelectedItem.Tag)
If fListViewSelectedItemsCount(frmPlayers.lvwPlayers) = 0 Then
    frmPlayers.lvwPlayers.SelectedItem.Selected = True
End If
Call lvwPlayers_ButtonItemClick

objSelected.LineOffset = CLng(frmLines.lvwLines.SelectedItem.Tag)
If fListViewSelectedItemsCount(frmLines.lvwLines) = 0 Then
    frmLines.lvwLines.SelectedItem.Selected = True
End If
Call lvwLines_ButtonItemClick

Exit_:
'If Screen.ActiveControl.Enabled Then
'    If Left(Screen.ActiveControl.Name, 3) = cboLeft Then
'        Dim cboIndex As ComboBox
'        Set cboIndex = Screen.ActiveControl
'        Call sComboBoxRetract(cboIndex.hwnd)
'        Set cboIndex = Nothing
'    End If
'End If
Screen.MousePointer = vbNormal
Exit Sub

Err_:
Debug.Print "Team Update Error " & Err.Number
Select Case Err.Number
    Case 91:
        Resume Exit_
    Case 364:
        Resume Exit_
    Case Else:
        fErrMessage Err.Number, Err.Description, "Form_Load"
End Select
'Resume Exit_
Resume Next

End Sub


Sub lvwTeams_RequeryLineItem(ByVal psSelectedItem As MSComctlLib.ListItem)
On Error GoTo Err_

Dim lngOffset As Long
Dim lngLength As Long
Dim strName As String
Dim lngTeamOffset As Long
Dim lngStep As Long
Dim intLoop As Integer

lngTeamOffset = CLng(psSelectedItem.Tag)

psSelectedItem.Text = fDisplayOffset(CLng(psSelectedItem.Tag), blnmnuOptionsOffsetHex)

Call sSelectedItemsPopulate(objTemp, lngTeamOffset)

'lngTeamFreeBytes = lvwTeams_SelectedItemFreeBytes(lngTeamOffset, btyaryOpenFile())

'psSelectedItem.SubItems(1) = Format(lngTeamFreeBytes, "0")
With objTemp
    psSelectedItem.SubItems(1) = Format(.TeamFreeBytes, "0")
    'psSelectedItem.SubItems(2) = "g" & Format(.TeamGoalies, "0") & _
                                 "p" & Format(.TeamPlayers, "00") & _
                                 "t" & Format(.TeamRosterPlayers, "00")
    psSelectedItem.SubItems(2) = Format(.TeamRosterPlayers, "00") & " (" & Format(.TeamGoalies, "0") & ")"
                                 
End With

For intLoop = 0 To 3 Step 1
    
    If intLoop = 0 Then
        'lngOffset = lngTeamOffset + fHexToDecimal(fHexBytes(btyaryOpenFile(), lngTeamOffset + 4, 1))
        lngOffset = objTemp.TeamNameOffset
        lngLength = fHexToDecimal(fHexBytes(btyaryOpenFile(), lngOffset, 1))
    Else
        lngOffset = lngOffset + lngLength
        lngLength = fHexToDecimal(fHexBytes(btyaryOpenFile(), lngOffset, 1))
    End If
    
    strName = RTrim(fHexBytesChr(btyaryOpenFile(), lngOffset + 2, lngLength - 3))
    
    'For lngStep = (lngOffset + 2) To (lngOffset + lngLength - 1) Step 1
    '    If btyaryOpenFile(lngStep) = 0 Then   'Alphanumeric check preferably!
    '        strName = strName & " " 'Convert Last Null char into space!
    '    Else
    '        strName = strName & Chr(btyaryOpenFile(lngStep))
    '    End If
    'Next lngStep
   
    If intLoop = 0 Then
        psSelectedItem.SubItems(3) = Format(Len(RTrim(strName)), "00") & cForwardSlash & Format(lngLength - 2, "00")
        psSelectedItem.SubItems(4) = RTrim(strName)
    Else
        '**** If blnOpenFileSupportsPlayerNames Then
        '*** FUCK FIX ****
        Select Case strROMVersion
            Case rvSMD91, rvSG92:
                For lngStep = 5 To 10 Step 1
                    psSelectedItem.SubItems(lngStep) = vbNullString 'N/A
                Next lngStep
                Exit For
            Case rvSG93:
                psSelectedItem.SubItems((intLoop * 2) + 3) = Format(Len(RTrim(strName)), "00") & cForwardSlash & Format(lngLength - 2, "00")
                psSelectedItem.SubItems((intLoop * 2) + 4) = RTrim(strName)
                If intLoop = 1 Then
                    For lngStep = 7 To 10 Step 1
                        psSelectedItem.SubItems(lngStep) = vbNullString 'N/A
                    Next lngStep
                    Exit For
                End If
            Case rvSG94, rvSG95, rvSMD95E, rvSG96, rvSMD96E, rvSG97, rvSG98:
                psSelectedItem.SubItems((intLoop * 2) + 3) = Format(Len(RTrim(strName)), "00") & cForwardSlash & Format(lngLength - 2, "00")
                psSelectedItem.SubItems((intLoop * 2) + 4) = RTrim(strName)
        End Select
    End If
Next intLoop

Exit_:

Exit Sub

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

End Sub

Sub lvwGoaliesPlayers_RequeryLineItem(ByVal psSelectedItem As MSComctlLib.ListItem)
On Error GoTo Err_

Const cSubItemRequeryStart = 2

'Dim clsINISettings As clsINI
'Dim strINIFilename As String
'Dim strHeader As String

Dim lngPlayerOffset As Long
Dim intPlayerAttribStep As Integer
Dim lngPlayerAttribOffset As Long
Dim strPlayerName As String
Dim lngPlayerNameOffset As Long
Dim lngPlayerNameLength As Long
Dim lngPlayerIndex As Long
Dim strPos As String
Dim strPosBytes As String

Dim blnPlayer As Boolean

Dim strHexByte As String

Dim arystrColumnHexText() As String
'Dim strColumnHexText As String

'Dim strValueText As String

Dim lngStep As Long
        
lngPlayerOffset = CLng(psSelectedItem.Tag)

'strPlayerName = ""

'**** If blnOpenFileSupportsPlayerNames Then

psSelectedItem.Text = fDisplayOffset(CLng(psSelectedItem.Tag), blnmnuOptionsOffsetHex)

lngPlayerIndex = fTeamGoaliePlayerIndex(CLng(psSelectedItem.Tag), objSelected.TeamRosterOffset, objSelected.TeamNameOffset)

blnPlayer = lngPlayerIndex > objSelected.TeamGoalies

Select Case strROMVersion
    Case rvSMD91, rvSG92:
        If blnPlayer Then
            strPos = "P"
        Else
            strPos = "G"
        End If
    Case rvSG93, rvSG94, rvSG95, rvSMD95E:
        If blnPlayer Then
            If (lngPlayerIndex - objSelected.TeamGoalies) > objSelected.TeamPlayersOffense Then
                strPos = "D"
            Else
                strPos = "F"
            End If
        Else
            strPos = "G"
        End If
    Case rvSG96, rvSMD96E, rvSG97, rvSG98:
        strPosBytes = fHexBytes(btyaryOpenFile, objSelected.TeamPositionsOffset, objSelected.TeamPositionsBytes - 1)
        If lngPlayerIndex > (objSelected.TeamPositionsBytes * 2) Then
            strPos = Split(cTeamPositionsAbrev, iniValueDelimiter)(16) '16 is custom for me!
        Else
            strPos = Split(cTeamPositionsAbrev, iniValueDelimiter)(fHexToDecimal(Mid(strPosBytes, lngPlayerIndex, 1)))
        End If
End Select

If blnPlayer Then
    arystrColumnHexText() = arystrPlayerColumnHexText()
Else
    arystrColumnHexText() = arystrGoalieColumnHexText()
End If

psSelectedItem.SubItems(cSubItemRequeryStart - 1) = strPos

If blnROMPlayerNameSupport Then
    lngPlayerNameLength = fHexToDecimal(fHexBytes(btyaryOpenFile(), lngPlayerOffset, 1))
    
    strPlayerName = RTrim(fHexBytesChr(btyaryOpenFile(), lngPlayerOffset + 2, lngPlayerNameLength - 3))
    
    psSelectedItem.SubItems(cSubItemRequeryStart) = Format(Len(strPlayerName), "00") & cForwardSlash & Format(lngPlayerNameLength - 2, "00")
    psSelectedItem.SubItems(cSubItemRequeryStart + 1) = strPlayerName
    
    lngPlayerOffset = lngPlayerOffset + lngPlayerNameLength
    
Else 'N/A
    psSelectedItem.SubItems(cSubItemRequeryStart) = vbNullString
    psSelectedItem.SubItems(cSubItemRequeryStart + 1) = vbNullString
End If

'Jersey No
psSelectedItem.SubItems(cSubItemRequeryStart + 2) = "# " & fHexByte(btyaryOpenFile(lngPlayerOffset)) 'Jersey No
       
psSelectedItem.SubItems(cSubItemRequeryStart + 3) = fCalculateOverallRating(Right(fHexBytes(btyaryOpenFile(), lngPlayerOffset + 1, 6), 13), blnPlayer, strROMVersion) 'Overall Rating

For intPlayerAttribStep = 0 To 6 '7 bytes of attributes minus the number byte at the offset
    lngPlayerAttribOffset = lngPlayerOffset + intPlayerAttribStep + 1
    
    'strHexByte = fHexByte(btyaryOpenFile(lngPlayerAttribOffset))
    
    If blnmnuOptionsPlayerAttributesHex Then
        psSelectedItem.SubItems(intPlayerAttribStep * 2 + 1 + cSubItemRequeryStart + 3) = Hex(btyaryOpenFile(lngPlayerAttribOffset) \ &H10) 'Left(strHexByte, 1)
        psSelectedItem.SubItems(intPlayerAttribStep * 2 + 2 + cSubItemRequeryStart + 3) = Hex(btyaryOpenFile(lngPlayerAttribOffset) Mod &H10) 'Right(strHexByte, 1)
    Else
        psSelectedItem.SubItems(intPlayerAttribStep * 2 + 1 + cSubItemRequeryStart + 3) = arystrColumnHexText(intPlayerAttribStep * 2, btyaryOpenFile(lngPlayerAttribOffset) \ &H10) '(fHexToDecimal(Left(strHexByte, 1))))
        psSelectedItem.SubItems(intPlayerAttribStep * 2 + 2 + cSubItemRequeryStart + 3) = arystrColumnHexText(intPlayerAttribStep * 2 + 1, btyaryOpenFile(lngPlayerAttribOffset) Mod &H10) '(fHexToDecimal(Right(strHexByte, 1))))
    End If
Next intPlayerAttribStep

Exit_:
Exit Sub

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

End Sub

Sub lvwLines_RequeryLineItem(ByVal psSelectedItem As MSComctlLib.ListItem, ByVal lsvTeamsSelected As MSComctlLib.ListItem)
On Error GoTo Err_:

Const cSubItemRequeryStart = 2
'Const cSeparater = ":"
Const cSpacer = " "
Const cError = "!!!!"
Const cTypePlayer = "P"
Const cTypeGoalie = "G"
Const cTypeOffense = "F"
Const cTypeDefense = "D"

Dim lngLineOffset As Long
Dim intLinePlayersStep As Integer

Dim intLinePlayer As Integer
Dim strPosBytes As String
Dim strPos As String

Dim strRosterPlayerNames() As String
Dim lngPlayerCount As Long
Dim lngPlayerOffset As Long
Dim lngPlayerNameOffset As Long
Dim strNamePrefix As String
Dim strPlayerJerseyName As String

ReDim strRosterPlayerNames(0 To objSelected.TeamRosterPlayers)

strRosterPlayerNames(0) = "Hex 0"

lngPlayerCount = 0
lngPlayerOffset = objSelected.TeamRosterOffset
If blnROMPlayerNameSupport Then
    lngPlayerNameOffset = lngPlayerOffset + fHexToDecimal(fHexBytes(btyaryOpenFile(), lngPlayerOffset, 1))
Else
    lngPlayerNameOffset = lngPlayerOffset
End If
strPlayerJerseyName = ""

psSelectedItem.Text = fDisplayOffset(CLng(psSelectedItem.Tag), blnmnuOptionsOffsetHex)
psSelectedItem.SubItems(1) = Split(strLineRowLabels, ";")(psSelectedItem.Index - 1)

Do While lngPlayerNameOffset < objSelected.TeamNameOffset
    lngPlayerCount = lngPlayerCount + 1

    Select Case strROMVersion
    Case rvSMD91, rvSG92:
        If lngPlayerCount > objSelected.TeamGoalies Then
            strPos = cTypePlayer
        Else
            strPos = cTypeGoalie
        End If
        'strPlayerJerseyName = strPlayerJerseyName & fHexByte(btyaryOpenFile(lngPlayerOffset)) & cSeparater & strPos
        strPlayerJerseyName = strPos & cSpacer & fHexByte(btyaryOpenFile(lngPlayerOffset))
        
    Case rvSG93, rvSG94, rvSG95, rvSMD95E:
        If lngPlayerCount > objSelected.TeamGoalies Then
            If (lngPlayerCount - objSelected.TeamGoalies) > objSelected.TeamPlayersOffense Then
                strPos = cTypeDefense
            Else
                strPos = cTypeOffense
            End If
        Else
            strPos = cTypeGoalie
        End If
        'strPlayerJerseyName = strPlayerJerseyName & fHexByte(btyaryOpenFile(lngPlayerOffset + fHexToDecimal(fHexBytes(btyaryOpenFile(), lngPlayerOffset, 1)))) & _
                              cSeparater & strPos & cSpacer & RTrim(fHexBytesChr(btyaryOpenFile(), lngPlayerOffset + 2, fHexToDecimal(fHexBytes(btyaryOpenFile(), lngPlayerOffset, 1)) - 3))
                              
        strPlayerJerseyName = strPos & cSpacer & fHexByte(btyaryOpenFile(lngPlayerOffset + fHexToDecimal(fHexBytes(btyaryOpenFile(), lngPlayerOffset, 1)))) & _
                              cSpacer & RTrim(fHexBytesChr(btyaryOpenFile(), lngPlayerOffset + 2, fHexToDecimal(fHexBytes(btyaryOpenFile(), lngPlayerOffset, 1)) - 3))
                              
                              
                              
    Case rvSG96, rvSMD96E, rvSG97, rvSG98:
        strPosBytes = fHexBytes(btyaryOpenFile, objSelected.TeamPositionsOffset, objSelected.TeamPositionsBytes - 1)
        If lngPlayerCount > (objSelected.TeamPositionsBytes * 2) Then
            strPos = Split(cTeamPositionsAbrev, iniValueDelimiter)(16) '16 is custom for me!
        Else
            strPos = Split(cTeamPositionsAbrev, iniValueDelimiter)(fHexToDecimal(Mid(strPosBytes, lngPlayerCount, 1)))
        End If
        
        'strPlayerJerseyName = strPlayerJerseyName & fHexByte(btyaryOpenFile(lngPlayerOffset + fHexToDecimal(fHexBytes(btyaryOpenFile(), lngPlayerOffset, 1)))) & _
                              cSeparater & strPos & cSpacer & RTrim(fHexBytesChr(btyaryOpenFile(), lngPlayerOffset + 2, fHexToDecimal(fHexBytes(btyaryOpenFile(), lngPlayerOffset, 1)) - 3))
        
        strPlayerJerseyName = strPos & cSpacer & fHexByte(btyaryOpenFile(lngPlayerOffset + fHexToDecimal(fHexBytes(btyaryOpenFile(), lngPlayerOffset, 1)))) & _
                              cSpacer & RTrim(fHexBytesChr(btyaryOpenFile(), lngPlayerOffset + 2, fHexToDecimal(fHexBytes(btyaryOpenFile(), lngPlayerOffset, 1)) - 3))
        
    End Select

    strRosterPlayerNames(lngPlayerCount) = strPlayerJerseyName
    
    lngPlayerOffset = lngPlayerNameOffset + 8
    
    If blnROMPlayerNameSupport Then
        lngPlayerNameOffset = lngPlayerOffset + fHexToDecimal(fHexBytes(btyaryOpenFile(), lngPlayerOffset, 1))
    Else
        lngPlayerNameOffset = lngPlayerOffset
    End If
    strPlayerJerseyName = ""
Loop

lngLineOffset = CLng(psSelectedItem.Tag) 'dont use objslection here!

'check for dupes in line????

For intLinePlayersStep = 0 To 6 Step 1
    intLinePlayer = fHexToDecimal(fHexByte(btyaryOpenFile(lngLineOffset + intLinePlayersStep)))
    
    Select Case True
        Case intLinePlayer = 0:
            strPlayerJerseyName = cError & cSpacer & strRosterPlayerNames(intLinePlayer)
        Case intLinePlayer > objSelected.TeamRosterPlayers:
            strPlayerJerseyName = cError & cSpacer & "Hex " & fHexByte(intLinePlayer)
        Case Else:
            If (intLinePlayersStep = 0 And intLinePlayer > 1) Or _
               (intLinePlayersStep > 0 And intLinePlayer <= objSelected.TeamGoalies) Then  '1st not a goalie, rest are a goalie? - error
               strPlayerJerseyName = cError & cSpacer & strRosterPlayerNames(intLinePlayer)
            Else
                strPlayerJerseyName = strRosterPlayerNames(intLinePlayer)
            End If
    End Select
    
    psSelectedItem.SubItems(intLinePlayersStep + cSubItemRequeryStart) = strPlayerJerseyName
    
Next intLinePlayersStep

Exit_:
Exit Sub

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

End Sub

Sub lvwGoaliesOptions_RequeryLineItem(ByVal psSelectedItem As MSComctlLib.ListItem)
On Error GoTo Err_

Const cSubItemRequeryStart = 1

Dim clsINISettings As clsINI
Dim strINIFilename As String
Dim strHeader As String

Dim lngGoalieOptionsOffset As Long
Dim lngGoalieOptionsOffsetPart As Long
Dim intPlayerAttribStep As Integer
Dim lngPlayerAttribOffset As Long
Dim strPlayerName As String
Dim lngPlayerNameOffset As Long
Dim lngPlayerNameLength As Long

Dim strValueText As String

Dim lngStep As Long

With psSelectedItem
    lngGoalieOptionsOffset = CLng(Split(.Tag, ";")(0))
    lngGoalieOptionsOffsetPart = CLng(Split(.Tag, ";")(1))
    .SubItems(cSubItemRequeryStart) = lngGoalieOptionsOffsetPart
    
    .SubItems(cSubItemRequeryStart + 1) = Mid(fHexBytes(btyaryOpenFile(), lngGoalieOptionsOffset, 1), lngGoalieOptionsOffsetPart, 1)
    
    If intTeamGoalies >= lngGoalieOptionsOffsetPart Then
        .SubItems(cSubItemRequeryStart + 2) = "Goalie"
    Else
        .SubItems(cSubItemRequeryStart + 2) = "Player"
    End If
    
    'fix all this shit

End With
      
      
      
strPlayerName = ""

'**** If blnOpenFileSupportsPlayerNames Then
'If intROMDataStructureVersion > 1 Then
'    lngPlayerNameLength = fHexToDecimal(fHexBytes(btyaryOpenFile(), lngPlayerOffset, 1))
    
'    strPlayerName = RTrim(fHexBytesChr(btyaryOpenFile(), lngPlayerOffset + 2, lngPlayerNameLength - 3))
    
'    psSelectedItem.SubItems(cSubItemRequeryStart) = Format(Len(strPlayerName), "00") & cForwardSlash & Format(lngPlayerNameLength - 2, "00")
'    psSelectedItem.SubItems(cSubItemRequeryStart + 1) = strPlayerName
    
'    lngPlayerOffset = lngPlayerOffset + lngPlayerNameLength
    
       
'psSelectedItem.SubItems(cSubItemRequeryStart + 2) = fHexByte(btyaryOpenFile(lngPlayerOffset)) 'Jersey No
       
'If Not blnmnuOptionsPlayerAttributesHex Then
'    strINIFilename = AppPath() & "\" & "hextext.ini"
'
'    Set clsINISettings = New clsINI
'
'    clsINISettings.FileName = strINIFilename
'End If
       
'For intPlayerAttribStep = 0 To 6 '7 bytes of attributes minus the number byte at the offset
'    lngPlayerAttribOffset = lngPlayerOffset + intPlayerAttribStep + 1
'
'    If blnmnuOptionsPlayerAttributesHex Then
'        psSelectedItem.SubItems(intPlayerAttribStep * 2 + 1 + cSubItemRequeryStart + 2) = Hex(fHexToDecimal(Left(fHexByte(btyaryOpenFile(lngPlayerAttribOffset)), 1)))
'        psSelectedItem.SubItems(intPlayerAttribStep * 2 + 2 + cSubItemRequeryStart + 2) = Hex(fHexToDecimal(Right(fHexByte(btyaryOpenFile(lngPlayerAttribOffset)), 1)))
'    Else
'        strHeader = Split(IIf(False, strGoalieColumnHexText, strPlayerColumnHexText), ";")(intPlayerAttribStep * 2) ' + 1 + cSubItemRequeryStart)
'        With clsINISettings
'            strValueText = Trim(.GetValue(strHeader, "HexText"))
'        End With
'        psSelectedItem.SubItems(intPlayerAttribStep * 2 + 1 + cSubItemRequeryStart + 2) = Split(strValueText, ";")(fHexToDecimal(Left(fHexByte(btyaryOpenFile(lngPlayerAttribOffset)), 1)))

'        strHeader = Split(IIf(False, strGoalieColumnHexText, strPlayerColumnHexText), ";")(intPlayerAttribStep * 2 + 1) ' + 2 + cSubItemRequeryStart)
'        With clsINISettings
'            strValueText = Trim(.GetValue(strHeader, "HexText"))
'        End With
'        psSelectedItem.SubItems(intPlayerAttribStep * 2 + 2 + cSubItemRequeryStart + 2) = Split(strValueText, ";")(fHexToDecimal(Right(fHexByte(btyaryOpenFile(lngPlayerAttribOffset)), 1)))
'    End If
'Next intPlayerAttribStep

'Set clsINISettings = Nothing

Exit_:
Exit Sub

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

End Sub

Sub lvwRules_RequeryLineItem(ByVal psSelectedItem As MSComctlLib.ListItem)
On Error GoTo Err_

Const cHex = "0x"

Dim lngRuleOffset As Long
Dim lngRuleLength As Long
Dim strRule As String
Dim strRuleLabel As String

With psSelectedItem
    
    lngRuleOffset = CLng(.Tag)
    
    lngRuleLength = fHexToDecimal(fHexBytes(btyaryOpenFile(), lngRuleOffset + 2, 1))
    strRule = RTrim(fHexBytesChr(btyaryOpenFile(), lngRuleOffset + 4, lngRuleLength - 3))
    
    .SubItems(1) = cHex & fHexByte(btyaryOpenFile(lngRuleOffset)) & " (" & fHexToDecimal(fHexByte(btyaryOpenFile(lngRuleOffset))) & ")"
    .SubItems(2) = cHex & fHexByte(btyaryOpenFile(lngRuleOffset + 1)) & " (" & fHexToDecimal(fHexByte(btyaryOpenFile(lngRuleOffset + 1))) & ")"
    .SubItems(3) = Format(Len(strRule), "00") & cForwardSlash & Format(lngRuleLength - 2, "00")
    .SubItems(4) = strRule
    
    '.SubItems(1) = fHexToDecimal(fHexBytes(btyaryOpenFile(), lngSecondsOffset, 1))
    '.SubItems(2) = fDisplayOffset(lngTextOffset, blnmnuOptionsOffsetHex)
    '.SubItems(3) = Format(Len(strTextLabel), "00") & cForwardSlash & Format(lngTextLength - 2, "00")
    '.SubItems(4) = strTextLabel

End With

Exit_:
Exit Sub

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

End Sub

Sub sPlayoffDraw_Refresh()

Dim intFor As Integer

For intFor = 1 To intPlayoffDraws
    Call lvwPlayoffDraws_RequeryLineItem(frmPlayoffDraws.lvwPlayoffDraws.ListItems(intFor))
Next intFor

End Sub


Sub lvwPlayoffDraws_RequeryLineItem(ByVal psSelectedItem As MSComctlLib.ListItem)
On Error GoTo Err_

Const cSpacer = ":"

Dim lngOffsetDraw As Long
Dim intFor As Integer
Dim strTeamAbreviation() As String
Dim lngTeamOffset As Long
Dim lngTeamAbreviationOffset As Long
Dim strHexByte As String

ReDim strTeamAbreviation(0 To intTeamCount - 1)

intFor = 0
Do While intFor < intTeamCount
    lngTeamOffset = fHexToDecimal(fHexBytes(btyaryOpenFile(), lngTeamsStartOffset + (intFor * 4), 3))
    lngTeamAbreviationOffset = lngTeamOffset + fHexToDecimal(fHexBytes(btyaryOpenFile(), lngTeamOffset + 4, 1))
    If blnROMPlayerNameSupport Then
        lngTeamAbreviationOffset = lngTeamAbreviationOffset + fHexToDecimal(fHexBytes(btyaryOpenFile(), lngTeamAbreviationOffset, 1))
    End If
    strTeamAbreviation(intFor) = RTrim(Left(fHexBytesChr(btyaryOpenFile(), lngTeamAbreviationOffset + 2, fHexToDecimal(fHexBytes(btyaryOpenFile(), lngTeamAbreviationOffset, 1)) - 3), 3))
    
    intFor = intFor + 1
Loop

With psSelectedItem
    
    lngOffsetDraw = CLng(.Tag)
    
    .Text = fDisplayOffset(CLng(.Tag), blnmnuOptionsOffsetHex)
    
    For intFor = 0 To 15
        strHexByte = fHexBytes(btyaryOpenFile(), lngOffsetDraw + intFor, 0)
        '.SubItems(intFor + 1) = strHexByte & cSpacer & strTeamAbreviation(fHexToDecimal(strHexByte))
        If fHexToDecimal(strHexByte) > UBound(strTeamAbreviation()) Then
            .SubItems(intFor + 1) = "!!!! Hex " & strHexByte 'Clean up
        Else
            .SubItems(intFor + 1) = strTeamAbreviation(fHexToDecimal(strHexByte))
        End If
    Next intFor
    
End With

Exit_:
Exit Sub

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

End Sub


Sub lvwGoaliesPlayers_ItemMove(ByVal mySelectedItem As MSComctlLib.ListItem, ByVal myAffectedItem As MSComctlLib.ListItem)

Const cPlayerAttribSize = 8

Dim intFor As Integer
Dim intPlayer1Size As Integer
Dim intPlayer2Size As Integer
Dim btyPlayer1() As Byte
Dim btyPlayer2() As Byte
Dim lngPlayer1Offset As Long
Dim lngPlayer2Offset As Long

Dim strPosByteNew As String
Dim lngPosOffsetAdd As Long
Dim lngPlayerIndex As Long


lngPlayer1Offset = CLng(mySelectedItem.Tag)
lngPlayer2Offset = CLng(myAffectedItem.Tag)
        
If blnROMPlayerNameSupport Then
    intPlayer1Size = fHexToDecimal(fHexBytes(btyaryOpenFile, lngPlayer1Offset, 1)) + cPlayerAttribSize
    'MsgBox fHexBytes(btyaryOpenFile, lngPlayer1Offset, intPlayer1Size - 1)
    intPlayer2Size = fHexToDecimal(fHexBytes(btyaryOpenFile, lngPlayer2Offset, 1)) + cPlayerAttribSize
    'MsgBox fHexBytes(btyaryOpenFile, lngPlayer2Offset, intPlayer2Size - 1)
Else
    intPlayer1Size = cPlayerAttribSize
    intPlayer2Size = cPlayerAttribSize
End If
ReDim btyPlayer1(0 To (intPlayer1Size - 1)) As Byte
ReDim btyPlayer2(0 To (intPlayer2Size - 1)) As Byte
    
'Store
For intFor = 0 To intPlayer1Size - 1
    btyPlayer1(intFor) = btyaryOpenFile(lngPlayer1Offset + intFor)
Next intFor
'MsgBox fHexBytes(btyPlayer1, 0, intPlayer1Size - 1)

lngPlayerIndex = fTeamGoaliePlayerIndex(lngPlayer1Offset, objSelected.TeamRosterOffset, objSelected.TeamNameOffset)

For intFor = 0 To intPlayer2Size - 1
    btyPlayer2(intFor) = btyaryOpenFile(lngPlayer2Offset + intFor)
Next intFor
'MsgBox fHexBytes(btyPlayer2, 0, intPlayer2Size - 1)

'Transfer
For intFor = 0 To intPlayer2Size - 1
    btyaryOpenFile(lngPlayer1Offset + intFor) = btyPlayer2(intFor)
Next intFor

lngPlayer2Offset = lngPlayer1Offset + intPlayer2Size

For intFor = 0 To intPlayer1Size - 1
    btyaryOpenFile(lngPlayer2Offset + intFor) = btyPlayer1(intFor)
Next intFor

myAffectedItem.Tag = lngPlayer2Offset

If blnROMPlayerPositionSupport Then
    If lngPlayerIndex < (objSelected.TeamPositionsBytes * 2) Then 'has to be less than.  Move not technially possible on last player!
        lngPosOffsetAdd = (lngPlayerIndex - 1) \ 2
        If (lngPlayerIndex - 1) Mod 2 = 1 Then 'Right Bit Affected/crossed over bytes
            strPosByteNew = fHexBytes(btyaryOpenFile, objSelected.TeamPositionsOffset + lngPosOffsetAdd, 1)
            strPosByteNew = Left(strPosByteNew, 1) & Mid(strPosByteNew, 3, 1) & Mid(strPosByteNew, 2, 1) & Right(strPosByteNew, 1)
            btyaryOpenFile(objSelected.TeamPositionsOffset + lngPosOffsetAdd) = fHexToDecimal(Left(strPosByteNew, 2))
            btyaryOpenFile(objSelected.TeamPositionsOffset + lngPosOffsetAdd + 1) = fHexToDecimal(Right(strPosByteNew, 2))
        Else 'Left Bit Affected
            strPosByteNew = fHexByte(btyaryOpenFile(objSelected.TeamPositionsOffset + lngPosOffsetAdd))
            strPosByteNew = Right(strPosByteNew, 1) & Left(strPosByteNew, 1)
            btyaryOpenFile(objSelected.TeamPositionsOffset + lngPosOffsetAdd) = fHexToDecimal(strPosByteNew)
        End If
    End If
End If

Call lvwGoaliesPlayers_RequeryLineItem(mySelectedItem)
Call lvwGoaliesPlayers_RequeryLineItem(myAffectedItem)
'mySelectedItem.Parent.Text = lvwGoalies.ListItems(lvwGoalies.SelectedItem.Index + 1)

End Sub

Sub lvwLines_RequeryAllItems()

Dim intListItemStep As Integer
Dim litStep As MSComctlLib.ListItem

'Requery Lines all lines incase of jersey no/name change
 For intListItemStep = 1 To frmLines.lvwLines.ListItems.Count Step 1
     Set litStep = frmLines.lvwLines.ListItems(intListItemStep)
     Call lvwLines_RequeryLineItem(litStep, frmTeams.lvwTeams.SelectedItem)
 Next intListItemStep

Set litStep = Nothing


End Sub

Sub sQuickEditPlayerJerseyAdjust(ByVal lngPlayerOffset As Long, ByVal KeyCode As Integer) ', ByVal Shift As Integer

Dim intAdjustValue As Integer
Dim intJerseyValue As Integer
Dim lngByteOffset As Long
Dim strByte As String

lngByteOffset = 0
If blnROMPlayerNameSupport Then
    lngByteOffset = lngPlayerOffset + fHexToDecimal(fHexBytes(btyaryOpenFile(), lngPlayerOffset, 1))
Else
    lngByteOffset = lngPlayerOffset
End If

strByte = fHexByte(btyaryOpenFile(lngByteOffset))

If IsNumeric(strByte) Then
    intJerseyValue = CInt(strByte)
    If KeyCode = vbKeyAdd Then
        intAdjustValue = 1
    Else 'vbKeySubtract
        intAdjustValue = -1
    End If
    intJerseyValue = intJerseyValue + intAdjustValue
    If intJerseyValue < 0 Then
        intJerseyValue = 99
    ElseIf intJerseyValue > 99 Then
        intJerseyValue = 0
    End If
End If

strByte = Format(intJerseyValue, "00")

btyaryOpenFile(lngByteOffset) = fHexToDecimal(strByte)

End Sub


Function fQuickEditPlayerBitShift(ByVal lngPlayerOffset As Long, ByVal KeyCode As Integer, ByVal Shift As Integer) As Boolean
On Error GoTo Err_:

Dim intAdjustBitValue As Integer
Dim intAdjustBit As Integer
Dim lngByteOffset As Long
Dim blnLeftBit As Boolean

Dim bytByte As Byte
Dim intLeft As Integer
Dim intRight As Integer
Dim intNew As Integer

Select Case KeyCode
    Case vbKeyRightSingleQuoteTilde:  '`````` 'vbKeyNumpad0:
        intAdjustBit = 0
        blnLeftBit = True
    Case vbKey1: 'vbKeyNumpad1:
        intAdjustBit = 0
        blnLeftBit = False
    Case vbKey2: 'vbKeyNumpad2:
        intAdjustBit = 1
        blnLeftBit = True
    Case vbKey3: 'vbKeyNumpad3:
        intAdjustBit = 1
        blnLeftBit = False
    Case vbKey4: 'vbKeyNumpad4:
        intAdjustBit = 2
        blnLeftBit = True
    Case vbKey5: 'vbKeyNumpad5:
        intAdjustBit = 2
        blnLeftBit = False
    Case vbKey6 'vbKeyNumpad6:
        intAdjustBit = 3
        blnLeftBit = True
    Case vbKey7: ' vbKeyNumpad7:
        intAdjustBit = 3
        blnLeftBit = False
    Case vbKey8: 'vbKeyNumpad8:
        intAdjustBit = 4
        blnLeftBit = True
    Case vbKey9: 'vbKeyNumpad9:
        intAdjustBit = 4
        blnLeftBit = False
    Case vbKey0: 'vbKeyAdd:
        intAdjustBit = 5
        blnLeftBit = True
    Case vbKeyMinusUnderscore:  '----- 'vbKeyDivide:
        intAdjustBit = 5
        blnLeftBit = False
    Case vbKeyEqualsPlus:  '===== 'vbKeyMultiply
        intAdjustBit = 6
        blnLeftBit = True
    Case vbKeyBack, vbKeyOEM5Backslash:
        intAdjustBit = 6
        blnLeftBit = False
End Select

lngByteOffset = 0
If blnROMPlayerNameSupport Then
    lngByteOffset = lngPlayerOffset + fHexToDecimal(fHexBytes(btyaryOpenFile(), lngPlayerOffset, 1))
Else
    lngByteOffset = lngPlayerOffset
End If

lngByteOffset = lngByteOffset + 1 'skip jersey byte

If (Shift And vbShiftMask) > 0 Then
    intAdjustBitValue = -1 'deduct
Else
    intAdjustBitValue = 1 'add
End If

lngByteOffset = lngByteOffset + intAdjustBit
'strByte = fHexByte(btyaryOpenFile(lngByteOffset))

intLeft = btyaryOpenFile(lngByteOffset) \ &H10 'CInt(fHexToDecimal(Left(strByte, 1)))
intRight = btyaryOpenFile(lngByteOffset) Mod &H10  'CInt(fHexToDecimal(Right(strByte, 1)))

If blnLeftBit Then
    intNew = intLeft + intAdjustBitValue
Else
    intNew = intRight + intAdjustBitValue
End If

If intNew < 0 Then
    intNew = 0 'don't scroll thru?
ElseIf intNew > 15 Then
    intNew = 15 'don't scroll thru?
End If

If blnLeftBit Then
    If intLeft = intNew Then 'not changed
        fQuickEditPlayerBitShift = False
    Else
        bytByte = CByte((intNew * &H10) + intRight)
        btyaryOpenFile(lngByteOffset) = bytByte 'fHexToDecimal (strByte)
        fQuickEditPlayerBitShift = True
        'strByte = Hex(intNewValue) & Right(strByte, 1)
    End If
Else
    If intRight = intNew Then  'not changed
        fQuickEditPlayerBitShift = False
    Else
        bytByte = CByte((intLeft * &H10) + intNew)
        btyaryOpenFile(lngByteOffset) = bytByte 'fHexToDecimal (strByte)
        fQuickEditPlayerBitShift = True
        'strByte = Left(strByte, 1) & Hex(intNewValue)
    End If
End If

Exit_:
Exit Function

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

End Function

Function fQuickEditPlayerPositionAdjust(ByVal lngPlayerOffset As Long, ByVal KeyCode As Integer, ByVal Shift As Integer) As Boolean
On Error GoTo Err_:

Dim intPosBitNew As Integer
Dim intLeft As Integer
Dim intRight As Integer

Dim blnUpdated As Boolean
'Dim strPosByteNew As String
Dim lngPlayerIndex As Long
Dim lngPosOffsetAdd As Long

blnUpdated = False

If blnROMPlayerPositionSupport Then
    
    lngPlayerIndex = fTeamGoaliePlayerIndex(lngPlayerOffset, objSelected.TeamRosterOffset, objSelected.TeamNameOffset)
    
    If Not lngPlayerIndex > (objSelected.TeamPositionsBytes * 2) Then
    
        Select Case KeyCode
            'G;LD;RD;LW;C;RW;
            Case vbKeyNumpad2:
                intPosBitNew = 0 'G
            Case vbKeyNumpad1:
                intPosBitNew = 1 'LD
            Case vbKeyNumpad3:
                intPosBitNew = 2 'RD
            Case vbKeyNumpad4:
                intPosBitNew = 3 'RD
            Case vbKeyNumpad5:
                intPosBitNew = 4 'C
            Case vbKeyNumpad6:
                intPosBitNew = 5 'RW
        End Select
    
        lngPosOffsetAdd = (lngPlayerIndex - 1) \ 2
        'strPosByteNew = fHexByte(btyaryOpenFile(objSelected.TeamPositionsOffset + lngPosOffsetAdd))
        
        intLeft = btyaryOpenFile(objSelected.TeamPositionsOffset + lngPosOffsetAdd) \ &H10
        intRight = btyaryOpenFile(objSelected.TeamPositionsOffset + lngPosOffsetAdd) Mod &H10
        
        If (lngPlayerIndex - 1) Mod 2 = 0 Then 'Left Bit Affected
            If Not intLeft = intPosBitNew Then
                btyaryOpenFile(objSelected.TeamPositionsOffset + lngPosOffsetAdd) = CByte((intPosBitNew * &H10) + intRight)
                blnUpdated = True
                'strPosByteNew = Left(strPosByteNew, 1) & strPosBitNew
            End If
        Else '= 1 so Right Bit Affected
            If Not intRight = intPosBitNew Then
                btyaryOpenFile(objSelected.TeamPositionsOffset + lngPosOffsetAdd) = CByte((intLeft * &H10) + intPosBitNew)
                blnUpdated = True
                'strPosByteNew = strPosBitNew & Right(strPosByteNew, 1)
            End If
        End If
        'btyaryOpenFile(objSelected.TeamPositionsOffset + lngPosOffsetAdd) = fHexToDecimal(strPosByteNew)
    End If
End If

Exit_:
fQuickEditPlayerPositionAdjust = blnUpdated
Exit Function

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

End Function

Function fDisplayOffset(ByVal flngOffset As Long, ByVal fblnOffsetHex As Boolean) As String

If fblnOffsetHex = True Then
    fDisplayOffset = String(8 - Len(Hex(flngOffset)), "0") & Hex(flngOffset)
Else
    fDisplayOffset = Format(flngOffset, "00000000")
End If

End Function

Function fPopulatePlayoffDraws() As Boolean
On Error GoTo Err_

Dim lvwItem As MSComctlLib.ListItem
Dim lngOffsetDraw As Long
Dim lngOffsetText As Long
Dim intFor As Integer

intFor = 0
Do While intFor < intPlayoffDraws
    lngOffsetDraw = lngPlayoffDrawOffset + (intFor * 16) '16 for length in bytes - 16 teams
    Set lvwItem = frmPlayoffDraws.lvwPlayoffDraws.ListItems.Add(, , fDisplayOffset(lngOffsetDraw, blnmnuOptionsOffsetHex))
    lvwItem.Tag = CStr(lngOffsetDraw)
    Call lvwPlayoffDraws_RequeryLineItem(lvwItem)
    intFor = intFor + 1
Loop

Exit_:
Exit Function

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

End Function

Function fPopulateRules() As Boolean
On Error GoTo Err_

Dim lvwItem As MSComctlLib.ListItem
Dim lngOffsetRule As Long
'Dim lngOffsetText As Long
Dim intFor As Integer
Dim intItems As Integer
Dim intDupe As Integer
Dim blnIgnore As Boolean
Dim lngOffsets() As Long
Dim intRuleLength As Integer


intFor = 1
ReDim Preserve lngOffsets(0)
Do While intFor <= intRules
    lngOffsetRule = lngRulesStartOffset + fHexToDecimal(fHexBytes(btyaryOpenFile, lngRulesStartOffset + (2 * intFor), 1))
    
    If lngOffsets(UBound(lngOffsets)) > 0 Then
        blnIgnore = False
        For intDupe = UBound(lngOffsets) To LBound(lngOffsets) Step -1
            If lngOffsets(intDupe) = lngOffsetRule Then
                blnIgnore = True
                Exit For
            End If
        Next intDupe
        
        If Not blnIgnore Then
            intRuleLength = fHexToDecimal(fHexBytes(btyaryOpenFile, lngOffsetRule + 2, 1))
            blnIgnore = intRuleLength = 2 'ingore empty character rules (2/0)
            If Not blnROMPlayerNameSupport And intRuleLength = 4 Then '91/92 scenario only
                blnIgnore = True
            End If
        End If
        
        If Not blnIgnore Then
            ReDim Preserve lngOffsets(0 To UBound(lngOffsets) + 1)
            'sort in order of offet
            For intDupe = UBound(lngOffsets) - 1 To LBound(lngOffsets) Step -1
                If lngOffsets(intDupe) < lngOffsetRule Then
                    lngOffsets(intDupe + 1) = lngOffsetRule
                    Exit For
                Else
                    lngOffsets(intDupe + 1) = lngOffsets(intDupe)
                    lngOffsets(intDupe) = 0
                End If
    
                'lngOffsets(UBound(lngOffsets)) = lngOffsetRule
            Next
        End If
    Else
        lngOffsets(0) = lngOffsetRule
    End If
    intFor = intFor + 1
Loop

For intFor = LBound(lngOffsets) To UBound(lngOffsets)
'intFor = 1
'Do While intFor <= intRules
    'lngOffsetRule = lngRulesStartOffset + fHexToDecimal(fHexBytes(btyaryOpenFile, lngRulesStartOffset + (2 * intFor), 1))
    'Set lvwItem = frmRules.lvwRules.ListItems.Add(, , fDisplayOffset(lngOffsetRule, blnmnuOptionsOffsetHex))
    Set lvwItem = frmRules.lvwRules.ListItems.Add(, , fDisplayOffset(lngOffsets(intFor), blnmnuOptionsOffsetHex))
    lvwItem.Tag = CStr(lngOffsets(intFor))
    Call lvwRules_RequeryLineItem(lvwItem)
    'intFor = intFor + 1
'Loop
Next intFor

Exit_:
Exit Function

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

End Function

Function fMDIChildMinimizeOnClose(frm As Form) As Boolean

If blnMDIApplicationIsUnloading Then
    fMDIChildMinimizeOnClose = False
Else
    frm.WindowState = vbMinimized
    fMDIChildMinimizeOnClose = True
End If

End Function

Sub pbxColorPreview_SetColor_HexBGR(ByVal strHexBGR As String)
On Error Resume Next

Dim lngColor As Long
Dim strR As String
Dim strG As String
Dim strB As String

With frmMDI
    
    If Len(strHexBGR) = 4 Then
        
        lngColor = fColorHexBGRtoRGB(strHexBGR, strR, strG, strB, True)
        
        .pbxColorPreview.Tag = strHexBGR
        .pbxColorPreview.BackColor = lngColor
        
        .txtPreviewRGB(0).Caption = strR
        .txtPreviewRGB(1).Caption = strG
        .txtPreviewRGB(2).Caption = strB
         
        .txtPreviewBGR(0).Caption = Mid(strHexBGR, 2, 1)
        .txtPreviewBGR(1).Caption = Mid(strHexBGR, 3, 1)
        .txtPreviewBGR(2).Caption = Mid(strHexBGR, 4, 1)
        
    End If
    
End With
 
End Sub

Sub pbxColorSelected_SetColor_HexBGR(ByVal strHexBGR As String)
On Error Resume Next

With frmMDI

    If Len(strHexBGR) = 4 Then
    
        .cboColorSelectedBGR(0).ListIndex = fHexToDecimal(Mid(strHexBGR, 2, 1))
        .cboColorSelectedBGR(1).ListIndex = fHexToDecimal(Mid(strHexBGR, 3, 1))
        .cboColorSelectedBGR(2).ListIndex = fHexToDecimal(Mid(strHexBGR, 4, 1))
        
        .pbxColorSelected.Tag = strHexBGR
    
    End If
    
End With

End Sub


Sub sDisplayFileOffset(Optional ByVal blnUpdateStripOffsetOnly As Boolean = False)

Dim intStep As Integer
Dim intItem As Integer
Dim strColumnHeader As String
Dim lsvGeneral As MSComctlLib.ListView
Dim strRinkPaletteOffset As String
Dim strStripHomeOffset As String
Dim strStripVisitorOffset As String
Dim strMenuDefaultsOffset As String

Dim strColumnLabel As String


If blnmnuOptionsOffsetHex = True Then
    strColumnHeader = " Hex"
    
    strStripHomeOffset = Hex(objSelected.TeamColorOffset)
    strStripVisitorOffset = Hex(objSelected.TeamColorOffset + 16)
    strRinkPaletteOffset = Hex(lngRinkPaletteOffset)
    strMenuDefaultsOffset = Hex(lngMenuDefaultsAddressOffset)
Else
    strColumnHeader = " Dec"
    strStripHomeOffset = CStr(objSelected.TeamColorOffset)
    strStripVisitorOffset = CStr(objSelected.TeamColorOffset + 16)
    strRinkPaletteOffset = CStr(lngRinkPaletteOffset)
    strMenuDefaultsOffset = CStr(lngMenuDefaultsAddressOffset)
End If

strStripHomeOffset = " " & String(8 - Len(strStripHomeOffset), "0") & strStripHomeOffset
strStripVisitorOffset = " " & String(8 - Len(strStripVisitorOffset), "0") & strStripVisitorOffset
strRinkPaletteOffset = " " & String(8 - Len(strRinkPaletteOffset), "0") & strRinkPaletteOffset
strMenuDefaultsOffset = " " & String(8 - Len(strMenuDefaultsOffset), "0") & strMenuDefaultsOffset

frmStrips.fmeColorHome.Caption = frmStrips.fmeColorHome.Tag & strColumnHeader & strStripHomeOffset
frmStrips.fmeColorAway.Caption = frmStrips.fmeColorAway.Tag & strColumnHeader & strStripVisitorOffset

If blnUpdateStripOffsetOnly Then
    GoTo Exit_
End If

For intStep = 0 To 6 Step 1

    Select Case intStep
        Case 0:
            Set lsvGeneral = frmTeams.lvwTeams
            strColumnLabel = strTeamColumnLabels
        Case 1:
            Set lsvGeneral = frmGoalies.lvwGoalies
            strColumnLabel = strGoalieColumnLabels
        Case 2:
            Set lsvGeneral = frmPlayers.lvwPlayers
            strColumnLabel = strPlayerColumnLabels
        Case 3:
            Set lsvGeneral = frmLines.lvwLines
            strColumnLabel = strLineColumnLabels
        Case 4:
            Set lsvGeneral = frmTimers.lvwTimers
            strColumnLabel = strTimerColumnLabels
        Case 5:
            Set lsvGeneral = frmPlayoffDraws.lvwPlayoffDraws
            strColumnLabel = strPlayoffDrawColumnLabels
        Case 6:
            Set lsvGeneral = frmRules.lvwRules
            strColumnLabel = strRuleColumnLabels
    End Select

    With lsvGeneral
        .ColumnHeaders(1).Text = Split(strColumnLabel, ";")(0) & strColumnHeader
        If intStep = 4 Then
            .ColumnHeaders(5).Text = Split(strColumnLabel, ";")(4) & strColumnHeader
        End If

        For intItem = 1 To .ListItems.Count Step 1
            Select Case intStep
                Case 0: 'lsvTeams
                    .ListItems(intItem).Text = fDisplayOffset(CLng(Split(.ListItems(intItem).Tag, ";")(0)), blnmnuOptionsOffsetHex)
                Case 4: 'lsvPeriodLengths
                    .ListItems(intItem).Text = fDisplayOffset(CLng(Split(.ListItems(intItem).Tag, ";")(0)), blnmnuOptionsOffsetHex)
                    If UBound(Split(.ListItems(intItem).Tag, ";")) = 1 Then
                        .ListItems(intItem).SubItems(4) = fDisplayOffset(CLng(Split(.ListItems(intItem).Tag, ";")(1)), blnmnuOptionsOffsetHex)
                    Else
                        .ListItems(intItem).SubItems(4) = vbNullString
                    End If
                Case Else:
                    .ListItems(intItem).Text = fDisplayOffset(CLng(.ListItems(intItem).Tag), blnmnuOptionsOffsetHex)
            End Select
        Next intItem
    End With
Next intStep

frmRink.fmeRink.Caption = frmRink.fmeRink.Tag & strColumnHeader & strRinkPaletteOffset

If Not blnROMPlayerPositionSupport Then
    frmMenu.fmeMenu.Caption = frmMenu.fmeMenu.Tag & strColumnHeader & strMenuDefaultsOffset
End If

Exit_:
Exit Sub


End Sub


Sub sDisplayPlayerAttributes()

Dim intFor As Integer
Dim lvwItem As MSComctlLib.ListItem

With frmGoalies.lvwGoalies
    For intFor = 1 To .ListItems.Count Step 1
        Set lvwItem = .ListItems(intFor)
        Call lvwGoaliesPlayers_RequeryLineItem(lvwItem)
    Next intFor
End With

With frmPlayers.lvwPlayers
    For intFor = 1 To .ListItems.Count Step 1
        Set lvwItem = .ListItems(intFor)
        Call lvwGoaliesPlayers_RequeryLineItem(lvwItem)
    Next intFor
End With

Set lvwItem = Nothing

End Sub


Sub lvwTeams_Bookmark()

With frmTeams.lvwTeams
    If Not lvwTeamsBookmarkItemIndex = .SelectedItem.Index Then 'different bookmark... record it.
        lvwTeamsBookmarkItemIndex = .SelectedItem.Index
        lvwTeamsSelectedItemIndex = 0 'clear any supposed last selected item index.
    End If
End With

End Sub

Sub lvwTeams_Bookmark_Cycle()

With frmTeams.lvwTeams
    If Not (lvwTeamsBookmarkItemIndex = .SelectedItem.Index And lvwTeamsSelectedItemIndex = 0) Then
        If lvwTeamsSelectedItemIndex = 0 Then
            lvwTeamsSelectedItemIndex = .SelectedItem.Index
        End If
        
        If lvwTeamsBookmarkItemIndex = .SelectedItem.Index Then
            .SelectedItem = .ListItems(lvwTeamsSelectedItemIndex)
        Else
            If Not lvwTeamsSelectedItemIndex = .SelectedItem.Index Then
                lvwTeamsSelectedItemIndex = .SelectedItem.Index
            Else
                If lvwTeamsBookmarkItemIndex = 0 Then
                    lvwTeamsBookmarkItemIndex = .SelectedItem.Index '? check.
                End If
            End If
            .SelectedItem = .ListItems(lvwTeamsBookmarkItemIndex)
        End If
    End If
    .SelectedItem.EnsureVisible
End With
DoEvents

End Sub

Sub lvwTeams_Previous()
        
With frmTeams.lvwTeams
    If .SelectedItem.Index = 1 Then
        .SelectedItem = .ListItems(.ListItems.Count)
    Else
        .SelectedItem = .ListItems(.SelectedItem.Index - 1) 'handing control myself, as if fixes problem with _click sub.
    End If
    .SelectedItem.EnsureVisible
End With
DoEvents

End Sub
        
Sub lvwTeams_Next()

With frmTeams.lvwTeams
    If .SelectedItem.Index = .ListItems.Count Then
        .SelectedItem = .ListItems(1)
    Else
        .SelectedItem = .ListItems(.SelectedItem.Index + 1) 'handing control myself, as if fixes problem with _click sub.
    End If
    .SelectedItem.EnsureVisible
End With
DoEvents

End Sub
        
Sub lvwListItem_Previous(lvwListView As MSComctlLib.ListView)

With lvwListView
       If .MultiSelect Then
            Call lvwListItem_Clear(lvwListView)
        End If
        If .SelectedItem.Index = 1 Then
            .SelectedItem = .ListItems(.ListItems.Count)
        Else
            .SelectedItem = .ListItems(.SelectedItem.Index - 1) 'handing control myself, as if fixes problem with _click sub.
        End If
        .SelectedItem.EnsureVisible
End With
DoEvents

End Sub

Sub lvwListItem_Clear(lvwListView As MSComctlLib.ListView)

Dim intFor As Integer

With lvwListView
    If .MultiSelect Then
        If .ListItems.Count > 0 Then
            For intFor = 1 To .ListItems.Count
               .ListItems(intFor).Selected = False
            Next
        End If
    End If
End With

End Sub

Sub lvwListItem_Next(lvwListView As MSComctlLib.ListView)

Dim intFor As Integer

With lvwListView
       If .MultiSelect Then
            Call lvwListItem_Clear(lvwListView)
        End If
        If .SelectedItem.Index = .ListItems.Count Then
            .SelectedItem = .ListItems(1)
        Else
            .SelectedItem = .ListItems(.SelectedItem.Index + 1) 'handing control myself, as if fixes problem with _click sub.
        End If
        .SelectedItem.EnsureVisible
End With
DoEvents

End Sub

Sub lvwGoalies_ButtonItemClick() '(ByVal Item As MSComctlLib.ListItem)

With frmGoalies
    objSelected.GoalieListIndex = .lvwGoalies.SelectedItem.Index
    objSelected.GoalieOffset = CLng(.lvwGoalies.SelectedItem.Tag)
    If blnROMPlayerNameSupport Then
        objSelected.GoalieJerseyOffset = objSelected.GoalieOffset + fHexToDecimal(fHexBytes(btyaryOpenFile(), objSelected.GoalieOffset, 1))
    Else
        objSelected.GoalieJerseyOffset = objSelected.GoalieOffset
    End If

    'frmGoalies.tlbIcons.Buttons(tiGotoPrev).Enabled = Not .SelectedItem.Index = 1
    'frmGoalies.tlbIcons.Buttons(tiGotoNext).Enabled = Not .SelectedItem.Index = .ListItems.Count
    If fListViewSelectedItemsCount(.lvwGoalies) = 1 Then 'disable if multi-selected
        .tlbIcons.Buttons(tiItemUp).Enabled = Not .lvwGoalies.SelectedItem.Index = 1
        .tlbIcons.Buttons(tiItemDown).Enabled = True
    Else
        .tlbIcons.Buttons(tiItemUp).Enabled = False
        .tlbIcons.Buttons(tiItemDown).Enabled = False
    End If
    
End With

End Sub


Sub lvwPlayers_ButtonItemClick() '(ByVal Item As MSComctlLib.ListItem)

With frmPlayers
    'If .ListItems.Count > 0 Then
        objSelected.PlayerListIndex = .lvwPlayers.SelectedItem.Index
        objSelected.PlayerOffset = CLng(.lvwPlayers.SelectedItem.Tag)
        If blnROMPlayerNameSupport Then
            objSelected.PlayerJerseyOffset = objSelected.PlayerOffset + fHexToDecimal(fHexBytes(btyaryOpenFile(), objSelected.PlayerOffset, 1))
        Else
            objSelected.PlayerJerseyOffset = objSelected.PlayerOffset
        End If
        'frmPlayers.tlbIcons.Buttons(tiItemDown).Enabled = Not .SelectedItem.Index = .ListItems.Count
        If fListViewSelectedItemsCount(.lvwPlayers) = 1 Then
            .tlbIcons.Buttons(tiItemDown).Enabled = Not .lvwPlayers.SelectedItem.Index = .lvwPlayers.ListItems.Count
            .tlbIcons.Buttons(tiItemUp).Enabled = True
        Else
            .tlbIcons.Buttons(tiItemDown).Enabled = False
            .tlbIcons.Buttons(tiItemUp).Enabled = False
        End If
   'Else
   '     frmPlayers.tlbIcons.Buttons(tiItemProp).Enabled = False
   '     frmPlayers.tlbIcons.Buttons(tiPlayrDel).Enabled = False
   '     frmPlayers.tlbIcons.Buttons(tiItemUp).Enabled = False
   '     frmPlayers.tlbIcons.Buttons(tiItemDown).Enabled = Not False
   'End If
    
End With

End Sub


Sub lvwLines_ButtonItemClick() '(ByVal Item As MSComctlLib.ListItem)

Dim blnItemUp As Boolean
Dim blnItemDown As Boolean

blnItemUp = False
blnItemDown = False

With frmLines
    objSelected.LineListIndex = .lvwLines.SelectedItem.Index
    objSelected.LineOffset = CLng(.lvwLines.SelectedItem.Tag)
    
    If fListViewSelectedItemsCount(.lvwLines) = 1 Then
        blnItemDown = Not .lvwLines.SelectedItem.Index = .lvwLines.ListItems.Count
        blnItemUp = Not .lvwLines.SelectedItem.Index = 1
    End If
    
    .tlbIcons.Buttons(tiItemDown).Enabled = blnItemDown
    .tlbIcons.Buttons(tiItemUp).Enabled = blnItemUp

End With

End Sub

        
Sub lvwPlayoffDraws_ButtonItemClick() '(ByVal Item As MSComctlLib.ListItem)

Dim blnItemUp As Boolean
Dim blnItemDown As Boolean

blnItemUp = False
blnItemDown = False

With frmPlayoffDraws
    If fListViewSelectedItemsCount(.lvwPlayoffDraws) = 1 Then
        blnItemDown = Not .lvwPlayoffDraws.SelectedItem.Index = .lvwPlayoffDraws.ListItems.Count
        blnItemUp = Not .lvwPlayoffDraws.SelectedItem.Index = 1
    End If
    .tlbIcons.Buttons(tiItemDown).Enabled = blnItemDown
    .tlbIcons.Buttons(tiItemUp).Enabled = blnItemUp
End With

End Sub

Sub lvwItem_Move(ByRef lvw As MSComctlLib.ListView, ByVal intBytes As Integer, ByVal strDirection As String)
On Error Resume Next

Dim intFor As Integer
Dim lngOffset As Long
Dim lngOffsetAdjust As Long
Dim intIndexAdjust As Integer
Dim arybytItem() As Byte

ReDim arybytItem(0 To intBytes - 1)

With lvw
    lngOffset = CLng(.SelectedItem.Tag)
    lngOffsetAdjust = UBound(arybytItem) + 1
    intIndexAdjust = 1
    If strDirection = tiItemUp Then
        lngOffsetAdjust = -lngOffsetAdjust
        intIndexAdjust = -1
    End If
    
    For intFor = LBound(arybytItem) To UBound(arybytItem)
        arybytItem(intFor) = btyaryOpenFile(lngOffset + lngOffsetAdjust + intFor)
        btyaryOpenFile(lngOffset + lngOffsetAdjust + intFor) = btyaryOpenFile(lngOffset + intFor)
        btyaryOpenFile(lngOffset + intFor) = arybytItem(intFor)
    Next intFor
    
    Select Case intBytes 'kinda bad, need to fix this!
        Case 8: 'Lines
            Call lvwLines_RequeryLineItem(.SelectedItem, frmTeams.lvwTeams.SelectedItem)
            Call lvwLines_RequeryLineItem(.ListItems(.SelectedItem.Index + intIndexAdjust), frmTeams.lvwTeams.SelectedItem)
        Case 16: 'Playoff Draws
            Call lvwPlayoffDraws_RequeryLineItem(.SelectedItem)
            Call lvwPlayoffDraws_RequeryLineItem(.ListItems(.SelectedItem.Index + intIndexAdjust))
    End Select
    .SelectedItem.Selected = False
    .SelectedItem = .ListItems(.SelectedItem.Index + intIndexAdjust)
            
End With




End Sub


'Sub lvwPeriodLengths_ButtonItemClick()

'With frmPeriodLengths
'    .tlbIcons.Buttons(tiGotoPrev).Enabled = Not .lvwPeriodLengths.SelectedItem.Index = 1
'    .tlbIcons.Buttons(tiGotoNext).Enabled = Not .lvwPeriodLengths.SelectedItem.Index = .lvwPeriodLengths.ListItems.Count
'End With

'End Sub


Sub lvwTeams_ButtonItemClick() 'ByVal lngFreeBytes As Long

Dim blnIsEnabled As Boolean

If blnmnuOptionsTeamAutoManageFreeBytes Then
    blnIsEnabled = False
Else
    blnIsEnabled = (objSelected.TeamFreeBytes > 0)  'was lngFreeBytes
End If

With frmTeams.tlbIcons
    .Buttons(tiByteUp).Enabled = blnIsEnabled
    .Buttons(tiByteDown).Enabled = blnIsEnabled
End With

'With frmTeams.lvwTeams
'    frmTeams.tlbIcons.Buttons(tiGotoPrev).Enabled = Not .SelectedItem.Index = 1
'    frmTeams.tlbIcons.Buttons(tiGotoNext).Enabled = Not .SelectedItem.Index = .ListItems.Count
'End With


End Sub

Function lvwTeams_SelectedItemFreeBytes(ByVal lngTeamOffset As Long, ByRef bytArray() As Byte) As Long
'lvwTeams_SelectedItemFreeBytes(lngOffsetTeam, btyaryOpenFile())
On Error GoTo Err_

lvwTeams_SelectedItemFreeBytes = _
lvwTeams_SelectedItemPlayerOffset(lngTeamOffset, bytArray()) - lvwTeams_SelectedItemLineOrderEndOffset(lngTeamOffset, bytArray())

Exit_:
Exit Function

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


End Function


Function lvwTeams_SelectedItemPlayerOffset(ByVal lngTeamOffset As Long, ByRef bytArray() As Byte) As Long
On Error GoTo Err_

lvwTeams_SelectedItemPlayerOffset = lngTeamOffset + fHexToDecimal(fHexBytes(bytArray(), lngTeamOffset, 1))

Exit_:
Exit Function

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

End Function


Function lvwTeams_SelectedItemLineOrderOffset(ByVal lngTeamOffset As Long, ByRef bytArray() As Byte) As Long
On Error GoTo Err_

Dim intByteIndex As Integer

If blnROMPlayerNameSupport Then
    intByteIndex = 6
Else
    intByteIndex = 8
End If

lvwTeams_SelectedItemLineOrderOffset = lngTeamOffset + fHexToDecimal(fHexBytes(bytArray(), lngTeamOffset + intByteIndex, 1))

Exit_:
Exit Function

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

End Function

Function lvwTeams_SelectedItemLineOrderEndOffset(ByVal lngTeamOffset As Long, ByRef bytArray() As Byte) As Long
On Error GoTo Err_

lvwTeams_SelectedItemLineOrderEndOffset = lvwTeams_SelectedItemLineOrderOffset(lngTeamOffset, bytArray()) + (8 * intROMLines)

Exit_:
Exit Function

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

End Function



Function fGetPixel(ByVal pbxParameter As PictureBox, X As Single, Y As Single, Optional ScaleMode As Integer = 1) As Long
    
Dim sngX As Single
Dim sngY As Single

With pbxParameter
    Select Case .ScaleMode
    Case vbTwips: 'twips
        sngX = X \ Screen.TwipsPerPixelX '/ ?
        sngY = Y \ Screen.TwipsPerPixelY '/ ?
    Case vbPixels:  'pixels
        sngX = X
        sngY = Y
    End Select
    fGetPixel = GetPixel(.hdc, sngX, sngY)
End With

End Function


Function fValidPlayerName(strName As String) As Boolean

Dim intStep As Integer
Dim intCharacterCount As Integer

intCharacterCount = 0

fValidPlayerName = False
If Len(strName) > 0 Then
    For intStep = 1 To Len(strName) Step 1
        If Mid(strName, intStep, 1) = " " Then intCharacterCount = intCharacterCount + 1
    Next intStep
End If

fValidPlayerName = (intCharacterCount = 1)

Exit_:
Exit Function

End Function

Sub sRedrawStrip(ByVal Index As Integer, ByRef stripTemplate As STRIP_IMAGE, ByRef stripImage() As Byte)
On Error GoTo Err_

Dim X As Integer
Dim Y As Integer
Dim lngColor As Long
Dim lngvb3dFace As Long
Dim intAddIndex As Integer
Dim stripWidth As Integer
Dim stripHeight As Integer

With stripTemplate.BMPInfo.bmiHeader
    stripWidth = Abs(.biWidth)
    stripHeight = Abs(.biHeight)
End With

intAddIndex = Index * 16

stripImage() = stripTemplate.btyaryStripPixels()

lngvb3dFace = TranslateColor(vb3DFace)

    For Y = 0 To stripHeight - 1
        For X = 0 To stripWidth - 1
            If stripTemplate.btyaryStripPixels(pixR, X, Y) > 15 Then
                psExtractRGBFromColor lngvb3dFace, stripImage(pixR, X, Y), stripImage(pixG, X, Y), stripImage(pixB, X, Y)
            Else
                If frmStrips.cbxSample(Index) = vbChecked Then
                    psExtractRGBFromColor frmStrips.pbxTeamColorPreview(stripImage(pixR, X, Y) + intAddIndex).BackColor, stripImage(pixR, X, Y), stripImage(pixG, X, Y), stripImage(pixB, X, Y)
                Else
                    psExtractRGBFromColor frmStrips.pbxTeamColor(stripImage(pixR, X, Y) + intAddIndex).BackColor, stripImage(pixR, X, Y), stripImage(pixG, X, Y), stripImage(pixB, X, Y)
                End If
            End If
        Next X
    Next Y

    With frmStrips.pbxStrip(Index)
        If stripHeight = .ScaleHeight And stripWidth = .ScaleWidth Then
            SetDIBits .hdc, .Image, 0, stripHeight, stripImage(0, 0, 0), stripTemplate.BMPInfo, DIB_RGB_COLORS
        Else
            StretchDIBits .hdc, 0, 0, .ScaleWidth, .ScaleHeight, 0, 0, stripWidth, stripHeight, VarPtr(stripImage(0, 0, 0)), stripTemplate.BMPInfo, DIB_RGB_COLORS, vbSrcCopy
        End If
        .Picture = .Image
    End With

Exit_:
Exit Sub

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

End Sub

Sub sRedrawStripSection(ByVal Index As Integer, ByRef stripTemplate As STRIP_IMAGE, ByRef stripImage() As Byte, ByVal ColorByte As Integer)
On Error GoTo Err_

Dim X As Integer
Dim Y As Integer
Dim lngColor As Long

Dim stripHeight As Integer
Dim stripWidth As Integer

With stripTemplate.BMPInfo.bmiHeader
    stripWidth = Abs(.biWidth)
    stripHeight = Abs(.biHeight)
End With

For Y = 0 To stripHeight - 1
    For X = 0 To stripWidth - 1
        If stripTemplate.btyaryStripPixels(pixR, X, Y) = ColorByte Then
            If frmStrips.cbxSample(Index) = vbChecked Then
                psExtractRGBFromColor frmStrips.pbxTeamColorPreview(ColorByte + (Index * 16)).BackColor, stripImage(pixR, X, Y), stripImage(pixG, X, Y), stripImage(pixB, X, Y)
            Else
                psExtractRGBFromColor frmStrips.pbxTeamColor(ColorByte + (Index * 16)).BackColor, stripImage(pixR, X, Y), stripImage(pixG, X, Y), stripImage(pixB, X, Y)
            End If
        End If
    Next X
Next Y

With frmStrips.pbxStrip(Index)
    If stripHeight = .ScaleHeight And stripWidth = .ScaleWidth Then
        SetDIBits .hdc, .Image, 0, stripHeight, stripImage(0, 0, 0), stripTemplate.BMPInfo, DIB_RGB_COLORS
    Else
        StretchDIBits .hdc, 0, 0, .ScaleWidth, .ScaleHeight, 0, 0, stripWidth, stripHeight, VarPtr(stripImage(0, 0, 0)), stripTemplate.BMPInfo, DIB_RGB_COLORS, vbSrcCopy
    End If
    .Picture = .Image
End With

Exit_:
Exit Sub

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

End Sub

Sub sRedrawRink(ByRef stripTemplate As STRIP_IMAGE, ByRef stripImage() As Byte)
On Error GoTo Err_

Dim X As Integer
Dim Y As Integer
Dim lngColor As Long
Dim lngvb3dFace As Long

Dim stripWidth As Integer
Dim stripHeight As Integer

With stripTemplate.BMPInfo.bmiHeader
    stripWidth = Abs(.biWidth)
    stripHeight = Abs(.biHeight)
End With

stripImage() = stripTemplate.btyaryStripPixels()

lngvb3dFace = TranslateColor(vb3DFace)

    For Y = 0 To stripHeight - 1
        For X = 0 To stripWidth - 1
            If stripTemplate.btyaryStripPixels(pixR, X, Y) > 31 Then
                psExtractRGBFromColor lngvb3dFace, stripImage(pixR, X, Y), stripImage(pixG, X, Y), stripImage(pixB, X, Y)
            Else
                If frmRink.cbxSample = vbChecked Then
                    psExtractRGBFromColor frmRink.pbxRinkColorPreview(stripImage(pixR, X, Y)).BackColor, stripImage(pixR, X, Y), stripImage(pixG, X, Y), stripImage(pixB, X, Y)
                Else
                    psExtractRGBFromColor frmRink.pbxRinkColor(stripImage(pixR, X, Y)).BackColor, stripImage(pixR, X, Y), stripImage(pixG, X, Y), stripImage(pixB, X, Y)
                End If
            End If
        Next X
    Next Y

    With frmRink.pbxRink
        If stripHeight = .ScaleHeight And stripWidth = .ScaleWidth Then
            SetDIBits .hdc, .Image, 0, stripHeight, stripImage(0, 0, 0), stripTemplate.BMPInfo, DIB_RGB_COLORS
        Else
            StretchDIBits .hdc, 0, 0, .ScaleWidth, .ScaleHeight, 0, 0, stripWidth, stripHeight, VarPtr(stripImage(0, 0, 0)), stripTemplate.BMPInfo, DIB_RGB_COLORS, vbSrcCopy
        End If
        .Picture = .Image
    End With

Exit_:
Exit Sub

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

End Sub

Sub sRedrawRinkSection(ByRef stripTemplate As STRIP_IMAGE, ByRef stripImage() As Byte, ByVal ColorByte As Integer)
On Error GoTo Err_

Dim X As Integer
Dim Y As Integer
Dim lngColor As Long

Dim stripHeight As Integer
Dim stripWidth As Integer

With stripTemplate.BMPInfo.bmiHeader
    stripWidth = Abs(.biWidth)
    stripHeight = Abs(.biHeight)
End With

For Y = 0 To stripHeight - 1
    For X = 0 To stripWidth - 1
        If stripTemplate.btyaryStripPixels(pixR, X, Y) = ColorByte Then
            If frmRink.cbxSample = vbChecked Then
                psExtractRGBFromColor frmRink.pbxRinkColorPreview(ColorByte).BackColor, stripImage(pixR, X, Y), stripImage(pixG, X, Y), stripImage(pixB, X, Y)
            Else
                psExtractRGBFromColor frmRink.pbxRinkColorPreview(ColorByte).BackColor, stripImage(pixR, X, Y), stripImage(pixG, X, Y), stripImage(pixB, X, Y)
            End If
        End If
    Next X
Next Y

With frmRink.pbxRink
    If stripHeight = .ScaleHeight And stripWidth = .ScaleWidth Then
        SetDIBits .hdc, .Image, 0, stripHeight, stripImage(0, 0, 0), stripTemplate.BMPInfo, DIB_RGB_COLORS
    Else
        StretchDIBits .hdc, 0, 0, .ScaleWidth, .ScaleHeight, 0, 0, stripWidth, stripHeight, VarPtr(stripImage(0, 0, 0)), stripTemplate.BMPInfo, DIB_RGB_COLORS, vbSrcCopy
    End If
    .Picture = .Image
End With

Exit_:
Exit Sub

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

End Sub






Function TranslateColor(ByVal clr As OLE_COLOR, _
                        Optional hPal As Long = 0) As Long
    If OleTranslateColor(clr, hPal, TranslateColor) Then
        TranslateColor = CLR_INVALID
    End If
End Function


Sub sTeamLinesPlayerOffsetAdjust(ByVal intStartIndex As Integer, ByVal intAdjustValue As Integer)

Dim intFor As Integer
Dim intLinesStep As Integer
Dim lngLinesOffset As Long

With objSelected
    For intLinesStep = 1 To intROMLines
        lngLinesOffset = .TeamLinesOffset + ((intLinesStep - 1) * 8)   '8 = bytes per lines
        If lngLinesOffset < .TeamRosterOffset Then  '?WTF FIX - more of a check/precaution only
            For intFor = 0 To 7 '6 would do... last not used
                If btyaryOpenFile(lngLinesOffset + intFor) > intStartIndex Then
                    Call sHexBytesAdjust(btyaryOpenFile(), lngLinesOffset + intFor, 0, intAdjustValue, True)
                End If
            Next intFor
        Else
            Exit For
        End If
    Next intLinesStep
End With

End Sub

Function fTeamGoalieCount(ByVal strBytes As String) As Integer

Dim intFor As Integer

For intFor = 1 To 4
    If Not Right(strBytes, intFor) = String(intFor, "0") Then
        fTeamGoalieCount = (4 - intFor) + 1
        Exit For
    End If
Next intFor

End Function

Function fTeamGoaliePlayerIndex(ByVal lngOffset As Long, ByVal lngTeamRosterOffset As Long, ByVal lngTeamNameOffset As Long)

Dim lngPlayerOffset As Long
Dim lngPlayerNameOffset As Long
Dim intPlayerCount As Integer
Dim intTeamGoaliePlayerIndex As Integer

intTeamGoaliePlayerIndex = 0
intPlayerCount = 0
   
    lngPlayerOffset = lngTeamRosterOffset
    If blnROMPlayerNameSupport Then
        lngPlayerNameOffset = lngPlayerOffset + fHexToDecimal(fHexBytes(btyaryOpenFile(), lngPlayerOffset, 1))
    Else
        lngPlayerNameOffset = lngPlayerOffset
    End If
    
    Do While lngPlayerNameOffset < lngTeamNameOffset
        intPlayerCount = intPlayerCount + 1
        
        If lngPlayerOffset = lngOffset Then
            intTeamGoaliePlayerIndex = intPlayerCount
            Exit Do
        End If
        
        lngPlayerOffset = lngPlayerNameOffset + 8
        
        If blnROMPlayerNameSupport Then
            lngPlayerNameOffset = lngPlayerOffset + fHexToDecimal(fHexBytes(btyaryOpenFile(), lngPlayerOffset, 1))
        Else
            lngPlayerNameOffset = lngPlayerOffset
        End If
    
    Loop

Exit_:
fTeamGoaliePlayerIndex = intTeamGoaliePlayerIndex

End Function


Sub sShiftTeamBytes(ByVal ToTeamOffset As Long, ByVal FromTeamOffset As Long)
On Error GoTo Err_

Dim lngOffsetShiftStart As Long
Dim lngOffsetShiftEnd As Long
Dim lngTag As Long
Dim lngFor As Long
Dim intDestinationIndex As Integer

Dim lvwItem As MSComctlLib.ListItem

'With lvwTeams
    
    Call sSelectedItemsPopulate(objDestination, ToTeamOffset) 'To
    Call sSelectedItemsPopulate(objFrom, FromTeamOffset) 'From
    
    If objFrom.TeamFreeBytes <= 0 Then
        GoTo Exit_
    End If
    
    If objFrom.TeamOffset < objDestination.TeamOffset Then
        lngOffsetShiftStart = objFrom.TeamRosterOffset
        lngOffsetShiftEnd = objDestination.TeamLinesEndOffset - 1
    Else
        lngOffsetShiftStart = objDestination.TeamRosterOffset
        lngOffsetShiftEnd = objFrom.TeamLinesEndOffset - 1
    End If
        
    Call sHexBytesAdjust(btyaryOpenFile(), objFrom.TeamOffset, 1, -objFrom.TeamFreeBytes, True)    'Players
    Call sHexBytesAdjust(btyaryOpenFile(), objDestination.TeamOffset, 1, objFrom.TeamFreeBytes, True)   'Players
    
    Call sHexBytesAdjust(btyaryOpenFile(), objFrom.TeamOffset + 4, 1, -objFrom.TeamFreeBytes, True) 'Team Name
    Call sHexBytesAdjust(btyaryOpenFile(), objDestination.TeamOffset + 4, 1, objFrom.TeamFreeBytes, True)  'Team Name
    
    If blnROMTeamHeaderNextTeam Then
        Call sHexBytesAdjust(btyaryOpenFile(), objFrom.TeamOffset + 6, 1, -objFrom.TeamFreeBytes, True) 'Team Name
        Call sHexBytesAdjust(btyaryOpenFile(), objDestination.TeamOffset + 6, 1, objFrom.TeamFreeBytes, True)  'Team Name
    End If
    
    If objFrom.TeamOffset < objDestination.TeamOffset Then
        Call sHexBytesShift(btyaryOpenFile(), lngOffsetShiftStart, lngOffsetShiftEnd, -objFrom.TeamFreeBytes)
    Else
        Call sHexBytesShift(btyaryOpenFile(), lngOffsetShiftStart, lngOffsetShiftEnd, objFrom.TeamFreeBytes)
    End If
    
    'Adjust Team Order Bytes
    For lngFor = 0 To (intTeamCount - 1)
        lngTag = fHexToDecimal(fHexBytes(btyaryOpenFile(), (lngFor * 4) + lngTeamsStartOffset, 3))
        If lngTag > lngOffsetShiftStart And lngTag <= lngOffsetShiftEnd Then
            If objFrom.TeamOffset < objDestination.TeamOffset Then
                Call sHexBytesAdjust(btyaryOpenFile(), (lngFor * 4) + lngTeamsStartOffset, 3, -objFrom.TeamFreeBytes)
            Else
                Call sHexBytesAdjust(btyaryOpenFile(), (lngFor * 4) + lngTeamsStartOffset, 3, objFrom.TeamFreeBytes)
            End If
        End If
    Next lngFor
    
    'need to be separate as team indexs repeated in 97+
    With frmTeams.lvwTeams
        For lngFor = 1 To .ListItems.Count Step 1
            Set lvwItem = .ListItems(lngFor)
            lngTag = CLng(lvwItem.Tag)
            If lngTag > lngOffsetShiftStart And lngTag < lngOffsetShiftEnd Then
                If objFrom.TeamOffset < objDestination.TeamOffset Then
                    lngTag = lngTag + -objFrom.TeamFreeBytes
                Else
                    lngTag = lngTag + objFrom.TeamFreeBytes
                End If
                lvwItem.Tag = CStr(lngTag)
            End If
            lvwItem.Text = fDisplayOffset(lngTag, blnmnuOptionsOffsetHex)  'recalc offset
            Call lvwTeams_RequeryLineItem(lvwItem)
        Next lngFor
    End With
    
    'Write FFFF's (rewrite space - reusing variables)
    
    If ToTeamOffset > FromTeamOffset Then
        ToTeamOffset = ToTeamOffset + -objFrom.TeamFreeBytes
    End If
    Call sSelectedItemsPopulate(objDestination, ToTeamOffset) '? way to do it?
    lngOffsetShiftStart = objDestination.TeamLinesEndOffset
    lngOffsetShiftEnd = objDestination.TeamRosterOffset - 1
    For lngFor = lngOffsetShiftStart To lngOffsetShiftEnd
        btyaryOpenFile(lngFor) = &HFF
    Next lngFor
    
Exit_:
Exit Sub


Err_:
MsgBox vbNewLine & Err.Description & vbTab, vbCritical, Err.Number
Resume Next
    
End Sub

Sub sTeamFreeBytesMerge(Optional intLastSelectedItemIndex As Integer = -1)

Dim intFor As Integer
Dim intSelected As Integer
Dim intStart As Integer
Dim intEnd As Integer

If intLastSelectedItemIndex = -1 Then 'Not Specified
    intStart = 1
    intEnd = frmTeams.lvwTeams.ListItems.Count
Else
    intStart = intLastSelectedItemIndex
    intEnd = intLastSelectedItemIndex
End If

intSelected = frmTeams.lvwTeams.SelectedItem.Index

'If MsgBox("?", vbYesNo) = vbYes Then
    With frmTeams.lvwTeams
        For intFor = intStart To intEnd Step 1
            If Not intFor = intSelected Then
                Call sShiftTeamBytes(CLng(.ListItems(intSelected).Tag), CLng(.ListItems(intFor).Tag))
                Call lvwTeams_RequeryLineItem(.SelectedItem) 'somewhat not needed!?
                Call sSelectedItemsPopulate(objSelected, CLng(.ListItems(.SelectedItem.Index).Tag))
            End If
        Next intFor
    End With
'End If

'Call lvwTeams_Update

End Sub

Function fListViewSelectedItemsCount(ByVal lvw As ListView) As Integer
On Error Resume Next 'avoid error in resize to ziltch

Dim intFor As Integer
Dim intSelectedCount As Integer

intSelectedCount = 0

With lvw
    If .ListItems.Count > 0 Then
        For intFor = 1 To .ListItems.Count
            If .ListItems(intFor).Selected Then
                intSelectedCount = intSelectedCount + 1
            End If
        Next
    End If
    fListViewSelectedItemsCount = intSelectedCount
End With

End Function

Sub sListViewItemsSelectAll(ByVal lvw As ListView)
On Error Resume Next

Dim intFor As Integer
Dim intSelectedItemIndex As Integer

With lvw
    If .ListItems.Count > 0 Then
        intSelectedItemIndex = .SelectedItem.Index
        For intFor = 1 To .ListItems.Count
            .ListItems(intFor).Selected = True
        Next
        .ListItems(intSelectedItemIndex).Selected = True
    End If
    .SetFocus
End With

End Sub

Sub sListViewItemsInvertSelection(ByVal lvw As ListView)
On Error Resume Next

Dim intFor As Integer
Dim intSelectedItemIndex As Integer
Dim blnSelectedItemSelected As Boolean

With lvw
    If .ListItems.Count > 0 Then
        intSelectedItemIndex = .SelectedItem.Index
        blnSelectedItemSelected = .SelectedItem.Selected
        For intFor = 1 To .ListItems.Count
            .ListItems(intFor).Selected = Not .ListItems(intFor).Selected
        Next
    End If
    .ListItems(intSelectedItemIndex).Selected = True 'refocus item
    .ListItems(intSelectedItemIndex).Selected = Not blnSelectedItemSelected 'invert original value
    .SetFocus
End With

End Sub

Sub sLoadToolbarIcons(ByRef tlbIcons As Toolbar, ByRef imlIcons As ImageList)
On Error GoTo Err_

Dim objButton As Button
Dim objButtons As Buttons
Dim blnNoIconError As Boolean

AddImageFileToImageList imlIcons, tiNoIcon, tiNoIcon

Set tlbIcons.ImageList = imlIcons
        
    Set objButtons = tlbIcons.Buttons
    For Each objButton In objButtons
        If Not objButton.Key = "" Then
            AddImageFileToImageList imlIcons, objButton.Key, objButton.Key
            tlbIcons.Buttons(objButton.Key).Image = objButton.Key
        End If
    Next objButton
    
    Set objButton = Nothing
    Set objButtons = Nothing

Exit_:
    Exit Sub
    
Err_:
    Select Case Err.Number
    Case 326: '?
        Resume Next
    Case 35601:
        If Not blnNoIconError Then
            tlbIcons.Buttons(objButton.Key).Image = tiNoIcon
        End If
        Resume Next
    Case 35601: 'ImageList cannot be initialized (missing noicon.ico)
        Resume Next
    Case 35613: 'ImageList must be initialized before it can be used
        Resume Next
    Case Else
        MsgBox vbNewLine & Err.Description & vbTab, vbExclamation, Err.Number
        Resume Next
        'Resume Exit_
    End Select
End Sub


Sub sLoadToolbarState(ByRef tlbIcons As Toolbar, ByVal blnEnabled As Boolean)
On Error Resume Next

Dim objButton As Button
Dim objButtons As Buttons

tlbIcons.Enabled = blnEnabled

Set objButtons = tlbIcons.Buttons
For Each objButton In objButtons
    objButton.Enabled = blnEnabled
Next objButton
Set objButton = Nothing
Set objButtons = Nothing

End Sub


Sub sClipboardCopyPaste(ByRef lvw As ListView, ByVal strItemFormat As String, ByVal strButtonKey As String)
On Error Resume Next

Const cClipboardName = "NOSE Item Data v001"
Const cClipboardDelimiter = "|"
Const cClipboardSubDelimiter = ";"

Const cRequiredBytesAttributes = 7 'deliberate 8 -1 =7

Const cMsgTitle = "Paste"

Dim objClipboard As New clsCustomClipboard
Dim strClipboard As String
Dim strClipboardObject As String 'used to audit if lines, or player etc. data is loaded into the clipboard
Dim strClipboardBytes As String
Dim strClipboardROMVersion As String

Dim arybtyClipboard() As Byte
'Public objClipboardID As Long
'Public Const cClipboardLines = "Line"
'Public Const cClipboardPlayers = "Player"
'Public Const cClipboardGoalies = "Goalie"
'Public Const cClipboardPlayoffDraws = "Playoff Draw"

Dim strMsgTitle As String
Dim strMsgText As String
Dim intMsgClipboardItems As Integer
Dim intMsgSelectedItems As Integer
Dim intMsgBoxResult As VbMsgBoxResult

Dim blnClipboardPlayerNameSupport As Boolean
Dim intClipboardStart As Integer
Dim intClipboardEnd As Integer
Dim intSelectItemStart As Integer
Dim lngNameBytesClipboard As Long
Dim lngNameBytesSelected As Long
Dim lngNameSelectedLength As Long
'Dim blnClipboardHasPos As Boolean
Dim strPosBytes As String

Dim intFor As Integer
Dim intItems As Integer
Dim intItemSplit As Integer
Dim intBytesPlus As Integer
Dim strCopyPos As String
Dim lngPlayerIndex As Long
Dim blnClipboardPlayerData As Boolean
Dim blnIncompatibleData As Boolean 'used to evaluate if data pasted between clipboard and rom required adjusting!

'load clipboard on first use
If objClipboardID = 0 Then
    objClipboardID = objClipboard.AddFormat(cClipboardName)
    If objClipboardID = 0 Then
        MsgBox vbNewLine & "Failed to load custom clipboard!" & vbTab, vbExclamation ' Exceptional circumstance (API call failed):
        GoTo Exit_
    End If
End If

blnClipboardPlayerData = False
Select Case strItemFormat
Case cClipboardPlayoffDraws:
    intBytesPlus = 15 '16 bytes used in line
Case cClipboardGoalies, cClipboardPlayers:
    intBytesPlus = cRequiredBytesAttributes '8 bytes used when rom has no name support!
    blnClipboardPlayerData = True
Case cClipboardLines:
    intBytesPlus = 7 '8 bytes used in line
Case Else:
    MsgBox vbNewLine & "Unknown Clipboard Item Format" & vbTab, vbExclamation
    GoTo Exit_
End Select

Select Case strButtonKey
Case tiItemCopy:
    If objClipboard.ClipboardOpen(frmMDI.hwnd) Then 'pass hwnd? was Me.hWnd
        strClipboard = strROMVersion & cClipboardSubDelimiter & strItemFormat
        
        With lvw
            For intItems = 1 To .ListItems.Count
                If .ListItems(intItems).Selected = True Then
                    If blnClipboardPlayerData And blnROMPlayerNameSupport Then
                        intBytesPlus = fHexToDecimal(fHexBytes(btyaryOpenFile, CLng(.ListItems(intItems).Tag), 1)) + cRequiredBytesAttributes
                    End If
                    strClipboard = strClipboard & cClipboardDelimiter & fHexBytesAsc(btyaryOpenFile(), CLng(.ListItems(intItems).Tag), intBytesPlus)
                    
                    If blnClipboardPlayerData Then
                        '0=G,1=LD,2=RD,3=LW,4=C,5=RW,F=No Player
                        '0=G,1=LD,3=LW
                        lngPlayerIndex = fTeamGoaliePlayerIndex(CLng(.ListItems(intItems).Tag), objSelected.TeamRosterOffset, objSelected.TeamNameOffset)
                        
                        If blnROMPlayerNameSupport Then
                            If blnROMPlayerPositionSupport Then '96+
                                strCopyPos = fHexBytes(btyaryOpenFile, objSelected.TeamPositionsOffset, objSelected.TeamPositionsBytes - 1)
                                If lngPlayerIndex > (objSelected.TeamPositionsBytes * 2) Then
                                    strCopyPos = "F" 'None/Error?
                                Else
                                    strCopyPos = Mid(strCopyPos, lngPlayerIndex, 1)
                                End If
                            ElseIf blnROMPlayerForwardsSupport Then '94/5
                                If lngPlayerIndex <= objSelected.TeamGoalies Then
                                    strCopyPos = "0" 'G Default
                                ElseIf (lngPlayerIndex - objSelected.TeamGoalies) > objSelected.TeamPlayersOffense Then
                                    strCopyPos = "1" 'LD Default
                                Else
                                    strCopyPos = "3" 'LW Default
                                End If
                            End If
                        Else '91/2
                            If lngPlayerIndex <= objSelected.TeamGoalies Then
                                strCopyPos = "0" 'G Default
                            Else
                                strCopyPos = "4" 'C Default
                            End If
                        End If
                        strClipboard = strClipboard & cClipboardSubDelimiter & strCopyPos
                    End If
                End If
            Next intItems
        End With
        Call objClipboard.SetTextData(objClipboardID, strClipboard)
        objClipboard.ClipboardClose
        'Debug.Print "----" & strItemFormat; Now()
        'Debug.Print strClipboard
    End If
    
Case tiItemPste, tiItemPsta:
    If objClipboard.ClipboardOpen(frmMDI.hwnd) Then
        If objClipboard.IsDataAvailableForFormat(objClipboardID) Then
            If objClipboard.GetTextData(objClipboardID, strClipboard) Then
                strClipboardObject = Split(Split(strClipboard, cClipboardDelimiter)(0), cClipboardSubDelimiter)(1)
                If strClipboardObject = strItemFormat Then
                    
                    strClipboardROMVersion = Split(strClipboard, cClipboardSubDelimiter)(0)
                    blnIncompatibleData = fClipboardROMVersionsIncompatible(strClipboardROMVersion, strROMVersion)
                    
                    'MsgBox vbNewLine & strClipboard & vbTab, vbInformation, strClipboardObject
                    strMsgTitle = cMsgTitle & " " & strClipboardObject & " "
                    If strButtonKey = tiItemPsta Then
                        strMsgTitle = strMsgTitle & "Attributes"
                    End If
                    
                    intMsgClipboardItems = UBound(Split(strClipboard, cClipboardDelimiter))
                    intMsgSelectedItems = fListViewSelectedItemsCount(lvw)
                    
                    strMsgText = vbNewLine & "Your are about to paste from the " & CStr(intMsgClipboardItems) & " item(s) on the clipboard over the " & CStr(intMsgSelectedItems) & " selected item(s)!" & vbTab & vbNewLine
                    
                    If intMsgClipboardItems > intMsgSelectedItems Then
                        'not all pasted
                        strMsgText = strMsgText & vbNewLine & "Not all clipboard items can pasted with the current selection(s)!" & vbTab & vbNewLine
                    ElseIf intMsgSelectedItems > intMsgClipboardItems Then
                        'repeated
                        strMsgText = strMsgText & vbNewLine & "The clipboard item(s) will be repeated over the current selections!" & vbTab & vbNewLine
                    End If
                    
                    strMsgText = strMsgText & vbNewLine & "Continue?"
                    
                    'If intMsgClipboardItems = intMsgSelectedItems Then
                    '    intMsgBoxResult = vbYes 'skip if pasting same amount of items...
                    'Else
                        intMsgBoxResult = MsgBox(strMsgText, vbInformation + vbYesNo, strMsgTitle) 'warning before commit
                    'End If
                    
                    If intMsgBoxResult = vbYes Then
                        With lvw
                            If blnClipboardPlayerData Then
                                blnClipboardPlayerNameSupport = fROMPlayerNameSupport(Split(Split(strClipboard, cClipboardDelimiter)(0), cClipboardSubDelimiter)(0))
                            
                                If blnROMPlayerNameSupport And blnClipboardPlayerNameSupport And strButtonKey = tiItemPste Then  'Checking for enough bytes
                                    lngNameBytesClipboard = 0
                                        
                                    intItemSplit = 1
                                    For intItems = 1 To .ListItems.Count
                                        If .ListItems(intItems).Selected = True Then
                                    
                                            lngNameBytesClipboard = lngNameBytesClipboard + fHexToDecimal(Left(Split(Split(strClipboard, cClipboardDelimiter)(intItemSplit), cClipboardSubDelimiter)(0), 4)) - 2
                                            lngNameBytesSelected = lngNameBytesSelected + fHexToDecimal(fHexBytes(btyaryOpenFile, CLng(.ListItems(intItems).Tag), 1)) - 2 'minus to for length bytes
                                    
                                            If intItemSplit = UBound(Split(strClipboard, cClipboardDelimiter)) Then
                                                intItemSplit = 1
                                            Else
                                                intItemSplit = intItemSplit + 1
                                            End If
                                        End If
                                    Next intItems
                                        
                                    'MsgBox lngNameBytesClipboard & ":" & lngNameBytesSelected & ";" & objSelected.TeamFreeBytes
                                    If objSelected.TeamFreeBytes + (lngNameBytesSelected - lngNameBytesClipboard) < 0 Then
                                        MsgBox vbNewLine & "The selected team has insufficient free bytes to successfully paste the clipboard data!" & vbTab, vbExclamation
                                        lvw.SetFocus
                                        GoTo Exit_
                                    Else
                                        For intItems = 1 To .ListItems.Count
                                            If .ListItems(intItems).Selected = True Then
                                                lngNameSelectedLength = fHexToDecimal(fHexBytes(btyaryOpenFile, CLng(.ListItems(intItems).Tag), 1)) - 2 'minus to for length bytes
                                                If lngNameSelectedLength > 0 Then
                                                    Call sHexBytesAdjust(btyaryOpenFile, CLng(.ListItems(intItems).Tag), 1, -lngNameSelectedLength)
                                                    Call sHexBytesShift(btyaryOpenFile(), objSelected.TeamRosterOffset, CLng(.ListItems(intItems).Tag) + 1, lngNameSelectedLength)
                                                    Call sHexBytesWriteByte(btyaryOpenFile(), objSelected.TeamRosterOffset, lngNameSelectedLength - 1)
                                                    Call sHexBytesAdjust(btyaryOpenFile(), objSelected.TeamOffset, 1, lngNameSelectedLength) 'rewrite header
                                                    objSelected.TeamRosterOffset = objSelected.TeamRosterOffset + lngNameSelectedLength
                                                    'objSelected.TeamFreeBytes =  objSelected.TeamFreeBytes + lngNameSelectedLength
                                                End If
                                            End If
                                        Next intItems
                                        
                                        Call lvwTeams_RequeryLineItem(frmTeams.lvwTeams.SelectedItem)
                                        Call lvwTeams_Update(True)
                                    End If
                                End If
                            End If
                            
                            intItemSplit = 1 'Stand processing of clipboard really starts here!
                            For intItems = 1 To .ListItems.Count
                                If .ListItems(intItems).Selected = True Then
                                    strClipboardBytes = Split(Split(strClipboard, cClipboardDelimiter)(intItemSplit), cClipboardSubDelimiter)(0)
                                    
                                    
                                    '**********************************************
                                    '* Check and Alter Bytes between Versions Here!
                                    '**********************************************
                                    'blnIncompatibleData = Not fClipboardROMVersionsCompatible(strClipboardROMVersion, strROMVersion) 'move this higher when done properly!
                                     
                                    If blnClipboardPlayerData And blnIncompatibleData Then
                                        strClipboardBytes = fClipboardItemDataFixes(strROMVersion, strClipboardROMVersion, strClipboardObject, strClipboardBytes)
                                    End If
                                    Call sHexStringToBytes(arybtyClipboard(), strClipboardBytes)
                                
                                    intClipboardStart = LBound(arybtyClipboard) '0?
                                    intClipboardEnd = UBound(arybtyClipboard) '0?
                                    intSelectItemStart = 0
                                    
                                    If blnClipboardPlayerData Then
                                        Call sHexStringToBytes(arybtyClipboard(), strClipboardBytes)
                                        
                                        If blnROMPlayerNameSupport And blnClipboardPlayerNameSupport And strButtonKey = tiItemPste Then
                                            lngNameBytesClipboard = fHexToDecimal(Left(Split(Split(strClipboard, cClipboardDelimiter)(intItemSplit), cClipboardSubDelimiter)(0), 4)) - 2
                                            Call sHexBytesAdjust(btyaryOpenFile, CLng(.ListItems(intItems).Tag), 1, lngNameBytesClipboard)
                                            Call sHexBytesShift(btyaryOpenFile, objSelected.TeamRosterOffset, CLng(.ListItems(intItems).Tag) + 1, -lngNameBytesClipboard)
                                            Call sHexBytesAdjust(btyaryOpenFile(), objSelected.TeamOffset, 1, -lngNameBytesClipboard) 'rewrite header
                                            objSelected.TeamRosterOffset = objSelected.TeamRosterOffset + -lngNameBytesClipboard
                                            .ListItems(intItems).Tag = CStr(CLng(.ListItems(intItems).Tag) + -lngNameBytesClipboard)
                                            intClipboardStart = 2
                                            intSelectItemStart = 2  'skip name len bytes
                                        Else
                                            If blnClipboardPlayerNameSupport Then 'skip name bytes (for now)
                                                intClipboardStart = fHexToDecimal(fHexBytes(arybtyClipboard, intClipboardStart, 1))
                                            End If
                                            If blnROMPlayerNameSupport Then 'skip name bytes (for now)
                                                intSelectItemStart = fHexToDecimal(fHexBytes(btyaryOpenFile, CLng(.ListItems(intItems).Tag), 1))
                                            End If
                                            
                                            If strButtonKey = tiItemPsta Then 'pasting attributes, skip jersey
                                                intClipboardStart = intClipboardStart + 1
                                                intSelectItemStart = intSelectItemStart + 1
                                            End If
                                        End If
                                    End If
                                    
                                    'For intFor = LBound(arybtyClipboard) To UBound(arybtyClipboard)
                                    '    btyaryOpenFile(CLng(.ListItems(intItems).Tag) + intFor) = arybtyClipboard(intFor)
                                    'Next intFor
                                    For intFor = intClipboardStart To intClipboardEnd
                                        btyaryOpenFile(CLng(.ListItems(intItems).Tag) + intSelectItemStart) = arybtyClipboard(intFor)
                                        intSelectItemStart = intSelectItemStart + 1
                                    Next intFor
                                    
                                    If blnClipboardPlayerData Then 'Handle player position stuff here
                                        If blnROMPlayerPositionSupport And strButtonKey = tiItemPste Then 'dont copy when only attributes
                                            strClipboardBytes = Split(Split(strClipboard, cClipboardDelimiter)(intItemSplit), cClipboardSubDelimiter)(1) 'Position
                                            Call sHexStringToBytes(arybtyClipboard(), strClipboardBytes)
                                            
                                            lngPlayerIndex = fTeamGoaliePlayerIndex(CLng(.ListItems(intItems).Tag), objSelected.TeamRosterOffset, objSelected.TeamNameOffset) 'needed!
                                            If Not lngPlayerIndex > (objSelected.TeamPositionsBytes * 2) Then
                                                lngPlayerIndex = lngPlayerIndex - 1
                                                strPosBytes = fHexByte(btyaryOpenFile(objSelected.TeamPositionsOffset + (lngPlayerIndex \ 2)))
                                                If (lngPlayerIndex Mod 2) = 0 Then 'even index after above subtract
                                                    strPosBytes = CStr(arybtyClipboard(0)) & Right(strPosBytes, 1)
                                                Else
                                                    strPosBytes = Left(strPosBytes, 1) & CStr(arybtyClipboard(0))
                                                End If
                                                btyaryOpenFile(objSelected.TeamPositionsOffset + (lngPlayerIndex \ 2)) = fHexToDecimal(strPosBytes)
                                            End If
                                        End If
                                    End If
                                    
                                    Select Case strItemFormat
                                    Case cClipboardLines:
                                        Call lvwLines_RequeryLineItem(.ListItems(intItems), frmTeams.lvwTeams.SelectedItem)
                                    Case cClipboardPlayoffDraws:
                                        Call lvwPlayoffDraws_RequeryLineItem(.ListItems(intItems))
                                    Case cClipboardPlayers, cClipboardGoalies:
                                        'no need to requery all until all pasting done! see below
                                        Call lvwGoaliesPlayers_RequeryLineItem(.ListItems(intItems))
                                    End Select
                                    
                                    If intItemSplit = UBound(Split(strClipboard, cClipboardDelimiter)) Then
                                        intItemSplit = 1
                                    Else
                                        intItemSplit = intItemSplit + 1
                                    End If
                                End If
                            Next intItems
                        
                            If blnClipboardPlayerData And strButtonKey = tiItemPste Then 'don't worry if only pasting attributes
                                Call lvwTeams_RequeryLineItem(frmTeams.lvwTeams.SelectedItem)
                                Call lvwTeams_Update(True) '*** IMPORTANT! ****
                                'Call lvwLines_RequeryAllItems
                            End If
                        End With
                        
                    End If 'Msgbox for matching items
                    lvw.SetFocus 'return focus after msgbox
                Else
                    MsgBox vbNewLine & "The clipboard currently contains " & strClipboardObject & " item data!" & vbTab & vbTab, vbExclamation, "Paste " & strItemFormat
                End If
            End If
        Else
            MsgBox vbNewLine & "There is no NOSE item data currently stored on the clipboard!" & vbTab, vbExclamation, "Paste " & strItemFormat
        End If
        objClipboard.ClipboardClose
    End If
End Select

Exit_:
Exit Sub

End Sub


Public Function fClipboardItemDataFixes(ByVal strDestinationROMVersion As String, ByVal strClipboardROMVersion As String, ByVal strClipboardObject As String, ByVal strClipboardBytes As String) As String

Const cAttributeLength As Integer = 14

Dim strNameJersey As String
Dim strAttributes As String
Dim strAttributesLeft As String
Dim strAttributesRight As String
Dim strAttributesMid As String
Dim intAttributeMid As Integer
Dim intAttributeFight As Integer 'Fighting/Aggression

Dim blnClipboardROMLeftIsOdd As Boolean
Dim blnROMLeftIsOdd As Boolean

Dim strClipboardAttributeRatingFormat As String
Dim strROMAttributeRatingFormat As String

strNameJersey = Left(strClipboardBytes, Len(strClipboardBytes) - cAttributeLength)
strAttributes = Right(strClipboardBytes, cAttributeLength)


'Handedness - same pos for all! :)
'*********************************
Select Case strClipboardROMVersion
    Case rvSMD91, rvSG92, rvSG93, rvSG95, rvSMD95E:
        blnClipboardROMLeftIsOdd = True
    Case Else 'rvSG94,rvSG96, rvSMD96E,rvSG97, rvSG98:
        blnClipboardROMLeftIsOdd = False
End Select

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

strAttributesLeft = Left(strAttributes, 7) 'only change this value
strAttributesRight = Right(strAttributes, cAttributeLength - Len(strAttributesLeft) - 1)
strAttributesMid = Mid(strAttributes, Len(strAttributesLeft) + 1, 1)
intAttributeMid = fHexToDecimal(strAttributesMid)

Select Case strClipboardObject
Case cClipboardGoalies: 'DONE
    
    If intAttributeMid < 2 Then 'Else IGNORE!  Values out of expected range.
        If Not blnClipboardROMLeftIsOdd = blnROMLeftIsOdd Then
            strAttributesMid = Hex(Abs(Not -intAttributeMid))
        End If
    End If

Case cClipboardPlayers:
    Select Case strClipboardROMVersion
        Case rvSMD91, rvSG92:
            intAttributeFight = fHexToDecimal(Right(strAttributes, 1))
            intAttributeFight = intAttributeFight - (intAttributeFight Mod 2) 'make even
            If intAttributeMid < 2 Then
                If Not blnClipboardROMLeftIsOdd = blnROMLeftIsOdd Then
                    intAttributeMid = Abs(Not -intAttributeMid)
                End If
                If (Not strDestinationROMVersion = rvSMD91) And (Not strDestinationROMVersion = rvSG92) Then
                    intAttributeMid = intAttributeMid + intAttributeFight
                End If
                strAttributesMid = Left(Hex(intAttributeMid), 1)
            End If
        Case Else: '03+
            If strDestinationROMVersion = rvSMD91 Or strDestinationROMVersion = rvSG92 Then
                'strAttributesRight = Left(strAttributesRight, Len(strAttributesRight) - 1) & CStr(intAttributeMid) 'Set Fight
                intAttributeMid = intAttributeMid Mod 2 'convert back to 0 if even, or 1 if odd
                strAttributesMid = Hex(intAttributeMid) 'set here if condition below not met
                
            End If
            If Not blnClipboardROMLeftIsOdd = blnROMLeftIsOdd Then
                If (intAttributeMid Mod 2 = 0) Then 'Even
                    strAttributesMid = Hex(intAttributeMid + 1)
                Else
                    strAttributesMid = Hex(intAttributeMid - 1)
                End If
            End If
    End Select
End Select
strAttributes = strAttributesLeft & strAttributesMid & strAttributesRight
'*****************
'End of Handedness

'Convert 91 Goalie Attributes
If strClipboardObject = cClipboardGoalies Then
    If (strClipboardROMVersion = rvSMD91) Or (strClipboardROMVersion = rvSG92) Then
        strAttributes = Left(strAttributes, 5) & Mid(strAttributes, 13, 2) & Mid(strAttributes, 8, 1) & Mid(strAttributes, 6, 2) & Mid(strAttributes, 9, 4)
    End If
End If

'Check formats and convert hex values here!
strClipboardAttributeRatingFormat = fAttributeRatingFormat(strClipboardROMVersion, strClipboardObject)
strROMAttributeRatingFormat = fAttributeRatingFormat(strROMVersion, strClipboardObject)
If Not strClipboardAttributeRatingFormat = strROMAttributeRatingFormat Then
    strAttributes = fAttributeRatingConversion(strAttributes, strClipboardAttributeRatingFormat, strROMAttributeRatingFormat)
End If

'Revert 91 Goalie Attributes if required
If strClipboardObject = cClipboardGoalies Then
    If (strDestinationROMVersion = rvSMD91) Or (strDestinationROMVersion = rvSG92) Then
        strAttributes = Left(strAttributes, 5) & Mid(strAttributes, 9, 2) & Mid(strAttributes, 8, 1) & Mid(strAttributes, 11, 4) & Mid(strAttributes, 6, 2)
    End If
End If

Exit_:
fClipboardItemDataFixes = strNameJersey & strAttributes
Exit Function

End Function

Public Function fClipboardROMVersionsIncompatible(ByVal strClipboardROMVersion As String, ByVal strROMVersion As String) As String

Dim blnCompatible As Boolean

Select Case strClipboardROMVersion
    Case rvSMD91, rvSG92:
        blnCompatible = (strROMVersion = rvSMD91 Or strROMVersion = rvSG92)
    Case rvSG93:
        blnCompatible = (strROMVersion = rvSG93)
    Case rvSG94:
        blnCompatible = (strROMVersion = rvSG94)
    Case rvSG95, rvSMD95E: 'StH
        blnCompatible = (strROMVersion = rvSG95 Or strROMVersion = rvSMD95E)
    Case rvSG96, rvSMD96E, rvSG97, rvSG98:
        blnCompatible = (strROMVersion = rvSG96 Or strROMVersion = rvSMD96E Or strROMVersion = rvSG97 Or strROMVersion = rvSG98)
End Select

fClipboardROMVersionsIncompatible = Not blnCompatible

End Function

Public Function fAttributeRatingFormat(ByVal strVersion As String, ByVal strClipboardObject As String) As String

Dim strFormat As String

'Attribute Conversion Stuff Here
'0 = Leave at Zero
'6 = 0-6 Rating
'F = 0-F Rating
'X = Ingnore

Select Case strVersion
    Case rvSMD91, rvSG92:
        If strClipboardObject = cClipboardGoalies Then
            strFormat = "XFFFFF0X00FFFF"
        Else 'cClipboardPlayers
            strFormat = "XFFFFFFXFFFFFF"
        End If
    Case rvSG93:
        If strClipboardObject = cClipboardGoalies Then
            strFormat = "XFFFFF0X00FFFF"
        Else 'cClipboardPlayers
            strFormat = "XFFFFFFXFFFFFF"
        End If
    Case rvSG94:
        If strClipboardObject = cClipboardGoalies Then
            strFormat = "X666660X006666"
        Else 'cClipboardPlayers
            strFormat = "X666666X666666"
        End If
    Case rvSG95, rvSMD95E: 'StH
        If strClipboardObject = cClipboardGoalies Then
            strFormat = "X666660X006666"
        Else 'cClipboardPlayers
            strFormat = "X666666XF66666"
        End If
    Case rvSG96, rvSMD96E, rvSG97, rvSG98:
        If strClipboardObject = cClipboardGoalies Then
            strFormat = "X666660X606666"
        Else 'cClipboardPlayers
            strFormat = "X666666X666666" 'Last F instead?
        End If
End Select

fAttributeRatingFormat = strFormat

End Function

Public Function fAttributeRatingConversion(ByVal strAttributes As String, ByVal strClipboardFormat As String, ByVal strROMFormat As String) As String
On Error GoTo Err_

Const cx = "X"
Const c0 = "0"
Const c6 = "6"
Const cF = "F"
                     '0123456789ABCDEF
Const cConvert6toF = "0247ADF"
Const cConvertFto6 = "0112223334445556"

Dim intFor As Integer
Dim strConversion As String

Dim strMidClipboardFormat As String
Dim strMidROMFormat As String
Dim strMidAttribute As String

Dim intMidAttribute As Integer

strConversion = vbNullString

For intFor = 1 To 14
    
    strMidClipboardFormat = Mid(strClipboardFormat, intFor, 1)
    strMidROMFormat = Mid(strROMFormat, intFor, 1)
    strMidAttribute = Mid(strAttributes, intFor, 1)
    
    If Not strMidClipboardFormat = strMidROMFormat Then
        intMidAttribute = fHexToDecimal(strMidAttribute)
    
        Select Case strMidClipboardFormat
            Case c0:
                If Not strMidROMFormat = cx Then
                    intMidAttribute = 0
                End If
            
            Case c6:
                Select Case strMidROMFormat
                    Case c0:
                        intMidAttribute = 0
                    Case cF:
                        If intMidAttribute < Len(cConvert6toF) Then '< accounting for string starting a 1, not 0
                            intMidAttribute = fHexToDecimal(Mid(cConvert6toF, intMidAttribute + 1, 1))
                        End If
                    'Case Else: 'Ingnore! includes cX
                End Select
            
            Case cF:
                Select Case strMidROMFormat
                    Case c0:
                        intMidAttribute = 0
                    Case c6:
                        intMidAttribute = fHexToDecimal(Mid(cConvertFto6, intMidAttribute + 1, 1))
                    'Case Else: 'Ingnore! includes cX
                End Select
            
            'Case Else: 'Ingnore! includes cX
        End Select
        
        strMidAttribute = Hex(intMidAttribute)
    
    End If
    
    strConversion = strConversion & strMidAttribute

Next intFor

Exit_:
fAttributeRatingConversion = strConversion
Exit Function

Err_:
MsgBox vbNewLine & Err.Description & vbTab, vbExclamation, Err.Number
Resume Next

End Function


Public Sub sLoadPictureAsCursor(ByRef pbx As PictureBox, ByVal strCursorFileName As String)
On Error Resume Next

Dim strCursorPath As String

With pbx
     strCursorPath = AppPath & apCursors & strCursorFileName
     If fFileDIRExists(strCursorPath) Then
         .Picture = LoadPicture(strCursorPath, vbLPCustom, vbLPColor, 32, 32)
         .Visible = False
     Else
         .BackColor = vb3DFace
         .Visible = True 'prepare for evaluation later
     End If
End With

End Sub

Public Function fMouseFocusInPictureBox(ByRef pbx As PictureBox, ByVal X As Single, ByVal Y As Single) As Boolean
On Error Resume Next

With pbx
    If X < 0 Or X >= .ScaleWidth Or Y < 0 Or Y >= .ScaleHeight Then
        fMouseFocusInPictureBox = False
    Else
        fMouseFocusInPictureBox = True
    End If
End With
    
End Function

Sub sFrameEditCaption(ByRef fme As Frame, ByRef lvw As ListView)

With lvw
    fme.Caption = fme.Tag & " " & .ColumnHeaders(1).Text & " " & .SelectedItem.Text
End With

End Sub

Public Sub sLoadColorHexBGRtoRGB()
On Error Resume Next

Const cDelimiter = ";"

Const cvRB = "0;0;32;32;72;72;104;104;144;144;176;176;216;216;248;248"
Const cvGn = "0;0;36;36;72;72;108;108;144;144;180;180;216;216;252;252"

Dim bytX As Integer
Dim bytR As Byte, bytG As Byte, bytB As Byte

For bytX = 0 To 15
    aryBGRRed(bytX) = CInt(Split(cvRB, cDelimiter)(bytX))
    aryBGRGreen(bytX) = CInt(Split(cvGn, cDelimiter)(bytX))
    'aryBGRBlue(bytX) = CInt(Split(cvRB, cDelimiter)(bytX))
    aryBGRBlue(bytX) = aryBGRRed(bytX)
Next bytX

'For bytR = 0 To 15
'    For bytG = 0 To 15
'        For bytB = 0 To 15
'            aryBGRtoRGBLong(bytR, bytG, bytB) = RGB( _
                                                aryBGRRed(bytR), _
                                                aryBGRGreen(bytG), _
                                                aryBGRGreen(bytB) _
                                                )
'        Next bytB
'    Next bytG
'Next bytR


End Sub

Public Function fColorHexBGRtoRGB(ByVal strHexBGR As String, _
                                  Optional ByRef strRed As String, _
                                  Optional ByRef strGreen As String, _
                                  Optional ByRef strBlue As String, _
                                  Optional ByVal blnStringRGB As Boolean = False) As Long
On Error Resume Next


Dim bytR As Byte
Dim bytG As Byte
Dim bytB As Byte

If strHexBGR = vbNullString Then
    fColorHexBGRtoRGB = vb3DFace
Else
    bytR = fHexToDecimal(Mid(strHexBGR, 4, 1))
    bytG = fHexToDecimal(Mid(strHexBGR, 3, 1))
    bytB = fHexToDecimal(Mid(strHexBGR, 2, 1))
    
    If blnStringRGB Then
        strRed = CStr(aryBGRRed(bytR))
        strGreen = CStr(aryBGRGreen(bytG))
        strBlue = CStr(aryBGRBlue(bytB))
    End If
       
    fColorHexBGRtoRGB = RGB(aryBGRRed(bytR), aryBGRGreen(bytG), aryBGRBlue(bytB))
    'fColorHexBGRtoRGB = aryBGRtoRGBLong(bytR, bytG, bytB)
End If

   
End Function


Public Function fColorRGBMatchHexBGR(ByVal lngColor As Long, _
                                     Optional ByRef strRed As String, _
                                     Optional ByRef strGreen As String, _
                                     Optional ByRef strBlue As String, _
                                     Optional ByVal blnStringRGB As Boolean = False) As String
On Error Resume Next


Dim bytFor As Byte

Dim bytR As Byte
Dim bytG As Byte
Dim bytB As Byte

Dim intDiff As Integer
Dim intDif_R As Integer: Dim intDif_G As Integer: Dim intDif_B As Integer

Dim bytBGR_R As Byte: Dim bytBGR_G As Byte: Dim bytBGR_B As Byte
Dim bytRGB_R As Byte: Dim bytRGB_G As Byte: Dim bytRGB_B As Byte

intDif_R = 256: intDif_G = 256: intDif_B = 256

Call psExtractRGBFromColor(lngColor, bytRGB_R, bytRGB_G, bytRGB_B)

'If bytRGB_R = 238 And bytRGB_G = 255 And bytRGB_B = 25 Then
'    Debug.Print "fuck"
'End If

For bytFor = 0 To 14 Step 2
    
    intDiff = Abs(CInt(bytRGB_R) - aryBGRRed(bytFor))
    If intDiff < intDif_R Then
        intDif_R = intDiff
        bytBGR_R = bytFor
    End If

    intDiff = Abs(CInt(bytRGB_G) - aryBGRGreen(bytFor))
    If intDiff < intDif_G Then
        intDif_G = intDiff
        bytBGR_G = bytFor
    End If

    intDiff = Abs(CInt(bytRGB_B) - aryBGRBlue(bytFor))
    If intDiff < intDif_B Then
        intDif_B = intDiff
        bytBGR_B = bytFor
    End If

Next bytFor

If blnStringRGB Then
    strRed = CStr(aryBGRRed(bytBGR_R))
    strGreen = CStr(aryBGRGreen(bytBGR_G))
    strBlue = CStr(aryBGRBlue(bytBGR_B))
End If
   
fColorRGBMatchHexBGR = "0" & Hex(bytBGR_B) & Hex(bytBGR_G) & Hex(bytBGR_R)
   
End Function


Public Function fCalculateOverallRating(ByVal strAttributes As String, ByVal blnPlayer As Boolean, ByVal strROMVersion As String, Optional ByRef strToolTipText As String) As Integer
On Error GoTo Err_

Const cConvertFto6 = "0112223334445556"

Dim intFor As Integer
Dim dblOverallRating As Double
Dim dblRatingBonus As Double
Dim aryintHexAttributes(0 To 12) As Integer
Dim intType As Integer

'Call sLoadOverallRatingFactors(strROMVersion)

If Len(strAttributes) = 13 Then
    
    intType = Abs(blnPlayer)
    
    For intFor = 0 To 12
        
        If (strROMVersion = rvSG95 Or strROMVersion = rvSMD95E) And intType = 1 And intFor = 7 Then 'Adjust for 95 Player Stick Handing
            aryintHexAttributes(intFor) = CInt(Mid(cConvertFto6, fHexToDecimal(Mid(strAttributes, intFor + 1, 1)) + 1, 1)) '+1 for fhex2dec as string starts at 1
        Else
            aryintHexAttributes(intFor) = fHexToDecimal(Mid(strAttributes, intFor + 1, 1))
        End If
        
    Next intFor
    
    dblOverallRating = 0
    
    Select Case strROMVersion
        Case rvSMD91, rvSG92, rvSG93:
            For intFor = 0 To 12 'Sum Rating
                dblOverallRating = dblOverallRating + (((aryintHexAttributes(intFor) / 15) * 100) * arydblRatingXFactor(intType, intFor))
            Next intFor
            
            If intType = 0 Then  'Goalies
                strToolTipText = Format(dblOverallRating, "0.00") & " Rating Sum / 8 Attributes"
                dblOverallRating = dblOverallRating / 8
            Else 'Players
                strToolTipText = Format(dblOverallRating, "0.00") & " Rating Sum / 9 Attributes"
                dblOverallRating = dblOverallRating / 9
            End If
            
        Case Else: 'rvSG94, rvSG95, rvSMD95E, rvSG96, rvSMD96E, rvSG97, rvSG98:
            For intFor = 0 To 12
                
                dblOverallRating = dblOverallRating + (aryintHexAttributes(intFor) * arydblRatingXFactor(intType, intFor))
                
                If intType = 0 Then 'handles 2.25 rating round down (to nearest 0.5) when hex value is odd.
                    If intFor = 0 Or intFor = 3 Or intFor = 4 Then
                        If aryintHexAttributes(intFor) Mod 2 = 1 Then
                            dblOverallRating = dblOverallRating - 0.25
                        End If
                    End If
                End If
            Next intFor
               
            dblRatingBonus = dblOverallRating - intRatingBaseFactor
                
            If dblRatingBonus < 0 Then dblRatingBonus = 0
            
            strToolTipText = CStr(intRatingBaseFactor) & " Base + " & CStr(dblOverallRating) & " Rating + " & CStr(dblRatingBonus) & " Bonus"
            dblOverallRating = dblOverallRating + dblRatingBonus
            
            dblOverallRating = dblOverallRating + intRatingBaseFactor

    End Select
    
Else
    dblOverallRating = 0
End If

Exit_:
fCalculateOverallRating = Int(dblOverallRating) 'INT/FIX ROUNDS DOWN EFFECTIVELY!
'Debug.Print Int(fCalculateOverallRating) & " = " & strToolTipText
Exit Function

Err_:
dblOverallRating = -1
Resume Exit_

End Function

Public Sub sLoadOverallRatingFactors(ByVal strROMVersion As String)
On Error Resume Next

'Starts at Agility
Const cXFactorGoalies92 = "1;1;0;1;0;0;0;1;1;1;1;1;0" '8
'for cXFactorPlayers92 use 93

Const cXFactorGoalies93 = "1;1;0;1;1;0;0;0;0;1;1;1;1" '8
Const cXFactorPlayers93 = "1;1;1;1;1;0;0;1;1;1;0;1;0" '9

'94, 95, 96, 97, 98
Const cXFactorGoalies94 = "2.25;0;0;2.25;2.25;0;0;0;0;0.5;0.5;0.5;0.5"
Const cXFactorPlayers94 = "1;1.5;1.5;1;0.5;1;0;1.5;1;0.5;0;0.5;0"
Const cDefault94 = 25
Const cDefault96 = 40

Const cDelimiter = ";"

Dim strXFactorGoalies As String
Dim strXFactorPlayers As String
Dim intDefault As Integer

Dim intFor As Integer

Select Case strROMVersion
    Case rvSMD91, rvSG92:
        strXFactorGoalies = cXFactorGoalies92
        strXFactorPlayers = cXFactorPlayers93
        intDefault = 0
    
    Case rvSG93:
        strXFactorGoalies = cXFactorGoalies93
        strXFactorPlayers = cXFactorPlayers93
        intDefault = 0
    
    Case rvSG94, rvSG95, rvSMD95E:
        strXFactorGoalies = cXFactorGoalies94
        strXFactorPlayers = cXFactorPlayers94
        intDefault = cDefault94
    
    Case Else: 'rvSG96, rvSMD96E, rvSG97, rvSG98:
        strXFactorGoalies = cXFactorGoalies94
        strXFactorPlayers = cXFactorPlayers94
        intDefault = cDefault96
End Select

'Set Private Variables here!
For intFor = 0 To 12
    arydblRatingXFactor(0, intFor) = CDbl(Split(strXFactorGoalies, cDelimiter)(intFor))
    arydblRatingXFactor(1, intFor) = CDbl(Split(strXFactorPlayers, cDelimiter)(intFor))
Next intFor
intRatingBaseFactor = intDefault

End Sub


Public Function fcmdActionCaption(ByVal intIndex As Integer, Optional ByVal intButtons As Integer = 3) As String

Const cstrApply = "Apply"
Const cstrOk = "Ok"
Const cstrCancel = "Cancel"

Dim strOutput As String

Select Case intButtons
    Case 2: ' Ok/Cancel
        Select Case intIndex
            Case 0: strOutput = cstrOk
            Case 1: strOutput = cstrCancel
            Case Else: strOutput = vbNullString
        End Select
    
    Case 3: ' Apply/Ok/Cancel
        Select Case intIndex
            Case 0: strOutput = cstrApply
            Case 1: strOutput = cstrOk
            Case 2: strOutput = cstrCancel
            Case Else: strOutput = vbNullString
        End Select

    Case Else:
        strOutput = vbNullString
        
End Select

fcmdActionCaption = strOutput
 
End Function

Public Sub sShowChangesCombo(ByRef cbo As ComboBox)

With cbo
    If Not .Tag = vbNullString Then
        If .ListIndex = CLng(.Tag) Then
            If Not .ForeColor = vbWindowText Then
                .ForeColor = vbWindowText
                .BackColor = vbWindowBackground
                '.Refresh
            End If
        Else
            If Not .ForeColor = vbWindowBackground Then
                .ForeColor = vbWindowBackground
                .BackColor = vbWindowText
                '.Refresh
            End If
        End If
    End If
End With

End Sub

Public Sub sShowChangesText(ByRef txt As TextBox)

With txt
    'If Not .Tag = vbNullString Then
        If .Text = .Tag Then
            If Not .ForeColor = vbWindowText Then
                .ForeColor = vbWindowText
                .BackColor = vbWindowBackground
            End If
        Else
            If Not .ForeColor = vbWindowBackground Then
                .ForeColor = vbWindowBackground
                .BackColor = vbWindowText
            End If
        End If
    'End If
End With

End Sub

'Public Function fLngRoundDown(ByVal dblValue As Double) As Long 'INT() OR FIX()
'
'fLngRoundDown = CLng(dblValue) - Abs(CLng(dblValue) > dblValue) '(dblValue \ 1) is an alternative to CLng(dblValue).
'
'End Function

'Public Function fLngRoundUp(ByVal dblValue As Double) As Long
'
'fLngRoundUp = CLng(dblValue) + Abs(CLng(dblValue) < dblValue) '(dblValue \ 1) is an alternative to CLng(dblValue).
'
'End Function


'Public Function fRoundToNearest(dblValue As Double, dblRoundToNearest As Double, Optional ByVal blnRoundUp As Boolean = False) As Double
   
'Dim dblX As Double
'Dim lngX As Long

'dblX = dblValue / dblRoundToNearest
'lngX = CLng(dblX)

'If lngX = dblX Then
'    fRoundToNearest = dblValue
'Else
'    If blnRoundUp Then
'        'round up
'        dblX = lngX + 1
'    Else
'    'round down
'        dblX = lngX
'    End If
'    fRoundToNearest = dblX * dblRoundToNearest
'End If

'End Function



