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

fpspreadsheet: Fix font color issues of xlsx reader. No fails in unit test any more.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@3396 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2014-07-29 21:02:14 +00:00
parent 827245c127
commit f989031cf9
4 changed files with 98 additions and 15 deletions
Download Patch File Download Diff File Expand all files Collapse all files

2
components/fpspreadsheet/fpsopendocument.pas
View File

@ -3316,7 +3316,7 @@ begin
exit;
fnt := Workbook.GetFont(AFormat.FontIndex);
defFnt := Workbook.GetFont(0); // Defaultfont
defFnt := Workbook.GetDefaultfont;
if fnt.FontName <> defFnt.FontName then
Result := Result + Format('style:font-name="%s" ', [fnt.FontName]);

25
components/fpspreadsheet/fpsutils.pas
View File

@ -127,7 +127,7 @@ function PtsToPx(AValue: Double; AScreenPixelsPerInch: Integer): Integer;
function HTMLLengthStrToPts(AValue: String): Double;
function HTMLColorStrToColor(AValue: String): TsColorValue;
function ColorToHTMLColorStr(AValue: TsColorValue): String;
function ColorToHTMLColorStr(AValue: TsColorValue; AExcelDialect: Boolean = false): String;
function UTF8TextToXMLText(AText: ansistring): ansistring;
function AnalyzeCompareStr(AString: String; out ACompareOp: TsCompareOperation): String;
@ -1408,7 +1408,7 @@ end;
{@@
Converts a HTML color string to a TsColorValue. Need for the ODS file format.
@param AValue HTML color string, such as '#FF0000'
@param AValue HTML color string, such as '#FF0000'
@return rgb color value in little endian byte-sequence. This value is
compatible with the TColor data type of the graphics unit.
}
@ -1454,18 +1454,23 @@ end;
{@@
Converts an rgb color value to a string as used in HTML code (for ods)
@param AValue RGB color value (compatible with the TColor data type of the
graphics unit)
@return HTML-compatible string, like '#FF0000'
@param AValue RGB color value (compatible with the TColor data type
of the graphics unit)
@param AExcelDialect If TRUE, returned string is in Excels format for xlsx,
i.e. in AARRGGBB notation, like '00FF0000' for "red"
@return HTML-compatible string, like '#FF0000' (AExcelDialect = false)
}
function ColorToHTMLColorStr(AValue: TsColorValue): String;
function ColorToHTMLColorStr(AValue: TsColorValue; AExcelDialect: Boolean = false): String;
type
TRGB = record r,g,b,a: Byte end;
var
rgb: TRGB;
begin
rgb := TRGB(AValue);
Result := Format('#%.2x%.2x%.2x', [rgb.r, rgb.g, rgb.b]);
if AExcelDialect then
Result := Format('00%.2x%.2x%.2x', [rgb.r, rgb.g, rgb.b])
else
Result := Format('#%.2x%.2x%.2x', [rgb.r, rgb.g, rgb.b]);
end;
{@@
@ -1906,8 +1911,8 @@ end;
Is needed for some Excel-strings.
@param AString Input string starting with "<", "<=", ">", ">=", "<>" or "="
If this start is missing a "=" is assumed.
@param ACompareOp Identifier for the comparins operation extracted - see TsCompareOperation
If this start code is missing a "=" is assumed.
@param ACompareOp Identifier for the comparing operation extracted - see TsCompareOperation
@return Input string with the comparing characters stripped.
}
function AnalyzeComparestr(AString: String; out ACompareOp: TsCompareOperation): String;
@ -1931,7 +1936,7 @@ begin
end;
'>' : case AString[2] of
'=' : RemoveChars(2, coGreaterEqual);
else Removechars(1, coGreater);
else RemoveChars(1, coGreater);
end;
'=' : RemoveChars(1, coEqual);
else RemoveChars(0, coEqual);

2
components/fpspreadsheet/xlsbiff8.pas
View File

