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

Private Const m_cNAME As String = "clsMap"
Private Const m_cMAPITEMSEP As String = "<MI +>"
Private Const m_cItemSubSep As String = "<M ù>"

Private m_oTableHelperMaps As New clsFOTAADOTableHelper

Public m_nMapID As Long
Public m_sName As String
Public m_sDescription As String
Public m_sPicture As String
Public m_nPartyX As Long
Public m_nPartyY As Long
Public m_nVersion As Long
Public m_sGUID As String
Public m_nLenEqualOneDay As Double

Public m_oMapItems As New Collection

Public Sub Add(oMapItem As clsMapItem)
  
    On Error GoTo ErrorHandler
    Dim sRoutineName As String
    sRoutineName = m_cNAME & ".Item"
    Call WriteProcStart(sRoutineName)
    
    
    Call m_oMapItems.Add(oMapItem)
    
    
    Call WriteProcStop(sRoutineName)
    'Exit the sub... on an error we will jump over this function
    Exit Sub
ErrorHandler:
    Call LogErrorToFile(sRoutineName & "." & Err.Description): Call g_oErrors.HandleErrorWithSource(Err, sRoutineName): Call g_oErrors.DisplayErrorCount
    
End Sub

Public Function Col() As Collection
    
    On Error GoTo ErrorHandler
    Dim sRoutineName As String
    sRoutineName = m_cNAME & ".Col"
    Call WriteProcStart(sRoutineName)

    
    Set Col = m_oMapItems


    Call WriteProcStop(sRoutineName)
    'Exit the sub... on an error we will jump over this function
    Exit Function
ErrorHandler:
    Call LogErrorToFile(sRoutineName & "." & Err.Description): Call g_oErrors.HandleErrorWithSource(Err, sRoutineName): Call g_oErrors.DisplayErrorCount

End Function
Public Function LoadByGUID(oDB As ADODB.Connection, sGUID As String)

    On Error GoTo ErrorHandler
    Dim sRoutineName As String
    sRoutineName = m_cNAME & ".LoadByGUID"
    Call WriteProcStart(sRoutineName)

    
    Dim rstMap As ADODB.Recordset
    Dim nID As Long
    
    Set rstMap = OpenMyRset(oDB, "SELECT * FROM Maps WHERE sGUID = '" & sGUID & "'")
    
    If rstMap.RecordCount() > 0 Then
        nID = rstMap![nMapID]
        Call Load(oDB, nID)
    End If


    Call WriteProcStop(sRoutineName)
    'Exit the sub... on an error we will jump over this function
    Exit Function
ErrorHandler:
    Call LogErrorToFile(sRoutineName & "." & Err.Description): Call g_oErrors.HandleErrorWithSource(Err, sRoutineName): Call g_oErrors.DisplayErrorCount

End Function

Public Function Load(oDB As ADODB.Connection, nMapID As Long)

    On Error GoTo ErrorHandler
    Dim sRoutineName As String
    sRoutineName = m_cNAME & ".Load"
    Call WriteProcStart(sRoutineName)

    
    Dim rstMapItems As ADODB.Recordset
    Dim oMapItem As clsMapItem
    
    Call m_oTableHelperMaps.LoadRecords("WHERE nMapID = " & nMapID)

    m_nMapID = m_oTableHelperMaps.GetValue("nMapID")
    m_sName = Trim(m_oTableHelperMaps.GetValue("sName"))
    m_sDescription = Trim(m_oTableHelperMaps.GetValue("sDescription"))
    m_sPicture = Trim(m_oTableHelperMaps.GetValue("sPicture"))
    m_nPartyX = m_oTableHelperMaps.GetValue("nPartyX")
    m_nPartyY = m_oTableHelperMaps.GetValue("nPartyY")
    m_nVersion = m_oTableHelperMaps.GetValue("nVersion")
    m_sGUID = Trim(m_oTableHelperMaps.GetValue("sGUID"))
    m_nLenEqualOneDay = m_oTableHelperMaps.GetValue("nLenEqualOneDay")
    
    Set rstMapItems = OpenMyRecordset(oDB, "SELECT * FROM MapItems WHERE nMapID = " & nMapID)
    If rstMapItems.RecordCount > 0 Then
        Call rstMapItems.MoveFirst
    
        While rstMapItems.EOF = False
            Set oMapItem = New clsMapItem
            Call oMapItem.Load(oDB, rstMapItems![nMapItemID])
            Call Add(oMapItem)
        
            Call rstMapItems.MoveNext
        Wend
    End If


    Call WriteProcStop(sRoutineName)
    'Exit the sub... on an error we will jump over this function
    Exit Function
