home *** CD-ROM | disk | FTP | other *** search
/ Chip 2001 October / Chip_2001-10_cd1.bin / zkuste / delphi / nastroje / RTF2HTML.ZIP / r2hconv.pas < prev    next >
Pascal/Delphi Source File  |  1998-07-15  |  107KB  |  2,721 lines
  1. unit r2hconv;
  2.  
  3. interface
  4.  
  5.  
  6. uses Classes, SysUtils, Mdfuncs;
  7.  
  8.  
  9. const                               { Pseudo-enum fⁿr Tabellen-Behandlung }
  10.     plain : integer = 0;
  11.     in_cell : integer = 1;
  12.     cell_end : integer = 2;
  13.     row_end : integer = 3;
  14.  
  15.  
  16.     fontsOpt : integer = 3;         { Die ersten <fontsOpt> Schriftarten in der font table werden bei Redundanz }
  17.                                     { im HTML-Code wegoptimiert (sofern Flag 'optimize' gesetzt ist)            }
  18.  
  19.     ul_indent : integer = 285;      { left indent wird in (left indent DIV ul_indent) <UL>s umgewandelt       }
  20.                                     { je kleiner dieser Wert ist, desto feiner sind die Level-Unterteilungen, }
  21.                                     { aber es werden auch umso mehr <UL>s pro Einzug generiert                } 
  22.  
  23. type format = record
  24.     invis : boolean;                { versteckter Text }
  25.     caps : boolean;                 { Blockschrift }
  26.     bold : boolean;                 { fett }
  27.     italic : boolean;               { kursiv }
  28.     underline : boolean;            { unterstrichen }
  29.     superscript : boolean;          { hochgestellt }
  30.     subscript : boolean;            { tiefgestellt }
  31.     strike : boolean;               { durchgestrichen }
  32.     font : integer;                 { Schriftart }
  33.     fcol : string;                  { Text-Fabe }
  34.     fsize : integer;                { Text-Gr÷▀e }
  35.     rjustified : boolean;           { rechtsbⁿndig }
  36.     centered : boolean;             { zentriert }
  37.     table : integer;                { Tabelle }
  38. end;
  39.  
  40. type font = record
  41.     name : string;
  42.     number : integer;
  43. end;
  44.  
  45. type
  46.     stackptr = ^stackelem;     { der Formatierungs-Stack }
  47.     stackelem = record
  48.     tagstart : string;
  49.     tagend : string;
  50.     next : stackptr;
  51. end;
  52.  
  53. type
  54.     strlptr = ^slelem;
  55.     slelem = record
  56.     lstring : string;
  57.     next : strlptr;
  58. end;
  59.  
  60. type enumlist = record
  61.     doclvl : integer;
  62.     lvl : integer;
  63.     indent : array[0..20] of integer;
  64. end;
  65.  
  66. type ss = record
  67.     name : string;
  68.     ctrl : string;
  69. end;
  70.  
  71. type flags = record
  72.     noFonts : boolean;
  73.     optimize : boolean;
  74.     onlyDefiniteOpt : boolean;
  75. end;
  76.  
  77. var
  78.     flag : flags;
  79.     stylesheet : array [0..300] of ss;
  80.     killstr : strlptr;
  81.     col : TStringList;
  82.     fonts : array[0..200] of font;
  83.     linkstyles, anchstyles, actlinknum, actanchnum : array [1..9] of integer;
  84.  
  85.     outstring, pntxta, pntxtb, enumtxt, txtwait : string;
  86.     invis, bkmkpar, lastline, li_open, listitem, listbull, pnnum, nextpar, enumdigit : boolean;
  87.     ahref, anchor, ahrefwait, newhrefnum, no_newind : boolean;
  88.  
  89.     changefmt : boolean;
  90.     mainstack : stackptr;
  91.  
  92.     anchlvl, indexlvl, lastindent, lvlnum, globbrk : integer;
  93.  
  94.     enums : enumlist;
  95.     
  96.  
  97. procedure rtf2html (filename: string; destfilename: string; param: array of string);
  98.  
  99.  
  100. implementation
  101.  
  102. {  ************************************************************************  }
  103. {                                                                            }
  104. {  RTF2HTML V 2.1                                                            }
  105. {  by hr                                                                     }
  106. {  last change:  15-07-98                                                    }
  107. {                                                                            }
  108. {  Diese Version sollte weniger komplexe RTF-Files fehlerfrei bzw.           }
  109. {  komplexere RTF-Files layoutmΣ▀ig weitestgehend korrekt ⁿbersetzen k÷nnen  }
  110. {                                                                            }
  111. {  Aufruf-Parameter:                                                         }
  112. {                                                                            }
  113. {  -  'optimize'                                                             }
  114. {     eliminiert ⁿberflⁿssige HTML-Tags wie zb. '<B></B>' oder </SUB><SUB>   }
  115. {  -  'onlyDefiniteOpt'                                                      }
  116. {     sorgt dafⁿr, das Strings wie '</FONT><FONT FACE="Arial">' NICHT        }
  117. {     wegoptimiert werden, da das schlie▀ende </FONT>-Tag u.u. eine andere   }
  118. {     Anweisung als <FONT FACE="Arial"> hier im Beispiel deaktivieren        }
  119. {     k÷nnte                                                                 }
  120. {  -  'noFonts'                                                              }
  121. {     deaktiviert alle <FONT FACE="...">-Anweisungen                         }
  122. {                                                                            }
  123. {  Folgendes wird, so weit im HTML 3 m÷glich, Σquivalent ⁿbersetzt:          }
  124. {                                                                            }
  125. {  -  Stylesheets im allgemeinen (flie▀t in die spezifischen Zeilen-         }
  126. {     Formatierungen mit ein)                                                }
  127. {  -  bold, italic, underline, strikethrough, subscript, superscript         }
  128. {  -  center, left/right justified                                           }
  129. {  -  AufzΣhlungen aller Arten                                               }
  130. {  -  left indents (mittels <UL>-Schachtelungen)                             }
  131. {  -  Zeilenumbruch/Absatz                                                   }
  132. {  -  etwaige Farb-/Schriftart-/Schriftgr÷▀e-Formatierungen                  }
  133. {  -  Sonderzeichen ( ' " <   usw.)                                          }
  134. {  -  Tabellen                                                               }
  135. {                                                                            }
  136. {  Folgendes kann Fehler bzw. unerwⁿnschte Ergebnisse verursachen            }
  137. {  (known 'bugs'):                                                           }
  138. {                                                                            }
  139. {  -  Der Aufrufparameter 'optimize' bewirkt, da▀ auch Zeichenketten wie     }
  140. {     '</FONT><FONT FACE="Arial">' gnadenlos wegoptimiert werden kann, was   }
  141. {     leicht in Formatierungs-Fehlern (NICHT HTML-Syntax-Fehlern) enden      }
  142. {     kann; Abhilfe: Parameter 'onlyDefiniteOpt'                             }
  143. {  -  ▄bernahme von Text-Formatierungen in eine Tabelle, wenn eine solche    }
  144. {     beginnt, was in RTF rein theoretisch m÷glich ist, findet NICHT statt   }
  145. {     GRUND:   1. werden beim Beginn einer Tabelle normalerweise ohnehin     }
  146. {                 alle Text-Formatierungen zurⁿckgesetzt                     }
  147. {              2. mⁿ▀te man eine 'mitgeschleifte' Formatierung in einer      }
  148. {                 HTML-Tabelle Feld fⁿr Feld neu setzen und am Feld-Ende     }
  149. {                 wieder l÷schen  --->  das ausgespuckte HTML-File wird      }
  150. {                 **SEHR** gro▀                                              }
  151. {  -  AufzΣhlungen in Tabellenfeldern (soll's ja auch geben) werden nur      }
  152. {     mit Pseudo-Tabs und ·'s ⁿbersetzt (ohne <UL>, <LI>)              }
  153. {  -  wenig sinnvolle RTF-Dokumente mit Punkten im Inhaltsverzeichnis,       }
  154. {     zu denen keine entsprechende ▄berschrift existiert verursachen         }
  155. {     HTML-Dokumente mit Phantasie-Referenzen                                }
  156. {                                                                            }
  157. {  Folgendes wird in der vorliegenden Version ignoriert:                     }
  158. {                                                                            }
  159. {  -  Kopf-/Fu▀zeile                                                         }
  160. {  -  File Tables                                                            }
  161. {  -  Bilder  (Text-Hinweis wird im Html-Dokument angezeigt)                 }
  162. {  -  bestimmte rtf-spezifische Formatierungen                               }
  163. {  -  Dokument-Infos                                                         }
  164. {                                                                            }
  165. {  ************************************************************************  }
  166. {  History:                                                                  }
  167. {                                                                            }
  168. {  V 1.0:  - erste offizielle Version                                        }
  169. {                                                                            }
  170. {  V 1.1:  - Bug in IgnoreGroup() entfernt (Index binind wurde nicht erh÷ht) }
  171. {          - Function empty() zum Leeren der Stacks                          }
  172. {          - ─nderung bei der Behandlung von Gruppen-Enden                   }
  173. {          - ─nderung bei der Darstellung von Bullet-Listen                  }
  174. {                                                                            }
  175. {  V 1.2:  - ▄bersetzung von Tabellen (neue Prozedur ProcessTable() )        }
  176. {          - erweiterte Sonderzeichen-Behandlung                             }
  177. {          - AufzΣhlungen/Listen werden jetzt als Symbol+Text nach HTML      }
  178. {            konvertiert (ohne <UL> bzw. <OL>-Tags)                          }
  179. {          - kleine Layout-Bereinigungen                                     }
  180. {                                                                            }
  181. {  V 1.3:  - ─nderung bei der Behandlung von Gruppen-AnfΣngen (neue Pro-     }
  182. {            zeduren CopyStack(), CopyAttrib() )                             }
  183. {          - neue Prozedur htmlchar() zur korrekten Ausgabe von Dokument-    }
  184. {            Text                                                            }
  185. {          - Bug in chfmt() entfernt (in einzelnen FΣllen wurden Format-     }
  186. {            Flags falsch gesetzt)                                           }
  187. {                                                                            }
  188. {  V 2.0:  - Einbindung von Stylesheets (neue Procedures initstyles(),       }
  189. {            plainchar() )                                                   }
  190. {          - Inhaltsverzeichnis/▄berschrift-Verweis-Strukturen werden        }
  191. {            in HTML-Sprungmarken umgewandelt                                }
  192. {          - W÷rter, die mit 'http://' beginnen, werdem automatisch in       }
  193. {            Hyperlinks umgewandelt (neue Prozedur incl_hlink() )            }
  194. {          - AufzΣhlungen (auch geschachtelt) werden als entsprechend        }
  195. {            strukturierte <UL>'s nach HTML konvertiert                      }
  196. {          - verbesserte HTML-Code-Optimierfunktion                          }
  197. {          - neue Procedures addfontname(), addcolstr(), add_ks() zur        }
  198. {            Unterstⁿtzung von optim()                                       }
  199. {          - Aufrufparameter fⁿr rtf2html() zum Variieren der Konvertier-    }
  200. {            Vorgangsweisen                                                  }
  201. {          - Globale Liste von 'left indents', womit Einzⁿge bei Auf-        }
  202. {            zΣhlungen im RTF-Doc. in (halbwegs) entsprechend tiefe          }
  203. {            <UL>-Schachtelungen umgewandelt werden                          }
  204. {          - diverse kleine Layout-─nderungen                                }
  205. {                                                                            }
  206. {  V 2.1:  - ⁿberarbeiteter Formatierungs-Algorithmus                        }
  207. {          - alle left indents werden nun mittels <UL>-Schachtelungen,       }
  208. {            so weit m÷glich, ⁿbersetzt                                      }
  209. {                                                                            }
  210. {  ************************************************************************  }
  211.  
  212. procedure add_ks (st: string);
  213. var
  214.     helpp : strlptr;
  215. begin
  216.     New(helpp);
  217.     helpp^.lstring := st;
  218.     helpp^.next := killstr;
  219.     killstr := helpp;
  220. end;
  221.  
  222. procedure init_killstr;
  223. begin
  224.     killstr := NIL;
  225.     add_ks('<FONT SIZE=-2></FONT>');
  226.     add_ks('<FONT SIZE=-1></FONT>');
  227.     add_ks('<FONT SIZE=+0></FONT>');
  228.     add_ks('<FONT SIZE=+1></FONT>');
  229.     add_ks('<FONT SIZE=+2></FONT>');
  230.     add_ks('<FONT SIZE=+3></FONT>');
  231.     add_ks('<FONT SIZE=+4></FONT>');
  232. end;
  233.  
  234. function optim (src: string): string;   { eliminiert ⁿberflⁿssige Formatierungs-Anweisungen }
  235. var
  236.     line, comp : string;
  237.     helpp : strlptr;
  238.  
  239. begin
  240.     line := src;
  241.  
  242.     repeat
  243.         comp := line;
  244.  
  245.         if flag.optimize then
  246.         begin
  247.             line := ReplaceAll(['<B></B>','<I></I>','<U></U>','</B><B>','</I><I>','</U><U>'],['','','','','',''],line);
  248.             line := ReplaceAll(['<SUP></SUP>','<SUB></SUB>','<S></S>','</SUP><SUP>','</SUB><SUB>','</S><S>'],['','','','','',''],line);
  249.             line := ReplaceAll(['<CENTER></CENTER>','</CENTER><CENTER>','<DIV ALIGN=right></DIV>','</DIV><DIV ALIGN=right>'],['','','',''],line);
  250.         end;
  251.  
  252.         line := ReplaceAll(['<UL></UL>','</UL><UL>'],['',''],line);
  253.  
  254.         if flag.optimize then
  255.         begin
  256.             helpp := killstr;
  257.             while (helpp <> NIL) do
  258.             begin
  259.                 line := ReplaceIn(helpp^.lstring, '', line);
  260.                 helpp := helpp^.next;
  261.             end;
  262.         end;
  263.  
  264.     until line = comp;
  265.  
  266.     Result := line;
  267. end;
  268.  
  269. {  ************************************************************************  }
  270.  
  271. procedure incl_hlink (var line: string);
  272. var
  273.    helpstr, htxt, str : string;
  274.    h, h_end, strlen : integer;
  275.  
  276. begin
  277.     str := line;
  278.  
  279.     h := Pos('http://', str);
  280.     helpstr := '';
  281.  
  282.     while h > 0 do
  283.     begin
  284.         h_end := h + 7;
  285.         strlen := length(str);
  286.  
  287.         while (str[h_end] <> '<')
  288.         and (str[h_end] <> ' ')
  289.         and (str[h_end] <> ',')
  290.         and (h_end <= strlen) do
  291.             Inc(h_end);
  292.  
  293.         htxt    := Copy(str, h, h_end-h);
  294.         helpstr := helpstr + Copy(str, 1, h-1) + '<A HREF="' + htxt + '">' + htxt + '</A>';
  295.         str     := Copy(str, h_end, length(str));
  296.  
  297.         h := Pos('http://', str);
  298.     end;
  299.  
  300.     line := helpstr + str;
  301. end;
  302.  
  303. {  ************************************************************************  }
  304.  
  305. procedure WriteHtml (const txt: string; var outstring: string; var outfile: textfile);
  306. var
  307.     i, strlen: integer;
  308.     str, htxt: string;
  309.     par, br: boolean;
  310.  
  311. begin
  312.     if length(txt) > 0 then
  313.     begin
  314.         outstring := outstring + txt;
  315.  
  316.         par := false;
  317.         br := false;
  318.  
  319.         str := optim(outstring);
  320.  
  321.         strlen := length(str);
  322.  
  323.         i := Pos('<P>', str) + 2;
  324.         if i = 2 then
  325.         begin
  326.             i := Pos('<BR>', str) + 3;
  327.             if i > 3 then br := true;
  328.         end
  329.         else
  330.             par := true;
  331.  
  332.         if (br) or (par) or (strlen > 100) then
  333.         begin
  334.             while par or br do
  335.             begin
  336.                 htxt := Copy(str, 1, i);
  337.                 incl_hlink(htxt);
  338.  
  339.                 WriteLn(outfile, htxt);
  340.                 str := Copy(str, i+1, length(str)-i);
  341.  
  342.                 par := false;
  343.                 br := false;
  344.  
  345.                 i := Pos('<P>', str) + 2;
  346.                 if i = 2 then
  347.                 begin
  348.                     i := Pos('<BR>', str) + 3;
  349.                     if i > 3 then br := true;
  350.                 end
  351.                 else
  352.                     par := true;
  353.             end;
  354.  
  355.             outstring := str;
  356.             strlen := length(str);
  357.  
  358.             if  (strlen > 100)
  359.             and (outstring[strlen] = '>')
  360.             and (outstring[strlen-1] <> 'L')
  361.             and (outstring[strlen-1] <> 'A') then
  362.             begin
  363.                 incl_hlink(outstring);
  364.                 WriteLn(outfile, outstring);
  365.                 outstring := '';
  366.             end;
  367.         end;
  368.     end; { if length(txt) > 0 ... }
  369. end;
  370.  
  371. {  ************************************************************************  }
  372.  
  373. function hex2dec (hex: string): integer;  { hexadezimal -> dezimal - Konvertierung fⁿr Zahlen <= 255 }
  374. var
  375.     i : integer;
  376.  
  377. begin
  378.     Result := 0;
  379.     for i := 1 to 2 do
  380.         if (hex[i] = 'A') or (hex[i] = 'a') then Result := Result*16 + 10
  381.         else if (hex[i] = 'B') or (hex[i] = 'b') then Result := Result*16 + 11
  382.         else if (hex[i] = 'C') or (hex[i] = 'c') then Result := Result*16 + 12
  383.         else if (hex[i] = 'D') or (hex[i] = 'd') then Result := Result*16 + 13
  384.         else if (hex[i] = 'E') or (hex[i] = 'e') then Result := Result*16 + 14
  385.         else if (hex[i] = 'F') or (hex[i] = 'f') then Result := Result*16 + 15
  386.         else Result := Result*16 + strtoint(hex[i]);
  387. end;
  388.  
  389. {  ************************************************************************  }
  390.  
  391. function dec2hex (num: integer): string;  { dezimal -> hexadezimal - Konvertierung fⁿr Zahlen <= 255 }
  392. var
  393.     hex : string;
  394.     digit : integer;
  395. begin
  396.     hex := '';
  397.     digit := num div 16;
  398.  
  399.     while length(hex) < 2 do
  400.     begin
  401.         if digit <= 9 then
  402.             hex := hex + inttostr(digit)
  403.         else if digit = 10 then
  404.             hex := hex + 'A'
  405.         else if digit = 11 then
  406.             hex := hex + 'B'
  407.         else if digit = 12 then
  408.             hex := hex + 'C'
  409.         else if digit = 13 then
  410.             hex := hex + 'D'
  411.         else if digit = 14 then
  412.             hex := hex + 'E'
  413.         else if digit = 15 then
  414.             hex := hex + 'F';
  415.  
  416.         digit := num mod 16;
  417.     end;
  418.  
  419.     Result := hex;
  420. end;
  421.  
  422. {  ************************************************************************  }
  423.  
  424. procedure addcolstr (colstr: string);
  425. var
  426.     str : string;
  427.  
  428. begin
  429.     str := '<FONT COLOR="' + colstr + '"></FONT>';
  430.     add_ks(str);
  431. end;
  432.  
  433. {  ************************************************************************  }
  434.  
  435. procedure addfontname (fname: string);
  436. var
  437.     str : string;
  438.  
  439. begin
  440.     str := '<FONT FACE="' + fname + '"></FONT>';
  441.  
  442.     add_ks(str);
  443.  
  444.     if not flag.onlyDefiniteOpt then                     { das kann u.u. ins Auge gehen, optimiert aber sehr gut }
  445.     begin                                                { vor allem bei <UL>'s                                  }
  446.         str := '</FONT><FONT FACE="' + fname + '">';     { das </FONT> zu Beginn k÷nnte aber von einer anderen   }
  447.         add_ks(str);                                     { Formatierung als <FONT FACE = "fname"> stammen        }
  448.     end;
  449. end;
  450.  
  451. {  ************************************************************************  }
  452.  
  453. procedure cut_tag (rtf_tag : string; var line : string);     { verkⁿrzt Stylesheet-Strings }
  454. var
  455.     i, strlen : integer;
  456.     act_tag : string;
  457.  
  458. begin
  459.     i := Pos(rtf_tag, line);
  460.     while i > 0 do
  461.     begin
  462.         strlen := length(line);
  463.         act_tag := rtf_tag;
  464.         Inc(i, length(rtf_tag));
  465.  
  466.         while (line[i] <> '\') and (line[i] <> ' ') and (i <= strlen) do
  467.         begin
  468.             act_tag := act_tag + line[i];
  469.             Inc(i);
  470.         end;
  471.  
  472.         line := ReplaceIn (act_tag, '', line);
  473.         i := Pos(rtf_tag, line);
  474.     end;
  475. end;
  476.  
  477. {  ************************************************************************  }
  478.  
  479. function optStyle(basestyle, actstyle: string) : string;
  480. var
  481.     sbased, sact : string;
  482.  
  483. begin
  484.     Result := '';
  485.     sbased := basestyle;
  486.     sact := actstyle;
  487.  
  488.     sact := ReplaceAll(['\widctlpar','\adjustright','\nowidctlpar'],['','',''], sact);
  489.     sact := ReplaceAll(['\keepn','\cgrid','\widctl'],['','',''], sact);
  490.  
  491.     cut_tag('\sbasedon', sact);
  492.     cut_tag('\snext', sact);
  493.     cut_tag('\sa', sact);
  494.     cut_tag('\sb', sact);
  495.     cut_tag('\lang', sact);
  496.     cut_tag('\slmult', sact);
  497.     cut_tag('\sl', sact);
  498.     cut_tag('\outlinelevel', sact);
  499.     cut_tag('\kerning', sact);
  500.     cut_tag('\expndtw', sact);
  501.     cut_tag('\expnd', sact);
  502.     cut_tag('\tx', sact);
  503.  
  504.     if pos(sbased, sact) > 0 then
  505.     begin
  506.         sbased := '';
  507.     end;
  508.     if ((pos('\fi', sact) > 0) or (pos('\li', sact) > 0))
  509.     and ((pos('\fi', sbased) > 0) or (pos('\li', sbased) > 0)) then
  510.     begin
  511.         cut_tag('\fi', sbased);
  512.         cut_tag('\li', sbased);
  513.     end;
  514.  
  515.     Result := sbased + sact;
  516. end;
  517.  
  518. {  ************************************************************************  }
  519.  
  520. procedure CloseLists (var outstring: string; var outfile: textfile);
  521. var
  522.     txt : string;
  523.  
  524. begin
  525.     txt := '';
  526.  
  527.     if listitem and not li_open then
  528.         txt := txt + '</LI>';
  529.  
  530.     while enums.lvl > 0 do
  531.     begin
  532.         txt := txt + '</UL>';
  533.         Dec(enums.lvl);
  534.     end;
  535.  
  536.     WriteHtml(txt, outstring, outfile);
  537. end;
  538.  
  539. {  ************************************************************************  }
  540.  
  541. function htmlcol (rtfcol: string): string;  { wandelt rft-Farbangabe in html-Farbangabe um }
  542. var
  543.     red_ind, green_ind, blue_ind : integer;
  544.     redstr, greenstr, bluestr, colstr : string;
  545.     red, green, blue : integer;
  546.  
  547. begin
  548.     redstr := '';
  549.     greenstr := '';
  550.     bluestr := '';
  551.  
  552.     red_ind := pos('red',rtfcol)+3;
  553.     green_ind := pos('green',rtfcol)+5;
  554.     blue_ind := pos('blue',rtfcol)+4;
  555.  
  556.     while (rtfcol[red_ind] in ['0'..'9']) and (red_ind <= length(rtfcol)) do
  557.     begin
  558.         redstr := redstr + rtfcol[red_ind];
  559.         Inc(red_ind);
  560.     end;
  561.     try
  562.        red := strtoint(redstr);
  563.     except
  564.        on EConvertError do red := 0;
  565.     end;
  566.     redstr := dec2hex(red);
  567.  
  568.     while (rtfcol[green_ind] in ['0'..'9']) and (green_ind <= length(rtfcol)) do
  569.     begin
  570.         greenstr := greenstr + rtfcol[green_ind];
  571.         Inc(green_ind);
  572.     end;
  573.     try
  574.        green := strtoint(greenstr);
  575.     except
  576.        on EConvertError do green := 0;
  577.     end;
  578.     greenstr := dec2hex(green);
  579.  
  580.     while (rtfcol[blue_ind] in ['0'..'9']) and (blue_ind <= length(rtfcol)) do
  581.     begin
  582.         bluestr := bluestr + rtfcol[blue_ind];
  583.         Inc(blue_ind);
  584.     end;
  585.     try
  586.        blue := strtoint(bluestr);
  587.     except
  588.        on EConvertError do blue := 0;
  589.     end;
  590.     bluestr := dec2hex(blue);
  591.  
  592.     colstr := '#'+redstr+greenstr+bluestr;
  593.     Result := colstr;
  594. end;
  595.  
  596. {  ************************************************************************  }
  597.  
  598. procedure resetfmt (var attrib: format; const kind: string);  { setzt intern gespeicherte Formatierungen zurⁿck }
  599. begin
  600.     with attrib do
  601.     begin
  602.         if (kind = 'text') or (kind = 'all') then
  603.         begin
  604.             invis := false;
  605.             caps := false;
  606.             bold := false;
  607.             italic := false;
  608.             underline := false;
  609.             superscript := false;
  610.             subscript := false;
  611.             strike := false;
  612.             font:= -1;
  613.             fcol:= 'none';
  614.             fsize:= -1;
  615.         end;
  616.         if (kind = 'par') or (kind = 'all') then
  617.         begin
  618.             rjustified := false;
  619.             centered := false;
  620.         end;
  621.         if (kind = 'all') then table := 0;
  622.     end;
  623. end;
  624.  
  625. {  ************************************************************************  }
  626.  
  627. function diff(attr1: format; attr2: format): boolean;  { vergleicht zwei Format-Records }
  628. begin
  629.     Result := false;
  630.  
  631.     if attr1.invis <> attr2.invis then
  632.         Result := true
  633.     else if attr1.bold <> attr2.bold then
  634.         Result := true
  635.     else if attr1.italic <> attr2.italic then
  636.         Result := true
  637.     else if attr1.underline <> attr2.underline then
  638.         Result := true
  639.     else if attr1.superscript <> attr2.superscript then
  640.         Result := true
  641.     else if attr1.subscript <> attr2.subscript then
  642.         Result := true
  643.     else if attr1.strike <> attr2.strike then
  644.         Result := true
  645.     else if attr1.font <> attr2.font then
  646.         Result := true
  647.     else if attr1.fcol <> attr2.fcol then
  648.         Result := true
  649.     else if attr1.fsize <> attr2.fsize then
  650.         Result := true
  651.     else if attr1.rjustified <> attr2.rjustified then
  652.         Result := true
  653.     else if attr1.centered <> attr2.centered then
  654.         Result := true;
  655. end;
  656.  
  657. {  ************************************************************************  }
  658.  
  659. function htmlfontsize (size: integer): string;  { liefert den html-Code fⁿr die angegebene neue Schrift-Gr÷▀e }
  660. var
  661.     sizestr: string;
  662.  
  663. begin
  664.     if (size <> 12) then
  665.     begin                                      { wir interpolieren..... }
  666.         if size <= 8 then sizestr := '-2'
  667.         else if size <= 11 then sizestr := '-1'
  668.         else if size <= 15 then sizestr := '+1'
  669.         else if size <= 20 then sizestr := '+2'
  670.         else if size <= 28 then sizestr := '+3'
  671.         else sizestr := '+4';
  672.         Result := '<FONT SIZE=' + sizestr + '>';
  673.     end
  674.     else
  675.         Result := '<FONT SIZE=+0>';
  676. end;
  677.  
  678. {  ************************************************************************  }
  679.  
  680. function fontname (var num: integer): string;
  681. var
  682.     i : integer;
  683.  
  684. begin
  685.     i := 0;
  686.     while (fonts[i].number <> num) and (i < high(fonts)) do Inc(i);
  687.  
  688.     if i > high(fonts) then           { sollte eigentlich nicht vorkommen..... }
  689.     begin
  690.         num := fonts[high(fonts)].number;
  691.         Result := fonts[high(fonts)].name;
  692.     end
  693.     else
  694.         Result := fonts[i].name;
  695. end;
  696.  
  697. {  ************************************************************************  }
  698.  
  699. procedure CopyAttrib(var dest: format; src: format);
  700. begin
  701.     dest.invis := src.invis;
  702.     dest.caps := src.caps;
  703.     dest.bold := src.bold;
  704.     dest.italic := src.italic;
  705.     dest.underline := src.underline;
  706.     dest.superscript := src.superscript;
  707.     dest.subscript := src.subscript;
  708.     dest.strike := src.strike;
  709.     dest.font := src.font;
  710.     dest.fcol := src.fcol;
  711.     dest.fsize := src.fsize;
  712.     dest.rjustified := src.rjustified;
  713.     dest.centered := src.centered;
  714.   {  dest.table := src.table;}
  715. end;
  716.  
  717. {  ************************************************************************  }
  718.  
  719. procedure addtag(var stk: stackptr; tagstart: string; tagend: string);
  720. var                             { neue Formatierung auf den Stack ..... }
  721.     ptr : stackptr;
  722. begin
  723.     New(ptr);
  724.     ptr^.tagstart := tagstart;
  725.     ptr^.tagend := tagend;
  726.     ptr^.next := stk;
  727.     stk := ptr;
  728. end;
  729.  
  730. {  ************************************************************************  }
  731.  
  732. procedure CopyStack(var dest: stackptr; src: stackptr);
  733. var
  734.     helpptr : stackptr;
  735. begin
  736.     dest := NIL;
  737.     helpptr := src;
  738.     while (helpptr <> NIL) do
  739.     begin
  740.         addtag(dest, helpptr^.tagstart, helpptr^.tagend);
  741.         helpptr := helpptr^.next;
  742.     end;
  743. end;
  744.  
  745. {  ************************************************************************  }
  746.  
  747. procedure poptag(var stk: stackptr);
  748. var                             { oberste Formatierung vom Stack entfernen }
  749.     ptr : stackptr;
  750. begin
  751.     ptr := stk;
  752.     stk := stk^.next;
  753.     Dispose(ptr);
  754. end;
  755.  
  756. {  ************************************************************************  }
  757.  
  758. function contents(stk: stackptr): string;
  759. var
  760.     helpp : stackptr;
  761.  
  762. begin
  763.     helpp := stk;
  764.     Result := '';
  765.     while (helpp <> NIL) do
  766.     begin
  767.         if copy(helpp^.tagend,1,6) = '</FONT' then
  768.             Result := Result + '</FONT>'
  769.         else
  770.             Result := Result + helpp^.tagend;
  771.         helpp := helpp^.next;
  772.     end;
  773. end;
  774.  
  775. {  ************************************************************************  }
  776.  
  777. function empty(var stk: stackptr): string;
  778. begin
  779.     Result := '';
  780.     while (stk <> NIL) do
  781.     begin
  782.         if copy(stk^.tagend,1,6) = '</FONT' then
  783.             Result := Result + '</FONT>'
  784.         else
  785.             Result := Result + stk^.tagend;
  786.         poptag(stk);
  787.     end;
  788. end;
  789.  
  790. {  ************************************************************************  }
  791.  
  792. function createFTags (attrib: format): string;
  793. var
  794.     txt : string;
  795.  
  796. begin
  797.     Result := '';
  798.     with attrib do
  799.     begin
  800.         if bold then
  801.         begin
  802.             addtag(mainstack, '<B>', '</B>');
  803.             Result := Result + '<B>';
  804.         end;
  805.         if italic then
  806.         begin
  807.             addtag(mainstack, '<I>', '</I>');
  808.             Result := Result + '<I>';
  809.         end;
  810.         if underline then
  811.         begin
  812.             addtag(mainstack, '<U>', '</U>');
  813.             Result := Result + '<U>';
  814.         end;
  815.         if subscript then
  816.         begin
  817.             addtag(mainstack, '<SUB>', '</SUB>');
  818.             Result := Result + '<SUB>';
  819.         end;
  820.         if superscript then
  821.         begin
  822.             addtag(mainstack, '<SUP>', '</SUP>');
  823.             Result := Result + '<SUP>';
  824.         end;
  825.         if strike then
  826.         begin
  827.             addtag(mainstack, '<S>', '</S>');
  828.             Result := Result + '<S>';
  829.         end;
  830.         if fcol <> 'none' then
  831.         begin
  832.             txt := '<FONT COLOR="' + fcol + '">';
  833.             addtag(mainstack, txt, '</FONT>');
  834.             Result := Result + txt;
  835.         end;
  836.         if font > -1 then
  837.         begin
  838.             txt := fontname(font);
  839.             txt := '<FONT FACE="' + txt + '">';
  840.             addtag(mainstack, txt, '</FONT>');
  841.             Result := Result + txt;
  842.         end;
  843.         if fsize > -1 then
  844.         begin
  845.             txt := htmlfontsize(fsize);
  846.             addtag(mainstack, txt, '</FONT>');
  847.             Result := Result + txt;
  848.         end;
  849.     end;
  850. end;
  851.  
  852. {  ************************************************************************  }
  853.  
  854. function htmlchar(ch: string; attrib: format): string;
  855. var
  856.     ltr : char;
  857.     curlink, curanch : string;
  858.  
  859. begin
  860.     Result := '';
  861.  
  862.     if changefmt then
  863.         Result := Result + empty(mainstack);
  864.  
  865.     if nextpar then
  866.     begin
  867.         if attrib.centered then
  868.             Result := Result + '<CENTER>'
  869.         else if attrib.rjustified then
  870.             Result := Result + '<DIV ALIGN=right>';
  871.     end;
  872.  
  873.     if changefmt or nextpar then
  874.     begin
  875.         Result := Result + CreateFTags(attrib);
  876.     end;
  877.  
  878.     enums.doclvl := globbrk;
  879.     nextpar := false;        { wir sind nicht mehr am Beginn eines neuen Absatzes }
  880.     changefmt := false;
  881.  
  882.     if ahrefwait then
  883.     begin
  884.         if newhrefnum then        { jetzt wird's Zeit, eine Referenz zu setzen }
  885.         begin
  886.             ahref := true;
  887.             newhrefnum := false;
  888.             Inc(actlinknum[indexlvl]);
  889.             curlink := inttostr(indexlvl) + '-' + inttostr(actlinknum[indexlvl]);
  890.             Result := Result + '<A HREF="#' + curlink + '">';
  891.         end;
  892.     end;
  893.  
  894.     if anchor then
  895.     begin                         { jetzt kommt eine Sprungmarke }
  896.         Inc(actanchnum[anchlvl]);
  897.         curanch := inttostr(anchlvl) + '-' + inttostr(actanchnum[anchlvl]);
  898.         Result := Result + '<A NAME="' + curanch + '">';
  899.     end;
  900.  
  901.     if not attrib.invis then
  902.     begin
  903.         if length(ch) = 1 then
  904.         begin
  905.             ltr := ch[1];
  906.             if ltr = '<' then
  907.                 Result := Result + '<'
  908.             else if ltr = '>' then
  909.                 Result := Result + '>'
  910.             else if ltr = '&' then
  911.                 Result := Result + '&'
  912.             else
  913.                 if ltr in ['a'..'z'] then
  914.                 begin
  915.                     if attrib.caps then
  916.                         Result := Result + UpperCase(ltr)
  917.                     else
  918.                         Result := Result + ltr;
  919.                 end
  920.                 else
  921.                     Result := Result + ltr;
  922.         end
  923.         else if (length(ch) = 2) then
  924.         begin
  925.             if ch = 'c4' then Result := Result + 'Ä'           { '─' }
  926.             else if ch = 'd6' then Result := Result + 'Ö'      { '╓' }
  927.             else if ch = 'dc' then Result := Result + 'Ü'      { '▄' }
  928.             else if ch = 'e4' then                         { 'Σ' }
  929.             begin
  930.                 if attrib.caps then
  931.                     Result := Result + 'Ä'
  932.                 else
  933.                     Result := Result + 'ä';
  934.             end
  935.             else if ch = 'f6' then                         { '÷' }
  936.             begin
  937.                 if attrib.caps then
  938.                     Result := Result + 'Ö'
  939.                 else
  940.                     Result := Result + 'ö';
  941.             end
  942.             else if ch = 'fc' then                         { 'ⁿ' }
  943.             begin
  944.                 if attrib.caps then
  945.                     Result := Result + 'Ü'
  946.                 else
  947.                     Result := Result + 'ü';
  948.             end
  949.             else if ch = 'df' then Result := Result + 'ß'     { '▀' }
  950.             else if ch = 'b7' then Result := Result + '·'    { AufzΣhlungs-Punkt }
  951.             else Result := Result + chr(hex2dec(ch));
  952.         end { if length(ch) = 1 ... }
  953.         else
  954.         begin
  955.             if ch = '&pict;' then
  956.                 Result := Result + '<P>[*** picture ***]<P>'     { Graphik-Substitut}
  957.             else if (Pos('&&', ch) = 1) then
  958.                 Result := Result + Copy(ch, 3, length(ch)-2)     { AufzΣhlungstext }
  959.             else if ch = '&tab;' then
  960.                 Result := Result + '        '
  961.             else if ch = '"e;' then
  962.                 Result := Result + #39
  963.             else if ch = '&dblquote;' then
  964.                 Result := Result + #34
  965.             else if ch = '&emspace;' then
  966.                 Result := Result + '  '
  967.             else if ch = '&enspace;' then
  968.                 Result := Result + ' '
  969.             else if ch = '&emdash;' then
  970.                 Result := Result + '--'
  971.             else if ch = '&endash;' then
  972.                 Result := Result + '-'
  973.             else if ch = ' ' then
  974.                 Result := Result + ch;                           { nonbreaking space }
  975.         end;
  976.     end
  977.     else  { hidden text }
  978.         Result := Result + '';
  979.  
  980.     if anchor then
  981.     begin
  982.         Result := Result + '</A>';
  983.         anchor := false;
  984.     end;
  985. end;
  986.  
  987. {  ************************************************************************  }
  988.  
  989. function plainchar(ch: string): string;
  990. begin
  991.     if ch = 'c4' then Result := '─'
  992.     else if ch = 'd6' then Result := '╓'
  993.     else if ch = 'dc' then Result := '▄'
  994.     else if ch = 'e4' then Result := 'Σ'
  995.     else if ch = 'f6' then Result := '÷'
  996.     else if ch = 'fc' then Result := 'ⁿ'
  997.     else if ch = 'df' then Result := '▀'
  998.     else Result := chr(hex2dec(ch));
  999. end;
  1000.  
  1001. {  ************************************************************************  }
  1002.  
  1003. function html (const ctrlword: string; var attrib: format): string;
  1004. var                                      { fri▀t rtf-Kontrollwort & spuckt entsprechenden html-Code aus }
  1005.     num : integer;
  1006.     txt : string;
  1007.  
  1008. begin
  1009.     Result := '';
  1010.  
  1011.     if (ctrlword = 'plain') or (ctrlword = 'pard') or (ctrlword = 'sectd') then         { alle Formatierungen deaktivieren }
  1012.     begin
  1013.         if (ctrlword = 'plain') then
  1014.         begin
  1015.             resetfmt(attrib, 'text');
  1016.             changefmt := true;
  1017.             if mainstack <> NIL then
  1018.                 Result := Result + empty(mainstack);
  1019.         end;
  1020.  
  1021.         if (ctrlword = 'pard') or (ctrlword = 'sectd') then      { neue Absatz-Formatierung }
  1022.         begin
  1023.             resetfmt(attrib, 'par');
  1024.  
  1025.             enumtxt := '';
  1026.             txtwait := '';
  1027.             ahrefwait := false;
  1028.             lastindent := 0;
  1029.             no_newind := true;
  1030.             li_open := false;
  1031.             listbull := false;
  1032.             enumdigit := false;
  1033.             pnnum := false;
  1034.             lvlnum := -1;
  1035.  
  1036.           {  if listitem then
  1037.                 Result := Result + '</LI>'; }
  1038.  
  1039.             while enums.lvl > 0 do
  1040.             begin
  1041.                 Dec(enums.lvl);
  1042.                 txt := txt + '</UL>';
  1043.             end;
  1044.             listitem := false;
  1045.         end;
  1046.  
  1047.         if txt <> '' then Result := Result + txt;
  1048.     end
  1049.  
  1050.     else if ctrlword = 'v' then          { versteckter Text }
  1051.         attrib.invis := true
  1052.  
  1053.     else if ctrlword = 'v0' then
  1054.         attrib.invis := false
  1055.  
  1056.     else if ctrlword = 'caps' then       { Blockschrift }
  1057.         attrib.caps := true
  1058.  
  1059.     else if ctrlword = 'caps0' then
  1060.         attrib.caps := false
  1061.  
  1062.     else if ctrlword = 'tab' then                         { Tabulator }
  1063.     begin                                                 { Notl÷sung }
  1064.         if not attrib.invis then Result := Result + htmlchar('&tab;', attrib);
  1065.     end
  1066.  
  1067.     else if ctrlword = 'qc' then       { Formatierung: zentriert }
  1068.     begin
  1069.         if not attrib.centered then
  1070.         begin
  1071.             attrib.centered := true;
  1072.         end;
  1073.     end
  1074.  
  1075.     else if ctrlword = 'qr' then       { Formatierung: rechtsbⁿndig }
  1076.     begin
  1077.         if not attrib.rjustified then
  1078.         begin
  1079.             attrib.rjustified := true;
  1080.         end;
  1081.     end
  1082.  
  1083.     else if (ctrlword = 'par') or (ctrlword = 'sect') then      { neuer Absatz }
  1084.     begin
  1085.         Result := Result + empty(mainstack);
  1086.  
  1087.         if attrib.rjustified then
  1088.         begin
  1089.             Result := Result + '</DIV>';
  1090.         end;
  1091.         if attrib.centered then
  1092.         begin
  1093.             Result := Result + '</CENTER>';
  1094.         end;
  1095.  
  1096.         changefmt := true;
  1097.         newhrefnum := true;
  1098.         nextpar := true;
  1099.  
  1100.         if listitem then
  1101.         begin
  1102.             Result := Result + '</LI>';
  1103.             li_open := true;
  1104.         end
  1105.         else
  1106.         begin
  1107.             Result := Result + '<BR>';
  1108.             if lvlnum > -1 then
  1109.             begin
  1110.                 Inc(lvlnum);
  1111.                 enumtxt := pntxtb + inttostr(lvlnum) + pntxta;
  1112.             end;
  1113.             bkmkpar := false;
  1114.         end;
  1115.     end
  1116.  
  1117.     else if (ctrlword = 'line') then      { Zeilenumbruch }
  1118.     begin
  1119.         Result := Result + '<BR>';
  1120.     end
  1121.  
  1122.     else if (ctrlword = 'page')then       { Seitenumbruch }
  1123.     begin
  1124.         Result := Result + '<BR><HR><BR>';
  1125.     end
  1126.  
  1127.     else if (ctrlword = 'emdash') then      { langer Gedankenstrich }
  1128.     begin
  1129.         if not attrib.invis then Result := Result + htmlchar('&emdash;', attrib);
  1130.     end
  1131.  
  1132.     { das hier mu▀ ALLES von htmlchar ⁿbernommen werden }
  1133.  
  1134.     else if (ctrlword = 'endash') then      { kurzer Gedankenstrich }
  1135.     begin
  1136.         if not attrib.invis then Result := Result + htmlchar('&endash;', attrib);
  1137.     end
  1138.  
  1139.     else if (ctrlword = 'emspace') then      { langer Zwischenraum }
  1140.     begin
  1141.         if not attrib.invis then Result := Result + htmlchar('&emspace;', attrib);
  1142.     end
  1143.  
  1144.     else if (ctrlword = 'enspace') then      { kurzer Zwischenraum }
  1145.     begin
  1146.         if not attrib.invis then Result := Result + htmlchar('&enspace;', attrib);
  1147.     end
  1148.  
  1149.     else if (ctrlword = 'lquote') or (ctrlword = 'rquote') then      { einfaches Anfⁿhrungszeichen, Apostroph }
  1150.     begin
  1151.         if not attrib.invis then Result := Result + htmlchar('"e;', attrib);
  1152.     end
  1153.  
  1154.     else if (ctrlword = 'ldblquote') or (ctrlword = 'rdblquote') then     { doppeltes Anfⁿhrungszeichen }
  1155.     begin
  1156.         if not attrib.invis then Result := Result + htmlchar('&dblquote;', attrib);
  1157.     end
  1158.  
  1159.     else if ctrlword = 'b' then        { Formatierung: fett }
  1160.     begin
  1161.         if not attrib.bold then
  1162.         begin
  1163.             changefmt := true;
  1164.             attrib.bold := true;
  1165.         end;
  1166.     end
  1167.  
  1168.     else if ctrlword = 'b0' then
  1169.     begin
  1170.         if attrib.bold then
  1171.         begin
  1172.             changefmt := true;
  1173.             attrib.bold := false;
  1174.         end;
  1175.     end
  1176.  
  1177.     else if ctrlword = 'i' then        { Formatierung: kursiv }
  1178.     begin
  1179.         if not attrib.italic then
  1180.         begin
  1181.             changefmt := true;
  1182.             attrib.italic := true;
  1183.         end;
  1184.     end
  1185.  
  1186.     else if ctrlword = 'i0' then
  1187.     begin
  1188.         if attrib.italic then
  1189.         begin
  1190.             changefmt := true;
  1191.             attrib.italic := false;
  1192.         end;
  1193.     end
  1194.  
  1195.     else if (ctrlword = 'ul')          { Formatierung: unterstreichen }
  1196.          or (ctrlword = 'uld')
  1197.          or (ctrlword = 'uldash')
  1198.          or (ctrlword = 'uldashd')
  1199.          or (ctrlword = 'uldashdd')
  1200.          or (ctrlword = 'uldb')
  1201.          or (ctrlword = 'ulth')
  1202.          or (ctrlword = 'ulwave') then
  1203.     begin
  1204.         if not attrib.underline then
  1205.         begin
  1206.             changefmt := true;
  1207.             attrib.underline := true;
  1208.         end;
  1209.     end
  1210.  
  1211.     else if (ctrlword = 'ulnone') or (ctrlword = 'ul0') then    { Formatierung: unterstreichen beenden }
  1212.     begin
  1213.         if attrib.underline then
  1214.         begin
  1215.             changefmt := true;
  1216.             attrib.underline := false;
  1217.         end;
  1218.     end
  1219.  
  1220.     else if (ctrlword = 'super') or (pos('up',ctrlword) = 1) then  { Formatierung: hochstellen }
  1221.     begin
  1222.         if not attrib.superscript then
  1223.         begin
  1224.             changefmt := true;
  1225.             attrib.superscript := true;
  1226.         end;
  1227.     end
  1228.  
  1229.     else if (ctrlword = 'sub') or (pos('dn',ctrlword) = 1) then  { Formatierung: tiefstellen }
  1230.     begin
  1231.         if not attrib.subscript then
  1232.         begin
  1233.             changefmt := true;
  1234.             attrib.subscript := true;
  1235.         end;
  1236.     end
  1237.  
  1238.     else if (ctrlword = 'nosupersub') then    { Formatierung: hoch-/tiefstellen beenden }
  1239.     begin
  1240.         if attrib.superscript or attrib.subscript then
  1241.         begin
  1242.             changefmt := true;
  1243.             attrib.superscript := false;
  1244.             attrib.subscript := false;
  1245.         end;
  1246.     end
  1247.  
  1248.     else if (ctrlword = 'strike') or (ctrlword = 'strikedl') then        { Formatierung: durchstreichen }
  1249.     begin
  1250.         if not attrib.strike then
  1251.         begin
  1252.             changefmt := true;
  1253.             attrib.strike := true;
  1254.         end;
  1255.     end
  1256.  
  1257.     else if (ctrlword = 'strike0') or (ctrlword = 'strikedl0') then
  1258.     begin
  1259.         if attrib.strike then
  1260.         begin
  1261.             changefmt := true;
  1262.             attrib.strike := false;
  1263.         end;
  1264.     end
  1265.  
  1266.     else if pos('li',ctrlword) = 1 then
  1267.     begin
  1268.         if (ctrlword[3] in ['0'..'9']) and (attrib.table = 0) then
  1269.         begin
  1270.             try
  1271.                 num := strtoint(copy(ctrlword,3,length(ctrlword)-2));
  1272.             except
  1273.                 on EConvertError do
  1274.                     num := 0;
  1275.             end;
  1276.  
  1277.             if no_newind then
  1278.             begin
  1279.                 lastindent := lastindent + num;
  1280.                 no_newind := false;
  1281.  
  1282.                 while (enums.indent[enums.lvl] < lastindent) and (enums.lvl <= 20)
  1283.                 do
  1284.                 begin
  1285.                     Inc(enums.lvl);
  1286.                     Result := Result + '<UL>';
  1287.                 end;
  1288.             end;
  1289.         end;
  1290.     end
  1291.  
  1292.     else if pos('fi',ctrlword) = 1 then
  1293.     begin
  1294.         if ctrlword[3] in ['0'..'9','-'] then
  1295.         begin
  1296.             try
  1297.                 num := strtoint(copy(ctrlword,3,length(ctrlword)-2));
  1298.             except
  1299.                 on EConvertError do
  1300.                     num := 0;
  1301.             end;
  1302.  
  1303.             if no_newind then
  1304.             begin
  1305.                 lastindent := lastindent + num;
  1306.             end;
  1307.         end;
  1308.     end
  1309.  
  1310.     else if pos('f',ctrlword) = 1 then
  1311.     begin
  1312.         if (ctrlword[2] in ['0'..'9']) and (not flag.noFonts) then       { neue Schriftart }
  1313.         begin
  1314.             try
  1315.                 num := strtoint(copy(ctrlword,2,length(ctrlword)-1));
  1316.             except
  1317.                 on EConvertError do
  1318.                     num := 0;
  1319.             end;                             { Font-Nummer erfassen }
  1320.  
  1321.             if attrib.font <> num then
  1322.             begin
  1323.                 changefmt := true;
  1324.                 attrib.font := num;
  1325.             end;
  1326.         end
  1327.         else if ctrlword[2] = 's' then       { neue Schrift-Gr÷▀e }
  1328.         begin
  1329.             try
  1330.                 num := strtoint(copy(ctrlword,3,length(ctrlword)-2));
  1331.             except
  1332.                 on EConvertError do             { Schrift-Gr÷▀en-Zahl erfassen }
  1333.                     num := 0;
  1334.             end;
  1335.             num := num div 2;   { Schrift-Gr÷▀en in RTF sind in halben Punkten angegeben }
  1336.  
  1337.             if attrib.fsize <> num then
  1338.             begin
  1339.                 changefmt := true;
  1340.                 attrib.fsize := num;
  1341.             end;
  1342.         end;
  1343.     end
  1344.  
  1345.     else if pos('cf',ctrlword) = 1 then       { neue Vordergrund-Farbe }
  1346.     begin
  1347.         try
  1348.             num := strtoint(copy(ctrlword,3,length(ctrlword)-2));
  1349.         except
  1350.             on EConvertError do              { Farb-Nummer erfassen }
  1351.                 num := 0;
  1352.         end;
  1353.  
  1354.         if num > col.count-1 then
  1355.             txt := col[col.count-1]           { sollte auch nicht vorkommen }
  1356.         else
  1357.             txt := col[num];
  1358.  
  1359.         if attrib.fcol <> txt then
  1360.         begin
  1361.             changefmt := true;
  1362.             attrib.fcol := txt;
  1363.         end;
  1364.     end;
  1365. end;
  1366.  
  1367. {  ************************************************************************  }
  1368.  
  1369. function LineAt (const index: integer; const line: string; var infile: textfile): string;
  1370. var                                                      { liefert einen Teilstring von 'line' ab Position 'index' }
  1371.     nextstr, str : string;                               { zurⁿck. Ist 'line' kⁿrzer als 'index', wird eine        }
  1372. begin                                                    { neue Zeile eingelesen und an 'line' angehΣngt, und dies }
  1373.     str := line;                                         { bei Bedarf so lange wiederholt, bis 'index' kleiner als }
  1374.     while (not EOF(infile)) and (index > length(str)) do { die ZeilenlΣnge ist und somit das gewⁿnschte Resultat   }
  1375.     begin                                                { geliefert werden kann }
  1376.         ReadLn(infile, nextstr);
  1377.         str := str + nextstr;
  1378.     end;
  1379.  
  1380.     if index > length(str) then    { gesuchte Stelle existiert im Input-File gar nicht mehr }
  1381.         Result := ''
  1382.     else
  1383.         Result := Copy(str,index,length(str)-index+1);
  1384. end;
  1385.  
  1386. {  ************************************************************************  }
  1387.  
  1388. procedure IgnoreGroup(var line: string; var infile: textfile);   { springt zum Ende der aktuellen Group }
  1389. var
  1390.     lastline : boolean;
  1391.     i, brk, strlen : integer;
  1392.     binlen, binind : longint;
  1393.  
  1394. begin
  1395.     lastline := false;
  1396.     i := 0;
  1397.     strlen := 0;
  1398.     brk := 0;   { zΣhlt die geschwungenen Klammern }
  1399.  
  1400.     while (not lastline) and (brk > -1) do
  1401.     begin
  1402.         if EOF(infile) then lastline := true;
  1403.         strlen := length(line);
  1404.         i := 1;
  1405.         while (i <= strlen) and (brk > -1) do
  1406.         begin
  1407.             if line[i] = '\' then
  1408.             begin
  1409.                 if pos('bin',line) = i+1 then     { bei BinΣr-Daten im RTF-File funktioniert das Klammern-ZΣhlen }
  1410.                 begin                             { nicht und daher wird die im 'bin'-tag angegebene Menge von   }
  1411.                     binlen := 0;                  { Bytes ungeprⁿft ⁿbersprungen                                 }
  1412.                     i := i+4;
  1413.                     while (line[i] in ['0'..'9']) and (i <= strlen) do
  1414.                     begin                                           { LΣnge der BinΣr-Daten erfassen }
  1415.                         binlen := binlen * 10 + strtoint(line[i]);
  1416.                         Inc(i);
  1417.                     end;
  1418.                     binind := 1;
  1419.                     while (binind <= binlen) and (not (EOF(infile) and (i > strlen)) ) do
  1420.                     begin                                           { BinΣr-Daten ⁿberspringen }
  1421.                         if EOF(infile) then lastline := true;
  1422.                         if (i > strlen) and (not lastline) then
  1423.                         begin
  1424.                             ReadLn(infile, line);
  1425.                             Inc(binind);
  1426.                             if EOF(infile) then lastline := true;
  1427.                             i := 1;
  1428.                         end
  1429.                         else
  1430.                         begin
  1431.                             Inc(i);
  1432.                             Inc(binind);
  1433.                         end;
  1434.                     end;
  1435.                 end;
  1436.             end;
  1437.  
  1438.             if line[i] = '{' then Inc(brk)
  1439.             else if line[i] = '}' then Dec(brk);
  1440.  
  1441.             Inc(i);
  1442.         end;
  1443.  
  1444.         if (brk > -1) and not lastline then ReadLn(infile, line);  { noch immer in in der Group --> nΣchste Zeile }
  1445.     end;
  1446.  
  1447.     if (i > strlen) and not lastline then
  1448.     begin
  1449.         ReadLn(infile, line);  { letztes Zeichen der Zeile war Group-Ende  -->  weiter mit neuer Zeile }
  1450.         line := '}' + line;
  1451.     end
  1452.     else line := LineAt(i-1, line, infile);    { sonst: Zeile := Zeile ab Group-Ende }
  1453. end;
  1454.  
  1455. {  ************************************************************************  }
  1456.  
  1457. procedure setfonts (var infile, outfile: textfile; var src: string);
  1458. var
  1459.     fnum, ftind, i, i2, strlen: integer;
  1460.     endfonts, lastline: boolean;
  1461.     nextstr: string;
  1462.  
  1463. begin
  1464.     ftind := 0;
  1465.     endfonts := false;
  1466.     lastline := false;
  1467.     i := pos('\fonttbl',src)+8;
  1468.     strlen := length(src);
  1469.  
  1470.     While not lastline and not endfonts do
  1471.     begin
  1472.         if EOF(infile) then lastline := true;
  1473.         while (i <= strlen) and (src[i] <> '\') do Inc(i); { Font-Deklaration suchen }
  1474.         Inc(i);
  1475.         if i > strlen then Exit;
  1476.         { Fehler im Format }
  1477.  
  1478.         fnum := 0;
  1479.         if src[i] = 'f' then
  1480.         begin
  1481.             Inc(i);
  1482.             while (src[i] in ['0'..'9']) and (i <= strlen) do   { Font-Nummer }
  1483.             begin
  1484.                 fnum := (fnum*10)+strtoint(src[i]);
  1485.                 Inc(i);
  1486.             end;
  1487.  
  1488.             { nun wird der Anfang des Font-Namens gesucht }
  1489.             while (i <= strlen) and (src[i] <> '}') and (src[i] <> '{') and (src[i] <> ' ') do Inc(i);
  1490.             if src[i] = '{' then
  1491.                 while (i <= strlen) and (src[i] <> '}') do Inc(i);
  1492.             Inc(i);
  1493.             if i > strlen then Exit;
  1494.  
  1495.             { und nun das Ende..... }
  1496.             i2 := i;
  1497.             while (i2 <= strlen) and (src[i2] <> ';') and (src[i2] <> '{') and (src[i2] <> '\') do Inc(i2);
  1498.             if (src[i2] = '{') and (pos('\*\falt',src) = i2+1) then
  1499.             begin
  1500.                 i := i2+9;
  1501.                 while (i2 <= strlen) and (src[i2] <> '}') do Inc(i2);
  1502.             end;
  1503.             if i2 > strlen then Exit;   { Fehler im Format }
  1504.  
  1505.             if not flag.noFonts then
  1506.             begin
  1507.                 with fonts[ftind] do
  1508.                 begin
  1509.                     name := Copy(src,i,i2-i);   { Font-Name }
  1510.                     number := fnum;
  1511.                     if (flag.optimize) and (ftind < fontsOpt) then
  1512.                         addfontname(name);    { KillStrings zum spΣteren Optimieren setzen }
  1513.                 end;                          { fⁿr die ersten <fontsOpt> deklarierten Schriften }
  1514.                 Inc(ftind);
  1515.             end;
  1516.  
  1517.             src := Copy(src,i2,strlen-i2+1);
  1518.  
  1519.             while (length(src) < 5) and (not lastline) do
  1520.             begin    { Deklaration in nΣchster Zeile fortgesetzt }
  1521.                 if EOF(infile) then
  1522.                     lastline := true
  1523.                 else
  1524.                     ReadLn(infile,nextstr);
  1525.                 src := src + nextstr;
  1526.             end;
  1527.  
  1528.             strlen := length(src);
  1529.             i := 0;
  1530.  
  1531.             while (i <= strlen) and (src[i] <> '}') do Inc(i);
  1532.  
  1533.             if i > strlen then Exit;
  1534.             { Fehler im Format }
  1535.  
  1536.             if (src[i] = '}') and (src[i+1] = '}') then
  1537.             begin
  1538.                 endfonts := true;
  1539.                 src := Copy(src,i+1,strlen-i);
  1540.             end
  1541.             { \fonttbl beendet }
  1542.             else
  1543.             begin
  1544.                 while (i <= strlen) and (src[i] <> '{') do Inc(i);
  1545.                 { Suche nach nΣchster Font-Deklaration }
  1546.                 if i > strlen then Exit;
  1547.                 { Fehler im Format }
  1548.                 src := Copy(src,i,strlen-i+1);
  1549.                 strlen := length(src);
  1550.                 i := 0;
  1551.             end;
  1552.         end
  1553.         else
  1554.             Exit;
  1555.     end;
  1556. end;
  1557.  
  1558. {  ************************************************************************  }
  1559.  
  1560. procedure setcolours (var infile, outfile: textfile; var src: string);
  1561. var
  1562.     i, i2, strlen : integer;
  1563.     endcolours, lastline : boolean;
  1564.     colstr, nextstr : string;
  1565.  
  1566. begin
  1567.     endcolours := false;
  1568.     lastline := false;
  1569.     i := pos('\colortbl',src)+9;
  1570.     strlen := length(src);
  1571.  
  1572.     if (src[i] = ';') then col.add('#000000');  { "auto" color (Farbe 0) nicht gesetzt --> schwarz }
  1573.  
  1574.     While not lastline and not endcolours do
  1575.     begin
  1576.         if EOF(infile) then lastline := true;
  1577.  
  1578.         while (i <= strlen) and (src[i] <> '\') do Inc(i); { Farb-Deklaration suchen }
  1579.         i2 := i;
  1580.         while (i2 <= strlen) and (src[i2] <> ';') do Inc(i2); { das Ende ebendieser suchen }
  1581.  
  1582.         if i2 > strlen then Exit;  { Fehler im Format }
  1583.         if (src[i2+1] = '}') then endcolours := true;
  1584.  
  1585.         colstr := htmlcol(Copy(src,i,i2-i));
  1586.         col.add(colstr); { im html-Farben-Format in die Liste eintragen }
  1587.  
  1588.         if flag.optimize then
  1589.             addcolstr(colstr); { KillStrings zum spΣteren Optimieren setzen }
  1590.  
  1591.         src := Copy(src,i2+1,strlen);
  1592.  
  1593.         while (length(src) < 5) and (not EOF(infile)) do
  1594.         begin    { Deklaration in nΣchster Zeile fortgesetzt }
  1595.             ReadLn(infile,nextstr);
  1596.             src := src + nextstr;
  1597.         end;
  1598.  
  1599.         strlen := length(src);
  1600.         i := 0;
  1601.     end;
  1602. end;
  1603.  
  1604. {  ************************************************************************  }
  1605.  
  1606. procedure initstyles (var infile, outfile: textfile; var src: string);
  1607. var
  1608.     i, j, hrnum, strlen, snum, sbased : integer;
  1609.     endstyles, lastline, str, ctr, firststyle : boolean;
  1610.     basedon, cwd, txt, nextstr, sname, snumstr, spchar : string;
  1611.  
  1612. begin
  1613.     basedon := '';      { Platzhalter fⁿr Basis-Styles }
  1614.     spchar := '';       { Sonderzeichen }
  1615.     snum := 0;          { Style-Nummer im Stylesheet }
  1616.     sbased := 0;        { basierend auf Style Nr. <sbased> }
  1617.     snumstr := '';      { Style-Nummer im String-Format }
  1618.     cwd := '';          { Kontroll-Wort }
  1619.     sname := '';        { Style-Bezeichnung }
  1620.     ctr := false;       { derzeit in einem Kontrollwort ? }
  1621.     str := false;       { derzeit in einer Style-Bezeichnung ? }
  1622.     endstyles := false; { Ende des Stylesheets ? }
  1623.     lastline := false;  { Ende des Input-Files ???????   (wer wei▀...) }
  1624.  
  1625.     firststyle := true;
  1626.     i := pos('\stylesheet',src)+11;
  1627.     strlen := length(src);
  1628.  
  1629.     While (not lastline) and (not endstyles) do
  1630.     begin
  1631.         if EOF(infile) then lastline := true;
  1632.  
  1633.         while (i <= strlen) and (src[i] <> '{') do Inc(i); { Style-Deklaration suchen }
  1634.  
  1635.         if (i < strlen) then
  1636.         begin
  1637.             txt := Copy(src, i+1, 3);
  1638.             if not(
  1639.                       ((Copy(txt, 1, 2) = '\s') and (txt[3] in ['0'..'9']))   { vieles ist m÷glich in RTF ..... }
  1640.                    or (txt = '\ds')
  1641.                    or (txt = '\*\')
  1642.                    ) then    { Style 0 }
  1643.             begin
  1644.                 firststyle := false;
  1645.                 Inc(i);
  1646.                 snum := 0;
  1647.                 while (i <= strlen) and (src[i] <> '}') do
  1648.                 begin
  1649.                     if src[i] = ';' then
  1650.                     begin
  1651.                          stylesheet[snum].name := sname;
  1652.                          str := false;
  1653.                     end;
  1654.  
  1655.                     if (
  1656.                         ctr                           { entweder Kontrollwort }
  1657.                     or  ((src[i] = '\') and not (src[i+1] = #39))
  1658.                         )                             { oder Beginn eines solchen und NICHT ein Sonderzeichen }
  1659.                     and not (src[i] = ' ')            { aber KEIN Leerzeichen }
  1660.                     then
  1661.                         stylesheet[snum].ctrl := stylesheet[snum].ctrl + src[i];
  1662.  
  1663.                     if str and (src[i] <> '\') then sname := sname + src[i];
  1664.                     if ctr then cwd := cwd + src[i];
  1665.  
  1666.                     if src[i] = ' ' then    { hier k÷nnte der Style-Name beginnen }
  1667.                     begin
  1668.                         ctr := false;
  1669.                         cwd := '';
  1670.                         str := true;
  1671.                     end;
  1672.                     if src[i] = '\' then   { hier beginnt ein Kontrollwort }
  1673.                     begin
  1674.                         if src[i+1] = #39 then
  1675.                         begin
  1676.                             spchar := src[i+2]+src[i+3];
  1677.                             sname := sname + plainchar(spchar);
  1678.                             i := i+3;
  1679.                         end
  1680.                         else
  1681.                         begin
  1682.                             ctr := true;
  1683.                             cwd := '';
  1684.                             str := false;
  1685.                             sname := '';
  1686.                         end;
  1687.                     end;
  1688.                     Inc(i);
  1689.  
  1690.                     if (i > strlen-5) then
  1691.                     begin
  1692.                         if not lastline then
  1693.                         begin
  1694.                             src := LineAt(i, src, infile);
  1695.                             ReadLn(infile, nextstr);
  1696.                             src := src + nextstr;
  1697.                             i := 1;
  1698.                         end;
  1699.                     end;
  1700.  
  1701.                     if src[i] = '{' then
  1702.                     begin
  1703.                         src := LineAt(i+1,src,infile);
  1704.                         IgnoreGroup(src, infile);
  1705.                         i := 2;
  1706.                         strlen := length(src);
  1707.                     end;
  1708.                 end;
  1709.                 stylesheet[snum].ctrl := optStyle('', stylesheet[snum].ctrl);
  1710.             end
  1711.             else if (txt = '\ds') or (txt = '\*\') then    { character / section style }
  1712.             begin
  1713.                 src := LineAt(i+1,src,infile);
  1714.                 IgnoreGroup(src, infile);
  1715.                 i := 1;
  1716.             end
  1717.             else if ((Copy(txt, 1, 2) = '\s') and (txt[3] in ['0'..'9'])) then  { paragraph style             }
  1718.             begin                                                               { (das, wonach wir suchen...) }
  1719.                 i := i+3;
  1720.                 snumstr := '';
  1721.                 while src[i] in ['0'..'9'] do
  1722.                 begin
  1723.                     snumstr := snumstr + src[i];
  1724.                     Inc(i);
  1725.                 end;
  1726.                 try
  1727.                     snum := strtoint(snumstr);
  1728.                 except
  1729.                     on EConvertError do
  1730.                         snum := 300;
  1731.                 end;
  1732.  
  1733.                 str := false;
  1734.                 ctr := false;
  1735.                 sname := '';
  1736.                 cwd := '';
  1737.  
  1738.                 while (i <= strlen) and (src[i] <> '}') do
  1739.                 begin
  1740.                     if src[i] = ';' then
  1741.                     begin
  1742.                          stylesheet[snum].name := sname;
  1743.                          str := false;
  1744.  
  1745.                          if pos('toc', sname) > 0 then
  1746.                          begin
  1747.                              hrnum := 0;
  1748.                              for j := 4 to length(sname) do
  1749.                              begin
  1750.                                  if sname[j] in ['1'..'9'] then
  1751.                                      hrnum := strtoint(sname[j]);
  1752.                              end;
  1753.                              if hrnum > 0 then
  1754.                                  linkstyles[hrnum] := snum;
  1755.                          end
  1756.                          else if pos('heading', sname) > 0 then
  1757.                          begin
  1758.                              hrnum := 0;
  1759.                              for j := 8 to length(sname) do
  1760.                              begin
  1761.                                  if sname[j] in ['1'..'9'] then
  1762.                                      hrnum := strtoint(sname[j]);
  1763.                              end;
  1764.                              if hrnum > 0 then
  1765.                                  anchstyles[hrnum] := snum;
  1766.                          end;
  1767.                     end;
  1768.  
  1769.                     if (
  1770.                         ctr                           { entweder Kontrollwort }
  1771.                     or  ((src[i] = '\') and not (src[i+1] = #39))
  1772.                         )                             { oder Beginn eines solchen und NICHT ein Sonderzeichen }
  1773.                     and not (src[i] = ' ')            { aber KEIN Leerzeichen }
  1774.                     then
  1775.                         stylesheet[snum].ctrl := stylesheet[snum].ctrl + src[i];
  1776.  
  1777.                     if str and (src[i] <> '\') then sname := sname + src[i];
  1778.                     if ctr then cwd := cwd + src[i];
  1779.  
  1780.                     if src[i] = ' ' then    { hier k÷nnte der Style-Name beginnen }
  1781.                     begin
  1782.                         ctr := false;
  1783.                         if Copy(cwd, 1, 8) = 'sbasedon' then  { Grundlage ist ein anderer Style }
  1784.                         begin
  1785.                             try
  1786.                                 sbased := strtoint(Copy(cwd, 9, length(cwd)-9));
  1787.                             except
  1788.                                 on EConvertError do
  1789.                                     sbased := -1;
  1790.                             end;
  1791.                             if (sbased >= 0) and (sbased < snum) then
  1792.                             begin
  1793.                                 basedon := stylesheet[sbased].ctrl;
  1794.                                 stylesheet[snum].ctrl := optStyle(stylesheet[sbased].ctrl, stylesheet[snum].ctrl);
  1795.                             end;
  1796.                         end;
  1797.                         cwd := '';
  1798.                         str := true;
  1799.                     end;
  1800.                     if src[i] = '\' then   { hier beginnt ein Kontrollwort }
  1801.                     begin
  1802.                         if src[i+1] = #39 then
  1803.                         begin
  1804.                             spchar := src[i+2]+src[i+3];
  1805.                             sname := sname + plainchar(spchar);
  1806.                             i := i+3;
  1807.                         end
  1808.                         else
  1809.                         begin
  1810.                             ctr := true;
  1811.                             if Copy(cwd, 1, 8) = 'sbasedon' then { Grundlage ist ein anderer Style }
  1812.                             begin
  1813.                                 try
  1814.                                     sbased := strtoint(Copy(cwd, 9, length(cwd)-9));
  1815.                                 except
  1816.                                     on EConvertError do
  1817.                                         sbased := -1;
  1818.                                 end;
  1819.                                 if sbased >= 0 then
  1820.                                 begin
  1821.                                     basedon := stylesheet[sbased].ctrl;
  1822.                                 end;
  1823.                             end;
  1824.                             cwd := '';
  1825.                             str := false;
  1826.                             sname := '';
  1827.                         end;
  1828.                     end;
  1829.                     Inc(i);
  1830.                     if (i > strlen-5) then      { bei Zeiten nΣchste Zeile anhΣngen... }
  1831.                     begin
  1832.                         if not lastline then
  1833.                         begin
  1834.                             src := LineAt(i, src, infile);
  1835.                             ReadLn(infile, nextstr);
  1836.                             src := src + nextstr;
  1837.                             i := 1;
  1838.                             strlen := length(src);
  1839.                         end;
  1840.                     end;
  1841.  
  1842.                     if src[i] = '{' then        { Groups im Stylesheet werden hier ignoriert }
  1843.                     begin
  1844.                         src := LineAt(i+1,src,infile);
  1845.                         IgnoreGroup(src, infile);
  1846.                         i := 2;
  1847.                         strlen := length(src);
  1848.                     end;
  1849.                 end; { while (i <= strlen) and (src[i] <> .... }
  1850.  
  1851.                 stylesheet[snum].ctrl := optStyle(basedon, stylesheet[snum].ctrl);
  1852.                 basedon := '';
  1853.             end;
  1854.         end; { while i <= strlen ..... }
  1855.  
  1856.         src := LineAt(i, src, infile);
  1857.         strlen := length(src);
  1858.         i := 1;
  1859.  
  1860.         while (length(src) < 5) and (not EOF(infile)) do
  1861.         begin    { Deklaration in nΣchster Zeile fortgesetzt }
  1862.             ReadLn(infile,nextstr);
  1863.             src := src + nextstr;
  1864.             strlen := length(src);
  1865.         end;
  1866.  
  1867.         if (src[i+1] = '}') then       { das Stylesheet ist zu Ende }
  1868.         begin
  1869.             endstyles := true;
  1870.             src := Copy(src,i+1,strlen-i);
  1871.         end
  1872.         else
  1873.         begin
  1874.             if not firststyle then
  1875.                 src := Copy(src,i+1,strlen-i);
  1876.         end;
  1877.     end;
  1878. end;
  1879.  
  1880. {  ************************************************************************  }
  1881.  
  1882. procedure ProcessTable (var infile, outfile: textfile; var line: string);
  1883. var                                   { bearbeitet eine Tabelle }
  1884.     brkopen, i, lvl, strlen : integer;
  1885.     ctrlword, txt, buf : string;
  1886.     attrib : format;
  1887.     tempattrib : array[1..20] of format;
  1888.     fmtdiff, lastline, tabpard : boolean;
  1889.  
  1890. begin
  1891.     lvl := 1;
  1892.     brkopen := 1;             { String-Index bei ÷ffnender Klammer, wird vor IgnoreGroup() gebraucht }
  1893.     i := 1;
  1894.     lastline := false;
  1895.     li_open := false;
  1896.     tabpard := false;
  1897.     buf := '';
  1898.     resetfmt(attrib, 'all');
  1899.  
  1900.     WriteHtml('<BR><TABLE BORDER=2><TR><TD>', outstring, outfile);
  1901.     attrib.table := in_cell;
  1902.  
  1903.     While not lastline do
  1904.     begin
  1905.         strlen := length(line);
  1906.  
  1907.         if not tabpard then i := 1;
  1908.  
  1909.         if EOF(infile) then lastline := true;
  1910.  
  1911.         while i <= strlen do
  1912.         begin
  1913.             case line[i] of
  1914.                 '{':
  1915.                     begin
  1916.                         Inc(globbrk);
  1917.                         Inc(lvl);
  1918.  
  1919.                         if tabpard then brkopen := i;
  1920.  
  1921.                         CopyAttrib(tempattrib[lvl], attrib);
  1922.                     end;
  1923.                 '}':
  1924.                     begin
  1925.                         Dec(globbrk);
  1926.                         Dec(lvl);
  1927.  
  1928.                         fmtdiff := diff(attrib, tempattrib[lvl+1]);
  1929.                         if fmtdiff then
  1930.                         begin
  1931.                             changefmt := true;
  1932.                             CopyAttrib(attrib, tempattrib[lvl+1]);
  1933.                         end;
  1934.                     end;
  1935.                 '\': { Kontroll-Ausdruck bzw. RTF-spezifische Zeichen als Text }
  1936.                     begin
  1937.                         Inc(i);
  1938.                         if line[i] in ['\','{','}'] then  {RTF-spezifisches Zeichen als Text}
  1939.                             if (attrib.table = row_end) or (attrib.table = cell_end) then
  1940.                             begin
  1941.                                 if not attrib.invis then buf := buf + htmlchar(line[i], attrib);
  1942.                             end
  1943.                             else
  1944.                             begin
  1945.                                 if not attrib.invis then WriteHtml(htmlchar(line[i], attrib), outstring, outfile);
  1946.                             end
  1947.  
  1948.                         else if line[i] = '~' then
  1949.                             if (attrib.table = row_end) or (attrib.table = cell_end) then
  1950.                             begin
  1951.                                 if not attrib.invis then buf := buf + htmlchar(' ', attrib);
  1952.                             end
  1953.                             else
  1954.                             begin
  1955.                                 if not attrib.invis then WriteHtml(htmlchar(' ', attrib), outstring, outfile);
  1956.                             end
  1957.  
  1958.                         else if line[i] = '*' then
  1959.                         begin
  1960.                             if tabpard then
  1961.                             begin
  1962.                                 txt := Copy (line, 1, brkopen-1);    { vor IgnoreGroup mu▀ die Zeile seit dem letzten }
  1963.                                 line := LineAt(i,line,infile);       { \pard gespeichert werden, da der aktuelle      }
  1964.                                 IgnoreGroup(line, infile);           { Absatz noch nicht als Teil einer Tabelle       }
  1965.                                 strlen := length(line);              { identifiziert ist                              }
  1966.                                 line := txt + Copy(line, 2, strlen-1);
  1967.                                 Dec(globbrk);
  1968.                                 i := brkopen-1;
  1969.                             end
  1970.                             else
  1971.                             begin
  1972.                                 line := LineAt(i,line,infile);
  1973.                                 IgnoreGroup(line, infile);
  1974.                                 strlen := length(line);
  1975.                                 i := 0;
  1976.                             end;
  1977.                         end
  1978.  
  1979.                         else if (line[i] = '_') then
  1980.                             if (attrib.table = row_end) or (attrib.table = cell_end) then
  1981.                             begin
  1982.                                 if not attrib.invis then buf := buf + htmlchar('-', attrib);
  1983.                             end
  1984.                             else
  1985.                             begin
  1986.                                 if not attrib.invis then WriteHtml(htmlchar('-', attrib), outstring, outfile);
  1987.                             end
  1988.  
  1989.                         else if (line[i] = '-') then
  1990.                         begin
  1991.                             { nix, da es sich um ein optionales Abteilungszeichen handelt }
  1992.                         end
  1993.  
  1994.                         else if line[i] = #39 then   { Sonderzeichen, z.B. Umlaut, beginnend mit ' }
  1995.                         begin
  1996.                             txt := line[i+1]+line[i+2];
  1997.                             i := i+2;
  1998.  
  1999.                             if (attrib.table = row_end) or (attrib.table = cell_end) then
  2000.                             begin
  2001.                                 buf := buf + htmlchar(txt, attrib);
  2002.                             end
  2003.                             else  { BestΣtigung, da▀ wir uns in einer neuen Cell befinden -> kein Buffer n÷tig }
  2004.                             begin
  2005.                                 WriteHtml(htmlchar(txt, attrib), outstring, outfile)
  2006.                             end;
  2007.                         end
  2008.  
  2009.                         else if line[i] in ['a'..'z'] then  { Kontroll-Ausdruck }
  2010.                         begin
  2011.                             ctrlword := '';
  2012.                             while (line[i] in ['a'..'z','0'..'9','-']) and (i <= strlen) do
  2013.                             begin
  2014.                                 ctrlword := ctrlword + line[i];
  2015.                                 Inc(i);
  2016.                             end;
  2017.  
  2018.                             if i > strlen then                 { Kontrollwort zu Ende + neue Zeile im RTF-File }
  2019.                             begin
  2020.                                 if not lastline then ReadLn(infile, line);
  2021.                                 if EOF(infile) then lastline := true;
  2022.                                 i := 0;
  2023.                                 strlen := length(line);
  2024.                             end
  2025.                             else
  2026.                                 if line[i] <> ' ' then Dec(i); { nur der Delimiter <SPACE> ist als solcher }
  2027.                                                                { Teil eines Kontrollwortes                 }
  2028.  
  2029.                             { Variable 'i' steht nun am Ende des Kontroll-Wortes }
  2030.  
  2031.                             if (ctrlword = 'bkmkstart') or
  2032.                                (ctrlword = 'bkmkend') or
  2033.                                (ctrlword = 'filetbl') or
  2034.                                (ctrlword = 'footer') or
  2035.                                (ctrlword = 'footerf') or
  2036.                                (ctrlword = 'footnote') or
  2037.                                (ctrlword = 'header') or
  2038.                                (ctrlword = 'headerf') or
  2039.                                (ctrlword = 'levelnumbers') or
  2040.                                (ctrlword = 'leveltext') or
  2041.                                (ctrlword = 'list') or
  2042.                                (ctrlword = 'listlevel') or
  2043.                                (ctrlword = 'listname') or
  2044.                                (ctrlword = 'listoverridetable') or
  2045.                                (ctrlword = 'listtable') or
  2046.                                (ctrlword = 'pict') or
  2047.                                (ctrlword = 'pntxtb') or
  2048.                                (ctrlword = 'pntxta') or
  2049.                                (ctrlword = 'revtbl') or
  2050.                                (ctrlword = 'sp') or
  2051.                                (ctrlword = 'template') then
  2052.                             begin
  2053.                                 if tabpard then
  2054.                                 begin
  2055.                                     txt := Copy (line, 1, brkopen-1);
  2056.                                     line := LineAt(i,line,infile);
  2057.                                     IgnoreGroup(line, infile);
  2058.                                     strlen := length(line);
  2059.                                     line := txt + Copy(line, 2, strlen-1);
  2060.                                     Dec(globbrk);
  2061.                                     i := brkopen-1;
  2062.                                 end
  2063.                                 else
  2064.                                 begin
  2065.                                     line := LineAt(i,line,infile);
  2066.                                     IgnoreGroup(line, infile);
  2067.                                     strlen := length(line);
  2068.                                     i := 0;
  2069.                                 end;
  2070.  
  2071.                                 if ctrlword = 'pict' then
  2072.                                     if (attrib.table = row_end) or (attrib.table = cell_end) then
  2073.                                         buf := buf + htmlchar('&pict;', attrib)
  2074.                                     else
  2075.                                         WriteHtml(htmlchar('&pict;', attrib), outstring, outfile);
  2076.                             end
  2077.                             else if (ctrlword = 'par') or (ctrlword = 'sect') then      { neuer Absatz }
  2078.                             begin
  2079.                                 txt := '';
  2080.                                 txt := empty(mainstack);
  2081.                                 if attrib.rjustified then
  2082.                                 begin
  2083.                                     txt := txt + '</DIV>';
  2084.                                 end;
  2085.                                 if attrib.centered then
  2086.                                 begin
  2087.                                     txt := txt + '</CENTER>';
  2088.                                 end;
  2089.  
  2090.                                 txt := txt + '<BR>';
  2091.  
  2092.                                 if attrib.table = cell_end then
  2093.                                 begin
  2094.                                     buf := buf + txt;
  2095.                                 end
  2096.                                 else if attrib.table = in_cell then
  2097.                                 begin
  2098.                                     WriteHtml(txt, outstring, outfile);
  2099.                                 end;
  2100.                             end
  2101.                             else if (ctrlword = 'intbl') then
  2102.                             begin
  2103.                                 tabpard := false;
  2104.                             end
  2105.                             else if (ctrlword = 'pard') or ((ctrlword = 'widctlpar') and (pos('\intbl', line) <> i+1)) then
  2106.                             begin
  2107.                                 if attrib.table = row_end then
  2108.                                 begin
  2109.                                     if tabpard then
  2110.                                     begin
  2111.                                         attrib.table := plain;
  2112.                                         WriteHtml('</TABLE><BR>', outstring, outfile);
  2113.                                         Exit;
  2114.                                     end
  2115.                                     else
  2116.                                     begin
  2117.                                         if line[i] = ' ' then
  2118.                                             line := Copy (line, i-5, strlen-i+6)
  2119.                                         else
  2120.                                             line := Copy (line, i-4, strlen-i+5);
  2121.                                         i := 5;
  2122.                                         strlen := length(line);
  2123.                                         tabpard := true;
  2124.                                     end;
  2125.                                 end;
  2126.                                 if ctrlword = 'pard' then
  2127.                                     if (attrib.table = cell_end) or (attrib.table = row_end) then
  2128.                                         buf := buf + html(ctrlword, attrib)  { Buffer, weil wir noch auf \cell warten }
  2129.                                     else
  2130.                                         WriteHtml(html(ctrlword, attrib), outstring, outfile);
  2131.                             end
  2132.                             else if ctrlword = 'trowd' then      { Beginn einer Tabellen-Zeile }
  2133.                             begin
  2134.                                 tabpard := false;
  2135.                                 if attrib.table = row_end then     { neue Zeile in bestehender Tabelle }
  2136.                                 begin
  2137.                                     buf := '';
  2138.                                     WriteHtml('<TR><TD>', outstring, outfile);
  2139.                                     resetfmt(attrib, 'all');
  2140.                                     attrib.table := in_cell;
  2141.                                 end;
  2142.                             end
  2143.                             else if ctrlword = 'row' then
  2144.                             begin
  2145.                                 resetfmt(attrib, 'all');
  2146.                                 buf := '';
  2147.                                 tabpard := false;
  2148.                                 WriteHtml('</TR>', outstring, outfile);
  2149.                                 attrib.table := row_end;
  2150.                             end
  2151.                             else if ctrlword = 'cell' then
  2152.                             begin
  2153.                                 tabpard := false;
  2154.                                 if attrib.table = cell_end then
  2155.                                     txt := '<TD>' + buf + empty(mainstack) + '</TD>'
  2156.                                 else if attrib.table = row_end then
  2157.                                     txt := '<TR><TD>' + buf + empty(mainstack) + '</TD>'
  2158.                                 else if attrib.table = in_cell then
  2159.                                     txt := empty(mainstack) + '</TD>';
  2160.  
  2161.                                 WriteHtml(txt, outstring, outfile);
  2162.                                 resetfmt(attrib, 'all');
  2163.                                 attrib.table := cell_end;
  2164.                                 buf := '';
  2165.                             end
  2166.                             else  { nicht ignoriertes Kontrollwort }
  2167.                             begin
  2168.                                 if (attrib.table = cell_end) or (attrib.table = row_end) then
  2169.                                     buf := buf + html(ctrlword, attrib)  { Buffer, weil wir noch auf \cell warten }
  2170.                                 else
  2171.                                     WriteHtml(html(ctrlword, attrib), outstring, outfile);
  2172.                             end;
  2173.                         end;
  2174.                     end;
  2175.                 else   { Dokument-Text }
  2176.                 begin
  2177.                     if (attrib.table = cell_end) or (attrib.table = row_end) then
  2178.                         { in Buffer schreiben, wir noch auf ein \cell warten, }
  2179.                         { welches bestΣtigt, da▀ die row noch nicht zu Ende ist }
  2180.                         buf := buf + htmlchar(line[i], attrib)
  2181.                     else
  2182.                         WriteHtml(htmlchar(line[i], attrib), outstring, outfile);
  2183.                 end;
  2184.             end;  { case }
  2185.             Inc(i);
  2186.         end;   { while i <= strlen... }
  2187.  
  2188.         if not lastline then
  2189.         begin
  2190.             if not tabpard then
  2191.                 ReadLn(infile, line)
  2192.             else
  2193.             begin
  2194.                 ReadLn(infile, txt);
  2195.                 line := line + txt;
  2196.             end;
  2197.         end;
  2198.     end;  { While not lastline }
  2199. end;
  2200.  
  2201. {  ************************************************************************  }
  2202.  
  2203. procedure ProcessGroup (var infile, outfile: textfile; var line: string; var attrib: format);
  2204. var                                   { bearbeitet eine rtf-'Group' }
  2205.     brk, i, j, num, strlen : integer;
  2206.     ctrlword, txt, lvlnumstr : string;
  2207.     tempattrib : format;
  2208.     fmtdiff, quitblock, inv : boolean;
  2209.  
  2210. begin
  2211.     Inc(globbrk);
  2212.     num := 0;
  2213.  
  2214.     quitblock := false;
  2215.  
  2216.     While not lastline do
  2217.     begin
  2218.         strlen := length(line);
  2219.         i := 1;
  2220.         if EOF(infile) then lastline := true;
  2221.  
  2222.         while i <= strlen do
  2223.         begin
  2224.             case line[i] of
  2225.                 '{': { neuer Block }
  2226.                     begin
  2227.                         line := LineAt(i+1, line, infile);
  2228.  
  2229.                         if ahref then
  2230.                         begin
  2231.                             WriteHtml('</A>', outstring, outfile);
  2232.                             ahref := false;
  2233.                         end;
  2234.  
  2235.                         CopyAttrib(tempattrib, attrib);
  2236.  
  2237.                         ProcessGroup (infile, outfile, line, attrib);
  2238.  
  2239.                         fmtdiff := diff(attrib, tempattrib);
  2240.                         if fmtdiff then
  2241.                         begin
  2242.                             txt := empty(mainstack);
  2243.                             changefmt := true;
  2244.                             WriteHtml(txt, outstring, outfile);
  2245.                             CopyAttrib(attrib, tempattrib);
  2246.                         end;
  2247.  
  2248.                         txt := '';
  2249.  
  2250.                         strlen := length(line);
  2251.                         i := 0; { aufgerufene Prozedur liefert neue 'line' zurⁿck }
  2252.                     end;
  2253.                 '}': { Ende des aktuellen Blocks }
  2254.                     begin
  2255.                         line := LineAt(i+1, line, infile);
  2256.  
  2257.                         if ahref then
  2258.                         begin
  2259.                             WriteHtml('</A>', outstring, outfile);
  2260.                             ahref := false;
  2261.                         end;
  2262.  
  2263.                         Dec(globbrk);
  2264.                         Exit;
  2265.                     end;
  2266.                 '\': { Kontroll-Ausdruck bzw. RTF-spezifische Zeichen als Text }
  2267.                     begin
  2268.                         inv := attrib.invis;
  2269.  
  2270.                         Inc(i);
  2271.                         if line[i] in ['\','{','}'] then  {RTF-spezifisches Zeichen als Text}
  2272.                         begin
  2273.                             if not inv then WriteHtml(htmlchar(line[i], attrib), outstring, outfile);
  2274.                         end
  2275.  
  2276.                         else if line[i] = '~' then
  2277.                         begin
  2278.                             if not inv then WriteHtml(htmlchar(' ', attrib), outstring, outfile);
  2279.                         end
  2280.  
  2281.                         else if line[i] = '*' then
  2282.                         begin
  2283.                             if (Copy(line, i+2, 3) = 'pn ') or (Copy(line, i+2, 3) = 'pn\') then
  2284.                             begin
  2285.                                 pntxta := '';
  2286.                                 pntxtb := '';
  2287.                                 lvlnumstr := '';
  2288.                                 i := i+4;
  2289.                                 brk := 1;
  2290.  
  2291.                                 while (brk > 0) and (not quitblock) do
  2292.                                 begin
  2293.                                     if line[i] = '\' then
  2294.                                     begin
  2295.                                         Inc(i);
  2296.                                         if line[i] in ['a'..'z'] then  { Kontroll-Ausdruck }
  2297.                                         begin
  2298.                                             ctrlword := '';
  2299.                                             while (line[i] in ['a'..'z','0'..'9','-']) and (i <= strlen) do
  2300.                                             begin
  2301.                                                 ctrlword := ctrlword + line[i];
  2302.                                                 Inc(i);
  2303.                                             end;
  2304.  
  2305.                                             Dec(i);    { sonst verlieren wir ein Zeichen }
  2306.  
  2307.                                             if (ctrlword = 'pnlvlblt')
  2308.                                             or ((pos('pnlvl', ctrlword) = 1) and (ctrlword[6] in ['5'..'9']))
  2309.                                             then
  2310.                                             begin
  2311.                                                 pnnum := false;
  2312.                                                 listbull := true;
  2313.                                                 listitem := true;
  2314.                                                 enums.doclvl := globbrk-1;   { aktuelles Group-Level speichern }
  2315.                                                 Inc(enums.lvl);
  2316.  
  2317.                                                 WriteHtml('<UL><LI type=disc>', outstring, outfile);
  2318.                                             end
  2319.                                             else if (ctrlword = 'pnlvlcont')
  2320.                                                  or (ctrlword = 'pnlvlbody')
  2321.                                                  or ((pos('pnlvl', ctrlword) = 1) and (ctrlword[6] in ['1'..'4'])) then
  2322.                                             begin
  2323.                                                 if (ctrlword = 'pnlvlbody') then
  2324.                                                     pnnum := true
  2325.                                                 else
  2326.                                                     pnnum := false;
  2327.  
  2328.                                                 listbull := false;
  2329.                                                 listitem := false;
  2330.                                                 enums.doclvl := globbrk-1;   { aktuelles Group-Level speichern }
  2331.                                               {  enums.lvl := 0;     }
  2332.                                             end
  2333.                                             else if (ctrlword = 'pndec')
  2334.                                                  or (ctrlword = 'pncard')
  2335.                                                  or (ctrlword = 'pnucltr')
  2336.                                                  or (ctrlword = 'pnucrm')
  2337.                                                  or (ctrlword = 'pnlcltr')
  2338.                                                  or (ctrlword = 'pnlcrm')
  2339.                                                  or (ctrlword = 'pnord')
  2340.                                                  or (ctrlword = 'pnordt') then
  2341.                                             begin
  2342.                                                 enumdigit := true;
  2343.                                             end
  2344.                                             else if (Pos('pnstart', ctrlword) > 0) then
  2345.                                             begin
  2346.                                                 if enumdigit and pnnum then
  2347.                                                 begin
  2348.                                                     lvlnumstr := '';
  2349.                                                     for j := 8 to length(ctrlword) do
  2350.                                                     begin
  2351.                                                         lvlnumstr := lvlnumstr + ctrlword[j];
  2352.                                                     end;
  2353.                                                     try
  2354.                                                         lvlnum := strtoint(lvlnumstr);
  2355.                                                     except
  2356.                                                         on EConvertError do
  2357.                                                             lvlnum := 1;
  2358.                                                     end;
  2359.                                                 end;
  2360.                                             end
  2361.                                             else if (ctrlword = 'pntxta') and (pnnum) then
  2362.                                             begin               { Text, der nach der AufzΣhlungs-Nummer steht }
  2363.                                                 Inc(i, 2);
  2364.                                                 while line[i] <> '}' do
  2365.                                                 begin
  2366.                                                     pntxta := pntxta + line[i];
  2367.                                                     Inc(i);
  2368.                                                 end;
  2369.                                                 Dec(i);   { sonst verlieren wir eine schlie▀ende Klammer }
  2370.                                             end
  2371.                                             else if (ctrlword = 'pntxtb') and (pnnum) then
  2372.                                             begin
  2373.                                                 Inc(i, 2);      { Text, der vor der AufzΣhlungs-Nummer steht }
  2374.                                                 while line[i] <> '}' do
  2375.                                                 begin
  2376.                                                     pntxtb := pntxtb + line[i];
  2377.                                                     Inc(i);
  2378.                                                 end;
  2379.                                                 Dec(i);   { sonst verlieren wir eine schlie▀ende Klammer }
  2380.                                             end;
  2381.                                         end;
  2382.                                     end
  2383.                                     else if line[i] = '{' then
  2384.                                     begin
  2385.                                         Inc(brk);
  2386.                                     end
  2387.                                     else if line[i] = '}' then
  2388.                                     begin
  2389.                                         Dec(brk);
  2390.                                     end;
  2391.  
  2392.                                     Inc(i);
  2393.  
  2394.                                     if (i > strlen) then
  2395.                                     begin
  2396.                                         if not lastline then
  2397.                                         begin
  2398.                                             ReadLn(infile, line);
  2399.                                             if (brk = 0) then
  2400.                                             begin
  2401.                                                 line := '}' + line;
  2402.                                                 i := 0;
  2403.                                             end
  2404.                                             else
  2405.                                                i := 1;
  2406.                                             if EOF(infile) then lastline := true;
  2407.                                         end
  2408.                                         else
  2409.                                         begin
  2410.                                             quitblock := true;
  2411.                                         end;
  2412.                                     end;
  2413.  
  2414.                                     if ((quitblock) or (brk = 0)) and (i > 0) then
  2415.                                         i := i-2;                 { sonst fehlt die letzte Klammer }
  2416.                                 end;                              { zum Beenden der Rekursion      }
  2417.                                 if (not listbull) and (pnnum) then
  2418.                                 begin
  2419.                                     txt := pntxtb + lvlnumstr + pntxta;
  2420.                                     if length(txt) > 0 then
  2421.                                     begin
  2422.                                         txt := '&&' + txt;
  2423.                                         WriteHtml(htmlchar(txt, attrib), outstring, outfile);
  2424.                                     end;
  2425.                                 end;
  2426.                             end
  2427.                             else
  2428.                             begin
  2429.                                 if (Copy(line, i+2, 4) = 'bkmk') and not bkmkpar then
  2430.                                 begin                                      { RTF-Bookmarks wirken sich im Layout }
  2431.                                     WriteHtml('<P>', outstring, outfile);  { als vergr÷▀erter Zeilenabstand ⁿber }
  2432.                                     bkmkpar := true;                       { und unter dem Bookmark aus.....     }
  2433.                                 end;
  2434.                                 line := LineAt(i,line,infile);
  2435.                                 IgnoreGroup(line, infile);
  2436.                                 i := 0;
  2437.                                 strlen := length(line);
  2438.                             end;
  2439.                         end
  2440.  
  2441.                         else if (line[i] = '_') then
  2442.                         begin
  2443.                             if not inv then WriteHtml(htmlchar('-', attrib), outstring, outfile);
  2444.                         end
  2445.  
  2446.                         else if (line[i] = '-') then
  2447.                         begin
  2448.                             { nix, da es sich um ein optionales Abteilungszeichen handelt }
  2449.                         end
  2450.  
  2451.                         else if line[i] = #39 then   { Sonderzeichen, z.B. Umlaut, beginnend mit ' }
  2452.                         begin
  2453.                             txt := line[i+1]+line[i+2];
  2454.                             i := i+2;
  2455.                             WriteHtml(htmlchar(txt, attrib), outstring, outfile);
  2456.                         end
  2457.  
  2458.                         else if line[i] in ['a'..'z'] then  { Kontroll-Ausdruck }
  2459.                         begin
  2460.                             ctrlword := '';
  2461.                             while (line[i] in ['a'..'z','0'..'9','-']) and (i <= strlen) do
  2462.                             begin
  2463.                                 ctrlword := ctrlword + line[i];
  2464.                                 Inc(i);
  2465.                             end;
  2466.  
  2467.                             if i > strlen then                 { Kontrollwort zu Ende + neue Zeile im RTF-File }
  2468.                             begin
  2469.                                 if not lastline then ReadLn(infile, line);
  2470.                                 if EOF(infile) then lastline := true;
  2471.                                 i := 0;
  2472.                                 strlen := length(line);
  2473.                             end
  2474.                             else
  2475.                                 if line[i] <> ' ' then Dec(i); { nur der Delimiter <SPACE> ist als solcher }
  2476.                                                                { Teil eines Kontrollwortes                 }
  2477.  
  2478.                             { Variable 'i' steht nun am Ende des Kontroll-Wortes }
  2479.  
  2480.                             if ctrlword = 'fonttbl' then
  2481.                             begin
  2482.                                 setfonts (infile, outfile, line); { erfa▀t die Schriftarten und liefert neue      }
  2483.                                 i := 0;                           { Zeile ab erstem Zeichen nach der Font-Tabelle }
  2484.                                 strlen := length(line);
  2485.                                 if EOF(infile) then lastline := true;  { just in case... }
  2486.                             end
  2487.                             else if ctrlword = 'colortbl' then
  2488.                             begin
  2489.                                 setcolours (infile, outfile, line);  { erfa▀t die verwendeten Farben und liefert neue }
  2490.                                 i := 0;                              { Zeile ab erstem Zeichen nach der Farb-Tabelle  }
  2491.                                 strlen := length(line);
  2492.                                 if EOF(infile) then lastline := true;  { just in case... }
  2493.                             end
  2494.                             else if ctrlword = 'stylesheet' then
  2495.                             begin
  2496.                                 initstyles (infile, outfile, line);  { erfa▀t die verwendeten Styles und liefert neue }
  2497.                                 i := 0;                              { Zeile ab erstem Zeichen nach dem Stylesheet    }
  2498.                                 strlen := length(line);
  2499.                                 if EOF(infile) then lastline := true;  { just in case... }
  2500.                             end
  2501.                             else if (pos('s',ctrlword) = 1) and (ctrlword[2] in ['0'..'9']) then
  2502.                             begin                                   { Stylesheet-Eintrag }
  2503.                                 try
  2504.                                     num := strtoint(copy(ctrlword,2,length(ctrlword)-1));
  2505.                                 except
  2506.                                     on EConvertError do
  2507.                                         num := 0;
  2508.                                 end;                             { Style-Nummer erfassen }
  2509.  
  2510.                                 for j := 1 to 9 do
  2511.                                 begin
  2512.                                     if linkstyles[j] = num then
  2513.                                     begin
  2514.                                         if anchstyles[j] > -1 then
  2515.                                         begin
  2516.                                             ahrefwait := true;
  2517.                                             newhrefnum := true;
  2518.                                             indexlvl := j;
  2519.                                         end;
  2520.                                         break;
  2521.                                     end;
  2522.                                     if anchstyles[j] = num then
  2523.                                     begin
  2524.                                         anchor := true;
  2525.                                         anchlvl := j;
  2526.                                     end;
  2527.                                 end;
  2528.  
  2529.                                 txt := LineAt(i+1, line, infile);
  2530.                                 line := stylesheet[num].ctrl + txt;
  2531.                                 strlen := length(line);
  2532.                                 i := 0;
  2533.                             end
  2534.                             else if ctrlword = 'trowd' then
  2535.                             begin
  2536.                                 WriteHtml(empty(mainstack), outstring, outfile);
  2537.                                 CloseLists(outstring, outfile);
  2538.  
  2539.                                 line := LineAt(i, line, infile);
  2540.                                 ProcessTable(infile, outfile, line);
  2541.                                 i := 0;
  2542.                                 strlen := length(line);
  2543.                             end
  2544.                             else if (ctrlword = 'bkmkstart') or
  2545.                                     (ctrlword = 'bkmkend') or
  2546.                                     (ctrlword = 'filetbl') or
  2547.                                     (ctrlword = 'footer') or
  2548.                                     (ctrlword = 'footerf') or
  2549.                                     (ctrlword = 'footnote') or
  2550.                                     (ctrlword = 'header') or
  2551.                                     (ctrlword = 'headerf') or
  2552.                                     (ctrlword = 'info') or
  2553.                                     (ctrlword = 'levelnumbers') or
  2554.                                     (ctrlword = 'leveltext') or
  2555.                                     (ctrlword = 'list') or
  2556.                                     (ctrlword = 'listlevel') or
  2557.                                     (ctrlword = 'listname') or
  2558.                                     (ctrlword = 'listoverridetable') or
  2559.                                     (ctrlword = 'listtable') or
  2560.                                     (ctrlword = 'pict') or
  2561.                                     (ctrlword = 'pntext') or
  2562.                                     (ctrlword = 'revtbl') or
  2563.                                     (ctrlword = 'sp') or
  2564.                                     (ctrlword = 'template') then
  2565.                             begin
  2566.                                 line := LineAt(i,line,infile);
  2567.                                 IgnoreGroup(line, infile);
  2568.                                 i := 0;
  2569.                                 strlen := length(line);
  2570.                                 if ctrlword = 'pict' then
  2571.                                     WriteHtml(htmlchar('&pict;', attrib), outstring, outfile);
  2572.                             end
  2573.                             else  { nicht ignoriertes Kontrollwort }
  2574.                             begin
  2575.                                 if ahref then
  2576.                                     WriteHtml('</A>', outstring, outfile);
  2577.  
  2578.                                 WriteHtml(html(ctrlword, attrib), outstring, outfile);
  2579.                                 if ahref then ahref := false;
  2580.                             end;   { begin nicht ignoriertes Kontrollwort }
  2581.                         end;
  2582.                     end;
  2583.                 else  { Dokument-Text }
  2584.                 begin
  2585.                     if li_open then
  2586.                     begin
  2587.                         WriteHtml('<LI type=disc>', outstring, outfile);
  2588.                         li_open := false;
  2589.                     end;
  2590.  
  2591.                     if pnnum and nextpar and (length(enumtxt) > 0) then
  2592.                     begin
  2593.                         enumtxt := '&&' + enumtxt;
  2594.                         WriteHtml(htmlchar(enumtxt, attrib), outstring, outfile);
  2595.                         enumtxt := '';
  2596.                     end;
  2597.                     WriteHtml(htmlchar(line[i], attrib), outstring, outfile);
  2598.                 end;
  2599.             end;  { case }
  2600.             Inc(i);
  2601.         end;   { while i <= strlen... }
  2602.  
  2603.         if not lastline then ReadLn(infile, line);
  2604.     end;  { While not lastline }
  2605.  
  2606.     Dec(globbrk);
  2607. end;
  2608.  
  2609. {  ************************************************************************  }
  2610.  
  2611. procedure rtf2html (filename: string; destfilename: string; param: array of string);
  2612. var
  2613.     infile, outfile: textfile;
  2614.     src, txt: string;
  2615.     attrib: format;
  2616.     i: integer;
  2617.  
  2618. begin
  2619.     changefmt := false;
  2620.  
  2621.     for i := 0 to 20 do            { Indents zur <UL>-Steuerung setzen }
  2622.     begin
  2623.         enums.indent[i] := (i*ul_indent);
  2624.     end;
  2625.  
  2626.     for i := 0 to 300 do           { internes Stylesheet initialisieren }
  2627.     begin
  2628.         stylesheet[i].ctrl := '';
  2629.         stylesheet[i].name := '';
  2630.     end;
  2631.  
  2632.  
  2633.     for i := 1 to 9 do            { arrays zur Sprungmarken-Steuerung initialisieren }
  2634.     begin
  2635.         linkstyles[i] := -1;
  2636.         anchstyles[i] := -1;
  2637.         actlinknum[i] := 0;
  2638.         actanchnum[i] := 0;
  2639.     end;
  2640.  
  2641.     flag.noFonts := false;           { default sind alle Aufrufparameter 'false' }
  2642.     flag.optimize := false;
  2643.     flag.onlyDefiniteOpt := false;
  2644.  
  2645.     for i := 0 to high(param) do     { auf mitgegebene Parameter prⁿfen ... }
  2646.     begin
  2647.         if param[i] = 'noFonts' then flag.noFonts := true;
  2648.         if param[i] = 'optimize' then flag.optimize := true;
  2649.         if param[i] = 'onlyDefiniteOpt' then flag.onlyDefiniteOpt := true;
  2650.     end;
  2651.  
  2652.     mainstack := NIL;            { Haupt-Formatierungs-Stack }
  2653.     resetfmt(attrib, 'all');     { Attribut-Record 'defaulten' }
  2654.     outstring := '';             { das, was letztendlich ins outfile geschrieben wird }
  2655.     bkmkpar := false;            { Hilfsflag zu Formatierungszwecken }
  2656.     lastline := false;           { Flag, um das File-Ende abzufangen }
  2657.     li_open := false;            { true, solange bei einer AufzΣhlung kein Ende feststeht }
  2658.     listitem := false;           { false, wenn <UL>, aber kein <LI> }
  2659.     lastindent := 0;
  2660.     no_newind := true;
  2661.     txtwait := '';
  2662.     pnnum := false;              { true, wenn ein AufzΣhlungspunkt mit formatierter Numerierung folgt }
  2663.     nextpar := true;             { true, sobald ein \par gelesen wird; false ab erstem Dokument-Text-Zeichen danach }
  2664.     enumdigit := false;          { true, wenn eine numerische AufzΣhlung folgt }
  2665.     enumtxt := '';               { der String, der die formatierte Numerierung enthΣlt }
  2666.  
  2667.     col := TStringList.Create;   { interne Farbtabelle }
  2668.     lvlnum := -1;                { aktuelle Zahl bei AufzΣhlungen }
  2669.     enums.lvl := 0;              { aktuelles AufzΣhlungs bzw. Einrⁿckungs-Level }
  2670.     globbrk := 0;                { Anzahl der offenen Klammern im RTF-Dokument }
  2671.  
  2672.     ahref := false;              { true bei einer Referenz }
  2673.     anchor := false;             { true bei einer Sprungmarke }
  2674.     indexlvl := 0;               { aktuelles Level im Inhaltsverzeichnis }
  2675.     anchlvl := 0;                { aktuelles Heading-(▄berschrift-)Level }
  2676.     ahrefwait := false;          { true, wenn der nΣchste Text Teil einer Referenz ist }
  2677.     newhrefnum := false;         { true bei jedem neuen Punkt im Inhaltsverzeichnis }
  2678.  
  2679.     if flag.optimize then
  2680.         init_killstr;            { wenn's optimiert werden soll, mⁿssen die Kill Strings gesetzt werden }
  2681.  
  2682.     AssignFile(infile, filename);
  2683.     AssignFile(outfile, destfilename);
  2684.     Reset(infile);
  2685.     ReWrite(outfile);
  2686.  
  2687.     WriteLn(outfile,'<HTML>');
  2688.     WriteLn(outfile,'<HEAD>');
  2689.     WriteLn(outfile,('<TITLE>'+filename+'</TITLE>'));
  2690.     WriteLn(outfile,'</HEAD>');
  2691.     WriteLn(outfile,'<BODY TEXT="#000000" BGCOLOR="#FFFFFF" LINK="#3333FF" VLINK="#999999" ALINK="#FF0000">');
  2692.  
  2693.     Flush(outfile);
  2694.  
  2695.     try
  2696.         ReadLn(infile, src);
  2697.         ProcessGroup (infile, outfile, src, attrib);
  2698.  
  2699.     finally
  2700.         txt := empty(mainstack);
  2701.         if attrib.rjustified then
  2702.             txt := txt + '</DIV>';
  2703.         if attrib.centered then
  2704.             txt := txt + '</CENTER>';
  2705.  
  2706.         WriteHtml(txt, outstring, outfile);
  2707.         CloseLists(outstring, outfile);
  2708.  
  2709.         WriteLn(outfile, outstring);
  2710.         WriteLn(outfile,'</BODY>');
  2711.         WriteLn(outfile,'</HTML>');
  2712.         col.Free;
  2713.  
  2714.         Flush(outfile);          { wir ziehen an der Leine, damit auch alles wegkommt.... }
  2715.         CloseFile(infile);
  2716.         CloseFile(outfile);
  2717.     end;
  2718. end;
  2719.  
  2720. end.
  2721.