Attribute VB_Name = "modMain"
Option Explicit

' This module needs:
'  frmCommonDialog
'  modDeclares
'  modWinAPI

Type FONT_PREFS
   Fontname As String
   FontSize As Long
   FontBold As Boolean
   FontItalic As Boolean
   FontForeColor As Long
   FontBackColor As Long
End Type

Type USER_PREFS
   ConfirmExit As Boolean
   StartMaximized As Boolean
   StartLoadLast As Boolean
   MRUMaxItems As Long ' n/a
   KeepLog As Boolean
   KeepHistory As Boolean
   ShowWholeDefinition As Boolean
   ListsSameAsTextBox As Boolean
   ProgramFont As FONT_PREFS
   TextBoxFont As FONT_PREFS
End Type

Global gUserPrefs As USER_PREFS
' -------------------------------------------------------------------

Type HISTORY_ITEM
   ItemName As String      ' word visited
   Location As String      ' dictionary from where item came
   Source As Long          ' 0=session, 1=file
   HitCount As Long        ' times visited
   DateEntered As Long     ' first date visited e.g. filtering
   TimeEntered As Long     ' first time visited
   Tag As String           ' user defined tag data for searches
End Type

Global gHistItems() As HISTORY_ITEM
' -------------------------------------------------------------------

Global gsCurrProjFileName As String
Global giLangID As Long

'Private msArrMRUItems() As String
'Private msMRUFileName As String

Private msArrErrItems() As String
Private msErrFileName As String
Private miErrCount As Long

Private msArrLogItems() As String
Private msLogFileName As String
Private miLogCount As Long

Private msArrHistoryItems() As String
Private msHistFileName As String
Private miHistCount As Long

Private mbProgStarted As Boolean

' ini file constants ------------------------------------------------
Private Const CONFIG_GENERAL As String = "General"
Private Const CONFIG_TEXTFONT As String = "TextFont"
Private Const CONFIG_PROGFONT As String = "ProgramFont"

Private Const CONFIG_DEF_FONTNAME As String = "Tahoma"
Private Const CONFIG_DEF_FONTSIZE As Long = 9
Private Const CONFIG_DEF_FORECOLOR As Long = &H0
Private Const CONFIG_DEF_BACKCOLOR As Long = &HFFFFFF

Private Const CONFIG_FONTNAME As String = "Name"
Private Const CONFIG_FONTSIZE As String = "Size"
Private Const CONFIG_FONTBOLD As String = "Bold"
Private Const CONFIG_FONTITALIC As String = "Italic"
Private Const CONFIG_FORECOLOR As String = "Forecolor"
Private Const CONFIG_BACKCOLOR As String = "Backcolor"

Private Const CONFIG_CONFIRMEXIT As String = "Confirm Exit"
Private Const CONFIG_STARTMAXIMIZED As String = "Start Maximized"
Private Const CONFIG_STARTLOADLAST As String = "Start Load Last"
Private Const CONFIG_MRUMAXSHOW As String = "MRU Max Show"
Private Const CONFIG_KEEPLOG As String = "Keep Log"
Private Const CONFIG_KEEPHISTORY As String = "Keep History"
Private Const CONFIG_SEEWHOLEDEF As String = "See Whole Definition"
Private Const CONFIG_LISTSSAMEASTEXT As String = "Lists Same As Textbox"
' -------------------------------------------------------------------

Sub Main()

   Prog_Start

End Sub

' ********** PROGRAM MANAGER STUFF ******
' manage the program

' ***********************************************
' Prog_Icon << Variant
'
'
' Parameters:
'   none
' ***********************************************
Property Get Prog_Icon()

   On Error GoTo ErrHan:
   
   Set Prog_Icon = frmIcon.Icon
   
   Exit Property

ErrHan:
   Debug.Print "Error " & Err.Number & " (" & Err.Description & ") in procedure Prog_Icon of Module modMain"
End Property

' ***********************************************
' Prog_Start
'  responsible for getting the program going
'
' Parameters:
'  none
' ***********************************************
Sub Prog_Start()
   
   On Error GoTo ErrHan:
   
   ' /* hoping to install XP Themes...
'   InitCommonControlsVB
   
   ' /* initialise user defined preferences...
   Prefs_Init
   
   frmSplash.Show
   DoEvents
   
   frmSplash.Splash_UpdateStatus "Starting"
   ' /* default language id, later other languages
   ' may be added to the resource file...
   giLangID = DEF_LANG_ID
   
   ' /* here we're just initialising a log device
   ' that currently writes to the debug window and
   ' saying the program is starting...
   Log_Write "Starting " & AppTitleVersion
   
   ' /* setup up History and Most Recently Used data...
   History_Init
   
'   MRU_Init
   ' */
   
   frmSplash.Splash_UpdateStatus "Checking data file"
      
   Dim iSuccess As Long
   iSuccess = modDict.Dict_Load
   If iSuccess = DICT_LOAD_FAIL Then _
      Err.Raise vbObjectError + 502, "modMain.ProgStart", "Couldn't load data"
         
   frmSplash.Splash_UpdateStatus "done reading data"
   
   Set frmTextReaderSearch.TextReader = Dict_Data
   ' /* load the program's main form, in this case
   ' mdiMain - set its icon and caption...
   Set mdiMain.Icon = Prog_Icon ' LoadResPicture(IDI_APP_ICO, vbResIcon)
   Form_SetCaption mdiMain, AppTitleVersion
   
   ' now show the form
   mdiMain.Show
'   mdiMain.mnuHist.Enabled = False
   ' /* apply maximize main form as specified in
   ' INI file
   If gUserPrefs.StartMaximized Then _
      mdiMain.WindowState = vbMaximized
   ' */
   
   ' /* tell the log the program started ok
   Log_Write "Program started."
   
   mbProgStarted = True
   
ResErr:
   
   If Not mbProgStarted Then
      MsgBox "Errors loading, gonna quit now", MB_ICONEXCLAMATION, "Load Error"
      Prog_End
   End If
   
   Memory_Clear
   
   frmSplash.Hide
   mdiMain.ZOrder
   
   DoEvents
   
   Exit Sub
   
ErrHan:
   ' /* handle program start up error
   Error_Manager Err, "modMain.Prog_Start"
   Log_Write "Program started with error/s."
   Err.Clear
   Resume ResErr:
   
End Sub