ErrorHandler:
    Call LogErrorToFile(sRoutineName & "." & Err.Description): Call g_oErrors.HandleErrorWithSource(Err, sRoutineName): Call g_oErrors.DisplayErrorCount

End Function

Public Sub SavePartyOnly(dbDND As ADODB.Connection)

    On Error GoTo ErrorHandler
    Dim sRoutineName As String
    sRoutineName = m_cNAME & ".SavePartyOnly"
    Call WriteProcStart(sRoutineName) ' "OBJECT")


    m_oTableHelperMaps.SetValue("nPartyX") = m_nPartyX
    m_oTableHelperMaps.SetValue("nPartyY") = m_nPartyY
    m_nMapID = m_oTableHelperMaps.Save()


    Call WriteProcStop(sRoutineName)
    'Exit the sub... on an error we will jump over this function
    Exit Sub
ErrorHandler:
    Call LogErrorToFile(sRoutineName & "." & Err.Description): Call g_oErrors.HandleErrorWithSource(Err, sRoutineName): Call g_oErrors.DisplayErrorCount

End Sub
Public Function Save(dbDND As ADODB.Connection) As Long

    On Error GoTo ErrorHandler
    Dim sRoutineName As String
    sRoutineName = m_cNAME & ".Save"
    Call WriteProcStart(sRoutineName) ' "OBJECT")


    Dim oMapItem As clsMapItem

    m_oTableHelperMaps.SetValue("sName") = m_sName
    m_oTableHelperMaps.SetValue("sDescription") = m_sDescription
    m_oTableHelperMaps.SetValue("sPicture") = m_sPicture
    m_oTableHelperMaps.SetValue("nPartyX") = m_nPartyX
    m_oTableHelperMaps.SetValue("nPartyY") = m_nPartyY
    m_oTableHelperMaps.SetValue("nVersion") = m_nVersion
    m_oTableHelperMaps.SetValue("sGUID") = m_sGUID
    m_oTableHelperMaps.SetValue("nLenEqualOneDay") = m_nLenEqualOneDay
    m_nMapID = m_oTableHelperMaps.Save()
    Save = m_nMapID
    
        
    'No go and save all the Items in this collection
    For Each oMapItem In Col()
        oMapItem.m_nMapID = m_nMapID
        Call oMapItem.Save(dbDND)
    Next oMapItem


    Call WriteProcStop(sRoutineName)
    'Exit the sub... on an error we will jump over this function
    Exit Function
ErrorHandler:
    Call LogErrorToFile(sRoutineName & "." & Err.Description): Call g_oErrors.HandleErrorWithSource(Err, sRoutineName): Call g_oErrors.DisplayErrorCount

End Function

Private Sub Class_Initialize()

    On Error GoTo ErrorHandler
    Dim sRoutineName As String
    sRoutineName = m_cNAME & ".Class_Initialize"
    Call WriteProcStart(sRoutineName)


    Call m_oTableHelperMaps.LoadSchema(g_oDB, "Maps")
    m_sGUID = GetGUID("Map")


    Call WriteProcStop(sRoutineName)
    'Exit the sub... on an error we will jump over this function
    Exit Sub
ErrorHandler:
    Call LogErrorToFile(sRoutineName & "." & Err.Description): Call g_oErrors.HandleErrorWithSource(Err, sRoutineName): Call g_oErrors.DisplayErrorCount

