Quelle  rtf2html.pas

unit rtf2html;
//------------------------------------------------------------------------------
//
//------------------------------------------------------------------------------
interface
uses
  SysUtils, Windows, Messages, Classes, Graphics, Controls, StrUtils,
  Forms, Dialogs, StdCtrls, Buttons, ExtCtrls, ComCtrls, UniRtf2HtmlUnit1;
//------------------------------------------------------------------------------
//
//------------------------------------------------------------------------------
procedure RichEditToHTML(RichEdit: TRichEdit; var strHTMLCode: string);
procedure HTMLToRichEdit(strHTMLCode: string; RichEdit: TRichEdit);
procedure GetLineBreak(var iBreakPos: integer;var strLine, strBreakChar: string;var CurrentParagraphFormat: TParagraphFormat);
procedure RemoveLineBreak(var strLine: string);
//------------------------------------------------------------------------------
//
//------------------------------------------------------------------------------
implementation
const
 skip:array[1..13] of String=
 ('<br>',
  '<li>', '</li>',
  '<p>', '</p>',
  '<p align="left">',
  '<p align="center">',
  '<p align="right">',
  '<div>', '</div>',
  '<div align="left">',
  '<div align="center">',
  '<div align="right">');
//------------------------------------------------------------------------------
//
//------------------------------------------------------------------------------
procedure RichEditToHTML(RichEdit: TRichEdit; var strHTMLCode: string);
var
  RTFString: TStringStream;
  strStream: string;
  UniRtf2Html: TUniRtf2Html;
begin
  if RichEdit.Text <> '' then
  begin
    RichEdit.Text := Trim(RichEdit.Text);
    RTFString := TStringStream.Create(strStream);
    try
      UniRtf2Html := TUniRtf2Html.Create;
      try
        RichEdit.Lines.SaveToStream(RTFString);
        RTFString.Position := 0;
        strHTMLCode := UniRtf2Html.ConvertRtfToHtml(RTFString.ReadString(RTFString.Size));
      finally
        UniRtf2Html.Free;
      end;
    finally
      RTFString.Free;
    end;
  end;
end;
//------------------------------------------------------------------------------
//
//------------------------------------------------------------------------------
procedure HTMLToRichEdit(strHTMLCode: string; RichEdit: TRichEdit);
var
  iBreakPos, iPosCtrlCharStart, iPosCtrlCharEnd, iPrevLinesLength, i, j: integer;
  strLine, strCtrlChar, strBreakChar: string;ll,oct:integer;Buf:string;
  TextLayouts: array of record t:string;p:TAlignment;a:TTextFormat;end;
  CurrentTextFormat: TTextFormat;CurrentParagraphFormat: TParagraphFormat;
