Lazreport, fix word wrapped fields produce multiple rows in html export, made css output default, made COMMA the QuoteChar by default in CSV exporter

git-svn-id: trunk@23114 -

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

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
-
+  AddData(x, y, View);
-  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;
 end;
 
 procedure TfrCSVExportFilter.OnText(X, Y: Integer; const Text: String;

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');

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:= '<body bgColor="#FFFFFF">' + 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 + '<br>' + Text;
+end;
+
+function TfrHTMExportFilter.GetviewText(View: TfrView): string;
+begin
+  result := '';
+end;
+
 
 procedure TfrHTMExportFilter.OnEndDoc;
 var

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
+  NewRec(View, Text, p);
-    Lines[Y] := TObject(p)
+  AddRec(Y, 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;
 end;