diff --git a/components/lazreport/source/lr_class.pas b/components/lazreport/source/lr_class.pas index 0dabe0f176..892252464e 100644 --- a/components/lazreport/source/lr_class.pas +++ b/components/lazreport/source/lr_class.pas @@ -808,11 +808,17 @@ type FOnSetup: TExportFilterSetup; FBandTypes: TfrBandTypes; FUseProgressBar: boolean; + FLineIndex: Integer; protected Stream: TStream; Lines: TFpList; procedure ClearLines; procedure Setup; virtual; + function AddData(x, y: Integer; view: TfrView): pointer; virtual; + procedure NewRec(View: TfrView; const AText:string; var P:Pointer); virtual; + procedure AddRec(ALineIndex: Integer; ARec: Pointer); virtual; + function GetviewText(View:TfrView): string; virtual; + function CheckView(View:TfrView): boolean; virtual; public constructor Create(AStream: TStream); virtual; destructor Destroy; override; @@ -8991,6 +8997,7 @@ begin end; end; Lines.Clear; + FLineIndex := -1; end; procedure TfrExportFilter.Setup; @@ -8999,6 +9006,107 @@ begin FOnSetup(Self); end; +function TfrExportFilter.AddData(x, y: Integer; view: TfrView):pointer; +var + p: PfrTextRec; + s: string; + i: Integer; +begin + result := nil; + + if (View = nil) or not (View.ParentBandType in BandTypes) then + exit; + + if View.Flags and flStartRecord<>0 then + Inc(FLineIndex); + + if CheckView(View) then + begin + s := GetViewText(View); + NewRec(View, s, p); + AddRec(FLineIndex, p); + result := p; + end; +end; + +procedure TfrExportFilter.NewRec(View: TfrView; const AText: string; + var p:pointer); +begin + GetMem(p, SizeOf(TfrTextRec)); + FillChar(p^, SizeOf(TfrTextRec), 0); + with PfrTextRec(p)^ do + begin + Next := nil; + X := View.X; + W := round(View.Width); + Typ := View.Typ; + Text := AText; + FillColor := View.FillColor; + Borders := View.Frames; + BorderColor := View.FrameColor; + BorderStyle := View.FrameStyle; + BorderWidth := Round(View.FrameWidth); + if View is TfrMemoView then + with View as TfrMemoView do + begin + FontName := Font.Name; + FontSize := Font.Size; + FontStyle := frGetFontStyle(Font.Style); + FontColor := Font.Color; + FontCharset := Font.Charset; + Alignment := Alignment; + end; + end; +end; + +procedure TfrExportFilter.AddRec(ALineIndex: Integer; ARec: pointer); +var + p, p1, p2: PfrTextRec; +begin + + p := ARec; + p1 := Lines[ALineIndex]; + if p1 = nil then + Lines[ALineIndex] := TObject(p) + else + begin + p2 := p1; + while (p1 <> nil) and (p1^.X <= p^.X) do + begin + p2 := p1; + p1 := p1^.Next; + end; + if p2 <> p1 then + begin + p2^.Next := p; + p^.Next := p1; + end + else + begin + Lines[ALineIndex] := TObject(p); + p^.Next := p1; + end; + end; + +end; + +function TfrExportFilter.GetviewText(View: TfrView): string; +var + i: Integer; +begin + result := ''; + for i:=0 to View.Memo.Count-1 do begin + result := result + View.Memo[i]; + if i<>View.Memo.Count-1 then + result := result + LineEnding; + end; +end; + +function TfrExportFilter.CheckView(View: TfrView): boolean; +begin + result := true; +end; + procedure TfrExportFilter.OnBeginDoc; begin // abstract method diff --git a/components/lazreport/source/lr_e_csv.pas b/components/lazreport/source/lr_e_csv.pas index 57aaa13680..e4da39df70 100644 --- a/components/lazreport/source/lr_e_csv.pas +++ b/components/lazreport/source/lr_e_csv.pas @@ -21,7 +21,7 @@ uses type - TfrQuoteType = (qtNone, qtQuoteChar); + TfrQuoteType = (qtNone, qtQuoteChar, qtAutoQuote); TfrCSVExport = class(TComponent) public @@ -35,12 +35,10 @@ type FQuoteChar: TUTF8Char; FQuoteType: TfrQuoteType; FSeparator: TUTF8Char; - FCurY : Integer; protected procedure GetUsedFont; override; public constructor Create(AStream: TStream); override; - procedure OnBeginPage; override; procedure OnEndPage; override; procedure OnData(x, y: Integer; View: TfrView); override; procedure OnText(X, Y: Integer; const Text: String; View: TfrView); override; @@ -55,9 +53,6 @@ implementation uses LR_Const; -const - FIELD_GRAIN = 32; // granularity of fields when converting pixel positions - procedure TfrCSVExportFilter.GetUsedFont; begin // never ask usedfont dialog in CSV exporter @@ -68,16 +63,10 @@ begin inherited Create(AStream); FQuoteType := qtQuoteChar; FQuoteChar := '"'; - FSeparator := ';'; + FSeparator := ','; BandTypes := [btMasterHeader,btMasterData,btColumnHeader]; end; -procedure TfrCSVExportFilter.OnBeginPage; -begin - inherited OnBeginPage; - FCurY := -1; -end; - function CompareIntervals(Item1, Item2: Pointer): Integer; begin result := PtrInt(Item1)-PtrInt(Item2); @@ -90,13 +79,23 @@ var s: String; procedure AddStr(aStr: string); + var + Qt: TfrQuoteType; begin - if QuoteType=qtNone then begin + Qt := QuoteType; + if Qt=qtAutoQuote then begin + if pos(Separator, aStr)<>0 then + Qt := qtQuoteChar + else + Qt := qtNone; + end; + if Qt=qtNone then begin if s = '' then s := aStr else s := s + Separator + aStr; - end else begin + end else + begin if s = '' then s := UTF8Quotedstr(aStr, QuoteChar) else @@ -128,62 +127,8 @@ begin end; procedure TfrCSVExportFilter.OnData(x, y: Integer; View: TfrView); -var - p, p1, p2: PfrTextRec; - i: Integer; - s: string; begin - - if (View = nil) or not (View.ParentBandType in BandTypes) then - exit; - if View.Flags and flStartRecord<>0 then - Inc(FCurY); - - p1 := PfrTextRec(Lines[FCurY]); - - GetMem(p, SizeOf(TfrTextRec)); - FillChar(p^, SizeOf(TfrTextRec), 0); - p^.Next := nil; - p^.X := X; - P^.Typ := View.Typ; - p^.Text := ''; - for i:=0 to View.Memo.Count-1 do begin - P^.Text := P^.Text + View.Memo[i]; - if i<>View.Memo.Count-1 then - P^.Text := P^.Text + LineEnding; - end; - 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^.FontCharset := Font.Charset; - end; - p^.FillColor := View.FillColor; - - if p1 = nil then - Lines[FCurY] := TObject(p) - else - begin - p2 := p1; - while (p1 <> nil) and (p1^.X < p^.X) do - begin - p2 := p1; - p1 := p1^.Next; - end; - if p2 <> p1 then - begin - p2^.Next := p; - p^.Next := p1; - end - else - begin - Lines[FCurY] := TObject(p); - p^.Next := p1; - end; - end; + AddData(x, y, View); end; procedure TfrCSVExportFilter.OnText(X, Y: Integer; const Text: String; diff --git a/components/lazreport/source/lr_e_gen.pas b/components/lazreport/source/lr_e_gen.pas index cbe136297c..c132f617a4 100644 --- a/components/lazreport/source/lr_e_gen.pas +++ b/components/lazreport/source/lr_e_gen.pas @@ -109,6 +109,7 @@ end; procedure TfrDBGExportFilter.OnData(x, y: Integer; View: TfrView); begin + if View.Flags and flStartRecord <>0 then WriteLn; Write(' OnData ['); if View.Flags and flStartRecord <>0 then Write(' StartRecord'); if View.Flags and flEndRecord <>0 then Write(' EndRecord'); diff --git a/components/lazreport/source/lr_e_htm.pas b/components/lazreport/source/lr_e_htm.pas index ff019cd1fc..153c9b2d53 100644 --- a/components/lazreport/source/lr_e_htm.pas +++ b/components/lazreport/source/lr_e_htm.pas @@ -43,6 +43,7 @@ type FUseCSS: boolean; styleStartLine: integer; outputLines: TStringList; + FLastField: PfrTextRec; function AddStyle(p: PfrTextRec): Integer; function ColorToHex(c: TColor): AnsiString; function StyleIndex(p: PfrTextRec; AddIfNotFound: boolean = true): Integer; @@ -50,9 +51,12 @@ type protected procedure AppendLine(const s: UTF8String); procedure InsertLine(const s: UTF8String; position: Integer); + function GetviewText(View:TfrView): string; override; public constructor Create(AStream: TStream); override; destructor Destroy; override; + procedure OnData(x, y: Integer; View: TfrView); override; + procedure OnText(X, Y: Integer; const Text: String; View: TfrView); override; procedure OnEndPage; override; procedure OnEndDoc; override; @@ -92,6 +96,8 @@ begin AppendLine(s); s:= '' + LineEnding; AppendLine(s); + + FUseCSS := true; end; destructor TfrHTMExportFilter.Destroy; @@ -245,6 +251,7 @@ begin sp:= Format('%.5d', [p^.X]); xp:= xPos.IndexOf(sp); sp:= Format('%.5d', [p^.X + p^.W]); + xp2 := 0; xPos.Find(sp, xp2); if Assigned(p^.Next) then begin @@ -389,6 +396,25 @@ begin outputLines.Insert(position, s); end; +procedure TfrHTMExportFilter.OnData(x, y: Integer; View: TfrView); +begin + FLastField := AddData(x, y, View); +end; + +procedure TfrHTMExportFilter.OnText(X, Y: Integer; const Text: String; + View: TfrView); +begin + if FLastField^.Text='' then + FLastField^.Text := Text + else + FLastField^.Text := FLastField^.Text + '
' + Text; +end; + +function TfrHTMExportFilter.GetviewText(View: TfrView): string; +begin + result := ''; +end; + procedure TfrHTMExportFilter.OnEndDoc; var diff --git a/components/lazreport/source/lr_e_txt.pas b/components/lazreport/source/lr_e_txt.pas index 2911930e09..7d3950f3f1 100644 --- a/components/lazreport/source/lr_e_txt.pas +++ b/components/lazreport/source/lr_e_txt.pas @@ -36,6 +36,9 @@ type protected procedure GetUsedFont; virtual; procedure Setup; override; + procedure NewRec(View: TfrView; const AText:string; var p:pointer); override; + procedure CalcXCoords(var x,w: integer); virtual; + function CheckView(View: TfrView): boolean; override; public constructor Create(AStream: TStream); override; procedure OnBeginDoc; override; @@ -71,6 +74,24 @@ begin GetUsedFont; end; +procedure TfrTextExportFilter.NewRec(View: TfrView; const AText: string; + var p:pointer); +begin + inherited NewRec(View, AText, p); + CalcXCoords(PfrTextRec(p)^.X, PfrTextRec(p)^.W); +end; + +procedure TfrTextExportFilter.CalcXCoords(var x, w: integer); +begin + x := round(x/UsedFont); + w := round(w/UsedFont); +end; + +function TfrTextExportFilter.CheckView(View: TfrView): boolean; +begin + Result:= View.Typ in [gtMemo,gtAddin]; +end; + constructor TfrTextExportFilter.Create(AStream: TStream); begin inherited; @@ -146,50 +167,9 @@ begin if View = nil then Exit; Y := Round(Y / UsedFont); - p1:= PfrTextRec(Lines[Y]); - GetMem(p, SizeOf(TfrTextRec)); - FillChar(p^, SizeOf(TfrTextRec), 0); - p^.Next := nil; - 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^.FontCharset := Font.Charset; - p^.Alignment := Alignment; - end; - if p1 = nil then - Lines[Y] := TObject(p) - else - begin - p2 := p1; - while (p1 <> nil) and (p1^.X <= p^.X) do - begin - p2 := p1; - p1 := p1^.Next; - end; - if p2 <> p1 then - begin - p2^.Next := p; - p^.Next := p1; - end - else - begin - Lines[Y] := TObject(p); - p^.Next := p1; - end; - end; + NewRec(View, Text, p); + AddRec(Y, p); end;