How to print HTML text inside FastReport?

mhmda · March 16, 2019

I need to print html text (unihtmlmemo) into FastReport. Has anyone done this before?

The AllowHTML in fastreport isn't a solution, I need to print also bullets.

billyChou · March 17, 2019

20 hours ago, mhmda said:

I need to print html text (unihtmlmemo) into FastReport. Has anyone done this before?

The AllowHTML in fastreport isn't a solution, I need to print also bullets.

html to rtf , fastreport use rtf

mhmda · March 17, 2019

Any recommended solution for that?

Thanx

billyChou · March 17, 2019

procedure Tfrm_epo110a3.HTMLtoRTF(html: string; var rtf: TRichedit);
var
  i, dummy, row: Integer;
  cfont: TFont; { Standard sschrift }
  Tag, tagparams: string;
  params: TStringList;

  function GetTag(s: string; var i: Integer; var Tag, tagparams: string): Boolean;
  var
    a_tag: Boolean;
  begin
    GetTag  := False;
    Tag  := '';
    tagparams := '';
    a_tag  := False;

    while i <= Length(s) do
    begin
      Inc(i);
      // es wird nochein tag geöffnet --> das erste war kein tag;
      if s[i] = '<' then
      begin
        GetTag := False;
        Exit;
      end;

      if s[i] = '>' then
      begin
        GetTag := True;
        Exit;
      end;

      if not a_tag then
      begin
        if s[i] = ' ' then
        begin
          if Tag <> '' then a_tag := True;
        end
        else
          Tag := Tag + s[i];
      end
      else
        tagparams := tagparams + s[i];
    end;
  end;

  procedure GetTagParams(tagparams: string; var params: TStringList);
  var
    i: Integer;
    s: string;
    gleich: Boolean;

    // kontrolliert ob nach dem zeichen bis zum nächsten zeichen ausser
    // leerzeichen ein Ist-Gleich-Zeichen kommt
    function notGleich(s: string; i: Integer): Boolean;
    begin
      notGleich := True;
      while i <= Length(s) do
      begin
        Inc(i);
        if s[i] = '=' then
        begin
          notGleich := False;
          Exit;
        end
        else if s[i] <> ' ' then Exit;
      end;
    end;
  begin
    Params.Clear;
    s := '';
    for i := 1 to Length(tagparams) do
    begin
      if (tagparams[i] <> ' ') then
      begin
        if tagparams[i] <> '=' then gleich := False;
        if (tagparams[i] <> '''') and (tagparams[i] <> '"') then s := s + tagparams[i]
      end
      else
      begin
        if (notGleich(tagparams, i)) and (not Gleich) then
        begin
          params.Add(s);
          s := '';
        end
        else
          Gleich := True;
      end;
    end;
    params.Add(s);
  end;

  function HtmlToColor(Color: string): TColor;
  begin
    Result := StringToColor('$' + Copy(Color, 6, 2) + Copy(Color, 4,
      2) + Copy(Color, 2, 2));
  end;

  procedure TransformSpecialChars(var s: string; i: Integer);
  var
    c: string;
    z, z2: Byte;
    i2: Integer;
  const
    nchars = 9;
    chars: array[1..nchars, 1..2] of string =
      (('Ö', 'Ö'), ('ö', 'ö'), ('Ä', 'Ä'), ('ä', 'ä'),
      ('Ü', 'Ü'), ('ü', 'ü'), ('ß', 'ß'), ('<', '<'),
      ('>', '>'));
  begin
    // Maximal die nächsten 7 zeichen auf sonderzeichen überprüfen
    c  := '';
    i2 := i;
    for z := 1 to 7 do
    begin
      c := c + s[i2];
      for z2 := 1 to nchars do
      begin
        if chars[z2, 1] = c then
        begin
          Delete(s, i, Length(c));
          Insert(chars[z2, 2], s, i);
          Exit;
        end;
      end;
      Inc(i2);
    end;
  end;

  // HtmlTag Schriftgröße in pdf größe umwandeln
  function CalculateRTFSize(pt: Integer): Integer;
  begin
    case pt of
      1: Result := 6;
      2: Result := 9;
      3: Result := 12;
      4: Result := 15;
      5: Result := 18;
      6: Result := 22;
      else
        Result := 30;
    end;
  end;


  // Die Font-Stack Funktionen
type
  fontstack = record
    Font: array[1..100] of tfont;
    Pos: Byte;
  end;

  procedure CreateFontStack(var s: fontstack);
  begin
    s.Pos := 0;
  end;

  procedure PushFontStack(var s: Fontstack; fnt: TFont);
  begin
    Inc(s.Pos);
    s.Font[s.Pos] := TFont.Create;
    s.Font[s.Pos].Assign(fnt);
  end;

  procedure PopFontStack(var s: Fontstack; var fnt: TFont);
  begin
    if (s.Font[s.Pos] <> nil) and (s.Pos > 0) then
    begin
      fnt.Assign(s.Font[s.Pos]);
      // vom stack nehmen
      s.Font[s.Pos].Free;
      Dec(s.Pos);
    end;
  end;

  procedure FreeFontStack(var s: Fontstack);
  begin
    while s.Pos > 0 do
    begin
      s.Font[s.Pos].Free;
      Dec(s.Pos);
    end;
  end;
var
  fo_cnt: array[1..1000] of tfont;
  fo_liste: array[1..1000] of Boolean;
  fo_pos: TStringList;
  fo_stk: FontStack;
  wordwrap, liste: Boolean;
begin
  CreateFontStack(fo_Stk);

  fo_Pos := TStringList.Create;

  rtf.Lines.BeginUpdate;
  rtf.Lines.Clear;
  // Das wordwrap vom richedit merken
  wordwrap  := rtf.wordwrap;
  rtf.WordWrap := False;


  // erste Zeile hinzufügen
  rtf.Lines.Add('');
  Params := TStringList.Create;



  cfont := TFont.Create;
  cfont.Assign(rtf.Font);


  i := 1;
  row := 0;
  Liste := False;
  // Den eigentlichen Text holen und die Formatiorung merken
  rtf.selstart := 0;
  html := html.Replace('&nbsp;',' ' );
  html := html.Replace('nbsp;',' ' );
  html := html.Replace('&amp;','&' );
  if Length(html) = 0 then Exit;
  repeat;


    if html[i] = '<' then
    begin
      dummy := i;
      GetTag(html, i, Tag, tagparams);
      GetTagParams(tagparams, params);

      // Das Font-Tag
      if Uppercase(Tag) = 'FONT' then
      begin
        // Schrift auf fontstack sichern
        pushFontstack(fo_stk, cfont);
        if params.Values['size'] <> '' then
          cfont.Size := CalculateRTFSize(StrToInt(params.Values['size']));

        if params.Values['color'] <> '' then cfont.Color :=
            htmltocolor(params.Values['color']);
      end
      else if Uppercase(Tag) = '/FONT' then  popFontstack(fo_stk, cfont)
      else // Die H-Tags-Überschriften
      if Uppercase(Tag) = 'H1' then
      begin
        // Schrift auf fontstack sichern
        pushFontstack(fo_stk, cfont);
        cfont.Size := 20;
      end
      else if Uppercase(Tag) = '/H1' then  popFontstack(fo_stk, cfont)
      else // Die H-Tags-Überschriften
      if Uppercase(Tag) = 'H2' then
      begin
        // Schrift auf fontstack sichern
        pushFontstack(fo_stk, cfont);
        cfont.Size := 18;
      end
      else if Uppercase(Tag) = '/H2' then  popFontstack(fo_stk, cfont)
      else // Die H-Tags-Überschriften
      if Uppercase(Tag) = 'H3' then
      begin
        // Schrift auf fontstack sichern
        pushFontstack(fo_stk, cfont);
        cfont.Size := 16;
      end
      else if Uppercase(Tag) = '/H3' then  popFontstack(fo_stk, cfont)
      else // Die H-Tags-Überschriften
      if Uppercase(Tag) = 'H4' then
      begin
        // Schrift auf fontstack sichern
        pushFontstack(fo_stk, cfont);
        cfont.Size := 14;
      end
      else if Uppercase(Tag) = '/H4' then  popFontstack(fo_stk, cfont)
      else // Die H-Tags-Überschriften
      if Uppercase(Tag) = 'H5' then
      begin
        // Schrift auf fontstack sichern
        pushFontstack(fo_stk, cfont);
        cfont.Size := 12;
      end
      else if Uppercase(Tag) = '/H5' then  popFontstack(fo_stk, cfont)
      else // Die H-Tags-Überschriften
      if Uppercase(Tag) = 'H6' then
      begin
        // Schrift auf fontstack sichern
        pushFontstack(fo_stk, cfont);
        cfont.Size := 10;
      end
      else if Uppercase(Tag) = '/H6' then  popFontstack(fo_stk, cfont)
      else // Die H-Tags-Überschriften
      if Uppercase(Tag) = 'H7' then
      begin
        // Schrift auf fontstack sichern
        pushFontstack(fo_stk, cfont);
        cfont.Size := 8;
      end
      else if Uppercase(Tag) = '/H7' then  popFontstack(fo_stk, cfont)
      else // Bold-Tag

      if Uppercase(Tag) = 'B' then cfont.Style := cfont.Style + [fsbold]
      else if Uppercase(Tag) = '/B' then cfont.Style := cfont.Style - [fsbold]
      else // Italic-Tag

      if Uppercase(Tag) = 'I' then cfont.Style := cfont.Style + [fsitalic]
      else if Uppercase(Tag) = '/I' then cfont.Style := cfont.Style - [fsitalic]
      else // underline-Tag

      if Uppercase(Tag) = 'U' then cfont.Style := cfont.Style + [fsunderline]
      else if Uppercase(Tag) = '/U' then cfont.Style := cfont.Style - [fsunderline]
      else // underline-Tag

      if Uppercase(Tag) = 'UL' then liste := True
      else if Uppercase(Tag) = '/UL' then
      begin
        liste := False;
        rtf.Lines.Add('');
        Inc(row);
        rtf.Lines.Add('');
        Inc(row);
      end
      else // BR - Breakrow tag

      if (Uppercase(Tag) = 'BR') or (Uppercase(Tag) = 'LI') then
      begin
        rtf.Lines.Add('');
        Inc(row);
      end;

      // unbekanntes tag als text ausgeben
      // else rtf.Lines[row]:=RTF.lines[row]+'<'+tag+' '+tagparams+'>';

      fo_pos.Add(IntToStr(rtf.selstart));
      fo_cnt[fo_pos.Count] := TFont.Create;
      fo_cnt[fo_pos.Count].Assign(cfont);
      fo_liste[fo_pos.Count] := liste;
    end
    else
    begin
      // Spezialzeichen übersetzen
      if html[i] = '&' then Transformspecialchars(html, i);

      if (Ord(html[i]) <> 13) and (Ord(html[i]) <> 10) then
        rtf.Lines[row] := RTF.Lines[row] + html[i];
    end;

    Inc(i);

  until i >= Length(html);
  // dummy eintragen
  fo_pos.Add('999999');

  // Den fertigen Text formatieren
  for i := 0 to fo_pos.Count - 2 do
  begin
    rtf.SelStart := StrToInt(fo_pos[i]);
    rtf.SelLength := StrToInt(fo_pos[i + 1]) - rtf.SelStart;
    rtf.SelAttributes.Style := fo_cnt[i + 1].Style;
    rtf.SelAttributes.Size := fo_cnt[i + 1].Size;
    rtf.SelAttributes.Color := fo_cnt[i + 1].Color;

    // die font wieder freigeben;
    fo_cnt[i + 1].Free;
  end;

  // die Paragraphen also Listen setzen
  i := 0;
  while i <= fo_pos.Count - 2 do
  begin
    if fo_liste[i + 1] then
    begin
      rtf.SelStart := StrToInt(fo_pos[i + 1]);
      while fo_liste[i + 1] do Inc(i);
      rtf.SelLength := StrToInt(fo_pos[i - 1]) - rtf.SelStart;
      rtf.Paragraph.Numbering := nsBullet;
    end;
    Inc(i);
  end;
  rtf.Lines.EndUpdate;
  Params.Free;
  cfont.Free;
  rtf.WordWrap := wordwrap;
  FreeFontStack(fo_stk);
end;

// 105.10.01  html to rtf ok add uniMemo1
procedure Tfrm_epo110a3.q_epo111_11BeforePost(DataSet: TDataSet);
var
  R:TRichEdit;
  sHtml , sRtfTxt: string;
  ms: TMemoryStream;
begin
   R := TRichEdit.CreateParented(HWND_MESSAGE);
  try
    ms := TMemoryStream.Create;
    sHtml := DataSet.FieldByName('h_data').Value;
    HTMLtoRTF(sHtml,R) ;
    ms.Position := 0;
    R.Lines.SaveToStream(ms);
    ms.Position := 0;
   // UniMemo1.Lines.LoadFromStream(ms);
    ms.Position := 0;
   //sRtfTxt := StringFromMemory(ms);
   //sRtfTxt := UniMemo1.Text;
   //sRtfTxt := RichEdit1.Text;

   if length(sRtfTxt) > 0 then
   begin
    // q_main.Edit;
     DataSet.FieldByName('m_data').Value := sRtfTxt;
    // q_main.Post;
   end;
  finally
    R.Free;
    ms.Free;
  end;

  DataSet.FieldByName('n_sch').Value  := TMainForm(MainForm).sN_sch;

end;

it's not complete for html convert to rtf, but i has not other method at 2016-2017.

fastreprt not support html .

you can test Report Workshop

https://www.trichview.com/features/reportworkshop.html

HTML Report Library

https://delphihtmlcomponents.com/reports.html

good news found.

HTML Library & Fast Report

https://delphihtmlcomponents.com/welcome.html

News

02.03.2019
HTML Component Library, HTML Report Library, HTML Editor Library version 3.9 released.
- What's new
- Fixed issues
11.02.2019
HTML Library and Fast Report

d.bernaert · April 2, 2019

I have 2 fields in the database.

1 field containing the html source and 1 field containing the converted html to rtf.

To make the conversion I make a call to the convertion api by sending the html and I get an rtf back.

Dominique

gerhardhziegler · December 30, 2019

@billyChou: I am sorry, it seems, the code doesnt work - whatever HTML I send to this function, the RTF Result is empty. I am still using Delphi 2010.

billyChou · December 31, 2019

sample test for html to richedit.

billyChou

Test01.zip

MAPS · April 11, 2020

On 12/30/2019 at 10:22 PM, billyChou said:

sample test for html to richedit.

billyChou

Test01.zip

There is still this example, I need it ....

cvefa · May 3, 2020

You can't use flawless print HTML or RTF with Fastreport on UniGui

Reasons

1- ( if Convert to HTML -> RTF ) Fast report FrxRichView not ThreadSafe. Only run localhost. isapi dll not working !

2- Fast report Allow HTML tag support a few html tags only. Not support all html tags

* Fastreport Enterprise Version include FastReportServer ?!

Sign In

How to print HTML text inside FastReport?

Recommended Posts

mhmda

Link to comment

Share on other sites

billyChou

Link to comment

Share on other sites

mhmda

Link to comment

Share on other sites

billyChou

HTML Library & Fast Report

News

Link to comment

Share on other sites

d.bernaert

Link to comment

Share on other sites

gerhardhziegler

Link to comment

Share on other sites

billyChou

Link to comment

Share on other sites

MAPS

Link to comment

Share on other sites

cvefa

Link to comment

Share on other sites

Join the conversation

Browse

Activity