fpspreadsheet: Add (intermediate) copy of csvdocument to component and use its parser and builder from the csv reader/writer of fpspreadsheet.

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@3683 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2014-10-23 22:43:30 +00:00
parent 118af5e671
commit 753fd6ab37
4 changed files with 1128 additions and 26 deletions

View File

@ -6,7 +6,7 @@ interface
uses
Classes, SysUtils,
fpspreadsheet;
fpspreadsheet, fpsCsvDocument;
type
TsCSVReader = class(TsCustomSpreadReader)
@ -32,6 +32,7 @@ type
TsCSVWriter = class(TsCustomSpreadWriter)
private
FCSVBuilder: TCSVBuilder;
FLineEnding: String;
protected
procedure WriteBlank(AStream: TStream; const ARow, ACol: Cardinal;
@ -82,6 +83,8 @@ var
FalseText: 'FALSE';
{%H-});
function LineEndingAsString(ALineEnding: TsCSVLineEnding): String;
implementation
@ -174,6 +177,16 @@ begin
AFormatSettings.TwoDigitYearCenturyWindow := ADefaultFormats.TwoDigitYearCenturyWindow;
end;
function LineEndingAsString(ALineEnding: TsCSVLineEnding): String;
begin
case ALineEnding of
leSystem: Result := LineEnding;
leCR : Result := #13;
leLF : Result := #10;
leCRLF : Result := #13#10;
end;
end;
{ -----------------------------------------------------------------------------}
{ TsCSVReader }
@ -317,6 +330,8 @@ begin
Unused(AStream);
end;
{ Determines content types from/for the text read from the csv file and writes
the corresponding data to the worksheet. }
procedure TsCSVReader.ReadCellValue(ARow, ACol: Cardinal; AText: String);
var
dblValue: Double;
@ -338,22 +353,6 @@ begin
exit;
end;
// Remove quotes
if (AText[1] = CSVParams.QuoteChar) and (AText[Length(AText)] = CSVParams.QuoteChar) then
begin
Delete(AText, Length(AText), 1);
Delete(AText, 1, 1);
end;
{
// Quoted text is a TEXT cell
if IsQuotedText(AText) then
begin
FWorksheet.WriteUTF8Text(ARow, ACol, AText);
exit;
end;
}
// Check for a NUMBER or CURRENCY cell
if IsNumber(AText, dblValue, nf, decs, currSym, warning) then
begin
@ -403,6 +402,28 @@ begin
inherited;
end;
procedure TsCSVReader.ReadFromStream(AStream: TStream; AData: TsWorkbook);
var
parser: TCSVParser;
begin
FWorkbook := AData;
FWorksheet := AData.AddWorksheet(FWorksheetName);
parser := TCSVParser.Create;
try
parser.Delimiter := CSVParams.Delimiter;
parser.LineEnding := LineEndingAsString(CSVParams.LineEnding);
parser.QuoteChar := CSVParams.QuoteChar;
parser.EqualColCountPerRow := false;
parser.SetSource(AStream);
while parser.ParseNextCell do
ReadCellValue(parser.CurrentRow, parser.CurrentCol, parser.CurrentCellText);
finally
parser.Free;
end;
end;
{
procedure TsCSVReader.ReadFromStream(AStream: TStream; AData: TsWorkbook);
var
n: Int64;
@ -452,7 +473,7 @@ begin
cellValue := cellValue + ch;
end;
end;
}
procedure TsCSVReader.ReadFromStrings(AStrings: TStrings; AData: TsWorkbook);
var
stream: TStringStream;
@ -503,19 +524,28 @@ end;
procedure TsCSVWriter.WriteBool(AStream: TStream; const ARow, ACol: Cardinal;
const AValue: Boolean; ACell: PCell);
begin
Unused(AStream);
Unused(ARow, ACol, ACell);
if AValue then
FCSVBuilder.AppendCell(CSVParams.TrueText)
else
FCSVBuilder.AppendCell(CSVParams.FalseText);
{
if AValue then
AppendToStream(AStream, CSVParams.TrueText)
else
AppendToStream(AStream, CSVParams.FalseText);
}
end;
{ Write date/time values in the same way they are displayed in the sheet }
procedure TsCSVWriter.WriteDateTime(AStream: TStream; const ARow, ACol: Cardinal;
const AValue: TDateTime; ACell: PCell);
begin
Unused(AStream);
Unused(ARow, ACol, AValue);
AppendToStream(AStream, FWorksheet.ReadAsUTF8Text(ACell));
FCSVBuilder.AppendCell(FWorksheet.ReadAsUTF8Text(ACell));
// AppendToStream(AStream, FWorksheet.ReadAsUTF8Text(ACell));
end;
{ CSV does not support formulas, but we have to write the formula results to
@ -541,13 +571,15 @@ procedure TsCSVWriter.WriteLabel(AStream: TStream; const ARow, ACol: Cardinal;
var
s: String;
begin
Unused(AStream);
Unused(ARow, ACol, AValue);
if ACell = nil then
exit;
s := ACell^.UTF8StringValue;
if CSVParams.QuoteChar <> #0 then
s := CSVParams.QuoteChar + s + CSVParams.QuoteChar;
AppendToStream(AStream, s);
FCSVBuilder.AppendCell(s);
// AppendToStream(AStream, s);
end;
procedure TsCSVWriter.WriteNumber(AStream: TStream; const ARow, ACol: Cardinal;
@ -555,6 +587,7 @@ procedure TsCSVWriter.WriteNumber(AStream: TStream; const ARow, ACol: Cardinal;
var
s: String;
begin
Unused(AStream);
Unused(ARow, ACol);
if ACell = nil then
exit;
@ -562,7 +595,8 @@ begin
s := Format(CSVParams.NumberFormat, [AValue], CSVParams.FormatSettings)
else
s := FWorksheet.ReadAsUTF8Text(ACell, CSVParams.FormatSettings);
AppendToStream(AStream, s);
FCSVBuilder.AppendCell(s);
// AppendToStream(AStream, s);
end;
procedure TsCSVWriter.WriteSheet(AStream: TStream; AWorksheet: TsWorksheet);
@ -572,8 +606,29 @@ var
cell: PCell;
begin
FWorksheet := AWorksheet;
lastRow := FWorksheet.GetLastOccupiedRowIndex;
lastCol := FWorksheet.GetLastOccupiedColIndex;
FCSVBuilder := TCSVBuilder.Create;
try
FCSVBuilder.Delimiter := CSVParams.Delimiter;
FCSVBuilder.LineEnding := LineEndingAsString(CSVParams.LineEnding);
FCSVBuilder.QuoteChar := CSVParams.QuoteChar;
FCSVBuilder.SetOutput(AStream);
lastRow := FWorksheet.GetLastOccupiedRowIndex;
lastCol := FWorksheet.GetLastOccupiedColIndex;
for r := 0 to lastRow do
for c := 0 to lastCol do
begin
cell := FWorksheet.FindCell(r, c);
if cell <> nil then
WriteCellCallback(cell, AStream);
if c = lastCol then
FCSVBuilder.AppendRow;
end;
finally
FreeAndNil(FCSVBuilder);
end;
{
for r := 0 to lastRow do
for c := 0 to lastCol do begin
cell := FWorksheet.FindCell(r, c);
@ -584,6 +639,7 @@ begin
else
AppendToStream(AStream, CSVParams.Delimiter);
end;
}
end;
procedure TsCSVWriter.WriteToStream(AStream: TStream);

File diff suppressed because it is too large Load Diff

View File

@ -9,6 +9,7 @@
<Version Value="11"/>
<PathDelim Value="\"/>
<SearchPaths>
<OtherUnitFiles Value="."/>
<UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
</SearchPaths>
<Parsing>
@ -25,7 +26,7 @@
This package is all you need if you don't want graphical components (like grids and charts)."/>
<License Value="LGPL with static linking exception. This is the same license as is used in the LCL (Lazarus Component Library)."/>
<Version Major="1" Minor="2"/>
<Files Count="26">
<Files Count="27">
<Item1>
<Filename Value="fpolestorage.pas"/>
<UnitName Value="fpolestorage"/>
@ -120,7 +121,7 @@ This package is all you need if you don't want graphical components (like grids
</Item23>
<Item24>
<Filename Value="fpsrpn.pas"/>
<UnitName Value="fpsrpn"/>
<UnitName Value="fpsRPN"/>
</Item24>
<Item25>
<Filename Value="fpsstrings.pas"/>
@ -130,6 +131,10 @@ This package is all you need if you don't want graphical components (like grids
<Filename Value="fpscsv.pas"/>
<UnitName Value="fpscsv"/>
</Item26>
<Item27>
<Filename Value="fpscsvdocument.pas"/>
<UnitName Value="fpsCsvDocument"/>
</Item27>
</Files>
<RequiredPkgs Count="2">
<Item1>

View File

@ -12,7 +12,7 @@ uses
fpsutils, fpszipper, uvirtuallayer_types, uvirtuallayer, uvirtuallayer_ole,
uvirtuallayer_ole_helpers, uvirtuallayer_ole_types, uvirtuallayer_stream,
fpolebasic, wikitable, fpsNumFormatParser, fpsfunc, fpsRPN, fpsStrings,
fpscsv;
fpscsv, fpsCsvDocument;
implementation