mhmda Posted March 16, 2019 Share Posted 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. Link to comment Share on other sites More sharing options...
billyChou Posted March 17, 2019 Share Posted 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 Link to comment Share on other sites More sharing options...
mhmda Posted March 17, 2019 Author Share Posted March 17, 2019 Any recommended solution for that? Thanx Link to comment Share on other sites More sharing options...
billyChou Posted March 17, 2019 Share Posted 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(' ',' ' ); html := html.Replace('nbsp;',' ' ); html := html.Replace('&','&' ); 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 Link to comment Share on other sites More sharing options...
d.bernaert Posted April 2, 2019 Share Posted 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 Link to comment Share on other sites More sharing options...
gerhardhziegler Posted December 30, 2019 Share Posted 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. Link to comment Share on other sites More sharing options...
billyChou Posted December 31, 2019 Share Posted December 31, 2019 sample test for html to richedit. billyChou Test01.zip 1 Link to comment Share on other sites More sharing options...
MAPS Posted April 11, 2020 Share Posted 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 .... Link to comment Share on other sites More sharing options...
cvefa Posted May 3, 2020 Share Posted 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 ?! Link to comment Share on other sites More sharing options...
Recommended Posts
Please sign in to comment
You will be able to leave a comment after signing in
Sign In Now