' ***********************************************
' Prog_ConfirmQuit <- Boolean
'  responsible for asking the user if they are sure
'  they want to quit the program.
'
' Parameters:
'  none
' ***********************************************
Function Prog_ConfirmQuit() As Boolean
         
   Dim sLogMsg As String
   sLogMsg = "Asking user sure to quit?"
   
   mbProgStarted = False ' it's a hack!!!restored below
   
   Log_Write sLogMsg
   
   If MsgBox(ResFile_GetText(IDS_ASK_QUIT), _
      MB_ICONQUESTION + MB_YESNO, AppTitle) = vbYes Then _
         Prog_ConfirmQuit = True
   
   Dim iResID As Long
   If Prog_ConfirmQuit Then
      iResID = IDS_USR_CONFIRMED_QUIT
   Else
      iResID = IDS_USR_CANCELLED_QUIT
   End If
   
   sLogMsg = ResFile_GetText(iResID)
   
   Log_Write sLogMsg
   
   mbProgStarted = True
   
End Function

' ***********************************************
' Prog_End
' Responsible for closing the program and saving
'  session data.
'
' Parameters:
'  none
' ***********************************************
Sub Prog_End()

   Prog_UnloadForms
   
'   MRU_Save
'   Erase msArrMRUItems
   
   Errors_Save
   Erase msArrErrItems
   
   If miHistCount > 0 Then
      
      Dim sLast As String
      sLast = msArrHistoryItems(miHistCount)
      
      Dim iFind As Long
      iFind = InStr(1, sLast, HIST_DETAIL_DELIMITER)
      If iFind > 0 Then _
         sLast = Left$(sLast, iFind - 1)
         
      File_WriteText MakeLocalFileName(LAST_FILENAME), sLast, False
      
   End If
   
   History_Save
   Erase msArrHistoryItems
   
   modDict.Dict_Unload
   
   mbProgStarted = False
   
   Log_Write "Ending " & AppTitleVersion
   Log_Save
   
   Erase msArrLogItems
   
   End

End Sub

' ***********************************************
' Prog_UnloadForms
' Responsible for ensuring all forms are unloaded
' when the program ends.
'
' Parameters:
'  none
' ***********************************************
Private Sub Prog_UnloadForms()
   
   Dim xFm As Form
   For Each xFm In Forms
      Log_Write "... unloading " & xFm.Name
      Unload xFm
   Next xFm
      
End Sub

' ***********************************************
' MakeLocalFileName <- String
' This takes the name of a file and appends the
' program's current working directory.
'
' Parameters:
'  FileName::String, the name of the file to which
'  working directory (pwd in linux) is appended
' ***********************************************
Function MakeLocalFileName(FileName As String) As String
Attribute MakeLocalFileName.VB_Description = "Returns a file name prefixing it with the program's folder and '\\'."

   MakeLocalFileName = _
      App.Path & STR_BACKSLASH & FileName
      
End Function

' ***********************************************
' Missing_AddItem <<
' Adds an item to those words which were listed
' as being within a definition but when searched
' for weren't actually found. Note: this can be
' updated when we have a realistic word stem find
' thing going on e.g. some words are in their plural
' doing form ...
'
' Parameters:
'   MissingWord::String, the word that could not be
'                        found / resolved to stem.
' ***********************************************
Sub Missing_AddItem( _
   MissingWord As String)

   Dim sFN As String
   sFN = MakeLocalFileName(MISSING_FILENAME)
   
   If File_Exists(sFN) Then
   
      Dim sData As String
      sData = File_ReadText(MakeLocalFileName(MISSING_FILENAME))
            
      If Len(sData) > 0 Then
         Dim sMissing() As String
         sMissing = Split(sData, vbCrLf)
   
         Dim iCurr As Long, iMax As Long
         iMax = UBound(sMissing)
         
         Dim bFound As Boolean
         For iCurr = LBound(sMissing) To iMax
            If UCase$(sMissing(iCurr)) = UCase(MissingWord) Then
               bFound = True
               Exit For
            End If
         Next iCurr
         
         Erase sMissing
         sData = vbNullString ' ""
         
         If bFound Then
            Beep
            GoTo Quit:
         End If
         
         File_WriteText sFN, MissingWord, True
         
      End If
         
   Else
      
      File_WriteText sFN, MissingWord, False
      
   End If
   
   MsgBox MissingWord, _
      MB_ICONINFORMATION, "Word not found"
      
Quit:

   sFN = vbNullString ' ""
            
   
End Sub

' ****** PREFERENCES STUFF **************

