Option Compare Database   'Use database order for string comparisons
Option Explicit


Sub EmitRTFFootnote (FileNum As Integer, FootnoteChar As String, 
                     FootnoteBody As String)

  ' Routine to emit an RTF footnote record.
  ' Assumes output file has been previously opened as #FileNum.
  ' Superscripting of FootnoteChar is not really necessary
  ' but looks nicer if RTF file is read into WinWord later.

  Print #FileNum, FootnoteChar + "{\footnote ";
  Print #FileNum, "{\fs16\up6 " + FootnoteChar + "} ";
  Print #FileNum, FootnoteBody + "}"

End Sub


Sub EmitRTFHeader (FileNum As Integer)

  ' Generate RTF file header using passed file number
  ' Assumes that the file has been previously opened successfully

  ' First emit RTF file identifier, default character set, etc.
  Print #FileNum, "{\rtf1\ansi \deff0\deflang1024"

  ' Generate a minimal font table containing just enough
  ' fonts to support Windows and Macintosh viewing
  Print #FileNum, "{\fonttbl"
  Print #FileNum, "{\f0\froman Times New Roman;}"
  Print #FileNum, "{\f1\froman Symbol;}"
  Print #FileNum, "{\f2\fswiss Arial;}"
  Print #FileNum, "{\f3\fswiss Helvetica;}"
  Print #FileNum, "{\f4\fswiss Hel;}"
  Print #FileNum, "}"

  ' Generate a minimal color table consisting of black,
  ' blue, green, red, and white.
  Print #FileNum, "{\colortbl;"
  Print #FileNum, "\red0\green0\blue0;"
  Print #FileNum, "\red0\green0\blue255;"
  Print #FileNum, "\red0\green255\blue0;"
  Print #FileNum, "\red255\green0\blue0;"
  Print #FileNum, "\red255\green255\blue255;"
  Print #FileNum, "\red0\green127\blue0;"
  Print #FileNum, "}"

  ' Set the default font to Times New Roman
  Print #FileNum, "\deff0"

  ' Generate an initial topic separator
  Print #FileNum, "\page"

End Sub


Sub EmitRTFHotLink (FileNum As Integer, HotLinkString As String, 
                    TargetString As String)

  ' Routine to emit RTF hotlink to the specified file.
  ' The RTF encoding for a hotlink is double-underlined text
  ' followed by hidden text. The double-underlined text is the
  ' visible portion of the hotlink to be clicked on by the user.
  ' The hidden text is the "context string" for the target topic.
  ' Note: Prefixing the hidden text with "%" suppresses visible
  ' underlining of the hotlink. We assume that the color of the
  ' text will be set to something other than black elsewhere.

  Print #FileNum, "{\uldb " & HotLinkString & "}{\v %" & TargetString & "}"

End Sub


Sub EmitRTFTabStopInches (FileNum As Integer, TabStop As Variant)

  ' Called with tab stop in fractional or integer inches.
  ' Converts inches to Twips and calls EmitRTFTabStopTwips to
  ' generate the RTF command.

  Call EmitRTFTabStopTwips(FileNum, Int(TabStop * 1440))

End Sub


Sub EmitRTFTabStopTwips (FileNum As Integer, TabStop As Integer)

  ' Generates the RTF command to set a tab stop.
  ' The RTF \tx command parameter and thus the TabStop parameter for
  ' this subroutine is given in twips. 1440 twips = one inch.

  Dim Str1 As String

  Str1 = "\tx" & LTrim$(Str$(TabStop)) & " "
  Print #FileNum, Str1

End Sub


Sub EmitRTFTopicDivider (FileNum As Integer, TopicTitle As String, 
                         ContextString As String, KeywordString As String, 
                         TitleFootnote As String, BrowseSequence as String)

  ' This routine emits the RTF code to begin a new "topic".
  ' The code consists of a "page break" command followed by
  ' footnotes for the topic's context string, title footnote
  ' for history list, keyword list, and browse sequence, followed
  ' by the topic heading which appears in a nonscrolling region
  ' in 14 pt. type. The default paragraph formatting and font are
  ' then restored.

  ' signal start of new viewer topic
  Print #FileNum, "\page"
  
  ' write context string footnote as label for this topic
  Call EmitRTFFootnote(FileNum, "#", ContextString)
  
  ' write title footnote to be used in history window
  ' and (for multimedia viewer) in search dialogs
  Call EmitRTFFootnote(FileNum, "$", TitleFootnote)

  ' write keyword footnote iff keyword string was supplied
  If KeywordString <> "" Then

    ' write keyword string footnote for use with Search button
    Call EmitRTFFootnote(FileNum, "K", KeywordString)

  End If
  
  ' write browse sequence footnote iff browse sequence was supplied
  If BrowseSequence <> "" Then

    ' write browse sequence number footnote
    Call EmitRTFFootnote(FileNum, "+", BrowseSequence)

  End If

  ' Write the topic header text, using the "keep with next"
  ' attribute to put the header in a nonscrolling window
  Print #FileNum, "\keepn \f2\fs28 ";
  Print #FileNum, TopicTitle
  Print #FileNum, "\par "
  
  ' Restore default paragraph formatting and font.
  ' The {dtype} command is needed for the multimedia compiler's
  ' full-text indexing, but does no harm if the WinHelp
  ' compiler is used instead.
  Print #FileNum, "\pard \f2\fs20 {\dtype}"

End Sub


Sub EmitRTFTrailer (FileNum As Integer)

  ' Routine to generate RTF file trailer.
  ' Just emits RTF codes to close out the current
  ' paragraph if any and then close out the current
  ' topic, following all with a closing brace to
  ' balance the initial brace written by the
  ' EmitRTFHeader routine.

  Print #FileNum, "\par"
  Print #FileNum, "\page"
  Print #FileNum, "}"

End Sub
[[caption]]
Figure 3: These RTF generator routines were used to build the WinHelp version of the employee database.