End Sub
Public Sub Delete(dbDND As ADODB.Connection)

    On Error GoTo ErrorHandler
    Dim sRoutineName As String
    sRoutineName = m_cNAME & ".Delete"
    Call WriteProcStart(sRoutineName)
    
    
    Dim oMapItem As clsMapItem
    
    If m_oTableHelperMaps.IsRecordLoaded() = True Then
        Call m_oTableHelperMaps.CreateSQLDelete(True)
        
        For Each oMapItem In Col()
            Call oMapItem.Delete(dbDND)
        Next oMapItem
    End If
        
    
    Call WriteProcStop(sRoutineName)
    'Exit the sub... on an error we will jump over this function
    Exit Sub
ErrorHandler:
    Call LogErrorToFile(sRoutineName & "." & Err.Description): Call g_oErrors.HandleErrorWithSource(Err, sRoutineName): Call g_oErrors.DisplayErrorCount

End Sub
Public Function Serialize() As String

    On Error GoTo ErrorHandler
    Dim sRoutineName As String
    sRoutineName = m_cNAME & ".Serialize"
    Call WriteProcStart(sRoutineName)
    
    
    Dim oLoopMapItem As clsMapItem
    
    Serialize = m_sGUID & m_cItemSubSep
    Serialize = Serialize & m_sName & m_cItemSubSep
    Serialize = Serialize & m_sDescription & m_cItemSubSep
    Serialize = Serialize & m_sPicture & m_cItemSubSep
    Serialize = Serialize & m_nPartyX & m_cItemSubSep
    Serialize = Serialize & m_nPartyY & m_cItemSubSep
    Serialize = Serialize & m_nVersion & m_cItemSubSep
    Serialize = Serialize & m_nLenEqualOneDay & m_cItemSubSep
    
    For Each oLoopMapItem In Col()
        Serialize = Serialize & oLoopMapItem.Serialize() & m_cMAPITEMSEP
    Next oLoopMapItem
    
    
    Call WriteProcStop(sRoutineName) ' Serialize)
    'Exit the sub... on an error we will jump over this function
    Exit Function
ErrorHandler:
    Call LogErrorToFile(sRoutineName & "." & Err.Description): Call g_oErrors.HandleErrorWithSource(Err, sRoutineName): Call g_oErrors.DisplayErrorCount
    
End Function
Public Function DeSerialize(sItem As String) As String

    On Error GoTo ErrorHandler
    Dim sRoutineName As String
    sRoutineName = m_cNAME & ".DeSerialize"
    Call WriteProcStart(sRoutineName) ' sItem)


    Dim oLoopMapItem As clsMapItem
    Dim sRemStr As String
    Dim sTemp As String
    sRemStr = sItem
    
    m_sGUID = Left(sRemStr, InStr(sRemStr, m_cItemSubSep) - 1)
        sRemStr = Right(sRemStr, Len(sRemStr) - InStr(sRemStr, m_cItemSubSep) - Len(m_cItemSubSep) + 1)
    m_sName = Left(sRemStr, InStr(sRemStr, m_cItemSubSep) - 1)
        sRemStr = Right(sRemStr, Len(sRemStr) - InStr(sRemStr, m_cItemSubSep) - Len(m_cItemSubSep) + 1)
    m_sDescription = Left(sRemStr, InStr(sRemStr, m_cItemSubSep) - 1)
        sRemStr = Right(sRemStr, Len(sRemStr) - InStr(sRemStr, m_cItemSubSep) - Len(m_cItemSubSep) + 1)
    m_sPicture = Left(sRemStr, InStr(sRemStr, m_cItemSubSep) - 1)
        sRemStr = Right(sRemStr, Len(sRemStr) - InStr(sRemStr, m_cItemSubSep) - Len(m_cItemSubSep) + 1)
    m_nPartyX = Left(sRemStr, InStr(sRemStr, m_cItemSubSep) - 1)
        sRemStr = Right(sRemStr, Len(sRemStr) - InStr(sRemStr, m_cItemSubSep) - Len(m_cItemSubSep) + 1)
    m_nPartyY = Left(sRemStr, InStr(sRemStr, m_cItemSubSep) - 1)
        sRemStr = Right(sRemStr, Len(sRemStr) - InStr(sRemStr, m_cItemSubSep) - Len(m_cItemSubSep) + 1)
    m_nVersion = Left(sRemStr, InStr(sRemStr, m_cItemSubSep) - 1)
        sRemStr = Right(sRemStr, Len(sRemStr) - InStr(sRemStr, m_cItemSubSep) - Len(m_cItemSubSep) + 1)
    m_nLenEqualOneDay = Left(sRemStr, InStr(sRemStr, m_cItemSubSep) - 1)
        sRemStr = Right(sRemStr, Len(sRemStr) - InStr(sRemStr, m_cItemSubSep) - Len(m_cItemSubSep) + 1)
        
    For Each oLoopMapItem In Col()
        Call oLoopMapItem.Delete(g_oDB)
    Next oLoopMapItem
    
    While InStr(1, sRemStr, m_cMAPITEMSEP) > 0
        sTemp = Left(sRemStr, InStr(sRemStr, m_cMAPITEMSEP) - 1)
            sRemStr = Right(sRemStr, Len(sRemStr) - InStr(sRemStr, m_cMAPITEMSEP) - Len(m_cMAPITEMSEP) + 1)
        
        Set oLoopMapItem = New clsMapItem
        Call oLoopMapItem.DeSerialize(sTemp)
        oLoopMapItem.m_nMapID = -1
        Call Add(oLoopMapItem)
    Wend
        
    DeSerialize = sRemStr
    
    
    Call WriteProcStop(sRoutineName) ' sRemStr)
    'Exit the sub... on an error we will jump over this function
    Exit Function