begin
  // RichEdit.Clear;
  // Per regel de RichEdit vullen en opmaak toepassen.
  CurrentParagraphFormat.Itemize.IsItemized := False;
  CurrentParagraphFormat.CurrentAlign := Left;
  RichEdit.Paragraph.Alignment:=taLeftJustify;
  // convert octals like “
  ll:=1;
  while ll<Length(strHTMLCode)-3 do begin
    if (strHTMLCode[ll]='&') and (strHTMLCode[ll+1]='#')
    and (strHTMLCode[ll+2] in ['0','1','2']) then begin
      Buf:=MidStr(strHTMLCode,ll,6);
      oct:=(ord(Buf[3])-ord('0'))*100+(ord(Buf[4])-ord('0'))*10+(ord(Buf[5])-ord('0'));
      strHTMLCode := StringReplace(strHTMLCode, Buf, chr(oct), [rfReplaceAll]);
      ll:=ll+3;
     end;
    ll:=ll+1;
  end;

  UniRtf2Html.SpecialChars(strHTMLCode,true);

  strLine := strHTMLCode;

  GetLineBreak(iBreakPos, strLine, strBreakChar, CurrentParagraphFormat);

  iPrevLinesLength := 0;
  CurrentTextFormat.Bold := Neutral;
  CurrentTextFormat.Italic := Neutral;
  CurrentTextFormat.Underline := Neutral;

  while iBreakPos <> 0 do begin
    if iBreakPos=-1 then begin
      iBreakPos:=0;
      //strHTMLCode:='';
    end else begin
      strHTMLCode := Copy(strHTMLCode, iBreakPos + Length(strBreakChar), Length(strHTMLCode));
    end;
    // De tekstregel in strLine zetten:
    // De huidige regel van strHTMLCode afknippen:
    i := 0;
    SetLength(TextLayouts, i);
    iPosCtrlCharStart := Pos('<', strLine);
    if iPosCtrlCharStart <> 1 then begin
      // De HTML-code begint niet een controlchar; het eerste deel van
      // de text heeft geen opmaak.
      SetLength(TextLayouts, i + 1);
      TextLayouts[i].t := Copy(strLine, 1, iPosCtrlCharStart - 1);
      TextLayouts[i].p := Left;
      TextLayouts[i].a.Bold := Neutral;
      TextLayouts[i].a.Italic := Neutral;
      TextLayouts[i].a.Underline := Neutral;
      strLine := Copy(strLine, iPosCtrlCharStart, Length(strLine));
      inc(i);
    end;
    // iPosCtrlCharStart = 1 in strLine
    iPosCtrlCharEnd := Pos('>', strLine);
    while iPosCtrlCharEnd > 0 do begin
      SetLength(TextLayouts, i + 1);
      strCtrlChar := Copy(strLine, 2, iPosCtrlCharEnd - 2);
      strLine := Copy(strLine, iPosCtrlCharEnd + 1, Length(strLine));
      iPosCtrlCharStart := Pos('<', strLine);
      if iPosCtrlCharStart > 0 then begin
        TextLayouts[i].t := Copy(strLine, 1, iPosCtrlCharStart - 1);
        strLine := Copy(strLine, iPosCtrlCharStart, Length(strLine));
      end else begin
        // Geen controlchars meer; rest van strLine toevoegen:
        TextLayouts[i].T := strLine;
        strLine := '';
      end;
      // Opmaak toepassen:
      TextLayouts[i].a.Bold := Neutral;
      TextLayouts[i].a.Italic := Neutral;
      TextLayouts[i].a.Underline := Neutral;

      if strCtrlChar = 'b' then
        TextLayouts[i].a.Bold := Activate;
      if strCtrlChar = '/b' then
        TextLayouts[i].a.Bold := Deactivate;
      if strCtrlChar = 'i' then
        TextLayouts[i].a.Italic := Activate;
      if strCtrlChar = '/i' then
        TextLayouts[i].a.Italic := Deactivate;
      if strCtrlChar = 'u' then
        TextLayouts[i].a.Underline := Activate;
      if strCtrlChar = '/u' then
        TextLayouts[i].a.Underline := Deactivate;

      iPosCtrlCharEnd := Pos('>', strLine);

      inc(i);
    end;
    if Length(strLine) > 0 then
    begin
      SetLength(TextLayouts, i + 1);
      TextLayouts[i].T := strLine;
      TextLayouts[i].a.Bold := Neutral;
      TextLayouts[i].a.Italic := Neutral;
      TextLayouts[i].a.Underline := Neutral;
    end;

    strLine := '';
    for i := Low(TextLayouts) to High(TextLayouts) do
    begin
      strLine := strLine + TextLayouts[i].t;
    end;
    RichEdit.Lines.Add(strLine);

    //RichEdit.Paragraph.Alignment := CurrentParagraphFormat;

    if CurrentParagraphFormat.Itemize.IsItemized and
      (RichEdit.Paragraph.Numbering = nsNone) then
      RichEdit.Paragraph.Numbering := nsBullet;
    if (not CurrentParagraphFormat.Itemize.IsItemized) and
      (RichEdit.Paragraph.Numbering = nsBullet) then
      RichEdit.Paragraph.Numbering := nsNone;

    j := 0;
    for i := Low(TextLayouts) to High(TextLayouts) do
    begin
      if (TextLayouts[i].a.Bold = Activate) then
        CurrentTextFormat.Bold := Activate;
      if (TextLayouts[i].a.Bold = Deactivate) then
        CurrentTextFormat.Bold := Deactivate;

      if (TextLayouts[i].a.Italic = Activate) then
        CurrentTextFormat.Italic := Activate;
      if (TextLayouts[i].a.Italic = Deactivate) then
        CurrentTextFormat.Italic := Deactivate;

      if (TextLayouts[i].a.Underline = Activate) then
        CurrentTextFormat.Underline := Activate;
      if (TextLayouts[i].a.Underline = Deactivate) then
        CurrentTextFormat.Underline := Deactivate;

      RichEdit.SelStart := j + iPrevLinesLength;
      RichEdit.SelLength := Length(TextLayouts[i].T);

      if (CurrentTextFormat.Bold = Activate) and
        not (fsBold in RichEdit.SelAttributes.Style) then
        RichEdit.SelAttributes.Style := RichEdit.SelAttributes.Style + [fsBold];
      if (CurrentTextFormat.Bold = Deactivate) and
        (fsBold in RichEdit.SelAttributes.Style) then
        RichEdit.SelAttributes.Style := RichEdit.SelAttributes.Style - [fsBold];

      if (CurrentTextFormat.Italic = Activate) and
        not (fsItalic in RichEdit.SelAttributes.Style) then
        RichEdit.SelAttributes.Style := RichEdit.SelAttributes.Style + [fsItalic];
      if (CurrentTextFormat.Italic = Deactivate) and
        (fsItalic in RichEdit.SelAttributes.Style) then
        RichEdit.SelAttributes.Style := RichEdit.SelAttributes.Style - [fsItalic];

      if (CurrentTextFormat.Underline = Activate) and
        not (fsUnderline in RichEdit.SelAttributes.Style) then
        RichEdit.SelAttributes.Style := RichEdit.SelAttributes.Style + [fsUnderline];
      if (CurrentTextFormat.Underline = Deactivate) and
        (fsUnderline in RichEdit.SelAttributes.Style) then
        RichEdit.SelAttributes.Style := RichEdit.SelAttributes.Style - [fsUnderline];

      j := j + sizeof(TextLayouts[i]);
    end;
    iPrevLinesLength := Length(RichEdit.Text);

    strLine := strHTMLCode;
    if iBreakPos > 0 then
      GetLineBreak(iBreakPos, strLine, strBreakChar, CurrentParagraphFormat);
  end;
