SUBROUTINE SY.MAKE.HTML(type, options, pgtitle, datavec, rowfmt, colfmt, colhdgs, hdgfmt, ftgfmt, htm, htmerror)
*************************************************************************
*  Bp.Sysctrl Sy.Make.Html - A subroutine to create an html report.
*
*  Copyright 2008 Rush Flat Software
*
*  Licensed under the Apache License, Version 2.0 (the "License");
*  you may not use this file except in compliance with the License.
*  You may obtain a copy of the License at
*
*      http://www.apache.org/licenses/LICENSE-2.0
*
*  Unless required by applicable law or agreed to in writing, software
*  distributed under the License is distributed on an "AS IS" BASIS,
*  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
*  See the License for the specific language governing permissions and
*  limitations under the License.
*
* Questions or comments to Rush Flat Software
* Email: brian at rushflat dot co dot nz
* ------------------------------------------------------------------------- *
*
*  Version: 1.0.1
*  Author : BSS
*  Date   : 15 Jul 2008
*  Updated: 15 Jul 2008
*
*  Program Description.
*  ===================
* Program to generate html for use with MS Excel, Open Office, and Web Browsers.
* Pass:
*   type    - 'EXCEL' (or 'XL'), 'OOO' (or 'OPENOFFICE'), 'WEB', 'HTM' (OR 'HTML').
*   options - A string containing papersize, page margins, and fonts. If this is
*             null, then default values will be used.
*   pgtitle - The title of the web page
*   datavec - A dynamic array containing the page data. Rows are @AM delimited;
*             columns are @VM delimited.
*   rowfmt  - Currently not used.
*   colfmt  - A dynamic array of column formatting information:
*             <1> = column width
*             <2> = justification
*             <3> = decimal precision
*             <4> = Break/Total flag (B/T)
*   colhdgs - A dynamic array of column headings. Columns are @AM delimited;
*             rows within each column heading are @VM delimited.
*   hdgfmt  - A dynamic array containing the page heading information. The page
*             heading has 3 "zones" - left, centre, right. These zones are @AM
*             delimited. The zones may have multiple lines - @VM delimited.
*   ftgfmt  - As for hdgfmt.
*
* Returns:
*    htm      - The completed html page.
*    htmerror - An error flag - currently not used.
*
*  Version History
*  ===============
*  v.1.0.1 - 29 Mar 2009
*   - Bug fix for mvBASE
*
*  v.1.0.0 - xx Jul 2008
*   - Subroutine split out from IA.REFORMAT program
*
* --------------------------------------------------------------------- *
*
$CATALOGUE GLOBAL;                               *  %%QM%%
$MODE UV.LOCATE;                                 *  %%QM%%
$MODE PICK.ERRMSG;                               *  %%QM%%
                                                 *  %%QM%%
 DEFFUN SY.EXCELDATE(datestring);                *  %%QM%%%%UV%%
 FUNCTION SY.EXCELDATE(datestring);              *  %%MV%%
   internaldate = ICONV(datestring, 'D');        *  %%MV%%
   xldate = internaldate + 24837;                *  %%MV%%
 RETURNING xldate;                               *  %%MV%%

 DEFFUN SY.DATATYPE(datastring);                 *  %%QM%%%%UV%%
 FUNCTION SY.DATATYPE(datastring);               *  %%MV%%
   CONVERT ',' TO '' IN datastring;              *  %%MV%%
   datetest = ICONV(datastring, 'D');            *  %%MV%%
   datetest = OCONV(datetest, 'D2/');            *  %%MV%%
   IF datetest NE '' AND LEN(datastring) < 6 THEN datetest = ''; *  %%MV%%
                                                 *  %%MV%%
   BEGIN CASE;                                   *  %%MV%%
     CASE datastring = '';                       *  %%MV%% NULL is Text
       thisdatatype = 'T';                       *  %%MV%%
     CASE INDEX(datastring,' ',1);               *  %%MV%% At least one space
       thisdatatype = 'T';                       *  %%MV%%
     CASE OCONV(datastring,'MCA') NE '';         *  %%MV%% Alpha is not null
       thisdatatype = 'T';                       *  %%MV%%
     CASE NUM(datastring);                       *  %%MV%% Is numeric
       thisdatatype = 'N';                       *  %%MV%%
     CASE datetest NE '';                        *  %%MV%% OCONV DATE is not null
       thisdatatype = 'D';                       *  %%MV%%
     CASE 1;                                     *  %%MV%% Anything else = text
       thisdatatype = 'T';                       *  %%MV%%
   END CASE;                                     *  %%MV%%
 RETURNING thisdatatype;                         *  %%MV%%
*
* --------------------------------------------------------------------- *
*
$INCLUDE SYSCTRLCOMMON.H
$INCLUDE STDEQUATES.H

 progname = 'SY.MAKE.HTML'
 PROMPT ''