' ***********************************************
' Prefs_Init
'  Responsible for reading the user preferences
'  INI file and loading its data.
'
' Parameters:
'  none
' ***********************************************
Sub Prefs_Init()
Attribute Prefs_Init.VB_Description = "Reads User Preferences either from local file or, if missing, a bunch of default values."

   On Error GoTo ErrHan:
      
   gUserPrefs.ConfirmExit = _
      CBool(Not Val(INI_Read(CONFIG_GENERAL, CONFIG_CONFIRMEXIT)) = 0)
   
   gUserPrefs.StartMaximized = _
      CBool(Not Val(INI_Read(CONFIG_GENERAL, CONFIG_STARTMAXIMIZED)) = 0)
   
   gUserPrefs.StartLoadLast = _
      CBool(Not Val(INI_Read(CONFIG_GENERAL, CONFIG_STARTLOADLAST)) = 0)
      
   gUserPrefs.MRUMaxItems = _
      CLng(Val(INI_Read(CONFIG_GENERAL, CONFIG_MRUMAXSHOW)))
   
   gUserPrefs.KeepLog = _
      CBool(Not Val(INI_Read(CONFIG_GENERAL, CONFIG_KEEPLOG)) = 0)
      
   gUserPrefs.KeepHistory = _
      CBool(Not Val(INI_Read(CONFIG_GENERAL, CONFIG_KEEPHISTORY)) = 0)
   
   gUserPrefs.ShowWholeDefinition = _
      CBool(Not Val(INI_Read(CONFIG_GENERAL, CONFIG_SEEWHOLEDEF)) = 0)
      
   gUserPrefs.ListsSameAsTextBox = _
      CBool(Not Val(INI_Read(CONFIG_GENERAL, CONFIG_LISTSSAMEASTEXT)) = 0)
      
   Dim sTmp As String
   sTmp = INI_Read(CONFIG_TEXTFONT, CONFIG_FONTNAME)
   If sTmp = "" Then sTmp = CONFIG_DEF_FONTNAME
   gUserPrefs.TextBoxFont.Fontname = sTmp
   
   Dim iTmp As Long
   iTmp = CLng(Val(INI_Read(CONFIG_TEXTFONT, CONFIG_FONTSIZE)))
   If iTmp = 0 Then iTmp = CONFIG_DEF_FONTSIZE
   gUserPrefs.TextBoxFont.FontSize = iTmp
   
   Dim bTmp As Boolean
   iTmp = 0
   iTmp = CLng(Val(INI_Read(CONFIG_TEXTFONT, CONFIG_FONTBOLD)))
   If iTmp > 0 Then bTmp = True
   gUserPrefs.TextBoxFont.FontBold = bTmp
   
   bTmp = False
   iTmp = 0
   iTmp = CLng(Val(INI_Read(CONFIG_TEXTFONT, CONFIG_FONTITALIC)))
   If iTmp > 0 Then bTmp = True
   gUserPrefs.TextBoxFont.FontItalic = bTmp
   
   iTmp = 0
   iTmp = CLng(Val(INI_Read(CONFIG_TEXTFONT, CONFIG_FORECOLOR)))
   If iTmp = 0 Then iTmp = CONFIG_DEF_FORECOLOR
   gUserPrefs.TextBoxFont.FontForeColor = iTmp
      
   iTmp = 0
   iTmp = CLng(Val(INI_Read(CONFIG_TEXTFONT, CONFIG_BACKCOLOR)))
   If iTmp = 0 Then iTmp = CONFIG_DEF_BACKCOLOR
   gUserPrefs.TextBoxFont.FontBackColor = iTmp
   
   sTmp = INI_Read(CONFIG_PROGFONT, CONFIG_FONTNAME)
   If sTmp = "" Then sTmp = CONFIG_DEF_FONTNAME
   gUserPrefs.ProgramFont.Fontname = sTmp
   
   iTmp = CLng(Val(INI_Read(CONFIG_PROGFONT, CONFIG_FONTSIZE)))
   If iTmp = 0 Then iTmp = CONFIG_DEF_FONTSIZE
   gUserPrefs.ProgramFont.FontSize = iTmp
   
   iTmp = 0
   iTmp = CLng(Val(INI_Read(CONFIG_PROGFONT, CONFIG_FONTBOLD)))
   If iTmp > 0 Then bTmp = True
   gUserPrefs.ProgramFont.FontBold = bTmp
   
   bTmp = False
   iTmp = 0
   iTmp = CLng(Val(INI_Read(CONFIG_PROGFONT, CONFIG_FONTITALIC)))
   If iTmp > 0 Then bTmp = True
   gUserPrefs.ProgramFont.FontItalic = bTmp
   
   iTmp = 0
   iTmp = CLng(Val(INI_Read(CONFIG_PROGFONT, CONFIG_FORECOLOR)))
   If iTmp = 0 Then iTmp = CONFIG_DEF_FORECOLOR
   gUserPrefs.ProgramFont.FontForeColor = iTmp
      
   iTmp = 0
   iTmp = CLng(Val(INI_Read(CONFIG_PROGFONT, CONFIG_BACKCOLOR)))
   If iTmp = 0 Then iTmp = CONFIG_DEF_BACKCOLOR
   gUserPrefs.ProgramFont.FontBackColor = iTmp
      
   Exit Sub

ErrHan:

   Error_Manager Err, "modMain.Prefs_Init"
   
End Sub

' ***********************************************
' Prefs_Save
' Responsible for updating current user preferences
' from local USER_PREFS to Global USER_PREFS...
' Note: data will be saved when program terminates.
'
' Parameters:
'  tPrefs::USER_PREFS, new user preferences to overwrite
'  original user preferences.
' ***********************************************
Sub Prefs_Save(tPrefs As USER_PREFS)

   INI_Write CONFIG_GENERAL, CONFIG_CONFIRMEXIT, IIf(tPrefs.ConfirmExit, "1", "0")
   INI_Write CONFIG_GENERAL, CONFIG_STARTLOADLAST, IIf(tPrefs.StartLoadLast, "1", "0")
   INI_Write CONFIG_GENERAL, CONFIG_STARTMAXIMIZED, IIf(tPrefs.StartMaximized, "1", "0")
   INI_Write CONFIG_GENERAL, CONFIG_KEEPLOG, IIf(tPrefs.KeepLog, "1", "0")
   INI_Write CONFIG_GENERAL, CONFIG_KEEPHISTORY, IIf(tPrefs.KeepHistory, "1", "0")
   INI_Write CONFIG_GENERAL, CONFIG_SEEWHOLEDEF, IIf(tPrefs.ShowWholeDefinition, "1", "0")
   INI_Write CONFIG_GENERAL, CONFIG_LISTSSAMEASTEXT, IIf(tPrefs.ListsSameAsTextBox, "1", "0")
   
   INI_Write CONFIG_TEXTFONT, CONFIG_FONTNAME, tPrefs.TextBoxFont.Fontname
   INI_Write CONFIG_TEXTFONT, CONFIG_FONTSIZE, CStr(tPrefs.TextBoxFont.FontSize)
   INI_Write CONFIG_TEXTFONT, CONFIG_FONTBOLD, IIf(tPrefs.TextBoxFont.FontBold, "1", "0")
   INI_Write CONFIG_TEXTFONT, CONFIG_FONTITALIC, IIf(tPrefs.TextBoxFont.FontItalic, "1", "0")
   INI_Write CONFIG_TEXTFONT, CONFIG_FORECOLOR, CStr(tPrefs.TextBoxFont.FontForeColor)
   INI_Write CONFIG_TEXTFONT, CONFIG_BACKCOLOR, CStr(tPrefs.TextBoxFont.FontBackColor)
   
   INI_Write CONFIG_PROGFONT, CONFIG_FONTNAME, tPrefs.ProgramFont.Fontname
   INI_Write CONFIG_PROGFONT, CONFIG_FONTSIZE, CStr(tPrefs.ProgramFont.FontSize)
   INI_Write CONFIG_PROGFONT, CONFIG_FONTBOLD, IIf(tPrefs.ProgramFont.FontBold, "1", "0")
   INI_Write CONFIG_PROGFONT, CONFIG_FONTITALIC, IIf(tPrefs.ProgramFont.FontItalic, "1", "0")
   INI_Write CONFIG_PROGFONT, CONFIG_FORECOLOR, CStr(tPrefs.ProgramFont.FontForeColor)
   INI_Write CONFIG_PROGFONT, CONFIG_BACKCOLOR, CStr(tPrefs.ProgramFont.FontBackColor)
   
   If tPrefs.MRUMaxItems > 0 Then _
      INI_Write CONFIG_GENERAL, CONFIG_MRUMAXSHOW, CStr(tPrefs.MRUMaxItems)
   
   gUserPrefs = tPrefs

   Log_Write "User Preferences updated"
   
'   mdiMain.MRU_LoadItems

End Sub

' ***********************************************
' Prefs_File_Exists <- Boolean
' Answers whether the user prefs. INI file can
' be found locally.
'
' Parameters:
'  none
' ***********************************************
Function Prefs_File_Exists() As Boolean
Attribute Prefs_File_Exists.VB_Description = "Returns True or False regarding existence of the User Preferences file in the local program folder."
   
   If File_Exists(Prefs_FileName) Then _
      Prefs_File_Exists = True
   