end;
//------------------------------------------------------------------------------
//
//------------------------------------------------------------------------------
procedure RemoveLineBreak(var strLine: string);
const
 bold:array[1..2] of String=('<b>', '</b>');
var i: integer;
begin
  for i := 1 to length(skip) do strLine := StringReplace(strLine, skip[i], '', [rfReplaceAll]);
  for i := 1 to length(bold) do strLine := StringReplace(strLine, bold[i], '', [rfReplaceAll]);
end;
//------------------------------------------------------------------------------
//
//------------------------------------------------------------------------------
procedure GetLineBreak(var iBreakPos: integer;var strLine, strBreakChar: string;
                       var CurrentParagraphFormat: TParagraphFormat);
var
  i, j: integer;
  str1: string;
  IsOk: boolean;
begin
  iBreakPos := 0;
  for i := 1 to length(skip) do begin
    j := Pos(skip[i], strLine);
    if j > 0 then
    begin
      if iBreakPos = 0 then begin
        iBreakPos := j
      end else begin
        if j < iBreakPos then iBreakPos := j;
      end;
    end;
  end;
  str1 := Copy(strLine, iBreakPos, Length(strLine));
  if iBreakPos > 0 then
    strLine := Copy(strLine, 1, iBreakPos - 1)
  else iBreakPos := -1;
  strBreakChar := '';
  IsOk := True;
  while IsOk do begin
    IsOk := False;
    for i := 1 to length(skip) do begin
      if Pos(skip[i], str1) = 1 then begin
        if (skip[i] <> '<br>') or (Length(strBreakChar) = 0) then
          strBreakChar := strBreakChar + skip[i];
        str1 := Copy(str1, Length(skip[i]) + 1, Length(str1));
        if skip[i] <> '<br>' then
          IsOk := True;
        if skip[i] = '</p>' then
          CurrentParagraphFormat.CurrentAlign := Left;
        if skip[i] = '<li>' then
          CurrentParagraphFormat.Itemize.IsItemized := True;
        if skip[i] = '</li>' then
          CurrentParagraphFormat.Itemize.IsItemized := False;
        if skip[i] = '<p align="left">' then begin
          CurrentParagraphFormat.CurrentAlign := Left;
          IsOk := True;
        end;
        if skip[i] = '<p align="center">' then begin
          CurrentParagraphFormat.CurrentAlign := Center;
          IsOk := True;
        end;
        if skip[i] = '<p align="right">' then  begin
          CurrentParagraphFormat.CurrentAlign := Right;
          IsOk := True;
        end;
      end;
    end;
  end;
end;
//------------------------------------------------------------------------------
//
//------------------------------------------------------------------------------
end.