@ -142,7 +142,7 @@ type
end;
var
// the palette of the default BIFF8 colors as "big-endian color" values
// the palette of the 64 default BIFF8 colors as "big-endian color" values
PALETTE_BIFF8: array[$00..$3F] of TsColorValue = (
$000000, // $00: black // 8 built-in default colors
$FFFFFF, // $01: white

84
components/fpspreadsheet/xlsxooxml.pas
View File

@ -72,6 +72,7 @@ type
procedure ReadFont(ANode: TDOMNode);
procedure ReadFonts(ANode: TDOMNode);
procedure ReadNumFormats(ANode: TDOMNode);
procedure ReadPalette(ANode: TDOMNode);
procedure ReadSharedStrings(ANode: TDOMNode);
procedure ReadSheetList(ANode: TDOMNode; AList: TStrings);
procedure ReadWorksheet(ANode: TDOMNode; AWorksheet: TsWorksheet);
@ -110,6 +111,7 @@ type
procedure WriteFillList(AStream: TStream);
procedure WriteFontList(AStream: TStream);
procedure WriteNumFormatList(AStream: TStream);
procedure WritePalette(AStream: TStream);
procedure WriteStyleList(AStream: TStream; ANodeName: String);
protected
{ Streams with the contents of files }
@ -584,8 +586,19 @@ begin
else
if nodename = 'color' then begin
s := GetAttrValue(node, 'rgb');
if s <> '' then
if s <> '' then begin
fntColor := FWorkbook.AddColorToPalette(HTMLColorStrToColor('#' + s));
node := node.NextSibling;
continue;
end;
s := GetAttrValue(node, 'indexed');
if s <> '' then begin
fntColor := StrToInt(s);
if (fntColor >= FWorkbook.GetPaletteSize) then
fntColor := scBlack;
node := node.NextSibling;
continue;
end;
end;
node := node.NextSibling;
end;
@ -643,6 +656,44 @@ begin
end;
end;
procedure TsSpreadOOXMLReader.ReadPalette(ANode: TDOMNode);
var
node, colornode: TDOMNode;
nodename: String;
rgb: string;
n: Integer;
color: TsColorValue;
pal: array of TsColorValue;
begin
if ANode = nil then
exit;
SetLength(pal, 1000);
n := 0;
node := ANode.FirstChild;
while Assigned(node) do begin
nodename := node.NodeName;
if nodename = 'indexedColors' then begin
colornode := node.FirstChild;
while Assigned(colornode) do begin
nodename := colornode.NodeName;
if nodename = 'rgbColor' then begin
rgb := GetAttrValue(colornode, 'rgb');
if rgb <> '' then begin
color := HTMLColorStrToColor('#' + rgb);
if n = Length(pal) then
SetLength(pal, Length(pal) + 1000);
pal[n] := color;
inc(n);
end;
end;
colornode := colorNode.NextSibling;
end;
end;
node := node.NextSibling;
end;
FWorkbook.UsePalette(@pal[0], n);
end;
procedure TsSpreadOOXMLReader.ReadSharedStrings(ANode: TDOMNode);
var
valuenode: TDOMNode;
@ -748,6 +799,7 @@ begin
if FileExists(FilePath + OOXML_PATH_XL_STYLES) then begin // should always exist, just to make sure...
ReadXMLFile(Doc, FilePath + OOXML_PATH_XL_STYLES);
DeleteFile(FilePath + OOXML_PATH_XL_STYLES);
ReadPalette(Doc.DocumentElement.FindNode('colors'));
ReadFonts(Doc.DocumentElement.FindNode('fonts'));
ReadNumFormats(Doc.DocumentElement.FindNode('numFmts'));
ReadCellXfs(Doc.DocumentElement.FindNode('cellXfs'));
@ -1150,8 +1202,9 @@ begin
if (fssStrikeout in font.Style) then
s := s + '<strike />';
if font.Color <> scBlack then begin
rgb := Workbook.GetPaletteColor(font.Color);
s := s + Format('<color rgb="%s" />', [Copy(ColorToHTMLColorStr(rgb), 2, 255)]);
s := s + Format('<color indexed="%d" />', [font.Color]);
// rgb := Workbook.GetPaletteColor(font.Color);
// s := s + Format('<color rgb="%s" />', [Copy(ColorToHTMLColorStr(rgb), 2, 255)]);
end;
AppendToStream(AStream,
'<font>', s, '</font>');
@ -1192,6 +1245,28 @@ begin
end;
end;
{ Writes the workbook's color palette to the file }
procedure TsSpreadOOXMLWriter.WritePalette(AStream: TStream);
var
c: TsColor;
rgb: TsColorValue;
i: Integer;
begin
AppendToStream(AStream,
'<colors>' +
'<indexedColors>');
for i:=0 to Workbook.GetPaletteSize-1 do begin
rgb := Workbook.GetPaletteColor(i);
AppendToStream(AStream,
'<rgbColor rgb="'+ColorToHTMLColorStr(rgb, true) + '" />');
end;
AppendToStream(AStream,
'</indexedColors>' +
'</colors>');
end;
{ Writes the style list which the writer has collected in FFormattingStyles. }
procedure TsSpreadOOXMLWriter.WriteStyleList(AStream: TStream; ANodeName: String);
var
@ -1364,6 +1439,9 @@ begin
AppendToStream(FSStyles,
'<tableStyles count="0" defaultTableStyle="TableStyleMedium9" defaultPivotStyle="PivotStyleLight16" />');
// Palette
WritePalette(FSStyles);
AppendToStream(FSStyles,
'</styleSheet>');
end;