End Function

' ***********************************************
' Prefs_FileName << String
' Returns the name of the local config ini file
'
' Parameters:
'   none
' ***********************************************
Function Prefs_FileName() As String
Attribute Prefs_FileName.VB_Description = "Returns the filename of the User Preferences file."

   Prefs_FileName = MakeLocalFileName(INI_FILENAME)

End Function

' ***********************************************
' Prefs_Font_Get << FONT_PREFS
' Returns a FONT_PREFS structure read from the
' various font & color properties of a control
'
' Parameters:
'   CTRL::Control, the control whose properties
'                  should be read and returned
' ***********************************************
Function Prefs_Font_Get( _
   CTRL As Control) As FONT_PREFS

   On Error Resume Next ' just for now
   
   Prefs_Font_Get.Fontname = CTRL.Fontname
   Prefs_Font_Get.FontSize = CTRL.FontSize
   Prefs_Font_Get.FontBold = CTRL.FontBold
   Prefs_Font_Get.FontItalic = CTRL.FontItalic
   Prefs_Font_Get.FontForeColor = CTRL.ForeColor
   Prefs_Font_Get.FontBackColor = CTRL.BackColor
   
End Function

' ***********************************************
' Prefs_Font_Set <<
' Sets a control's font and color properties to
' those defined in a FONT_PREFS structure
'
' Parameters:
'   FONTPREFS::FONT_PREFS,
'   CTRL::Control,
' ***********************************************
Sub Prefs_Font_Set( _
   FONTPREFS As FONT_PREFS, _
    CTRL As Control)
      
   On Error Resume Next ' just for now
   
   CTRL.Fontname = FONTPREFS.Fontname
   CTRL.FontSize = FONTPREFS.FontSize
   CTRL.FontBold = FONTPREFS.FontBold
   CTRL.FontItalic = FONTPREFS.FontItalic
   CTRL.ForeColor = FONTPREFS.FontForeColor
   CTRL.BackColor = FONTPREFS.FontBackColor
   
End Sub

' ********** LOG STUFF ******************

' ***********************************************
' Log_Write <<
' Writes a message to the program log and to the
' debug window when run in IDE.
'
' Parameters:
'   LogMessage::String, log message to write
' ***********************************************
Sub Log_Write( _
   LogMessage As String)
Attribute Log_Write.VB_Description = "Adds a string to the Log."
   
   On Error GoTo ErrHan:
   
   miLogCount = miLogCount + 1
   ReDim Preserve msArrLogItems(miLogCount)
   
   msArrLogItems(miLogCount) = LogMessage
   
   Debug.Print LogMessage
      
   Exit Sub

ErrHan:
   
   Debug.Print "Error.modMain.Log_Write " & Err.Description
   
End Sub

' ***********************************************
' Log_Save <<
' Save the program log to (local) file.
'
' Note: overwrites last file.
'
' Parameters:
'   none
' ***********************************************
Sub Log_Save()
Attribute Log_Save.VB_Description = "Saves Log string array to log file."
   
   On Error GoTo ErrHan:
   
   msLogFileName = MakeLocalFileName(LOG_FILENAME)
   
   If gUserPrefs.KeepLog = False Then
      If File_Exists(msLogFileName) Then _
         Kill msLogFileName
      Exit Sub
   End If
   
   ArrayString_WriteToFile msLogFileName, msArrLogItems
   
   Exit Sub

ErrHan:
   
   Debug.Print "Error.modMain.Log_Save " & Err.Description

End Sub

Function Log_ItemData()
Attribute Log_ItemData.VB_Description = "Returns Log string array."

   Log_ItemData = msArrLogItems

End Function

' ********** ERROR MANAGER STUFF ********

' ***********************************************
' Error_Manager <<
' Receives an error and source string and creates
' an error log message.
'
' Parameters:
'   ErrObject::ErrObject, the error that was raised
'   Source::String, the module and procedure that
'                   raised the error
'   ShowMsgBox::Boolean, show error message in
'                        a message box
' ***********************************************
Sub Error_Manager( _
   ErrObject As ErrObject, _
      Source As String, _
         Optional ShowMsgBox As Boolean = False)
Attribute Error_Manager.VB_Description = "Global error handler, pass the Err object and its source (as a string)."
   
   Dim sErrMsg As String
   
   sErrMsg = _
      "Error: " & _
         Source & STR_BACKSLASH & _
            ErrObject.Description
         
   Log_Write sErrMsg
   
   miErrCount = miErrCount + 1
   ReDim Preserve msArrErrItems(miErrCount)
   
   msArrErrItems(miErrCount) = sErrMsg
   
   If ShowMsgBox Then _
      MsgBox sErrMsg, vbExclamation, AppTitleVersion
      
End Sub

' ***********************************************
' Error_SessionCount << Long
' Returns the number of errors experienced during
' current program session
'
' Parameters:
'   none
' ***********************************************
Function Error_SessionCount() As Long

   Error_SessionCount = miErrCount

End Function

' ***********************************************
' Errors_Save <<
' Saves error log to (local) file
'
' Parameters:
'   none
' ***********************************************
Sub Errors_Save()
Attribute Errors_Save.VB_Description = "Saves session errors to file."
   
   msErrFileName = MakeLocalFileName(ERR_FILENAME)
   ArrayString_WriteToFile msErrFileName, msArrErrItems
   
End Sub

' ***********************************************
' Errors_ItemData << Variant
' Returns the error log as a string array
'
' Parameters:
'   none
' ***********************************************
Function Errors_ItemData()
Attribute Errors_ItemData.VB_Description = "Returns the Errors string array."

   Errors_ItemData = msArrErrItems

End Function

' ********* HISTORY STUFF ***************

' ***********************************************
' History_AddItem <<
' Add an item to the session History record
'
' Parameters:
'   HistItem::String,
' ***********************************************
Sub History_AddItem( _
   HistItem As String)
Attribute History_AddItem.VB_Description = "Adds an item to the History string array."
   
   If Len(HistItem) = 0 Then Exit Sub
   
   If miHistCount > 0 Then
      Dim sTmp As String
      sTmp = msArrHistoryItems(miHistCount)
      If Left$(sTmp, Len(HistItem)) = HistItem Then
         GoTo SameAsLast:
      End If
   End If
   
   Dim sDateStamp As String
   sDateStamp = Format$(Now, STR_DATE_TIME_FORMAT)

   Dim sTmpHistItem As String
   sTmpHistItem = HistItem & _
      HIST_DETAIL_DELIMITER & _
         sDateStamp
   
   miHistCount = miHistCount + 1
   ReDim Preserve msArrHistoryItems(miHistCount)
   
   msArrHistoryItems(miHistCount) = sTmpHistItem
   