ErrorHandler:
    Call LogErrorToFile(sRoutineName & "." & Err.Description): Call g_oErrors.HandleErrorWithSource(Err, sRoutineName): Call g_oErrors.DisplayErrorCount
    
End Function

Public Sub SaveByGUID()

    On Error GoTo ErrorHandler
    Dim sRoutineName As String
    sRoutineName = m_cNAME & ".SaveByGUID"
    Call WriteProcStart(sRoutineName) ' sItem)


    Dim oRst As ADODB.Recordset
    Dim oLoopMapItem As clsMapItem
    
    Set oRst = OpenMyRset(g_oDB, "SELECT * FROM Maps WHERE TRIM(sGUID) = '" & m_sGUID & "'")
    If oRst.RecordCount > 0 Then
        Call oRst.MoveFirst
        m_nMapID = oRst![nMapID]
        For Each oLoopMapItem In Col()
            oLoopMapItem.m_nMapID = m_nMapID
        Next oLoopMapItem
        
        Call m_oTableHelperMaps.LoadRecords("WHERE nMapID = " & m_nMapID)
    End If
    
    Call Save(g_oDB)
    
    
    Call WriteProcStop(sRoutineName) ' sRemStr)
    'Exit the sub... on an error we will jump over this function
    Exit Sub
ErrorHandler:
    Call LogErrorToFile(sRoutineName & "." & Err.Description): Call g_oErrors.HandleErrorWithSource(Err, sRoutineName): Call g_oErrors.DisplayErrorCount
    
End Sub

Public Sub RemoveMapItem(oMapItem As clsMapItem)

    On Error GoTo ErrorHandler
    Dim sRoutineName As String
    sRoutineName = m_cNAME & ".RemoveMapItem"
    Call WriteProcStart(sRoutineName) ' sItem)


    Dim i As Long
    Dim oLoopMapItem As clsMapItem
    
    For i = 1 To Col().Count()
        If i > Col().Count() Then Exit For
        
        Set oLoopMapItem = Col(i)
        If oLoopMapItem.m_nMapItemID = oMapItem.m_nMapItemID Then
            Call Col().Remove(i)
        End If
    Next i
    
    
    Call WriteProcStop(sRoutineName) ' sRemStr)
    'Exit the sub... on an error we will jump over this function
    Exit Sub
