From 45f97fdb97698b5f8eacce5aa9186368804fe2e1 Mon Sep 17 00:00:00 2001 From: jesus Date: Sat, 12 Dec 2009 08:10:41 +0000 Subject: [PATCH] LazReport, implemented css in html exporter, patch with changes from Ts.Petrov, issue #15011 git-svn-id: trunk@23089 - --- components/lazreport/doc/contributors.txt | 1 + components/lazreport/source/lr_class.pas | 12 +- components/lazreport/source/lr_e_csv.pas | 1 + components/lazreport/source/lr_e_htm.pas | 352 +++++++++++++++++++--- components/lazreport/source/lr_e_txt.pas | 59 ++-- 5 files changed, 351 insertions(+), 74 deletions(-) diff --git a/components/lazreport/doc/contributors.txt b/components/lazreport/doc/contributors.txt index 1250900cae..9bc2065988 100644 --- a/components/lazreport/doc/contributors.txt +++ b/components/lazreport/doc/contributors.txt @@ -12,5 +12,6 @@ Luiz Americo (br) Mattias Gaertner (de) Olivier Guilbaud (fr) Petr Smolik (cz) +Ts. Petrov ( ) Vincent Snijders (nl) diff --git a/components/lazreport/source/lr_class.pas b/components/lazreport/source/lr_class.pas index da0586b38e..0dabe0f176 100644 --- a/components/lazreport/source/lr_class.pas +++ b/components/lazreport/source/lr_class.pas @@ -1108,9 +1108,15 @@ type TfrTextRec = record Next: PfrTextRec; X: Integer; - Text: String[255]; + W: Integer; + Text: string; FontName: String[32]; FontSize, FontStyle, FontColor, FontCharset, FillColor: Integer; + Alignment: TAlignment; + Borders: TfrFrameBorders; + BorderColor: TColor; + BorderStyle: TfrFrameStyle; + BorderWidth: Integer; Typ: Byte; end; @@ -8489,6 +8495,7 @@ begin else begin p := TfrPreviewForm.Create(nil); + p.BorderIcons:=p.BorderIcons - [biMinimize]; {$IFDEF DebugLR} DebugLn('1 TfrPreviewForm.visible=',BooLToStr(p.Visible)); {$ENDIF} @@ -8957,7 +8964,7 @@ begin inherited Create; Stream := AStream; Lines := TFpList.Create; - FBandTypes := [btMasterHeader, btMasterData]; + FBandTypes := [btReportTitle..btNone]; end; destructor TfrExportFilter.Destroy; @@ -8979,6 +8986,7 @@ begin begin p1 := p; p := p^.Next; + SetLength(p1^.Text, 0); FreeMem(p1, SizeOf(TfrTextRec)); end; end; diff --git a/components/lazreport/source/lr_e_csv.pas b/components/lazreport/source/lr_e_csv.pas index 981c74257c..57aaa13680 100644 --- a/components/lazreport/source/lr_e_csv.pas +++ b/components/lazreport/source/lr_e_csv.pas @@ -69,6 +69,7 @@ begin FQuoteType := qtQuoteChar; FQuoteChar := '"'; FSeparator := ';'; + BandTypes := [btMasterHeader,btMasterData,btColumnHeader]; end; procedure TfrCSVExportFilter.OnBeginPage; diff --git a/components/lazreport/source/lr_e_htm.pas b/components/lazreport/source/lr_e_htm.pas index f6119ce1e4..ff019cd1fc 100644 --- a/components/lazreport/source/lr_e_htm.pas +++ b/components/lazreport/source/lr_e_htm.pas @@ -13,26 +13,50 @@ unit LR_E_HTM; interface {$I lr_vers.inc} +{$COPERATORS on} uses Classes, SysUtils, LResources, - Graphics,GraphType, Controls, Forms, Dialogs, LR_E_TXT, - LCLType,LCLIntf,LR_Class; + Graphics, GraphType, Controls, Forms, Dialogs, LR_E_TXT, + LCLType, LCLIntf, LR_Class; type + { TStyleDesc } + TStyleDesc = record + styleID: AnsiString; + styleInfo: AnsiString; + end; + { TfrHTMExport } TfrHTMExport = class(TComponent) public - Constructor Create(aOwner : TComponent); override; + constructor Create(aOwner: TComponent); override; end; + { TfrHTMExportFilter } + TfrHTMExportFilter = class(TfrTextExportFilter) + private + cssStyles: array of TStyleDesc; + FUseCSS: boolean; + styleStartLine: integer; + outputLines: TStringList; + function AddStyle(p: PfrTextRec): Integer; + function ColorToHex(c: TColor): AnsiString; + function StyleIndex(p: PfrTextRec; AddIfNotFound: boolean = true): Integer; + function TextStyleID(p: PfrTextRec): AnsiString; + protected + procedure AppendLine(const s: UTF8String); + procedure InsertLine(const s: UTF8String; position: Integer); public constructor Create(AStream: TStream); override; destructor Destroy; override; procedure OnEndPage; override; + procedure OnEndDoc; override; + + property UseCSS: boolean read FUseCSS write FUseCSS; end; @@ -46,34 +70,47 @@ var s: String; begin inherited Create(AStream); + outputLines:= TStringList.Create; + SetLength(cssStyles, 0); - s := '' + LineEnding + - '' + LineEnding + - '' + LineEnding + - 'LazReport Exported Report' + LineEnding + // TODO: improve - '' + LineEnding + - '' + LineEnding; + s:= '' + LineEnding; + AppendLine(s); + s:= '' + LineEnding + + '' + LineEnding + + '' + LineEnding + + '' + LineEnding + + 'LazReport Exported Report' + LineEnding; // TODO: improve + AppendLine(s); + s:= '' + LineEnding + + '' + LineEnding + + '' + LineEnding + + '' + LineEnding + LineEnding; + AppendLine(s); + s:= '' + LineEnding; + AppendLine(s); end; destructor TfrHTMExportFilter.Destroy; -var - s: String; begin - s := '
' + LineEnding; - Stream.Write(s[1], Length(s)); + SetLength(cssStyles, 0); + outputLines.Free; inherited Destroy; end; + +{%REGION 'procedure TfrHTMExportFilter.OnEndPage' } procedure TfrHTMExportFilter.OnEndPage; var - i, n: Integer; + i, j, n, cw, xp, xp2: integer; p: PfrTextRec; - s, s1, s2, s3: String; + s, s1, s2, s3, s4, sp, sAlign, sStyle, sEmpCells, sColSpan: AnsiString; + xPos: TStringList; - function GetHTMLFontSize(Size: Integer): String; + function GetHTMLFontSize(Size: integer): string; begin case Size of 6, 7: Result := '1'; @@ -86,64 +123,285 @@ var end; end; - function GetHTMLFontStyle(Style: Integer): String; + function GetHTMLFontStyle(Style: integer): string; begin Result := ''; - if (Style and $1) <> 0 then Result := ''; - if (Style and $2) <> 0 then Result := Result + ''; - if (Style and $4) <> 0 then Result := Result + ''; + if (Style and $1) <> 0 then + Result := ''; + if (Style and $2) <> 0 then + Result := Result + ''; + if (Style and $4) <> 0 then + Result := Result + ''; end; function GetEndHTMLFontStyle(Style: Integer): String; begin Result := ''; - if (Style and $4) <> 0 then Result := ''; - if (Style and $2) <> 0 then Result := Result + ''; - if (Style and $1) <> 0 then Result := Result + ''; + if (Style and $4) <> 0 then + Result := ''; + if (Style and $2) <> 0 then + Result := Result + ''; + if (Style and $1) <> 0 then + Result := Result + ''; + end; + + function FormatCellText(const sIn: AnsiString): AnsiString; + var + c, m: Integer; + begin + Result:= ''; + c:=1; + while (c<=Length(sIn)) and (sIn[c]=' ') do + inc(c); + dec(c); + for m:=1 to c do + Result:= Result + ' '; + Result:= Result + Copy(sIn, c+1, Length(sIn)-c); end; begin + n := Lines.Count - 1; while n >= 0 do begin - if Lines[n] <> nil then break; + if Lines[n] <> nil then + break; Dec(n); end; + xPos:= TStringList.Create; + xPos.Sorted:= true; for i := 0 to n do begin p := PfrTextRec(Lines[i]); - s := ''; while p <> nil do begin - s1 := ''; s2 := ''; s3 := ''; + s:= Format('%.5d', [p^.X]); + if xPos.IndexOf(s) < 0 then + xPos.Add(s); + s:= Format('%.5d', [p^.X + p^.W]); + if xPos.IndexOf(s) < 0 then + xPos.Add(s); + p:= p^.Next; + end; + end; + + s := ''+LineEnding; + s += ''; + for j:=1 to xPos.Count do + s += ''; + s += ''+LineEnding; + AppendLine(s); + + for i := 0 to n do + begin + + p := PfrTextRec(Lines[i]); + s := ''; + cw:= 0; + while p <> nil do + begin + + s1:= ''; + s2:= ''; + s3:= ''; + s4:= ''; + sEmpCells:= ''; + sColSpan:= ''; + sAlign:= ''; + sStyle:= ''; + if (p^.FontColor = clWhite) or (p^.FontColor = clNone) then p^.FontColor := clBlack; - if p^.FontColor <> clBlack then + + if FUseCSS then begin - s1 := IntToHex(p^.FontColor, 6); - s1 := 'Color="#' + Copy(s1, 5, 2) + Copy(s1, 3, 2) + - Copy(s1, 1, 2) + '"'; - end; -// most reports is done with font size = 10..13 - treat it as default font - if not (p^.FontSize in [10..13]) then - s1 := s1 + ' Size=' + GetHTMLFontSize(p^.FontSize); - if p^.FontStyle <> 0 then + sStyle:= Format(' class="fs%d"', [StyleIndex(p, true)]); + end + else begin - s2 := GetHTMLFontStyle(p^.FontStyle); - s3 := GetEndHTMLFontStyle(p^.FontStyle); + if p^.FontColor <> clBlack then + s1:= ' Color="' + ColorToHex(p^.FontColor) + '"'; + // most reports is done with font size = 10..13 - treat it as default font + if not (p^.FontSize in [10..13]) then + s1 := s1 + ' Size=' + GetHTMLFontSize(p^.FontSize); + if p^.FontStyle <> 0 then + begin + s2 := GetHTMLFontStyle(p^.FontStyle); + s3 := GetEndHTMLFontStyle(p^.FontStyle); + end; + if s1 <> '' then + begin + s1 := ''; + s4 := ''; + end; end; - if s1 <> '' then s1 := ''; - s := s + ''; + + case p^.Alignment of + taRightJustify: sAlign:= ' align="right"'; + taCenter: sAlign:= ' align="center"'; + end; + + sp:= Format('%.5d', [p^.X]); + xp:= xPos.IndexOf(sp); + sp:= Format('%.5d', [p^.X + p^.W]); + xPos.Find(sp, xp2); + if Assigned(p^.Next) then + begin + sp:= Format('%.5d', [p^.Next^.X]); + if xPos.IndexOf(sp)cw then + if (xp-cw)>1 then + sEmpCells:= Format('', [xp - cw]) + else + sEmpCells:= ''; + + if (xp2-xp)>1 then + sColSpan:= Format(' colspan=%d', [xp2 - xp]); + cw:= xp2; + + s := Format('%s%s%s%s%s%s%s', [s, sEmpCells, sAlign, sStyle, + sColSpan, s1, s2, FormatCellText(p^.Text), s3, s4]); p := p^.Next; end; - if s='' then - s := ''; - s := '' + s + '' + LineEnding; - Stream.Write(s[1], Length(s)); + + if s = '' then + s += ''; + + s += ''; + AppendLine(s + LineEnding); + end; + + xPos.Free; + + s := '
' + s1 + s2 + p^.Text + s3; - if s1 <> '' then s := s + ''; - s := s + '
' + LineEnding; + AppendLine(s); +end; +{%ENDREGION } + + +function TfrHTMExportFilter.TextStyleID(p: PfrTextRec): AnsiString; +var + x: Integer; +begin + Result:= '(none)'; + if p=nil then + exit; + Result := p^.FontName; + Result += LowerCase(IntToHex(p^.FontSize, 2) + IntToHex(p^.FontStyle, 2) + + IntToHex(p^.FontColor, 8) + IntToHex(p^.FillColor, 8) + + IntToHex(Integer(p^.Borders), 2)); + for x:=1 to Length(Result) do + if not (Result[x] in ['$', '%', '&', '0'..'9', '@'..'z']) then + Result[x]:= '_'; +end; + + +function TfrHTMExportFilter.StyleIndex(p: PfrTextRec; AddIfNotFound: boolean): integer; +var + s: string; + x: integer; +begin + Result:= -1; + s:= TextStyleID(p); + for x:=0 to High(cssStyles) do + if cssStyles[x].styleID = s then + begin + Result:= x; + break; + end; + if (Result<0) and AddIfNotFound then + Result:= AddStyle(p); +end; + + +function TfrHTMExportFilter.AddStyle(p: PfrTextRec): Integer; +var + s: string; +begin + Result:= Length(cssStyles); + SetLength(cssStyles, Result+1); + cssStyles[Result].styleID:= TextStyleID(p); + s:= ''; + if Assigned(p) then + begin + // s += Format(' /* Cell Style "%s" */'#10, [cssStyles[Result].styleID]); + s += Format(' td.fs%d {%s', [Result,LineEnding]); + s += Format(' font-family: "%s";%s', [p^.FontName,LineEnding]); + s += Format(' font-size: %dpt;%s', [p^.FontSize,LineEnding]); + if (p^.FontStyle and $1) <> 0 then + s += ' font-style: italic;'+LineEnding; + if (p^.FontStyle and $2) <> 0 then + s += ' font-weight: bold;'+LineEnding; + if (p^.FontStyle and $4) <> 0 then + s += ' text-decoration: underline;'+LineEnding; + if (p^.FontColor <> clNone) and (p^.FontColor <> clDefault) and (p^.FontColor <> clBlack) then + s += Format(' color: %s;%s', [ColorToHex(p^.FontColor),LineEnding]); + if (p^.FillColor <> clNone) and (p^.FillColor <> clDefault) and (p^.FillColor <> clWhite) then + s += Format(' background-color: %s;%s', [ColorToHex(p^.FillColor),LineEnding]); + if (p^.Borders <> []) then + begin + case p^.BorderStyle of + frsSolid: s += ' border-style: solid;'+LineEnding; + frsDash: s += ' border-style: dashed;'+LineEnding; + frsDot, + frsDashDot, + frsDashDotDot: s += ' border-style: dotted;'+LineEnding; + frsDouble: s += ' border-style: double;'+LineEnding; + end; + if not (frbLeft in p^.Borders) then + s += ' border-left-style: none;'+LineEnding; + if not (frbTop in p^.Borders) then + s += ' border-top-style: none;'+LineEnding; + if not (frbRight in p^.Borders) then + s += ' border-right-style: none;'+LineEnding; + if not (frbBottom in p^.Borders) then + s += ' border-bottom-style: none;'+LineEnding; + s += Format(' border-width: %dpx;%s', [p^.BorderWidth,LineEnding]); + s += Format(' border-color: %s;%s', [ColorToHex(p^.BorderColor),LineEnding]); + end; + s += ' } '+LineEnding+LineEnding; + end; + cssStyles[Result].styleInfo:= s; +end; + + +function TfrHTMExportFilter.ColorToHex(c: TColor): AnsiString; +var + s: AnsiString; +begin + s:= IntToHex(ColorToRGB(c), 8); + Result:= '#' + Copy(s, 7, 2) + Copy(s, 5, 2) + Copy(s, 3, 2); +end; + + +procedure TfrHTMExportFilter.AppendLine(const s: UTF8String); +begin + outputLines.Add(s); +end; + + +procedure TfrHTMExportFilter.InsertLine(const s: UTF8String; position: Integer); +begin + outputLines.Insert(position, s); +end; + + +procedure TfrHTMExportFilter.OnEndDoc; +var + s: string; + x: Integer; +begin + s := ''+LineEnding+''+LineEnding; + AppendLine(s); + for x:=0 to High(cssStyles) do + InsertLine(cssStyles[x].StyleInfo, styleStartLine + x); + for x:= 0 to Pred(outputLines.Count) do + if Length(outputLines[x])>0 then + Stream.Write(outputLines[x][1], Length(outputLines[x])); end; diff --git a/components/lazreport/source/lr_e_txt.pas b/components/lazreport/source/lr_e_txt.pas index 2d3f95ebb4..2911930e09 100644 --- a/components/lazreport/source/lr_e_txt.pas +++ b/components/lazreport/source/lr_e_txt.pas @@ -15,9 +15,8 @@ interface {$I lr_vers.inc} uses - Classes, SysUtils, LResources, - Graphics,GraphType, Controls, Forms, Dialogs, - LCLType,LCLIntf,LR_Class; + Classes, SysUtils, LResources, Graphics, GraphType, Controls, Forms, Dialogs, + LCLType, LCLIntf, LR_Class; type @@ -25,7 +24,7 @@ type TfrTextExport = class(TComponent) public - Constructor Create(aOwner : TComponent); override; + constructor Create(aOwner: TComponent); override; end; { TfrTextExportFilter } @@ -106,21 +105,22 @@ begin n := Lines.Count - 1; while n >= 0 do begin - if Lines[n] <> nil then break; + if Lines[n] <> nil then + break; Dec(n); end; for i := 0 to n do begin - s := ''; - tc1 := 0; - p := PfrTextRec(Lines[i]); + s := ''; + tc1:= 0; + p := PfrTextRec(Lines[i]); while p <> nil do begin - x := Round(p^.X / 6.5); - s := s + Dup(x - tc1) + p^.Text; - tc1 := x + Length(p^.Text); - p := p^.Next; + x := Round(p^.X / 6.5); + s := s + Dup(x - tc1) + p^.Text; + tc1:= x + Length(p^.Text); + p := p^.Next; end; s := s + LineEnding; Stream.Write(s[1], Length(s)); @@ -131,10 +131,11 @@ end; procedure TfrTextExportFilter.OnBeginPage; var - i: Integer; + i: integer; begin ClearLines; - for i := 0 to 200 do Lines.Add(nil); + for i := 0 to 200 do + Lines.Add(nil); end; procedure TfrTextExportFilter.OnText(X, Y: Integer; const Text: String; @@ -142,30 +143,38 @@ procedure TfrTextExportFilter.OnText(X, Y: Integer; const Text: String; var p, p1, p2: PfrTextRec; begin - if View = nil then Exit; + if View = nil then + Exit; Y := Round(Y / UsedFont); - p1 := PfrTextRec(Lines[Y]); + p1:= PfrTextRec(Lines[Y]); GetMem(p, SizeOf(TfrTextRec)); FillChar(p^, SizeOf(TfrTextRec), 0); p^.Next := nil; - p^.X := X; + p^.X := Round(View.X / UsedFont); + p^.W := Round(View.Width / UsedFont); p^.Text := Text; + p^.FillColor := View.FillColor; + p^.Borders := View.Frames; + p^.BorderColor:= View.FrameColor; + p^.BorderStyle:= View.FrameStyle; + p^.BorderWidth:= Round(View.FrameWidth); if View is TfrMemoView then with View as TfrMemoView do begin - p^.FontName := Font.Name; - p^.FontSize := Font.Size; - p^.FontStyle := frGetFontStyle(Font.Style); - p^.FontColor := Font.Color; + p^.FontName := Font.Name; + p^.FontSize := Font.Size; + p^.FontStyle := frGetFontStyle(Font.Style); + p^.FontColor := Font.Color; p^.FontCharset := Font.Charset; + p^.Alignment := Alignment; end; - p^.FillColor := View.FillColor; + if p1 = nil then Lines[Y] := TObject(p) else begin p2 := p1; - while (p1 <> nil) and (p1^.X < p^.X) do + while (p1 <> nil) and (p1^.X <= p^.X) do begin p2 := p1; p1 := p1^.Next; @@ -173,12 +182,12 @@ begin if p2 <> p1 then begin p2^.Next := p; - p^.Next := p1; + p^.Next := p1; end else begin Lines[Y] := TObject(p); - p^.Next := p1; + p^.Next := p1; end; end; end;