'   mdiMain.mnuHist.Enabled = CBool(miHistCount > 0)
   
SameAsLast:

End Sub

Function hist_itemfromfile(FileEntry As String) As HISTORY_ITEM
   
   ' format:
   '  NAME|TAG|DATE|TIME|
   Dim sProps() As String
   sProps = Split(FileEntry, HIST_ITEM_DELIMITER)
   
   Dim tHist As HISTORY_ITEM
   tHist.ItemName = sProps(0)
   tHist.Tag = sProps(1)
   tHist.DateEntered = CLng(Val(sProps(2)))
   tHist.TimeEntered = CLng(Val(sProps(3)))
   tHist.HitCount = CLng(Val(sProps(4)))
   
End Function

Function hist_makeforfile(HistItem As HISTORY_ITEM) As String
   
   Dim sOut As String
   Dim sTmp As String
   
   sTmp = Replace$(HistItem.ItemName, HIST_ITEM_DELIMITER, " ")
   sOut = sTmp
   
   sTmp = Replace$(HistItem.Tag, HIST_ITEM_DELIMITER, " ")
   sOut = sOut & HIST_ITEM_DELIMITER & sTmp
   
   sTmp = CStr(HistItem.DateEntered)
   sOut = sOut & HIST_ITEM_DELIMITER & sTmp
   
   sTmp = CStr(HistItem.TimeEntered)
   sOut = sOut & HIST_ITEM_DELIMITER & sTmp
   
   sTmp = CStr(HistItem.HitCount)
   sOut = sOut & HIST_ITEM_DELIMITER & sTmp
   
   hist_makeforfile = sOut
   sOut = vbNullString ' ""
   
End Function

Function hist_makeitem( _
   Word As String, Tag As String) As HISTORY_ITEM
   
   Dim tHist As HISTORY_ITEM
   tHist.ItemName = Word
   tHist.Tag = Tag
   tHist.DateEntered = CLng(Date)
   tHist.TimeEntered = CLng(Time)
   
   hist_makeitem = tHist
   
End Function

Sub hist_make_item( _
   histword As String, _
   item As HISTORY_ITEM, _
   Optional Source As Long = 0)

   item.ItemName = histword
   item.Source = Source
   item.DateEntered = CLng(Date)
   item.TimeEntered = CLng(Timer)
   

End Sub
' ***********************************************
' History_SessionCount << Long
' Returns the current count for the session History
'  record
'
' Parameters:
'   none
' ***********************************************
Function History_SessionCount() As Long
   
   History_SessionCount = miHistCount
   
End Function

' ***********************************************
' History_Clear_Session <<
' Clears the current session History record
'
' Parameters:
'   none
' ***********************************************
Sub History_Clear_Session()

   If miHistCount = 0 Then Exit Sub
   
   If MsgBox(ResFile_GetText(IDS_HIST_CLEAR_QUESTION), _
         MB_ICONQUESTION + MB_YESNO, _
            ResFile_GetText(IDS_HIST_CLEAR)) = vbYes Then
   
      Log_Write " user cleared session history, item count = " & miHistCount
      
      Erase msArrHistoryItems
      miHistCount = 0
   
   End If
   
End Sub

Sub History_Delete()
   
   If MsgBox("Sure you want to delete history file data?", MB_ICONQUESTION + MB_YESNO, "History - Delete") = vbYes Then
   
      Dim sDelMsg As String
      sDelMsg = "History data deleted on " & Format$(Date, "dd MMM yyyy")
      
      Log_Write sDelMsg
      File_WriteText msHistFileName, sDelMsg, False
      
   End If
   
End Sub

Sub History_Remove_Duplicates()
   
   If MsgBox("Sure you want to remove duplicates from history file?", MB_ICONQUESTION + MB_YESNO, "History - Remove duplicates") = vbYes Then
   
      Log_Write " History - remove duplicates request"
      
      Dim sData As String
      sData = File_ReadText(msHistFileName)
      
      If Len(sData) = 0 Then
         Log_Write " History - no data, nothing done"
         Exit Sub
      End If
      
      Dim sItems() As String
      sItems = Split(sData, vbCrLf)
      
      ArrayString_SortByShellAlgo sItems
      
      Dim iCurr As Long, iMax As Long, iCount As Long
      iMax = UBound(sItems)
      
      Dim sNewData() As String
      ReDim sNewData(iMax + 1)
      
      Dim sCurr As String, sLast As String
      Dim iFind As Long
      
      For iCurr = LBound(sItems) To iMax
         
         sCurr = sItems(iCurr)
         
         iFind = InStr(1, sCurr, HIST_DETAIL_DELIMITER)
         If iFind > 0 Then
            sCurr = Left$(sCurr, iFind - 1)
         End If
         
         If Not sCurr = sLast Then
            iCount = iCount + 1
            sNewData(iCount) = sItems(iCurr) '/* e.g. retain date part
         End If
         
         sLast = sCurr
         
      Next iCurr
      
      ReDim Preserve sNewData(iCount)
      
      ArrayString_SortByShellAlgo sNewData
      
      ArrayString_WriteToFile _
         msHistFileName, sNewData, vbCrLf, False
      
      Log_Write "History " & (iMax + 1) - iCount & " item/s removed"
   
   End If
   
End Sub

' ***********************************************
' History_Save <<
' Save the current session History record to file
'  actually appends to existing data in file
'
' Parameters:
'   none
' ***********************************************
Sub History_Save()
Attribute History_Save.VB_Description = "Saves the History string array data to the history file."
   
   If miHistCount = 0 Then Exit Sub
   
   If gUserPrefs.KeepHistory Then
   
      ArrayString_WriteToFile _
         msHistFileName, msArrHistoryItems, vbCrLf, True
   
   End If

End Sub

' ***********************************************
' History_ItemData << Variant
' Returns the array of current session History
'  records in a string array
'
' Parameters:
'   none
' ***********************************************
Function History_ItemData()
Attribute History_ItemData.VB_Description = "Returns the History string array."
   
   History_ItemData = msArrHistoryItems
   
End Function

' ***********************************************
' History_Init <<
' Basic initialisation for the session History
' record
'
' Parameters:
'   none
' ***********************************************
Sub History_Init()
Attribute History_Init.VB_Description = "Initialises the History's filename."

   msHistFileName = MakeLocalFileName(HIST_FILENAME)

End Sub

' *********RES FILE STUFF ***************
Function ResFile_GetText(ResID As Long) As String
   
   ResFile_GetText = _
      LoadResString(ResID + (giLangID * 100))

End Function