ErrorHandler:
    Call LogErrorToFile(sRoutineName & "." & Err.Description): Call g_oErrors.HandleErrorWithSource(Err, sRoutineName): Call g_oErrors.DisplayErrorCount
    
End Sub
Public Function GetMapScale(nDays As Double) As String

    On Error GoTo ErrorHandler
    Dim sRoutineName As String
    sRoutineName = m_cNAME & ".GetMapScale"
    Call WriteProcStart(sRoutineName) ' sItem)


    Dim nRemain As Double
    Dim sRetVal As String
    Dim nNumUsed As Long
    
    nRemain = nDays
    
    If Fix(nRemain) >= 720 And nNumUsed < 2 Then
        sRetVal = Fix(nRemain / 360) & " Years "
        nRemain = nRemain - Fix(nRemain / 360) * 360
        nNumUsed = nNumUsed + 1
    End If
    If Fix(nRemain) >= 360 And nNumUsed < 2 Then
        sRetVal = sRetVal & "1 Year "
        nRemain = nRemain - 360
        nNumUsed = nNumUsed + 1
    End If
    If Fix(nRemain) >= 60 And nNumUsed < 2 Then
        sRetVal = sRetVal & Fix(nRemain / 30) & " Months "
        nRemain = nRemain - Fix(nRemain / 30) * 30
        nNumUsed = nNumUsed + 1
    End If
    If Fix(nRemain) >= 30 And nNumUsed < 2 Then
        sRetVal = sRetVal & "1 Month "
        nRemain = nRemain - 30
        nNumUsed = nNumUsed + 1
    End If
    If Fix(nRemain) >= 14 And nNumUsed < 2 Then
        sRetVal = sRetVal & Fix(nRemain / 7) & " Weeks "
        nRemain = nRemain - Fix(nRemain / 7) * 7
        nNumUsed = nNumUsed + 1
    End If
    If Fix(nRemain) >= 7 And nNumUsed < 2 Then
        sRetVal = sRetVal & "1 Week "
        nRemain = nRemain - 7
        nNumUsed = nNumUsed + 1
    End If
    If Fix(nRemain) >= 2 And nNumUsed < 2 Then
        sRetVal = sRetVal & Fix(nRemain) & " Days "
        nRemain = nRemain - Fix(nRemain)
        nNumUsed = nNumUsed + 1
    End If
    If Fix(nRemain) >= 1 And nNumUsed < 2 Then
        sRetVal = sRetVal & "1 Day "
        nRemain = nRemain - 1
        nNumUsed = nNumUsed + 1
        
        If Fix(nRemain * 24) >= 2 And nNumUsed < 2 Then
            sRetVal = sRetVal & Fix(nRemain * 24) & " Hours"
            nNumUsed = nNumUsed + 1
        ElseIf Fix(nRemain * 24) >= 1 And nNumUsed < 2 Then
            sRetVal = sRetVal & Fix(nRemain * 24) & " Hour"
            nNumUsed = nNumUsed + 1
        End If
    End If
    If Len(Trim(sRetVal)) = 0 Then
        If Fix(nRemain * 24) >= 2 Then
            sRetVal = sRetVal & Fix(nRemain * 24) & " Hours"
        ElseIf Fix(nRemain * 24) >= 1 Then
            sRetVal = sRetVal & Fix(nRemain * 24) & " Hour"
        ElseIf Fix(nRemain * 24 * 60) >= 2 Then
            sRetVal = sRetVal & Fix(nRemain * 24 * 60) & " Minutes"
        ElseIf Fix(nRemain * 24 * 60) >= 1 Then
            sRetVal = sRetVal & Fix(nRemain * 24 * 60) & " Minute"
        Else
            sRetVal = ""
        End If
    End If
    
    GetMapScale = sRetVal
    
    
    Call WriteProcStop(sRoutineName) ' sRemStr)
    'Exit the sub... on an error we will jump over this function
    Exit Function
ErrorHandler:
    Call LogErrorToFile(sRoutineName & "." & Err.Description): Call g_oErrors.HandleErrorWithSource(Err, sRoutineName): Call g_oErrors.DisplayErrorCount
    
End Function
