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

fpspreadsheet: Adds bold support to ooxml

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@1883 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
sekelsenmat
2011-09-01 07:55:12 +00:00
parent 60540877cb
commit d887861a83
2 changed files with 35 additions and 15 deletions
Download Patch File Download Diff File Expand all files Collapse all files

24
components/fpspreadsheet/examples/ooxmldemo/ooxmlwrite.lpr
View File

@ -18,6 +18,7 @@ var
MyDir: string; MyDir: string;
i: Integer; i: Integer;
a: TStringList; a: TStringList;
MyCell: PCell;
begin begin
// Open the output file // Open the output file
MyDir := ExtractFilePath(ParamStr(0)); MyDir := ExtractFilePath(ParamStr(0));
@ -32,15 +33,24 @@ begin
MyWorksheet.WriteNumber(0, 2, 3.0); MyWorksheet.WriteNumber(0, 2, 3.0);
MyWorksheet.WriteNumber(0, 3, 4.0); MyWorksheet.WriteNumber(0, 3, 4.0);
{ Uncommend this to test large XLS files // Uncommend this to test large XLS files
for i := 2 to 20 do for i := 2 to 2{20} do
begin begin
MyWorksheet.WriteAnsiText(i, 0, ParamStr(0)); MyWorksheet.WriteUTF8Text(i, 0, ParamStr(0));
MyWorksheet.WriteAnsiText(i, 1, ParamStr(0)); MyWorksheet.WriteUTF8Text(i, 1, ParamStr(0));
MyWorksheet.WriteAnsiText(i, 2, ParamStr(0)); MyWorksheet.WriteUTF8Text(i, 2, ParamStr(0));
MyWorksheet.WriteAnsiText(i, 3, ParamStr(0)); MyWorksheet.WriteUTF8Text(i, 3, ParamStr(0));
end; end;
}
// Test for Bold
MyCell := MyWorksheet.GetCell(2, 0);
MyCell^.UsedFormattingFields := [uffBold];
MyCell := MyWorksheet.GetCell(2, 1);
MyCell^.UsedFormattingFields := [uffBold];
MyCell := MyWorksheet.GetCell(2, 2);
MyCell^.UsedFormattingFields := [uffBold];
MyCell := MyWorksheet.GetCell(2, 3);
MyCell^.UsedFormattingFields := [uffBold];
// Creates a new worksheet // Creates a new worksheet
MyWorksheet := MyWorkbook.AddWorksheet('My Worksheet 2'); MyWorksheet := MyWorkbook.AddWorksheet('My Worksheet 2');

26
components/fpspreadsheet/xlsxooxml.pas
View File

@ -57,6 +57,7 @@ type
procedure WriteGlobalFiles(AData: TsWorkbook); procedure WriteGlobalFiles(AData: TsWorkbook);
procedure WriteContent(AData: TsWorkbook); procedure WriteContent(AData: TsWorkbook);
procedure WriteWorksheet(CurSheet: TsWorksheet); procedure WriteWorksheet(CurSheet: TsWorksheet);
function GetStyleIndex(ACell: PCell): Cardinal;
public public
destructor Destroy; override; destructor Destroy; override;
{ General writing methods } { General writing methods }
@ -143,11 +144,9 @@ begin
FStyles := FStyles :=
XML_HEADER + LineEnding + XML_HEADER + LineEnding +
'<styleSheet xmlns="' + SCHEMAS_SPREADML + '">' + LineEnding + '<styleSheet xmlns="' + SCHEMAS_SPREADML + '">' + LineEnding +
' <fonts count="1">' + LineEnding + ' <fonts count="2">' + LineEnding +
' <font>' + LineEnding + ' <font><sz val="10" /><name val="Arial" /></font>' + LineEnding +
' <sz val="10" />' + LineEnding + ' <font><sz val="10" /><name val="Arial" /><b val="true"/></font>' + LineEnding +
' <name val="Arial" />' + LineEnding +
' </font>' + LineEnding +
' </fonts>' + LineEnding + ' </fonts>' + LineEnding +
' <fills count="2">' + LineEnding + ' <fills count="2">' + LineEnding +
' <fill>' + LineEnding + ' <fill>' + LineEnding +
@ -166,11 +165,13 @@ begin
' <diagonal />' + LineEnding + ' <diagonal />' + LineEnding +
' </border>' + LineEnding + ' </border>' + LineEnding +
' </borders>' + LineEnding + ' </borders>' + LineEnding +
' <cellStyleXfs count="1">' + LineEnding + ' <cellStyleXfs count="2">' + LineEnding +
' <xf numFmtId="0" fontId="0" fillId="0" borderId="0" />' + LineEnding + ' <xf numFmtId="0" fontId="0" fillId="0" borderId="0" />' + LineEnding +
' <xf numFmtId="0" fontId="1" fillId="0" borderId="0" />' + LineEnding +
' </cellStyleXfs>' + LineEnding + ' </cellStyleXfs>' + LineEnding +
' <cellXfs count="1">' + LineEnding + ' <cellXfs count="2">' + LineEnding +
' <xf numFmtId="0" fontId="0" fillId="0" borderId="0" xfId="0" />' + LineEnding + ' <xf numFmtId="0" fontId="0" fillId="0" borderId="0" xfId="0" />' + LineEnding +
' <xf numFmtId="0" fontId="1" fillId="0" borderId="0" xfId="0" />' + LineEnding +
' </cellXfs>' + LineEnding + ' </cellXfs>' + LineEnding +
' <cellStyles count="1">' + LineEnding + ' <cellStyles count="1">' + LineEnding +
' <cellStyle name="Normal" xfId="0" builtinId="0" />' + LineEnding + ' <cellStyle name="Normal" xfId="0" builtinId="0" />' + LineEnding +
@ -340,6 +341,13 @@ begin
'</worksheet>'; '</worksheet>';
end; end;
// This is an index to the section cellXfs from the styles.xml file
function TsSpreadOOXMLWriter.GetStyleIndex(ACell: PCell): Cardinal;
begin
if uffBold in ACell^.UsedFormattingFields then Result := 1
else Result := 0;
end;
destructor TsSpreadOOXMLWriter.Destroy; destructor TsSpreadOOXMLWriter.Destroy;
begin begin
SetLength(FSheets, 0); SetLength(FSheets, 0);
@ -439,6 +447,7 @@ procedure TsSpreadOOXMLWriter.WriteLabel(AStream: TStream; const ARow,
ACol: Word; const AValue: string; ACell: PCell); ACol: Word; const AValue: string; ACell: PCell);
var var
CellPosText: string; CellPosText: string;
lStyleIndex: Cardinal;
begin begin
FSharedStrings := FSharedStrings + FSharedStrings := FSharedStrings +
' <si>' + LineEnding + ' <si>' + LineEnding +
@ -446,8 +455,9 @@ begin
' </si>' + LineEnding; ' </si>' + LineEnding;
CellPosText := TsWorksheet.CellPosToText(ARow, ACol); CellPosText := TsWorksheet.CellPosToText(ARow, ACol);
lStyleIndex := GetStyleIndex(ACell);
FSheets[FCurSheetNum] := FSheets[FCurSheetNum] + FSheets[FCurSheetNum] := FSheets[FCurSheetNum] +
Format(' <c r="%s" s="0" t="s"><v>%d</v></c>', [CellPosText, FSharedStringsCount]) + LineEnding; Format(' <c r="%s" s="%d" t="s"><v>%d</v></c>', [CellPosText, lStyleIndex, FSharedStringsCount]) + LineEnding;
Inc(FSharedStringsCount); Inc(FSharedStringsCount);
end; end;