pascal/lazarus-ccr
1
0
Fork 0
Code Issues Releases Activity

fpspreadsheet: Modified virtual mode (VirtualColCount, VirtualRowCount and OnWriteCellData were moved from workbook to worksheet). NOTE: THIS BREAKS EXISTING CODE USING VIRTUAL MODE.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@4968 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2016-07-14 19:43:15 +00:00
parent 5782410686
commit c639d3f13d
10 changed files with 170 additions and 131 deletions
Download Patch File Download Diff File Expand all files Collapse all files

30
components/fpspreadsheet/examples/fpsspeedtest/mainform.pas
View File

@ -49,12 +49,12 @@ type
function GetRowCount(AIndex: Integer): Integer;
procedure ReadCellDataHandler(Sender: TObject; ARow, ACol: Cardinal;
const ADataCell: PCell);
procedure WriteCellStringHandler(Sender: TObject; ARow, ACol: Cardinal;
var AValue: Variant; var AStyleCell: PCell);
procedure WriteCellNumberHandler(Sender: TObject; ARow, ACol: Cardinal;
var AValue: Variant; var AStyleCell: PCell);
procedure WriteCellStringAndNumberHandler(Sender: TObject; ARow, ACol: Cardinal;
var AValue: Variant; var AStyleCell: PCell);
procedure WriteCellStringHandler(Sender: TsWorksheet;
ARow, ACol: Cardinal; var AValue: Variant; var AStyleCell: PCell);
procedure WriteCellNumberHandler(Sender: TsWorksheet;
ARow, ACol: Cardinal; var AValue: Variant; var AStyleCell: PCell);
procedure WriteCellStringAndNumberHandler(Sender: TsWorksheet;
ARow, ACol: Cardinal; var AValue: Variant; var AStyleCell: PCell);
procedure ReadFromIni;
procedure WriteToIni;
procedure RunReadTest(Idx: Integer; Log: String; Options: TsWorkbookOptions);
@ -116,7 +116,7 @@ begin
StatusMsg(Format('Virtual mode reading %s: Row %d...', [GetFileFormatName(FCurFormat), ARow]));
end;
procedure TForm1.WriteCellStringHandler(Sender: TObject; ARow, ACol: cardinal;
procedure TForm1.WriteCellStringHandler(Sender: TsWorksheet; ARow, ACol: cardinal;
var AValue: variant; var AStyleCell: PCell);
var
S: string;
@ -128,7 +128,7 @@ begin
StatusMsg(Format('Virtual mode writing %s: Row %d...', [GetFileFormatName(FCurFormat), ARow]));
end;
procedure TForm1.WriteCellNumberHandler(Sender: TObject; ARow, ACol: cardinal;
procedure TForm1.WriteCellNumberHandler(Sender: TsWorksheet; ARow, ACol: cardinal;
var AValue: variant; var AStyleCell: PCell);
begin
UnUsed(AStyleCell);
@ -137,8 +137,8 @@ begin
StatusMsg(Format('Virtual mode writing %s: Row %d...', [GetFileFormatName(FCurFormat), ARow]));
end;
procedure TForm1.WriteCellStringAndNumberHandler(Sender: TObject; ARow, ACol: cardinal;
var AValue: variant; var AStyleCell: PCell);
procedure TForm1.WriteCellStringAndNumberHandler(Sender: TsWorksheet;
ARow, ACol: cardinal; var AValue: variant; var AStyleCell: PCell);
begin
if odd(ARow + ACol) then
WriteCellStringHandler(Sender, ARow, ACol, AValue, AStyleCell)
@ -257,12 +257,12 @@ begin
try
if boVirtualMode in Options then
begin
MyWorkbook.VirtualRowCount := Rows;
MyWorkbook.VirtualColCount := numCols;
MyWorksheet.VirtualRowCount := Rows;
MyWorksheet.VirtualColCount := numCols;
case RgContent.ItemIndex of
0: MyWorkbook.OnWriteCellData := @WriteCellStringHandler;
1: MyWorkbook.OnWriteCellData := @WriteCellNumberHandler;
2: MyWorkbook.OnWriteCellData := @WriteCellStringAndNumberHandler;
0: MyWorksheet.OnWriteCellData := @WriteCellStringHandler;
1: MyWorksheet.OnWriteCellData := @WriteCellNumberHandler;
2: MyWorksheet.OnWriteCellData := @WriteCellStringAndNumberHandler;
end;
end
else

11
components/fpspreadsheet/examples/other/demo_virtualmode_write.lpr
View File

@ -13,7 +13,7 @@ uses
type
TDataProvider = class
procedure WriteCellDataHandler(Sender: TObject; ARow,ACol: Cardinal;
procedure WriteCellDataHandler(Sender: TsWorksheet; ARow,ACol: Cardinal;
var AData: variant; var AStyleCell: PCell);
end;
@ -24,7 +24,7 @@ var
headerTemplate: PCell;
t: TTime;
procedure TDataProvider.WriteCellDataHandler(Sender: TObject;
procedure TDataProvider.WriteCellDataHandler(Sender: TsWorksheet;
ARow, ACol: Cardinal; var AData: variant; var AStyleCell: PCell);
{ This is just a sample using random data. Normally, in case of a database,
you would read a record and return its field values, such as:
@ -58,7 +58,6 @@ var
end;
begin
dataprovider := TDataProvider.Create;
try
workbook := TsWorkbook.Create;
@ -78,12 +77,12 @@ begin
{ Next two numbers define the size of virtual spreadsheet.
In case of a database, VirtualRowCount is the RecordCount, VirtualColCount
the number of fields to be written to the spreadsheet file }
workbook.VirtualRowCount := 20000;
workbook.VirtualColCount := 100;
worksheet.VirtualRowCount := 20000;
worksheet.VirtualColCount := 100;
{ The event handler for OnWriteCellData links the workbook to the method
from which it gets the data to be written. }
workbook.OnWriteCellData := @dataprovider.WriteCellDataHandler;
worksheet.OnWriteCellData := @dataprovider.WriteCellDataHandler;
{ If we want to change the format of some cells we have to provide this
format in template cells of the worksheet. In the example, the first

21
components/fpspreadsheet/fpsopendocument.pas
View File

@ -4752,10 +4752,8 @@ begin
// rows and cells
// The cells need to be written in order, row by row, cell by cell
if (boVirtualMode in Workbook.Options) then
begin
if Assigned(Workbook.OnWriteCellData) then
WriteVirtualCells(AStream, FWorksheet)
end else
WriteVirtualCells(AStream, FWorksheet)
else
WriteRowsAndCells(AStream, FWorksheet);
// named expressions, i.e. print range, repeated cols/rows
@ -6401,9 +6399,16 @@ var
colsRepeatedStr: String;
lastCol, lastRow: Cardinal;
begin
if ASheet.VirtualColCount = 0 then
exit;
if ASheet.VirtualRowCount = 0 then
exit;
if not Assigned(ASheet.OnWriteCellData) then
exit;
// some abbreviations...
lastCol := Workbook.VirtualColCount - 1;
lastRow := Workbook.VirtualRowCount - 1;
lastCol := LongInt(ASheet.VirtualColCount) - 1;
lastRow := LongInt(ASheet.VirtualRowCount) - 1;
rowsRepeated := 1;
r := 0;
@ -6450,7 +6455,7 @@ begin
value := varNull;
styleCell := nil;
Workbook.OnWriteCellData(Workbook, r, c, value, styleCell);
ASheet.OnWriteCellData(ASheet, r, c, value, styleCell);
if VarIsNull(value) then
begin
@ -6461,7 +6466,7 @@ begin
InitCell(r, cc, lCell);
value := varNull;
styleCell := nil;
Workbook.OnWriteCellData(Workbook, r, cc, value, styleCell);
ASheet.OnWriteCellData(ASheet, r, cc, value, styleCell);
if not VarIsNull(value) then
break;
inc(cc);

103
components/fpspreadsheet/fpspreadsheet.pas
View File

@ -102,6 +102,12 @@ type
TsCellCompareEvent = procedure (Sender: TObject; ACell1, ACell2: PCell;
var AResult: Integer) of object;
{@@ Event fired when writing a file in virtual mode. The event handler has to
pass data ("AValue") and formatting style to be copied from a template
cell ("AStyleCell") to the writer }
TsWorksheetWriteCellDataEvent = procedure(Sender: TsWorksheet; ARow, ACol: Cardinal;
var AValue: variant; var AStyleCell: PCell) of object;
{@@ The worksheet contains a list of cells and provides a variety of methods
to read or write data to the cells, or to change their formatting. }
TsWorksheet = class
@ -129,10 +135,13 @@ type
FSortParams: TsSortParams; // Parameters of the current sorting operation
FBiDiMode: TsBiDiMode;
FPageLayout: TsPageLayout;
FVirtualColCount: Cardinal;
FVirtualRowCount: Cardinal;
FOnChangeCell: TsCellEvent;
FOnChangeFont: TsCellEvent;
FOnCompareCells: TsCellCompareEvent;
FOnSelectCell: TsCellEvent;
FOnWriteCellData: TsWorksheetWriteCellDataEvent;
{ Setter/Getter }
function GetDefaultColWidth: Single;
@ -142,6 +151,8 @@ type
procedure SetDefaultColWidth(AValue: Single);
procedure SetDefaultRowHeight(AValue: Single);
procedure SetName(const AName: String);
procedure SetVirtualColCount(AValue: Cardinal);
procedure SetVirtualRowCount(AValue: Cardinal);
{ Callback procedures called when iterating through all cells }
procedure DeleteColCallback(data, arg: Pointer);
@ -559,6 +570,12 @@ type
{@@ The default row height is given in "line count" (height of the default font }
property DefaultRowHeight: Single read GetDefaultRowHeight write SetDefaultRowHeight;
deprecated 'Use Read/WriteDefaultColWidth';
{@@ In VirtualMode, the value of VirtualColCount signals how many colums
will be transferred to the worksheet. }
property VirtualColCount: cardinal read FVirtualColCount write SetVirtualColCount;
{@@ The value VirtualRowCount indicates how many rows will be transferred
to the worksheet in VirtualMode. }
property VirtualRowCount: cardinal read FVirtualRowCount write SetVirtualRowCount;
// These are properties to interface to TsWorksheetGrid
property BiDiMode: TsBiDiMode read FBiDiMode write SetBiDiMode;
@ -581,6 +598,10 @@ type
property OnCompareCells: TsCellCompareEvent read FOnCompareCells write FOnCompareCells;
{@@ Event fired when a cell is "selected". }
property OnSelectCell: TsCellEvent read FOnSelectCell write FOnSelectCell;
{@@ This event allows to provide external cell data for writing to file,
standard cells are ignored. Intended for converting large database files
to a spreadsheet format. Requires Option boVirtualMode to be set. }
property OnWriteCellData: TsWorksheetWriteCellDataEvent read FOnWriteCellData write FOnWriteCellData;
end;
@ -614,13 +635,6 @@ type
{@@ Set of option flags for the workbook }
TsWorkbookOptions = set of TsWorkbookOption;
{@@
Event fired when writing a file in virtual mode. The event handler has to
pass data ("AValue") and formatting style to be copied from a template
cell ("AStyleCell") to the writer }
TsWorkbookWriteCellDataEvent = procedure(Sender: TObject; ARow, ACol: Cardinal;
var AValue: variant; var AStyleCell: PCell) of object;
{@@
Event fired when reading a file in virtual mode. Read data are provided in
the "ADataCell" (which is not added to the worksheet in virtual mode). }
@ -645,14 +659,11 @@ type
FWorksheets: TFPList;
FFormatID: TsSpreadFormatID;
FBuiltinFontCount: Integer;
FVirtualColCount: Cardinal;
FVirtualRowCount: Cardinal;
FReadWriteFlag: TsReadWriteFlag;
FCalculationLock: Integer;
FOptions: TsWorkbookOptions;
FActiveWorksheet: TsWorksheet;
FOnOpenWorkbook: TNotifyEvent;
FOnWriteCellData: TsWorkbookWriteCellDataEvent;
FOnReadCellData: TsWorkbookReadCellDataEvent;
FOnChangeWorksheet: TsWorksheetEvent;
FOnRenameWorksheet: TsWorksheetEvent;
@ -668,8 +679,6 @@ type
{ Setter/Getter }
function GetErrorMsg: String;
procedure SetVirtualColCount(AValue: Cardinal);
procedure SetVirtualRowCount(AValue: Cardinal);
{ Callback procedures }
procedure RemoveWorksheetsCallback(data, arg: pointer);
@ -819,8 +828,6 @@ type
property FileName: String read FFileName;
{@@ Identifies the file format which was detected when reading the file }
property FileFormatID: TsSpreadFormatID read FFormatID;
property VirtualColCount: cardinal read FVirtualColCount write SetVirtualColCount;
property VirtualRowCount: cardinal read FVirtualRowCount write SetVirtualRowCount;
property Options: TsWorkbookOptions read FOptions write FOptions;
property Units: TsSizeUnits read FUnits;
@ -838,10 +845,6 @@ type
property OnRemovingWorksheet: TsWorksheetEvent read FOnRemovingWorksheet write FOnRemovingWorksheet;
{@@ This event fires when a worksheet is made "active"}
property OnSelectWorksheet: TsWorksheetEvent read FOnSelectWorksheet write FOnSelectWorksheet;
{@@ This event allows to provide external cell data for writing to file,
standard cells are ignored. Intended for converting large database files
to a spreadsheet format. Requires Option boVirtualMode to be set. }
property OnWriteCellData: TsWorkbookWriteCellDataEvent read FOnWriteCellData write FOnWriteCellData;
{@@ This event accepts cell data while reading a spreadsheet file. Data are
not encorporated in a spreadsheet, they are just passed through to the
event handler for processing. Requires option boVirtualMode to be set. }
@ -4074,6 +4077,24 @@ begin
FLastRowIndex := GetLastRowIndex(true);
end;
{@@ ----------------------------------------------------------------------------
Setter method for the count of columns to be written in VirtualMode
-------------------------------------------------------------------------------}
procedure TsWorksheet.SetVirtualColCount(AValue: Cardinal);
begin
if FWorkbook.FReadWriteFlag = rwfWrite then exit;
FVirtualColCount := AValue;
end;
{@@ ----------------------------------------------------------------------------
Setter method for the count of rows to be written in VirtualMode
-------------------------------------------------------------------------------}
procedure TsWorksheet.SetVirtualRowCount(AValue: Cardinal);
begin
if FWorkbook.FReadWriteFlag = rwfWrite then exit;
FVirtualRowCount := AValue;
end;
{@@ ----------------------------------------------------------------------------
Writes UTF-8 encoded text to a cell.
@ -6996,7 +7017,8 @@ end;
-------------------------------------------------------------------------------}
procedure TsWorkbook.PrepareBeforeSaving;
var
sheet: pointer;
sheet: TsWorksheet;
virtModeOK: Boolean;
begin
// Clear error log
FLog.Clear;
@ -7007,11 +7029,19 @@ begin
// Calculated formulas (if requested)
if (boCalcBeforeSaving in FOptions) then
for sheet in FWorksheets do
TsWorksheet(sheet).CalcFormulas;
sheet.CalcFormulas;
// Abort if virtual mode is active without an event handler
if (boVirtualMode in FOptions) and not Assigned(FOnWriteCellData) then
raise Exception.Create('[TsWorkbook.PrepareBeforeWriting] Event handler "OnWriteCellData" required for virtual mode.');
if (boVirtualMode in FOptions) then
begin
virtModeOK := false;
for sheet in FWorksheets do
if Assigned(sheet.OnWriteCellData) then
virtModeOK := true;
if not virtModeOK then
raise Exception.Create('[TsWorkbook.PrepareBeforeWriting] At least one '+
'sheet must have an event handler "OnWriteCellData" for virtual mode.');
end;
end;
{@@ ----------------------------------------------------------------------------
@ -7274,17 +7304,22 @@ var
i: Integer;
sheet: TsWorksheet;
begin
ALastRow := 0;
ALastCol := 0;
if (boVirtualMode in Options) then
begin
ALastRow := FVirtualRowCount - 1;
ALastCol := FVirtualColCount - 1;
for sheet in FWorksheets do
if Assigned(sheet.OnWriteCellData) then
begin
if sheet.VirtualRowCount > 0 then
ALastRow := Max(ALastRow, sheet.VirtualRowCount - 1);
if sheet.VirtualColCount > 0 then
ALastCol := Max(ALastCol, sheet.VirtualColCount - 1);
end;
end else
begin
ALastRow := 0;
ALastCol := 0;
for i:=0 to GetWorksheetCount-1 do
for sheet in FWorksheets do
begin
sheet := GetWorksheetByIndex(i);
ALastRow := Max(ALastRow, sheet.GetLastRowIndex);
ALastCol := Max(ALastCol, sheet.GetLastColIndex);
end;
@ -7484,18 +7519,6 @@ begin
end;
end;
procedure TsWorkbook.SetVirtualColCount(AValue: Cardinal);
begin
if FReadWriteFlag = rwfWrite then exit;
FVirtualColCount := AValue;
end;
procedure TsWorkbook.SetVirtualRowCount(AValue: Cardinal);
begin
if FReadWriteFlag = rwfWrite then exit;
FVirtualRowCount := AValue;
end;
{@@ ----------------------------------------------------------------------------
Writes the document to a file. If the file doesn't exist, it will be created.
Can be used only for built-in file formats.

4
components/fpspreadsheet/fpsreaderwriter.pas
View File

@ -536,8 +536,8 @@ begin
begin
AFirstRow := 0;
AFirstCol := 0;
ALastRow := AWorksheet.Workbook.VirtualRowCount-1;
ALastCol := AWorksheet.Workbook.VirtualColCount-1;
ALastRow := LongInt(AWorksheet.VirtualRowCount)-1;
ALastCol := LongInt(AWorksheet.VirtualColCount)-1;
end else
begin
Workbook.UpdateCaches;

2
components/fpspreadsheet/xlsbiff2.pas
View File

@ -1339,7 +1339,7 @@ begin
WriteRows(AStream, FWorksheet);
if (boVirtualMode in Workbook.Options) then
WriteVirtualCells(AStream)
WriteVirtualCells(AStream, FWorksheet)
else begin
WriteRows(AStream, FWorksheet);
WriteCellsToStream(AStream, FWorksheet.Cells);

2
components/fpspreadsheet/xlsbiff5.pas
View File

@ -1166,7 +1166,7 @@ begin
//WriteRows(AStream, sheet);
if (boVirtualMode in Workbook.Options) then
WriteVirtualCells(AStream)
WriteVirtualCells(AStream, FWorksheet)
else begin
WriteRows(AStream, FWorksheet);
WriteCellsToStream(AStream, FWorksheet.Cells);

2
components/fpspreadsheet/xlsbiff8.pas
View File

@ -2141,7 +2141,7 @@ begin
//WriteRowAndCellBlock(AStream, sheet);
if (boVirtualMode in Workbook.Options) then
WriteVirtualCells(AStream)
WriteVirtualCells(AStream, FWorksheet)
else begin
WriteRows(AStream, FWorksheet);
WriteCellsToStream(AStream, FWorksheet.Cells);

18
components/fpspreadsheet/xlscommon.pas
View File

@ -602,7 +602,7 @@ type
procedure WriteStringRecord(AStream: TStream; AString: String); virtual;
procedure WriteVCenter(AStream: TStream);
// Writes cell content received by workbook in OnNeedCellData event
procedure WriteVirtualCells(AStream: TStream);
procedure WriteVirtualCells(AStream: TStream; ASheet: TsWorksheet);
// Writes out a WINDOW1 record
procedure WriteWindow1(AStream: TStream); virtual;
// Writes an XF record
@ -4580,21 +4580,29 @@ begin
AStream.WriteWord(WordToLE(w));
end;
procedure TsSpreadBIFFWriter.WriteVirtualCells(AStream: TStream);
procedure TsSpreadBIFFWriter.WriteVirtualCells(AStream: TStream;
ASheet: TsWorksheet);
var
r,c: Cardinal;
lCell: TCell;
value: variant;
styleCell: PCell;
begin
for r := 0 to Workbook.VirtualRowCount-1 do
for c := 0 to Workbook.VirtualColCount-1 do
if ASheet.VirtualRowCount = 0 then
exit;
if ASheet.VirtualColCount = 0 then
exit;
if not Assigned(ASheet.OnWriteCellData) then
exit;
for r := 0 to LongInt(ASheet.VirtualRowCount) - 1 do
for c := 0 to LongInt(ASheet.VirtualColCount) - 1 do
begin
lCell.Row := r; // to silence a compiler hint...
InitCell(lCell);
value := varNull;
styleCell := nil;
Workbook.OnWriteCellData(Workbook, r, c, value, styleCell);
ASheet.OnWriteCellData(ASheet, r, c, value, styleCell);
if styleCell <> nil then lCell := styleCell^;
lCell.Row := r;
lCell.Col := c;

108
components/fpspreadsheet/xlsxooxml.pas
View File

@ -2902,62 +2902,66 @@ begin
GetSheetDimensions(AWorksheet, r1, r2, c1, c2);
if (boVirtualMode in Workbook.Options) and Assigned(Workbook.OnWriteCellData)
then begin
for r := 0 to r2 do begin
row := AWorksheet.FindRow(r);
if row <> nil then
rh := Format(' ht="%.2f" customHeight="1"',
[FWorkbook.ConvertUnits(row^.Height, FWorkbook.Units, suPoints)],
FPointSeparatorSettings)
else
rh := '';
AppendToStream(AStream, Format(
'<row r="%d" spans="1:%d"%s>', [r+1, Workbook.VirtualColCount, rh]));
for c := 0 to c2 do begin
lCell.Row := r; // to silence a compiler hint
InitCell(lCell);
value := varNull;
styleCell := nil;
Workbook.OnWriteCellData(FWorkbook, r, c, value, styleCell);
if styleCell <> nil then
lCell := styleCell^;
lCell.Row := r;
lCell.Col := c;
if VarIsNull(value) then
begin
if (boVirtualMode in Workbook.Options) then begin
if Assigned(AWorksheet.OnWriteCellData) and
(AWorksheet.VirtualColCount > 0) and (AWorksheet.VirtualRowCount > 0)
then begin
for r := 0 to r2 do begin
row := AWorksheet.FindRow(r);
if row <> nil then
rh := Format(' ht="%.2f" customHeight="1"',
[FWorkbook.ConvertUnits(row^.Height, FWorkbook.Units, suPoints)],
FPointSeparatorSettings)
else
rh := '';
AppendToStream(AStream, Format(
'<row r="%d" spans="1:%d"%s>', [r+1, AWorksheet.VirtualColCount, rh]));
for c := 0 to c2 do begin
lCell.Row := r; // to silence a compiler hint
InitCell(lCell);
value := varNull;
styleCell := nil;
AWorksheet.OnWriteCellData(AWorksheet, r, c, value, styleCell);
if styleCell <> nil then
lCell.ContentType := cctEmpty
else
Continue;
end else
if VarIsNumeric(value) then
begin
lCell.ContentType := cctNumber;
lCell.NumberValue := value;
end else
if VarType(value) = varDate then
begin
lCell.ContentType := cctDateTime;
lCell.DateTimeValue := StrToDateTime(VarToStr(value), Workbook.FormatSettings); // was: StrToDate
end else
if VarIsStr(value) then
begin
lCell.ContentType := cctUTF8String;
lCell.UTF8StringValue := VarToStrDef(value, '');
end else
if VarIsBool(value) then
begin
lCell.ContentType := cctBool;
lCell.BoolValue := value <> 0;
lCell := styleCell^;
lCell.Row := r;
lCell.Col := c;
if VarIsNull(value) then
begin
if styleCell <> nil then
lCell.ContentType := cctEmpty
else
Continue;
end else
if VarIsNumeric(value) then
begin
lCell.ContentType := cctNumber;
lCell.NumberValue := value;
end else
if VarType(value) = varDate then
begin
lCell.ContentType := cctDateTime;
lCell.DateTimeValue := StrToDateTime(VarToStr(value), Workbook.FormatSettings); // was: StrToDate
end else
if VarIsStr(value) then
begin
lCell.ContentType := cctUTF8String;
lCell.UTF8StringValue := VarToStrDef(value, '');
end else
if VarIsBool(value) then
begin
lCell.ContentType := cctBool;
lCell.BoolValue := value <> 0;
end;
WriteCellToStream(AStream, @lCell);
varClear(value);
end;
WriteCellToStream(AStream, @lCell);
varClear(value);
AppendToStream(AStream,
'</row>');
end;
AppendToStream(AStream,
'</row>');
end;
end else
end // end of virtual mode writing
else
begin
// The cells need to be written in order, row by row, cell by cell
for r := r1 to r2 do begin