$INCLUDE CHECKCOMMON.H

 GOSUB setdefaults
 GOSUB decodeoptions
 GOSUB initialise
 GOSUB updatetemplate
 IF htmerror = '' THEN
   GOSUB htmlbody
 END

 RETURN
*
* --------------------------------------------------------------------- *
*
setdefaults: * Set program defaults section.
*
 htm = '';                                       *  Initialise return variable
 htmerror = ''
 username = OCONV(@LOGNAME, 'MCU');              *  %%QM%%%%UV%%
 username = FIELD(username, '\', 2);             *  %%UV%%
 username = OCONV(USYSTEM(25), 'MCU');           *  %%MV%% mvBASE username
 xhtml = 0
*
*  ----  Assumptions section
*        These variables may be changed to suit your local environment.
*
 pathconfig = 'C:\temp\'
 pathprogrpv = 'C:\Progra~1\rpv\Rpv.exe';        *  Path to rpv viewer
 pathprogspread = 'START'
 pathprogbrowser = 'START'

 maxrows  = 3000;                                *  Maximum report size
 maxrptwidth = 350;                              *  Maximum report width (in characters)
 papersize = 'A4';                               *  Set papersize
 deleteafter = 'Y';                              *  Delete rpv file after displaying in viewer
 bgcolour = 'gainsboro';                         *  Shading for column headings in html
 fontdpi = 120;                                  *  Windows font size (96 or 120 dpi)
 mincw = 11;                                     *  Minimum column width in pixels

 topmargin  =  1.0;                              *  Including unprintable areas (in centimetres)
 botmargin  =  1.0
 leftmargin =  1.0
 rightmargin = 1.0

 fontname = ''
 fontname<1>  = 'Arial';                         *  Headings
 fontname<2>  = 'Arial';                         *  Totals
 fontname<3>  = 'Arial';                         *  Detail lines (normal font)

 fontsize = ''
 fontsize<1>  = 12
 fontsize<2>  = 10
 fontsize<3>  = 10
 basefontsize =  4;                              *  Note: This is adjusted for Open Office (see Initialise section)

 fontbold = ''
 fontbold<1> = 'Y';                              *  Valid values: Y N y n
 fontbold<2> = 'Y'
 fontbold<3> = 'N'

 fontital = ''
 fontital<1> = 'N'
 fontital<2> = 'N'
 fontital<3> = 'N'

 bgcolour = 'gainsboro';                         *  Background colour for column headings
 fontdpi = 96;                                   *  Windows font size

 templateexcel = 'EXCEL2003.XLS'
 templateooo = 'HTML-3.2.HTML'
 templateweb = 'XHTML-1.0-STRICT.HTML'
 tabname = 'IA'

 RETURN
*
* --------------------------------------------------------------------- *
*
decodeoptions: * Check the options passed to subroutine.
*
 quit = SY$FALSE
 ii = 0
 LOOP
   ii += 1
   BEGIN CASE
     CASE ii = 1;   identifier = 'template'
     CASE ii = 2;   identifier = 'papersize'
     CASE ii = 3;   identifier = 'topmargin'
     CASE ii = 4;   identifier = 'botmargin'
     CASE ii = 5;   identifier = 'leftmargin'
     CASE ii = 6;   identifier = 'rightmargin'
     CASE ii = 7;   identifier = 'fontname'
     CASE ii = 8;   identifier = 'fontsize'
     CASE ii = 9;   identifier = 'fontbold'
     CASE ii = 10;  identifier = 'fontital'
     CASE ii = 11;  identifier = 'basefontsize'
     CASE ii = 12;  identifier = 'bgcolour'
     CASE ii = 13;  identifier = 'fontdpi'
     CASE 1;        quit = SY$TRUE
   END CASE
 UNTIL quit DO
   CALL SY.GET.SETTING(options, identifier, settings, found)
   IF found THEN
     CONVERT '~' TO @AM IN settings;             *  Allow for multi-valued settings
     BEGIN CASE
       CASE identifier = 'template';       template = settings
       CASE identifier = 'papersize';      papersize = settings
       CASE identifier = 'topmargin';      topmargin = settings
       CASE identifier = 'botmargin';      botmargin = settings
       CASE identifier = 'leftmargin';     leftmargin = settings
       CASE identifier = 'rightmargin';    rightmargin = settings
       CASE identifier = 'fontname';       fontname = settings
       CASE identifier = 'fontsize';       fontsize = settings
       CASE identifier = 'fontbold';       fontbold = settings
       CASE identifier = 'fontital';       fontital = settings
       CASE identifier = 'basefontsize';   basefontsize = settings
       CASE identifier = 'bgcolour';       bgcolour = settings
       CASE identifier = 'fontdpi';        fontdpi = settings
     END CASE
   END
 REPEAT

 RETURN
*
* --------------------------------------------------------------------- *
*
initialise: * Initialise variables.
*
*  Standardise "types"
*
 type = OCONV(type, 'MCU')
 IF type = 'XL' THEN type = 'EXCEL'
 IF type = 'OPENOFFICE' THEN type = 'OOO'
 IF type = 'WEB' OR type = 'HTM' THEN type = 'HTML'

 IF type NE 'EXCEL' THEN basefontsize = basefontsize - 2
 IF basefontsize < 2 THEN basefontsize = 2

 basefontnames = 'xx-small x-small small medium large x-large xx-large'
 CONVERT ' ' TO @AM IN basefontnames
*
* Valid papersizes
*  1 = Letter          5 = Legal           7 = Executive       8 = A3
*  9 = A4             11 = A5             12 = B4             13 = B5
* 14 = Folio          15 = Quarto         39 = US Std fanfold
*
 BEGIN CASE
   CASE papersize = 'A4';        papersizeindex = 9
   CASE papersize = 'LETTER';    papersizeindex = 1
   CASE papersize = 'EXECUTIVE'; papersizeindex = 7
   CASE papersize = 'LEGAL';     papersizeindex = 5
   CASE papersize = 'B5';        papersizeindex = 13
   CASE papersize = 'ENV10';     papersizeindex = 15
   CASE papersize = 'DL';        papersizeindex = 19
   CASE 1;                       papersizeindex = 9;  *  Default size of A4
 END CASE

 temp = fontsize<2>
 IF fontsize<3> > fontsize<2> THEN temp = fontsize<3>

 BEGIN CASE
   CASE fontdpi = 120
     ppcw = temp;                                *  Pixels per character (for column widths)
     ppch =  2
   CASE fontdpi =  96
     ppcw =  temp * 0.8
     ppch =  1.6
   CASE 1
     ppcw = (fontdpi / 12) * (temp / 10) 'R0'
     ppch = (fontdpi / 60) 'R1'
 END CASE

 fcnt = DCOUNT(colfmt<1>, @VM)
 rptwidth = 0
 FOR column = 1 TO fcnt;                         *  Set column widths
   rptwidth += colfmt<1, column>
 NEXT column

 RETURN
*
* --------------------------------------------------------------------- *
*
updatetemplate: *  Read and fill in template.
*
 OPEN 'SYSCTRL.TEMPLATES' TO sysctrl.templates ELSE
   OPEN 'VOC' TO voc ELSE;                       * %%QM%%%%UV%%
   OPEN 'MD' TO voc ELSE;                        * %%MV%%
     htmerror = "Can't open VOC/MD"
     RETURN
   END
   rec = "Q SYSCTRL SYSCTRL.TEMPLATES"
   CONVERT ' ' TO @AM IN rec
   WRITE rec ON voc, 'SYSCTRL.TEMPLATES'
   OPEN 'SYSCTRL.TEMPLATES' TO sysctrl.templates ELSE
     htmerror = "Can't open templates file"
     RETURN
   END
 END

 IF template = '' THEN
   BEGIN CASE
     CASE type = 'EXCEL' ; template = templateexcel
     CASE type = 'OOO'   ; template = templateooo
     CASE type = 'HTML'  ; template = templateweb
   END CASE
 END

 READ htm FROM sysctrl.templates, template ELSE
   htmerror = 'Template: ':SQUOTE(template):' not on file'
   RETURN
 END
*
*  ----- Get style information
*
 xhtml = (INDEX(htm<1>, ' XHTML ', 1) > 0)
 stylelist = '.hdg1 .hdg2 .hdg3 .iadp0 .iadp1 .iadp2 .iadp3 .iadp4 .iadate .spacer .odd'
 CONVERT ' ' TO @AM IN stylelist
 dc = DCOUNT(stylelist, @AM)
 FOR ii = dc TO 1 STEP -1
   temp = INDEX(htm, stylelist<ii>, 1)
   IF NOT(temp) THEN
     DEL stylelist<ii>
   END
 NEXT ii
 CONVERT '.' TO '' IN stylelist
 numstyles = DCOUNT(stylelist, @AM)
*
*  ----- Change tags for proper values
*
 IF xhtml THEN
   htm = CHANGE(htm, '%%username%%', DQUOTE(username))
 END ELSE
   htm = CHANGE(htm, '%%username%%', username)
 END

 IF pgtitle THEN
   htm = CHANGE(htm, '%%title%%', pgtitle)
 END ELSE
   htm = CHANGE(htm, '%%title%%', 'Info/Access Report');* %%MV%%
   htm = CHANGE(htm, '%%title%%', 'QMQuery Report');* %%QM%%
   htm = CHANGE(htm, '%%title%%', 'RetrieVe Report');* %%UV%%
 END

 temp = (topmargin / 2.5) 'R2'
 htm = CHANGE(htm, '%%topmargin%%', temp)
 temp = (rightmargin / 2.5) 'R2'
 htm = CHANGE(htm, '%%rightmargin%%', temp)
 temp = (botmargin / 2.5) 'R2'
 htm = CHANGE(htm, '%%bottommargin%%', temp)
 temp = (leftmargin / 2.5) 'R2'
 htm = CHANGE(htm, '%%leftmargin%%', temp)

 temp = 'portrait'
 IF rptwidth > 120 THEN temp = 'landscape'
 htm = CHANGE(htm, '%%orientation%%', temp)


 htm = CHANGE(htm, '%%fontfamilyhdg%%', fontname<1>)
 htm = CHANGE(htm, '%%fontfamilytot%%', fontname<2>)
 htm = CHANGE(htm, '%%fontfamilydet%%', fontname<3>)

 htm = CHANGE(htm, '%%fontsizehdg%%', fontsize<1>)
 htm = CHANGE(htm, '%%fontsizetot%%', fontsize<2>)
 htm = CHANGE(htm, '%%fontsizedet%%', fontsize<3>)

 FOR ii = 1 TO 3
   temp = 400
   IF fontbold<ii> = 'Y' THEN temp = 700
   temp2 = 'normal'
   IF fontital<ii> = 'Y' THEN temp2 = 'italic'
   thisfontsize = basefontsize + 3 - ii
   IF thisfontsize > 7 THEN thisfontsize = 7
   IF thisfontsize < 2 THEN thisfontsize = 2
   BEGIN CASE
     CASE ii = 1
       fontsizeratio = (fontsize<1> * 100 / fontsize<3>) 'R0'
       htm = CHANGE(htm, '%%fontweighthdg%%', temp)
       htm = CHANGE(htm, '%%fontstylehdg%%', temp2)
       htm = CHANGE(htm, '%%fontsizenamehdg%%', basefontnames<thisfontsize>)
       htm = CHANGE(htm, '%%fontsizeratiohdg%%', fontsizeratio)
     CASE ii = 2
       fontsizeratio = (fontsize<2> * 100 / fontsize<3>) 'R0'
       htm = CHANGE(htm, '%%fontweighttot%%', temp)
       htm = CHANGE(htm, '%%fontstyletot%%', temp2)
       htm = CHANGE(htm, '%%fontsizenametot%%', basefontnames<thisfontsize>)
       htm = CHANGE(htm, '%%fontsizeratiotot%%', fontsizeratio)
     CASE ii = 3
       fontsizeratio = (fontsize<3> * 100 / fontsize<3>) 'R0'
       htm = CHANGE(htm, '%%fontweightdet%%', temp)
       htm = CHANGE(htm, '%%fontstyledet%%', temp2)
       htm = CHANGE(htm, '%%fontsizenamedet%%', basefontnames<thisfontsize>)
       htm = CHANGE(htm, '%%fontsizeratiodet%%', fontsizeratio)
   END CASE
 NEXT ii

 htm = CHANGE(htm, '%%tabname%%', tabname)
 htm = CHANGE(htm, '%%papersizeindex%%', papersizeindex)

 tempd = OCONV(DATE(), 'DY')* 10000 + OCONV(DATE(), 'DM') * 100 + OCONV(DATE(), 'DD')
 tempt = OCONV(TIME(), 'MT')
 CONVERT ':' TO '' IN tempt
 tempt = tempt:'0000'

 htm = CHANGE(htm, '%%datetimecreated%%', DQUOTE(tempd:';':tempt))
 htm = CHANGE(htm, '%%datetimechanged%%', DQUOTE(tempd:';':tempt))

 RETURN
*
* ------------------------------------------------------------------------- *
*
htmlbody: * Create body of page.
*
 htmbody = '  <table frame=void cellspacing=0 cols=':fcnt:' rules=groups border=0 >'
 htmbody := @AM:'    <thead>'

 GOSUB htmlcolumnwidths
 GOSUB htmlpageheading
 GOSUB htmlcolumnheading
 fixedrows = hdgrows

 htmbody := @AM:'    </thead>'
 htmbody := @AM:'    <tbody>'

 GOSUB htmldata
 GOSUB htmlfooting

 htmbody := @AM:'    </tbody>'
 htmbody := @AM:'  </table>'

 htm = CHANGE(htm, '%%printtitles%%', '=':tabname:'!$1:$':fixedrows)
 htm = CHANGE(htm, '%%body%%', htmbody)

 RETURN
*
* --------------------------------------------------------------------- *
*
htmlcolumnwidths: *  Set column widths.
*
 IF type = 'EXCEL' THEN
   htmtemp = '    <colgroup>'
   FOR column = 1 TO fcnt;                       *  Set column widths
     cw = colfmt<1, column>
     htmtemp := '<col width=':DQUOTE(cw):'>'
   NEXT column
   htmtemp := '</colgroup>'
   htmbody := @AM:htmtemp
 END

 IF type = 'OOO' THEN
   htmtemp = '      <tr>';                       *  Put in 'dummy' row in Open Office to define column widths
   FOR column = 1 TO fcnt
     cw = colfmt<1, column>
     htmtemp := '<td width=':DQUOTE(cw)
     IF column = 1 THEN htmtemp := ' height="8"'
     htmtemp := '> </td>'
   NEXT column
   htmtemp := '</tr>'
   htmbody := @AM:htmtemp
 END

 RETURN
*
* --------------------------------------------------------------------- *
*
htmlpageheading: *  Define page heading.
*
 hdgrows = 0
 IF hdgfmt > '' THEN;                            *  Page heading
   fmtstr = hdgfmt
   GOSUB calchdrwidths
   hdgrows = level
   IF hdgrows THEN hdgrows += 1

   FOR row = 1 TO level
     BEGIN CASE
       CASE row = 1
         xlclass = 'hdg1'
         row1 = 1
         fsize = (fontsize<1> > fontsize<2>) + (fontsize<2> > fontsize<3>) + basefontsize

       CASE row = 2
         xlclass = 'hdg2'
         row1 = 2
         fsize = (fontsize<2> > fontsize<3>) + basefontsize

       CASE 1
         xlclass = 'hdg3'
         row1 = 3
         fsize = basefontsize
     END CASE
     htmtemp = '      <tr>'

     LOCATE xlclass IN stylelist SETTING spsn THEN hasstyle = SY$TRUE ELSE hasstyle = SY$FALSE
     FOR column = 1 TO 3
       IF tw<column> > 0  OR span<column> > 0 THEN
         BEGIN CASE
         CASE hasstyle;     htmtemp := '<td class=':DQUOTE(xlclass)
         CASE type = 'OOO';  htmtemp := '<td height=':DQUOTE((fontsize<row1> * ppch) 'R0')
         CASE 1;             htmtemp := '<td'
         END CASE
         IF span<column> > 1 THEN htmtemp := ' colspan=':DQUOTE(span<column>)

         BEGIN CASE
           CASE column = 1; htmtemp := ' align="left">'
           CASE column = 2; htmtemp := ' align="center">'
           CASE 1;          htmtemp := ' align="right">'
         END CASE

         IF (type = 'OOO') AND (numstyles = 0) THEN
           htmtemp := '<FONT FACE=':DQUOTE(fontname<row1>)
           IF fontsize<row1> > fontsize<3> THEN htmtemp := ' SIZE=':DQUOTE(fsize)
           htmtemp := '>'
           IF fontbold<row1> = 'Y' THEN htmtemp := '<b>'
           IF fontital<row1> = 'Y' THEN htmtemp := '<i>'
         END

         tvalue = hdgfmt<column, row>
         tvalue = CHANGE(tvalue, '&', '&amp;')

         IF TRIM(tvalue) = '' THEN
           IF xhtml THEN tvalue = '<br />' ELSE tvalue = '<br>'
         END
         htmtemp := tvalue

         IF (type = 'OOO') AND (numstyles = 0) THEN
           IF fontbold<row1> = 'Y' THEN htmtemp := '</b>'
           IF fontital<row1> = 'Y' THEN htmtemp := '</i>'
           htmtemp := '</FONT>'
         END
         htmtemp := '</td>'
       END
     NEXT column
     htmtemp := '</tr>'
     htmbody := @AM:htmtemp
   NEXT row
   htmtemp = '      <tr'
   IF INDEX(stylelist, 'spacer', 1) THEN htmtemp := ' class="spacer"'
   htmtemp := '><td colspan=':fcnt:'> </td></tr>'
   htmbody := @AM:htmtemp
 END

 RETURN
*
* --------------------------------------------------------------------- *
*
htmlcolumnheading: *  Define column headings.
*
 hdgdepth = 1
 FOR column = 1 TO fcnt
   temp = DCOUNT(colhdgs<column>, @VM)
   IF temp > hdgdepth THEN hdgdepth = temp
 NEXT column
 hdgrows += hdgdepth
 IF hdgdepth THEN hdgrows += 1

 FOR row = 1 TO hdgdepth;                        *  column headings
   htmtemp = '      <tr>'

   FOR column = 1 TO fcnt
     htmtemp := '<th align='
     BEGIN CASE
       CASE colfmt<2, column> = 'R';  htmtemp := DQUOTE('right')
       CASE 1;                        htmtemp := DQUOTE('left')
     END CASE
!     htmtemp := ' bgcolor=':bgcolour:'>'
     htmtemp := '>'

     tvalue = colhdgs<column, row>
     tvalue = CHANGE(tvalue, '&', '&amp;')
     IF TRIM(tvalue)[1,1] = '$' THEN tvalue = '&nbsp;':tvalue
     IF TRIM(tvalue) = '' THEN
       IF xhtml THEN tvalue = '<br />' ELSE tvalue = '<br>'
     END

     IF type = 'OOO' THEN htmtemp := '<FONT FACE="':fontname<3>:'">'
     htmtemp := tvalue
     IF type = 'OOO' THEN htmtemp := '</FONT>'
     htmtemp := '</th>'
   NEXT column
   htmtemp := '</tr>'
   htmbody := @AM:htmtemp
 NEXT row

 htmtemp = '      <tr';                     *  Blank row between column headers and data
 BEGIN CASE
   CASE INDEX(stylelist, 'spacer', 1) ; htmtemp := ' class="spacer"'
   CASE (type = 'OOO') AND (numstyles = 0) ; htmtemp := ' height=':(fontsize<3> * ppch / 2) 'R0'
 END CASE
 htmtemp := '><td colspan=':fcnt:'> </td></tr>'
 htmbody := @AM:htmtemp


 RETURN
*
* --------------------------------------------------------------------- *
*
htmldata: *  Define body of page.
*
 norows = DCOUNT(datavec, @AM)
 totalsflag = SY$FALSE

 isodd = SY$FALSE
 LOCATE 'hdg2' IN stylelist SETTING spsn THEN hasstyle = SY$TRUE ELSE hasstyle = SY$FALSE

 FOR row = 1 TO norows;                          *  Data output
   spancnt = 0
   hasdata = SY$FALSE
   thisrow = datavec<row>;                       *  Extract row of data
   isodd = NOT(isodd)
   IF isodd AND INDEX(stylelist, 'odd', 1) THEN
     htmtemp = '      <tr class="odd">'
   END ELSE
     htmtemp = '      <tr>'
   END

   IF totalsflag THEN;                           *  Allow column spanning in break fields
     fontname.temp = fontname<2>
     fontsize.temp = (fontsize<2> > fontsize<3>) + basefontsize
     boldflag = fontbold<2>
     italflag = fontital<2>

     column = 0
     LOOP
       column += 1
     UNTIL column GT fcnt DO
         btflag = colfmt<4, column>

         IF btflag = 'B' THEN;                   *  column spanning starts in break fields
           spancnt = 0
           LOOP
             spancnt += 1
             testcolumn = column + spancnt
             nextbtflag = colfmt<4, testcolumn>
           UNTIL nextbtflag OR testcolumn GT fcnt DO REPEAT
           endcolumn = testcolumn - 1
           GOSUB tdadd
           column = endcolumn
         END ELSE;                               *  Not a break field ==> normal display
           spancnt = 0
           GOSUB tdadd
         END
     REPEAT
   END ELSE;                                     *  Not a total line ==> normal display
     fontname.temp = fontname<3>
     fontsize.temp = basefontsize
     boldflag = fontbold<3>
     italflag = fontital<3>
     spancnt = 0
     FOR column = 1 TO fcnt
       GOSUB tdadd
     NEXT column
   END

   htmtemp := '</tr>'
   IF INDEX(thisrow, '---', 1) OR INDEX(thisrow, '===', 1) OR NOT(hasdata) THEN
     IF INDEX(stylelist, 'spacer', 1) THEN
       htmtemp = CHANGE(htmtemp, '<tr>', '<tr class="spacer">')
       htmtemp = CHANGE(htmtemp, '<tr class="odd">', '<tr class="odd spacer">')
     END
   END

   IF totalsflag THEN;                           *  Set/Reset totals flag
     totalsflag = SY$FALSE
     IF hasstyle THEN
       htmtemp = CHANGE(htmtemp, '<tr>', '<tr class="hdg2">')
       htmtemp = CHANGE(htmtemp, '<tr class="odd">', '<tr class="odd hdg2">')
     END
   END
   htmbody := @AM:htmtemp

   IF INDEX(thisrow, '---', 1) OR INDEX(thisrow, '===', 1) THEN
     totalsflag = SY$TRUE
   END
 NEXT row

 RETURN
*
* --------------------------------------------------------------------- *
*
htmlfooting: *  Define footing block.
*
 IF ftgfmt > '' THEN;                            *  Page footing
   fmtstr = ftgfmt
   GOSUB calchdrwidths

   FOR row = 1 TO level
     htmtemp = '      <tr>'
     FOR column = 1 TO 3
       IF tw<column> > 0 OR span<column> > 0 THEN
         htmtemp := '<td'
         IF (type = 'OOO') AND (numstyles = 0) AND (column = 1) THEN
           htmtemp := ' height=':(fontsize<3> * ppch) 'R0'
         END
         IF span<column> > 1 THEN
           htmtemp := ' colspan=':span<column>
         END

         BEGIN CASE
           CASE column = 1; htmtemp := ' align="left"><b>'
           CASE column = 2; htmtemp := ' align="center"><b>'
           CASE 1;          htmtemp := ' align="right"><b>'
         END CASE
         IF (type = 'OOO') AND (numstyles = 0) THEN
           htmtemp := '<b>'
           htmtemp := '<FONT FACE="':fontname<3>:'" SIZE=':basefontsize:'>'
         END

         tvalue = ftgfmt<column, row>
         tvalue = CHANGE(tvalue, '&', '&amp;')

         IF TRIM(tvalue) = '' THEN
           IF xhtml THEN tvalue = '<br />' ELSE tvalue = '<br>'
         END
         htmtemp := tvalue

         IF (type = 'OOO') AND (numstyles = 0) THEN
           htmtemp := '</FONT></b>'
         END
         htmtemp := '</td>'
       END
     NEXT column
     htmtemp := '</tr>'
     htmbody := @AM:htmtemp
   NEXT row
 END

 RETURN
*
* --------------------------------------------------------------------- *
*
tdadd: *  Add TD element to output string.
*
 tvalue = thisrow<1, column>
 IF spancnt GT 1 THEN
   FOR ii = 2 TO spancnt
     tvalue := thisrow<1, column + ii - 1>
   NEXT ii
 END
 IF tvalue > '' THEN hasdata = SY$TRUE
 tddatatype = @SY.DATATYPE(tvalue);                *  %%MV%%
 tddatatype = SY.DATATYPE(tvalue);                 *  %%QM%%%%UV%%

 htmtemp := '<td'
 IF spancnt GT 1 THEN
   htmtemp := ' colspan=':DQUOTE(spancnt)
 END

 BEGIN CASE
   CASE colfmt<2, column> = 'R';  align = 'right'
   CASE 1;                        align = 'left'
 END CASE
 htmtemp := ' align=':DQUOTE(align)

 BEGIN CASE
   CASE type = 'EXCEL'
     GOSUB tdexcel
   CASE type = 'OOO'
     GOSUB tdooo
   CASE 1
     GOSUB tdweb
 END CASE
 htmtemp := '>'

 IF NOT(xhtml) AND NOT(hasstyle) THEN
   IF boldflag = 'Y' THEN htmtemp := '<b>'
   IF italflag = 'Y' THEN htmtemp := '<i>'
 END

 tvalue = CHANGE(tvalue, '&', '&amp;')
 IF TRIM(tvalue) = '' THEN
   IF xhtml THEN tvalue = '<br />' ELSE tvalue = '<br>'
 END
 IF tvalue[1,3] = '===' THEN
   IF type = 'OOO' THEN
     tvalue = "'":tvalue
   END
 END

 IF type = 'OOO' AND NOT(xhtml) THEN
   htmtemp := '<FONT FACE=':DQUOTE(fontname.temp):' SIZE=':fontsize.temp:'>'
 END
 htmtemp := tvalue

 IF type = 'OOO' AND NOT(xhtml) THEN htmtemp := '</FONT>'
 IF NOT(xhtml) AND NOT(hasstyle) THEN
   IF italflag = 'Y' THEN htmtemp := '</i>'
   IF boldflag = 'Y' THEN htmtemp := '</b>'
 END
 htmtemp := '</td>'

 RETURN
*
* --------------------------------------------------------------------- *
*
tdexcel: *  Cell contents for Excel.
*
 BEGIN CASE
   CASE tddatatype = 'N'
     IF colfmt<3, column> > '' THEN htmtemp := ' class=':DQUOTE('iadp':colfmt<3, column>)
     tvalue1 = tvalue
     CONVERT ',' TO '' IN tvalue1
     htmtemp := ' x:num'
     IF tvalue NE tvalue1 THEN htmtemp := '=':DQUOTE(tvalue1)

   CASE tddatatype = 'D'
     xldate = @SY.EXCELDATE(tvalue);             *  %%MV%%
     xldate = SY.EXCELDATE(tvalue);              *  %%QM%%%%UV%%
     htmtemp := ' class=iadate x:num=':DQUOTE(xldate)

   CASE 1
     NULL
 END CASE

 IF totalsflag AND fontsize<2> NE fontsize<3> THEN
   htmtemp := ' style=font-size:':fontsize<2>:'pt'
 END

 RETURN
*
* --------------------------------------------------------------------- *
*
tdooo: *  Cell contents for Open Office.
*
 IF column = 1 THEN
   htmtemp := ' height=':(fontsize<3> * ppch) 'R0'
 END

 BEGIN CASE
   CASE tddatatype = 'N'
     IF colfmt<3, column> > '' THEN
       BEGIN CASE
         CASE colfmt<3, column> = 0;  dpformat = '#,##0'
         CASE colfmt<3, column> = 1;  dpformat = '#,##0.0'
         CASE colfmt<3, column> = 2;  dpformat = '#,##0.00'
         CASE colfmt<3, column> = 3;  dpformat = '#,##0.000'
         CASE colfmt<3, column> = 4;  dpformat = '#,##0,0000'
       END CASE
       tvalue1 = tvalue
       CONVERT ',' TO '' IN tvalue1
       htmtemp := ' SDVAL=':DQUOTE(tvalue1):' SDNUM=':DQUOTE('5129;0;':dpformat)
     END

   CASE tddatatype = 'D'
     xldate = @SY.EXCELDATE(tvalue);             *  %%MV%%
     xldate = SY.EXCELDATE(tvalue);              *  %%QM%%%%UV%%
     htmtemp := ' SDVAL=':DQUOTE(xldate):' SDNUM=':DQUOTE('5129;0;DD/MM/YY')

   CASE 1
     NULL
 END CASE

 RETURN
*
* --------------------------------------------------------------------- *
*
tdweb: *  Cell contents for Web browser.
*
 IF tddatatype = 'N' THEN
   fmtmask = colfmt<2,column>:colfmt<3,column>:','
   tvalue = tvalue fmtmask
 END

 RETURN
*
* --------------------------------------------------------------------- *
*
calchdrwidths: *  Calculate width of table for heading/footing.
*
 level = 1
 FOR column = 1 TO 3
   temp = DCOUNT(fmtstr<column>, @VM)
   IF temp > level THEN level = temp;            *  Get depth of heading
 NEXT column

 tw = '';                                        *  Total width
 seccnt = 0
 FOR column = 1 TO 3
   mw = 0;                                       *  Max width of this section
   FOR row = 1 TO level
     row1 = row
     IF row1 > 3 THEN row1 = 3
     temp = (LEN(fmtstr<column, row>) * ppcw * fontsize<row1> / fontsize<3>) 'R0'
     IF temp GT mw THEN mw = temp
   NEXT row
   tw<column> = mw
   seccnt = seccnt + (mw > 0);                   *  Count columns with data
 NEXT column

 span = '0':@AM:'0':@AM:'0';                     *  Number of columns to span for this section
 xsspan = '0':@AM:'0':@AM:'0';                   *  Amount of excess space allocated to this section
 IF seccnt = 1 THEN;                             *  Only one section to header/footer
   FOR ii = 1 TO 3
     IF tw<ii> GT 0 THEN span<ii> = fcnt
   NEXT ii
   RETURN
 END

 spanwidth = 0
 IF tw<1> > 0 THEN;                              *  Left section
   ii = 0
   LOOP
     ii += 1
     span<1> = ii
     spanwidth<1> += colfmt<1, ii>
   UNTIL (spanwidth<1> GE tw<1>) OR (ii GE fcnt) DO REPEAT
   xsspan<1> = spanwidth<1> - tw<1>
 END

 spanwidth<3> = 0
 IF tw<3> > 0 THEN;                              *  Right section
   minii = span<1> + 1
   ii = fcnt
   LOOP
     ii = ii - 1
     span<3> = fcnt - ii
     spanwidth<3> += colfmt<1, ii>
   UNTIL (spanwidth<3> GE tw<3>) OR (ii LE minii) DO REPEAT
   xsspan<3> = spanwidth<3> - tw<3>
 END

 spanwidth<2> = 0
 IF tw<2> > 0 THEN;                              *  Middle section
   maxii = fcnt - span<1> - span<3>
   ii = span<1>
   LOOP
     ii += 1
     span<2> = ii - span<1>
     spanwidth<2> += colfmt<1, ii>
   UNTIL (spanwidth<2> GE tw<2>) OR (ii GE maxii) DO REPEAT
   xsspan<2> = spanwidth<2> - tw<2>
 END

 totspan = span<1> + span<2> + span<3>
 temp = fcnt - totspan;                          *  Residual columns to be spanned
 BEGIN CASE
   CASE seccnt = 3
     IF temp > 0 THEN;                           *  Otherwise spanning will exceed column widths
       span<2> = fcnt - span<1> - span<3>
     END
   CASE 1
     IF temp > 0 THEN
       hicol = 0
       hicolw = 0
       FOR ii = 1 TO 3
         IF span<ii> GT hicolw THEN
           hicolw = span<ii>
           hicol = ii
         END
       NEXT ii
       span<hicol> += temp
     END
 END CASE

 RETURN
*
* --------------------------------------------------------------------- *
*
 END