' ********** APP STUFF ******************
Function AppTitle() As String
Attribute AppTitle.VB_Description = "Returns the program's Title as defined in the VBP."
   AppTitle = App.Title
End Function

Function AppVersion() As String
Attribute AppVersion.VB_Description = "Returns a concatenation of the program's version info."
   AppVersion = App.Major & STR_PERIOD & _
      App.Minor & STR_PERIOD & _
         App.Revision
End Function

Function AppTitleVersion() As String
Attribute AppTitleVersion.VB_Description = "Returns a concatenation of the program's Title and Version info."
   AppTitleVersion = _
      AppTitle & " v" & AppVersion
End Function

' ***** MOST RECENTLY USED STUF ********* e.g. MRU
'Function MRU_ItemData()
'
'   MRU_ItemData = msArrMRUItems
'
'End Function
'
'Sub MRU_AddItem( _
'   MRUItem As String)
'
'   On Error GoTo ErrHan:
'
'   If UBound(msArrMRUItems) > 0 Then
'      If UCase$(MRUItem) = UCase$(msArrMRUItems(1)) Then _
'         Exit Sub ' e.g. LIFO / Last In, First Out
'   End If
'
'   Dim sTmpArray() As String
'   sTmpArray = msArrMRUItems
'
'   Dim iCurr As Long, iMax As Long
'   iMax = UBound(sTmpArray) + 1
'
'   ReDim msArrMRUItems(iMax)
'   msArrMRUItems(1) = MRUItem
'
'   Dim iCnt As Long
'   iCnt = 1
'
'   For iCurr = 2 To iMax
'      If Not (UCase$(MRUItem) = UCase$(sTmpArray(iCurr - 1))) Then
'         iCnt = iCnt + 1
'         msArrMRUItems(iCnt) = sTmpArray(iCurr - 1)
'      End If
'   Next iCurr
'
'   ReDim Preserve msArrMRUItems(iCnt)
'
'   Exit Sub
'
'ErrHan:
'
'   Error_Manager Err, "modMain.MRU_AddItem"
'
'End Sub
'
'Private Sub MRU_Init()
'
'   On Error GoTo ErrHan:
'
'   ReDim msArrMRUItems(0)
'   msMRUFileName = MakeLocalFileName(MRU_FILENAME)
'
'   ' /* not doing an MRU in this app. */
'   Exit Sub
'
'   Dim sData As String
'   sData = File_ReadText(msMRUFileName)
'
'   If Len(sData) > 0 Then
'
'      Dim sDataItems() As String
'      sDataItems = Split(sData, vbCrLf)
'
'      Dim sTmpFileName As String
'
'      Dim iCurr As Long, iLocalCount As Long
'      For iCurr = 0 To UBound(sDataItems)
'         sTmpFileName = sDataItems(iCurr)
'         If Len(sTmpFileName) > 0 Then
'            If File_Exists(sTmpFileName) Then
'               iLocalCount = iLocalCount + 1
'               ReDim Preserve msArrMRUItems(iLocalCount)
'               msArrMRUItems(iLocalCount) = sTmpFileName
'            End If
'         End If
'      Next iCurr
'
'   Else
'      Err.Raise 99, "Main.MRU_Init", "No MRU Data"
'
'   End If
'
'   Exit Sub
'
'ErrHan:
'
'   Error_Manager Err, "modMain.MRU_Init"
'
'End Sub
'
'Private Sub MRU_Save()
'
'   On Error GoTo ErrHan:
'
'   If File_Exists(msMRUFileName) Then _
'      Kill msMRUFileName
'
'   Exit Sub
'
'   ' /* not doing an MRU in this app. */
'   ArrayString_WriteToFile msMRUFileName, msArrMRUItems
'   Exit Sub
'
'ErrHan:
'
'   Error_Manager Err, "modMain.MRU_Save"
'
'End Sub

' ********** ARRAY STUFF ****************
Sub ArrayString_WriteToFile( _
   FileName As String, Data() As String, _
      Optional Delimiter As String = vbCrLf, _
         Optional AppendToFile As Boolean = False)
Attribute ArrayString_WriteToFile.VB_Description = "Writes data in a string array to file."
      
   ' Desc:  Write data from a string array to a file
   '        as plain text.
   ' Note:  Designed to overwrite old file with
   '        an empty output e.g. no string data
   
   On Error GoTo ErrHan:
   
   Dim iMax As Long, iStage As Long
   
   iMax = UBound(Data)
   
   Dim sOut As String
   sOut = ArrayString_ToString(Data, Delimiter)
   
ResNoData:
   iStage = 1
   File_WriteText FileName, sOut, AppendToFile
   
   Exit Sub

ErrHan:
   If Err.Number = 9 And iStage = 0 Then
      Log_Write ResFile_GetText(IDS_NO_DATA_TO_WRITE) & FileName
      Resume ResNoData:
   Else
      Error_Manager Err, "modMain.ArrayString_WriteToFile"
   End If

End Sub

Sub ArrayString_SortByShellAlgo( _
   StringArray() As String, _
      Optional Descending As Boolean = False)
Attribute ArrayString_SortByShellAlgo.VB_Description = "Sorts a string array using a Shell sort algo."

   ' Author    : Romke Soldaat
   ' Purpose   : sort an array using ShellSort algo
   '             A Better Shell Sort: Part I
   '             http://msdn.microsoft.com/en-us/library/aa155630%28office.10%29.aspx
   ' Requires  : CompareResult function
   
   On Error GoTo ErrHan:
   
   Dim TempVal As String
   Dim iNext As Long
   Dim GapSize As Long, CurPos As Long
   Dim FirstRow As Long, LastRow As Long, NumRows As Long

   FirstRow = LBound(StringArray)
   LastRow = UBound(StringArray)
   NumRows = LastRow - FirstRow + 1
   
   Do
      GapSize = GapSize * 3 + 1
   Loop Until GapSize > NumRows
   
   Do
      GapSize = GapSize \ 3
      For iNext = (GapSize + FirstRow) To LastRow
         CurPos = iNext
         TempVal = StringArray(iNext)
         Do While CompareResult(StringArray(CurPos - GapSize), TempVal, Descending)
            StringArray(CurPos) = StringArray(CurPos - GapSize)
            CurPos = CurPos - GapSize
            If (CurPos - GapSize) < FirstRow Then Exit Do
         Loop
         StringArray(CurPos) = TempVal
      Next
   Loop Until GapSize = 1

   Exit Sub
   
ErrHan:

   Error_Manager Err, "modMain.ArrayString_SortByShellAlgo"

End Sub

Private Function CompareResult( _
   Value1 As String, _
      Value2 As String, _
         Optional pDescending As Boolean = False)
    
    CompareResult = (StrComp(Value1, Value2, vbTextCompare) = 1)
    CompareResult = CompareResult Xor pDescending

