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

Moves the formatting example and the styles building code so that OpenDocument can share them

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@1652 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
sekelsenmat
2011-05-27 13:14:14 +00:00
parent 9ac1f18a50
commit 9169c3f155
5 changed files with 84 additions and 84 deletions
Download Patch File Download Diff File Expand all files Collapse all files

2
components/fpspreadsheet/examples/excel8demo/run_excel8write_format.bat
View File

@ -1,2 +0,0 @@
excel8write_format.exe
pause

7
components/fpspreadsheet/examples/excel8demo/excel8write_format.lpi → components/fpspreadsheet/examples/other/test_write_formatting.lpi
View File

@ -10,6 +10,7 @@
</Flags>
<SessionStorage Value="InProjectDir"/>
<MainUnit Value="0"/>
<Title Value="test_write_formatting"/>
<ResourceType Value="res"/>
<UseXPManifest Value="True"/>
<Icon Value="0"/>
@ -40,9 +41,9 @@
</RequiredPackages>
<Units Count="1">
<Unit0>
<Filename Value="excel8write_format.pas"/>
<Filename Value="test_write_formatting.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="excel8write_format"/>
<UnitName Value="test_write_formatting"/>
</Unit0>
</Units>
</ProjectOptions>
@ -50,7 +51,7 @@
<Version Value="10"/>
<PathDelim Value="\"/>
<Target>
<Filename Value="excel8write_format"/>
<Filename Value="test_write_formatting"/>
</Target>
<SearchPaths>
<IncludeFiles Value="$(ProjOutDir)"/>

9
components/fpspreadsheet/examples/excel8demo/excel8write_format.pas → components/fpspreadsheet/examples/other/test_write_formatting.pas
View File

@ -1,5 +1,5 @@
{
excel8write.dpr
test_write_formatting.pas
Demonstrates how to write an Excel 8+ file using the fpspreadsheet library
@ -7,12 +7,12 @@ Adds formatting to the file
AUTHORS: Felipe Monteiro de Carvalho
}
program excel8write_format;
program test_write_formatting;
{$mode delphi}{$H+}
uses
Classes, SysUtils, fpspreadsheet, xlsbiff8,
Classes, SysUtils, fpspreadsheet, xlsbiff8, fpsopendocument,
laz_fpspreadsheet, fpsconvencoding;
var
@ -170,7 +170,8 @@ begin
WriteSecondWorksheet();
// Save the spreadsheet to a file
MyWorkbook.WriteToFile(MyDir + 'test3.xls', sfExcel8, False);
//MyWorkbook.WriteToFile(MyDir + 'test3.xls', sfExcel8, False);
MyWorkbook.WriteToFile(MyDir + 'test3.odt', sfOpenDocument, False);
MyWorkbook.Free;
end.

75
components/fpspreadsheet/fpspreadsheet.pas
View File

