'MacroName:ContentsNote
'MacroDescription:Create contents notes for bibliographic records.
'Written by: Joel Hahn, Niles Public Library District

Option Explicit
Option Base 1

   Dim ContentsArea$
   Dim TrackList$()
   Dim StoredList$
   Dim CurrentList$
   Dim tBox$

Declare Function ContentsEntry()
Declare Function DlgFuncContentsEntry( WhichControl$, action%, suppvalue& ) As Integer
Declare Sub DataHandler()
Declare Function NewGetField(text$, fieldnum%, delimiter$) As String

sub main
  Dim CS as Object
  Set CS = CreateObject("CatME.Application")
  Dim bool

  Err = 0
  On Error Resume Next
  CS.GetActiveRecord
  If Err>0 Then
    MsgBox "No active record available. Exiting..."
    Goto Done
  End If
  On Error Goto 0

  bool = ContentsEntry()
  If bool <> FALSE Then
    Call DataHandler
    bool = CS.AddField(99, ContentsArea$)
  End If

Done: 
End sub

Function DlgFuncContentsEntry( WhichControl$, action%, suppvalue& ) As Integer
  Dim place
  Dim tester$
  Dim count
  
   Select Case action%
      Case 1  ' set up initial values displayed in dialog box
        If DlgValue("tList")>=0 Then
          DlgValue "tList", -1
        End If

      Case 2  ' what to do if button or control value was changed (by clicking it)
         Select Case WhichControl$
            Case "tList"
              place = DlgValue("tList")
              If place>0 Then
                DlgFocus "tBox"
                tester$ = Trim(NewGetField(StoredList$, place+1, "--")) '(((place+1) * 2) - 1), "\\"))
                place = InStr(1, StoredList$, tester$)
                If place > 0 Then
                  count = DlgValue("tList")
                  SendKeys "{HOME}{RIGHT " + (place-1) + "}", -1
                End If
                DlgValue "tList", -1
              Else 
                DlgFocus "tBox"
                SendKeys "{HOME}", -1
                DlgValue "tList", -1
              End If
         End Select
      
      Case 3  ' what to do if text box or list/combo box was changed (by clicking it or by typing in it)
         Select Case WhichControl$
         End Select
      
      Case 4  ' what to do if control focus was changed (by leaving it and clicking elsewhere)

      Case 5  ' what to do while idle (repeated many times/sec)
         '
         ' if some action is supposed to occur while the function is idle,
         ' then the following line must be used here:
         '    DlgFuncContentsEntry = TRUE
         ' succeeded by source code for the action to perform
         ' (typical examples: timer, checking for user keystrokes, etc.)

         DlgFuncContentsEntry = TRUE

      If DlgFocus = "tBox" Then
        CurrentList$ = DlgText("tBox")
        If CurrentList$="" Then
          ReDim TrackList$(1)
          DlgListBoxArray "tList", TrackList$
        Else
                                      
        If StoredList$ <> CurrentList$ Then
          StoredList$ = CurrentList$

          count = 1 : place = 0
          Do
            ReDim Preserve TrackList$(count)
            TrackList$(count) = Trim(NewGetField(StoredList$, count, "--")) '((count * 2) - 1), "\\"))
            place = InStr(place+2, StoredList$, "--") '"\\")
            If place>0 Then
              count = count + 1
            End If
          Loop Until place = 0

          DlgListBoxArray "tList", TrackList$
        End If
      End If
     End If

   End Select
End Function

Function ContentsEntry() As Integer
DoDialog2:
   Dim DlgCaptionContentsEntry As String
   DlgCaptionContentsEntry = "Contents Note Entry"

Begin Dialog DlgContentsEntry 243, 139, DlgCaptionContentsEntry, .DlgFuncContentsEntry
   Text  7, 5, 211, 8, "Type everything to be included in the contents, each separated"
   Text  7, 15, 53, 8, "by two hyphens:"
   TextBox  7, 26, 224, 12, .tBox
   ListBox  7, 43, 224, 63, TrackList(), .tList
   PushButton  131, 118, 46, 14, "Finish", .Finish
   PushButton  185, 118, 46, 14, "Cancel", .Cancel
End Dialog

   Dim dlg As DlgContentsEntry
   Dim response As Integer
     'dlg.tBox = tBox$

     response = Dialog( dlg )
     ContentsEntry = response
     tBox$ = dlg.tBox
End Function

Sub DataHandler()
Dim place

DoContents:
     If tBox<>"" Then
       If InStr(1, tBox, Chr(223)) Then
         ContentsArea$ = "505 00 "
       Else
         ContentsArea$ = "505 0  "
       End If
       For place = 1 to UBound(TrackList$)
         ContentsArea$ = ContentsArea$ + TrackList$(place) + " -- "
       Next place
       If InStr(1, ContentsArea$, Chr(223)) Then
           Mid(ContentsArea$, 6, 1) = "0"
       End If
       ContentsArea$ = Left(ContentsArea$, Len(ContentsArea$)-4) 'ChopRight(ContentsArea$, 4)
       If Right(ContentsArea$, 1)<>"." Then
         ContentsArea$ = ContentsArea$ + "."
       End If
     End If
     'MsgBox ContentsArea$

end sub

'Use instead of the builtin GetField function, especially with delimiters of 2+ characters
Function NewGetField(text$, fieldnum%, delimiter$) As String
  Dim txt$
  Dim x : Dim y : Dim z
  Dim NumRecs%
  Dim retval$
  
  txt$ = text$ + delimiter$
  x=1 : y=1 : z=1 : NumRecs%=1
  retval$ = ""
  Do 'Until x=0
    z = x
    x = InStr(z, txt$, delimiter$)
    If x=0 Then
      If y=1 then
        retval$ = Mid(txt$, z)
      Else
        retval$=Chr(127)
      End If
    Else
      If y = fieldnum% Then
        retval$=Mid(txt$, z, x-z)
      Else
        y=y+1
      End If
      x = x + Len(delimiter$)
    End If
  
  Loop Until retval<>""

If retval$=Chr(127) Then retval$=""

NewGetField=retval$
     
End Function