End Function

Function ArrayString_ToString( _
   StringArray() As String, _
      Optional Delimiter As String = vbCrLf) As String
Attribute ArrayString_ToString.VB_Description = "Returns a string from a string array e.g. all the array's items concatenated."
   
   ' Desc:  a very basic string array to string function
   '        that starts from pos. 1 rather than 0.
   '        This is intended to handle relatively small
   '        arrays e.g. upto a 1000 or so.
   
   On Error GoTo ErrHan:
   
   Dim iCurr As Long, iMax As Long
   
   iMax = UBound(StringArray)
   
   Do While iCurr < iMax
      
      iCurr = iCurr + 1
      
      If Len(StringArray(iCurr)) > 0 Then
         
         If Len(ArrayString_ToString) > 0 Then _
            ArrayString_ToString = _
               ArrayString_ToString & Delimiter
         
         ArrayString_ToString = _
            ArrayString_ToString & StringArray(iCurr)
      
      End If
      
   Loop
   
   Exit Function
   
ErrHan:
   
   Error_Manager Err, "modMain.ArrayString_ToString"
   
End Function

' ********** FILE STUFF *****************

' ***********************************************
' File_Exists <- Boolean
' Answers whether a file name can be located.
'
' Parameters:
'  FileName::String, file name to test.
' ***********************************************
Function File_Exists( _
   FileName As String) As Boolean
Attribute File_Exists.VB_Description = "Tests for file existence and returns True if found."
   
   On Error GoTo ErrHan:
   
   Dim iAttributes As Long
   iAttributes = GetAttr(FileName)
   
   If iAttributes And vbDirectory Then _
      Exit Function
   
   File_Exists = True
   
   Exit Function
   
ErrHan:
End Function

' ***********************************************
' File_Extension <- String
' Returns the extension portion of a file name.
'
' Parameters:
'  FileName::String, the name of the file whose
'  extension is required.
' ***********************************************
Function File_GetExtension( _
   FileName As String) As String
Attribute File_GetExtension.VB_Description = "Pass a file name to return its extension e.g. txt, jpg ..."

   If File_Exists(FileName) Then
      
      Dim iPeriod As Long
      iPeriod = InStrRev(FileName, STR_PERIOD)
      
      If iPeriod > 0 Then _
         File_GetExtension = Mid$(FileName, iPeriod + 1)
      
   End If

End Function

' ***********************************************
' File_GetPath <- String
' Returns the directory / folder portion of a
' file name.
'
' Parameters:
'  FileName::String, the name of the file whose
'  path is required.
' ***********************************************
Function File_GetPath( _
   FileName As String) As String
Attribute File_GetPath.VB_Description = "Pass a file name to return its folder / path."
   
   If File_Exists(FileName) Then
      
      Dim iSlash As Long
      iSlash = InStrRev(FileName, STR_BACKSLASH)
      
      If iSlash > 0 Then _
         File_GetPath = Left$(FileName, iSlash - 1)
      
   End If
   
End Function

' ***********************************************
' File_GetName <- String
' Returns the file name portion of a file name
' e.g. minus the file's directory / folder / path...
'
' Parameters
'  FileName::String, the full path and filename of
'  the file whose name (alone) is required.
' ***********************************************
Function File_GetName( _
   FileName As String) As String
Attribute File_GetName.VB_Description = "Pass a file name to return its name."

   If File_Exists(FileName) Then
      
      Dim iSlash As Long
      iSlash = InStrRev(FileName, STR_BACKSLASH)
      
      If iSlash > 0 Then _
         File_GetName = Mid$(FileName, iSlash + 1)
      
   End If

End Function

' ***********************************************
' File_ReadText <- String
' Returns the contents of a text file as a string.
'
' Parameters:
'  FileName::String, the name of the file whose
'  text content should be read.
' ***********************************************
Function File_ReadText( _
   FileName As String) As String
Attribute File_ReadText.VB_Description = "Pass a file name and return its text content."

   On Error GoTo ErrHan:
   
   Dim iFileNum As Integer, bFileOpened As Boolean
   iFileNum = FreeFile()
   
   Open FileName For Binary As #iFileNum
   
   bFileOpened = True
   
   File_ReadText = _
      StrConv(InputB(LOF(iFileNum), iFileNum), vbUnicode)
   
ResErr:
      
   If Not Err.Number = 0 Then _
      Resume Next
      
   If bFileOpened Then _
      Close #iFileNum
      
   Exit Function
   
ErrHan:
   
   Error_Manager Err, "modMain.File_ReadText"
   Resume ResErr:
   
End Function

' ***********************************************
' File_WriteText <- String
' Writes text to a text file.
'
' Parameters:
'  FileName::String, name of the file to write to...
'  TextToWrite::String, the actual text to be written.
'  AppendToTextFile::Boolean, flag describing whether
'     to append new text or (if false) overwrite
'     existing text.
' ***********************************************
Sub File_WriteText( _
   FileName As String, TextToWrite As String, _
      AppendTextToFile As Boolean)
Attribute File_WriteText.VB_Description = "Pass a file name and some text to have that text saved to that file."
   
   On Error GoTo ErrHan:
   
   Dim iFileNum As Long, bFileOpened As Boolean
   iFileNum = FreeFile()
   
   If AppendTextToFile Then
      Open FileName For Append As #iFileNum
   Else
      Open FileName For Output As #iFileNum
   End If
   
   bFileOpened = True
   
   If AppendTextToFile Then
      If LOF(iFileNum) > 0 Then
         Print #iFileNum, vbCrLf;
      End If
   End If
   
   Print #iFileNum, TextToWrite;
   
ResErr:
   
   If Not Err.Number = 0 Then _
      Resume Next
   
   If bFileOpened Then _
      Close #iFileNum
   
   Exit Sub
   
ErrHan:
   
   Error_Manager Err, "modMain.File_WriteText", True
   
End Sub

Function Get_WordCount( _
   ByteData() As Byte) As Long

   On Error GoTo ErrHan:
   
   Dim iCurr As Long, iMax As Long, iChar As Long
   Dim iCharCount As Long

   iMax = UBound(ByteData)
   Do While iCurr < iMax
      iChar = ByteData(iCurr)
      If Is_WordBreakChar(iChar) Then
         If iCharCount > 0 Then
            Get_WordCount = Get_WordCount + 1
            iCharCount = 0
         End If
      Else
         iCharCount = iCharCount + 1
      End If
      iCurr = iCurr + 1
   Loop
   If iCharCount > 0 Then Get_WordCount = Get_WordCount + 1

   Exit Function