@ -272,7 +272,17 @@ type
TsCustomSpreadWriter = class
public
{@@
An array with cells which are models for the used styles
In this array the Row property holds the Index to the corresponding XF field
}
FFormattingStyles: array of TCell;
NextXFIndex: Integer; // Indicates which should be the next XF (Style) Index when filling the styles list
{ Helper routines }
function FindFormattingInList(AFormat: PCell): Integer;
procedure AddDefaultFormats(); virtual;
procedure ListAllFormattingStylesCallback(ACell: PCell; AStream: TStream);
procedure ListAllFormattingStyles(AData: TsWorkbook);
function ExpandFormula(AFormula: TsFormula): TsExpandedFormula;
{ General writing methods }
procedure WriteCellCallback(ACell: PCell; AStream: TStream);
@ -988,6 +998,71 @@ end;
{ TsCustomSpreadWriter }
{@@
Checks if the style of a cell is in the list FFormattingStyles and returns the index
or -1 if it isn't
}
function TsCustomSpreadWriter.FindFormattingInList(AFormat: PCell): Integer;
var
i: Integer;
begin
Result := -1;
for i := 0 to Length(FFormattingStyles) - 1 do
begin
if (FFormattingStyles[i].UsedFormattingFields <> AFormat^.UsedFormattingFields) then Continue;
if uffTextRotation in AFormat^.UsedFormattingFields then
if (FFormattingStyles[i].TextRotation <> AFormat^.TextRotation) then Continue;
if uffBorder in AFormat^.UsedFormattingFields then
if (FFormattingStyles[i].Border <> AFormat^.Border) then Continue;
if uffBackgroundColor in AFormat^.UsedFormattingFields then
if (FFormattingStyles[i].BackgroundColor <> AFormat^.BackgroundColor) then Continue;
// If we arrived here it means that the styles match
Exit(i);
end;
end;
{ Each descendent should define it's own default formats, if any.
Always add the normal, unformatted style first to speed up. }
procedure TsCustomSpreadWriter.AddDefaultFormats();
begin
SetLength(FFormattingStyles, 0);
NextXFIndex := 0;
end;
procedure TsCustomSpreadWriter.ListAllFormattingStylesCallback(ACell: PCell; AStream: TStream);
var
Len: Integer;
begin
if ACell^.UsedFormattingFields = [] then Exit;
if FindFormattingInList(ACell) <> -1 then Exit;
Len := Length(FFormattingStyles);
SetLength(FFormattingStyles, Len+1);
FFormattingStyles[Len] := ACell^;
FFormattingStyles[Len].Row := NextXFIndex;
Inc(NextXFIndex);
end;
procedure TsCustomSpreadWriter.ListAllFormattingStyles(AData: TsWorkbook);
var
i: Integer;
begin
SetLength(FFormattingStyles, 0);
AddDefaultFormats();
for i := 0 to AData.GetWorksheetCount - 1 do
begin
IterateThroughCells(nil, AData.GetWorksheetByIndex(i).Cells, ListAllFormattingStylesCallback);
end;
end;
{@@
Expands a formula, separating it in it's constituent parts,
so that it is already partially parsed and it is easier to

75
components/fpspreadsheet/xlsbiffcommon.pas
View File

@ -46,17 +46,7 @@ type
TsSpreadBIFFWriter = class(TsCustomSpreadWriter)
protected
{
An array with cells which are models for the used styles
In this array the Row property holds the Index to the corresponding XF field
}
FFormattingStyles: array of TCell;
NextXFIndex: Integer; // Indicates which should be the next XF Index when filling the styles list
function FPSColorToEXCELPallete(AColor: TsColor): Word;
function FindFormattingInList(AFormat: PCell): Integer;
procedure AddDefaultFormats(); virtual;
procedure ListAllFormattingStylesCallback(ACell: PCell; AStream: TStream);
procedure ListAllFormattingStyles(AData: TsWorkbook);
end;
implementation
@ -86,70 +76,5 @@ begin
end;
end;
{
Checks if the style of a cell is in the list FFormattingStyles and returns the index
or -1 if it isn't
}
function TsSpreadBIFFWriter.FindFormattingInList(AFormat: PCell): Integer;
var
i: Integer;
begin
Result := -1;
for i := 0 to Length(FFormattingStyles) - 1 do
begin
if (FFormattingStyles[i].UsedFormattingFields <> AFormat^.UsedFormattingFields) then Continue;
if uffTextRotation in AFormat^.UsedFormattingFields then
if (FFormattingStyles[i].TextRotation <> AFormat^.TextRotation) then Continue;
if uffBorder in AFormat^.UsedFormattingFields then
if (FFormattingStyles[i].Border <> AFormat^.Border) then Continue;
if uffBackgroundColor in AFormat^.UsedFormattingFields then
if (FFormattingStyles[i].BackgroundColor <> AFormat^.BackgroundColor) then Continue;
// If we arrived here it means that the styles match
Exit(i);
end;
end;
{ Each descendent should define it's own default formats, if any.
Always add the normal, unformatted style first to speed up. }
procedure TsSpreadBIFFWriter.AddDefaultFormats();
begin
SetLength(FFormattingStyles, 0);
NextXFIndex := 0;
end;
procedure TsSpreadBIFFWriter.ListAllFormattingStylesCallback(ACell: PCell; AStream: TStream);
var
Len: Integer;
begin
if ACell^.UsedFormattingFields = [] then Exit;
if FindFormattingInList(ACell) <> -1 then Exit;
Len := Length(FFormattingStyles);
SetLength(FFormattingStyles, Len+1);
FFormattingStyles[Len] := ACell^;
FFormattingStyles[Len].Row := NextXFIndex;
Inc(NextXFIndex);
end;
procedure TsSpreadBIFFWriter.ListAllFormattingStyles(AData: TsWorkbook);
var
i: Integer;
begin
SetLength(FFormattingStyles, 0);
AddDefaultFormats();
for i := 0 to AData.GetWorksheetCount - 1 do
begin
IterateThroughCells(nil, AData.GetWorksheetByIndex(i).Cells, ListAllFormattingStylesCallback);
end;
end;
end.