ErrHan:
   Error_Manager Err, "modMain.Get_WordCount"
   
End Function

Function Get_UniqueWords( _
   ByteData() As Byte) As String()

   On Error GoTo ErrHan:
   Dim iMaxWords As Long
   iMaxWords = Get_WordCount(ByteData)
   
   Dim sData() As String
   ReDim sData(iMaxWords)
      
   Dim iCurr As Long, iMax As Long, iChar As Long
   Dim iCharCount As Long, iWordCount As Long
   Dim iStart As Long, sTmp As String
   
   iMax = UBound(ByteData)
   Do While iCurr < iMax
      iChar = ByteData(iCurr)
      If Is_WordBreakChar(iChar) Then
         If iCharCount > 0 Then
            sTmp = Mid$(ByteData, iStart / 2, iCharCount)
'            Debug.Print sTmp
            iWordCount = iWordCount + 1
            sData(iWordCount) = sTmp
            iCharCount = 0
         End If
      Else
         iCharCount = iCharCount + 1
         If iCharCount = 1 Then _
            iStart = iCurr + 1 + 1
            
      End If
      iCurr = iCurr + 2
   Loop
   
   ' /// don't forget last word!!!
   If iCharCount > 0 Then
      sTmp = Mid$(ByteData, iStart / 2, iCharCount)
      iWordCount = iWordCount + 1
      sData(iWordCount) = sTmp
      iCharCount = 0
   End If
   
   ReDim Preserve sData(iWordCount)
   ArrayString_SortByShellAlgo sData
   
   Dim sLast As String
   iMax = iWordCount
   
   Dim sTmpData() As String
   ReDim sTmpData(iMax)
   
   iWordCount = 0
   For iCurr = 1 To iMax
      sTmp = UCase$(sData(iCurr))
      If Not CBool(sTmp = sLast) Then
         iWordCount = iWordCount + 1
         sTmpData(iWordCount) = sData(iCurr)
         sLast = sTmp
      End If
   
   Next iCurr
   
   ReDim Preserve sTmpData(iWordCount)
   Get_UniqueWords = sTmpData
   
   Erase sData
   Erase sTmpData
   
   Exit Function

ErrHan:
   Error_Manager Err, "modMain.Get_UniqueWords"


End Function

' ***********************************************
' Is_WordBreakChar <- Boolean
' ***********************************************
Function Is_WordBreakChar( _
 ByVal KeyCode As Long) As Boolean
   '---------------------------------------------------------------------------------------
   ' Purpose   : Return True/False if a key code is considered
   '             to be a word breaking character.
   '---------------------------------------------------------------------------------------
    
    Is_WordBreakChar = _
      KeyCode < 48 Or KeyCode > 57 And _
         KeyCode < 65 Or KeyCode > 90 And _
            KeyCode < 96 Or KeyCode > 122 And _
               KeyCode < 127
    
End Function

' ******* WINDOWS & CONTROLS STUFF ******
Sub Form_SetCaption( _
   Form As Form, FormCaption As String)
Attribute Form_SetCaption.VB_Description = "Uses Unicode compatible method to set a Form's Caption property."

   Window_SetText Form.hwnd, FormCaption

End Sub

Sub TextBox_SetText( _
   TextBox As TextBox, TheText As String)
   
   Window_SetText TextBox.hwnd, TheText
   
End Sub

Sub ComboBox_AddMissingItem( _
   ByRef ComboBox As ComboBox, _
      ByVal TestItemString As String)
Attribute ComboBox_AddMissingItem.VB_Description = "Pass a string to add to a combo box, if item exists it won't be added."
         
   On Error GoTo ErrHan:
   
   Dim bAdd As Boolean
   
   If ComboBox Is Nothing Then GoTo Quit:
   If Len(TestItemString) = 0 Then GoTo Quit:
   
   If ComboBox.ListCount = 0 Then
      bAdd = True
      GoTo TestAdd:
   End If
   
   Dim iXl As Long
   bAdd = True
   For iXl = 0 To ComboBox.ListCount - 1
      If UCase$(ComboBox.List(iXl)) = UCase$(TestItemString) Then
         bAdd = False
         Exit For
      End If
   Next iXl
   
TestAdd:
   If bAdd Then _
      ComboBox.AddItem TestItemString
      
Quit:
   Exit Sub

ErrHan:
   
   Error_Manager Err, "modMain.ComboBox_AddMissingItem"
   
End Sub

Sub ListBox_FillFromStringArray( _
   ListBox As ListBox, Data() As String)
Attribute ListBox_FillFromStringArray.VB_Description = "Loads strings from a string array into a ListBox."

   On Error GoTo ErrHan:

   ListBox.Clear
   
   Dim iCurr As Long, iMax As Long
   iMax = UBound(Data)
   
   If iMax > 32000 Then
      iMax = 32000
      Log_Write "ListBox:" & ListBox.Name & ", Data > 32,000"
   End If
   
   Dim sItem As String
   For iCurr = 1 To iMax
      sItem = Data(iCurr)
      ListBox.AddItem sItem
      ListBox.ItemData(ListBox.NewIndex) = iCurr
   Next iCurr
   
   Exit Sub

ErrHan:

   Error_Manager Err, "modMain.ListBox_FillFromStringArray"

End Sub

Sub ComboBox_FillFromStringArray( _
   ComboBox As ComboBox, Data() As String)

   On Error GoTo ErrHan:

   ComboBox.Clear

   Dim iCurr As Long, iMax As Long
   iMax = UBound(Data)

   If iMax > 32000 Then
      iMax = 32000
      Log_Write "ComboBox:" & ComboBox.Name & ", Data > 32,000"
   End If

   Dim sItem As String
   For iCurr = 1 To iMax
      sItem = Data(iCurr)
      ComboBox.AddItem sItem
      ComboBox.ItemData(ComboBox.NewIndex) = iCurr
   Next iCurr

   Exit Sub

ErrHan:

   Error_Manager Err, "modMain.ComboBox_FillFromStringArray"

End Sub

Sub TextBox_CopyFontFormat( _
   SrcTxtBox As TextBox, DestTxtBox As TextBox)
   
   On Error GoTo ErrHan:
   
   DestTxtBox.Fontname = SrcTxtBox.Fontname
   DestTxtBox.FontSize = SrcTxtBox.FontSize
   DestTxtBox.FontBold = SrcTxtBox.FontBold
   DestTxtBox.FontItalic = SrcTxtBox.FontItalic
   
   DestTxtBox.BackColor = SrcTxtBox.BackColor
   DestTxtBox.ForeColor = SrcTxtBox.ForeColor
   
   Exit Sub

ErrHan:
   
   Error_Manager Err, "modMain.TextBox_CopyFontFormat"
   
End Sub
