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

fpspreadsheet: Major reconstructor of color management: no more palettes now, use direct rgb colors instead. May break existing code - sorry! Update all demos and unit tests (passed).

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@4156 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2015-05-28 20:08:24 +00:00
parent 46386a0f37
commit 545bd7ed0f
33 changed files with 1696 additions and 1025 deletions
Download Patch File Download Diff File Expand all files Collapse all files

2
components/fpspreadsheet/examples/other/demo_recursive_calc.pas
View File

@ -49,7 +49,7 @@ begin
writeln('Finished.');
writeln;
writeln('Please open "'+OutputFile+'" in "fpsgrid".');
writeLn('It should show calculation results in cells B1 and B2.');
writeLn('It must show correct calculation results in cells B1 and B2.');
finally
workbook.Free;
end;

15
components/fpspreadsheet/examples/read_write/excel5demo/excel5write.lpr
View File

@ -10,7 +10,7 @@ program excel5write;
{$mode delphi}{$H+}
uses
Classes, SysUtils, fpsTypes, fpspreadsheet, xlsbiff5;
Classes, SysUtils, fpsTypes, fpSpreadsheet, fpsPalette, fpsUtils, xlsbiff5;
const
Str_First = 'First';
@ -28,6 +28,7 @@ var
i, r: Integer;
number: Double;
fmt: string;
palette: TsPalette;
begin
MyDir := ExtractFilePath(ParamStr(0));
@ -359,10 +360,16 @@ begin
// Creates a new worksheet
MyWorksheet := MyWorkbook.AddWorksheet('Colors');
for i:=0 to MyWorkbook.GetPaletteSize-1 do begin
palette := TsPalette.Create;
try
palette.UseColors(PALETTE_BIFF5); // This stores the colors of BIFF5 files in the local palette
for i:=0 to palette.Count-1 do begin
MyWorksheet.WriteBlank(i, 0);
Myworksheet.WriteBackgroundColor(i, 0, TsColor(i));
MyWorksheet.WriteUTF8Text(i, 1, MyWorkbook.GetColorName(i));
Myworksheet.WriteBackgroundColor(i, 0, palette[i]);
MyWorksheet.WriteUTF8Text(i, 1, GetColorName(palette[i]));
end;
finally
palette.Free;
end;
// Save the spreadsheet to a file

1
components/fpspreadsheet/examples/read_write/excel8demo/excel8write.lpr
View File

@ -36,7 +36,6 @@ begin
// Create the spreadsheet
MyWorkbook := TsWorkbook.Create;
MyWorkbook.SetDefaultFont('Calibri', 9);
MyWorkbook.UsePalette(@PALETTE_BIFF8, Length(PALETTE_BIFF8));
MyWorkbook.FormatSettings.CurrencyFormat := 2;
MyWorkbook.FormatSettings.NegCurrFormat := 14;
MyWorkbook.Options := MyWorkbook.Options + [boCalcBeforeSaving];

4
components/fpspreadsheet/examples/read_write/wikitabledemo/wikitablewrite.lpr
View File

@ -135,8 +135,8 @@ begin
MyWorksheet.WriteNumber(row, 0, row);
MyWorksheet.WriteUTF8Text(row, 1, 'RGB background color:');
MyWorksheet.WriteUTF8Text(row, 2, 'color #FF77C3');
MyWorksheet.WriteBackgroundColor(row, 2, MyWorkbook.AddColorToPalette($C377FF));
MyWorksheet.WriteUTF8Text(row, 2, 'color #FF77C3'); // HTML colors are big-endian
MyWorksheet.WriteBackgroundColor(row, 2, $C377FF); // fps colors are little-endian
inc(row);
MyWorksheet.WriteNumber(row, 0, row);

23
components/fpspreadsheet/examples/visual/spready/mainform.lfm
View File

@ -9,6 +9,7 @@ object MainFrm: TMainFrm
Menu = MainMenu
OnActivate = FormActivate
OnCreate = FormCreate
OnDestroy = FormDestroy
ShowHint = True
LCLVersion = '1.5'
object Panel1: TPanel
@ -425,7 +426,7 @@ object MainFrm: TMainFrm
end
end
object InspectorSplitter: TSplitter
Left = 639
Left = 591
Height = 453
Top = 84
Width = 5
@ -433,10 +434,10 @@ object MainFrm: TMainFrm
ResizeAnchor = akRight
end
object InspectorPageControl: TPageControl
Left = 644
Left = 596
Height = 453
Top = 84
Width = 241
Width = 289
ActivePage = PgCellValue
Align = alRight
TabIndex = 0
@ -445,18 +446,20 @@ object MainFrm: TMainFrm
object PgCellValue: TTabSheet
Caption = 'Cell value'
ClientHeight = 425
ClientWidth = 233
ClientWidth = 281
object CellInspector: TValueListEditor
Left = 0
Height = 425
Top = 0
Width = 233
Width = 281
Align = alClient
FixedCols = 0
MouseWheelOption = mwGrid
RowCount = 15
TabOrder = 0
TitleStyle = tsNative
DisplayOptions = [doColumnTitles, doAutoColResize]
DisplayOptions = [doColumnTitles]
Options = [goFixedVertLine, goFixedHorzLine, goVertLine, goHorzLine, goColSizing, goAlwaysShowEditor, goThumbTracking]
Strings.Strings = (
'Row='
'Column='
@ -478,8 +481,8 @@ object MainFrm: TMainFrm
''
)
ColWidths = (
114
115
138
139
)
end
end
@ -494,7 +497,7 @@ object MainFrm: TMainFrm
Left = 0
Height = 453
Top = 84
Width = 639
Width = 591
OnChange = TabControlChange
Align = alClient
TabOrder = 3
@ -502,7 +505,7 @@ object MainFrm: TMainFrm
Left = 2
Height = 448
Top = 3
Width = 635
Width = 587
FrozenCols = 0
FrozenRows = 0
ReadFormulas = False

65
components/fpspreadsheet/examples/visual/spready/mainform.pas
View File

@ -8,7 +8,7 @@ uses
Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs,
StdCtrls, Menus, ExtCtrls, ComCtrls, ActnList, Spin, Grids,
ColorBox, ValEdit,
fpstypes, fpspreadsheetgrid, fpspreadsheet,
fpstypes, fpspalette, fpspreadsheetgrid, fpspreadsheet,
{%H-}fpsallformats;
type
@ -325,6 +325,7 @@ type
procedure FontSizeComboBoxSelect(Sender: TObject);
procedure FormActivate(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure InspectorPageControlChange(Sender: TObject);
procedure MemoFormulaEditingDone(Sender: TObject);
procedure TabControlChange(Sender: TObject);
@ -334,6 +335,7 @@ type
private
FCopiedFormat: TCell;
FPalette: TsPalette;
function EditComment(ACaption: String; var AText: String): Boolean;
procedure LoadFile(const AFileName: String);
@ -928,9 +930,9 @@ begin
if WorksheetGrid.Workbook <> nil then begin
Items.Clear;
Items.AddObject('no fill', TObject(PtrInt(clNone)));
for i:=0 to WorksheetGrid.Workbook.GetPaletteSize-1 do begin
clr := WorksheetGrid.Workbook.GetPaletteColor(i);
clrName := WorksheetGrid.Workbook.GetColorName(i);
for i:=0 to FPalette.Count-1 do begin
clr := FPalette[i];
clrName := GetColorName(clr);
Items.AddObject(Format('%d: %s', [i, clrName]), TObject(PtrInt(clr)));
end;
end;
@ -947,7 +949,7 @@ begin
if CbBackgroundColor.ItemIndex <= 0 then
with WorksheetGrid do BackgroundColors[Selection] := scNotDefined
else
with WorksheetGrid do BackgroundColors[Selection] := CbBackgroundColor.ItemIndex - 1;
with WorksheetGrid do BackgroundColors[Selection] := PtrInt(CbBackgroundColor.Items.Objects[CbBackgroundColor.ItemIndex]);
end;
procedure TMainFrm.CbHeaderStyleChange(Sender: TObject);
@ -1087,12 +1089,20 @@ begin
FontSizeCombobox.DropDownCount := DROPDOWN_COUNT;
CbBackgroundColor.DropDownCount := DROPDOWN_COUNT;
FPalette := TsPalette.Create;
FPalette.AddExcelColors;
// Initialize a new empty workbook
AcNewExecute(nil);
ActiveControl := WorksheetGrid;
end;
procedure TMainFrm.FormDestroy(Sender: TObject);
begin
FPalette.Free;
end;
procedure TMainFrm.InspectorPageControlChange(Sender: TObject);
begin
CellInspector.Parent := InspectorPageControl.ActivePage;
@ -1184,13 +1194,14 @@ end;
procedure TMainFrm.UpdateBackgroundColorIndex;
var
sClr: TsColor;
clr: TsColor;
begin
with WorksheetGrid do sClr := BackgroundColors[Selection];
if sClr = scNotDefined then
with WorksheetGrid do
clr := BackgroundColors[Selection];
if (clr = scNotDefined) or (clr = scTransparent) then
CbBackgroundColor.ItemIndex := 0 // no fill
else
CbBackgroundColor.ItemIndex := sClr + 1;
CbBackgroundColor.ItemIndex := CbBackgroundColor.Items.IndexOfObject(TObject(PtrInt(clr)));
end;
procedure TMainFrm.UpdateHorAlignmentActions;
@ -1214,6 +1225,7 @@ var
cb: TsCellBorder;
r1,r2,c1,c2: Cardinal;
fmt: TsCellFormat;
nfparams: TsNumFormatParams;
begin
with CellInspector do
begin
@ -1223,10 +1235,10 @@ begin
if InspectorPageControl.ActivePage = PgCellValue then
begin
if ACell=nil
then Strings.Add('Row=')
then Strings.Add(Format('Row=%d', [WorksheetGrid.GetWorksheetRow(WorksheetGrid.Row)]))
else Strings.Add(Format('Row=%d', [ACell^.Row]));
if ACell=nil
then Strings.Add('Column=')
then Strings.Add(Format('Column=%d', [WorksheetGrid.GetWorksheetCol(WorksheetGrid.Col)]))
else Strings.Add(Format('Column=%d', [ACell^.Col]));
if ACell=nil
then Strings.Add('ContentType=')
@ -1308,29 +1320,40 @@ begin
else
Strings.Add(Format('BorderStyles[%s]=%s, %s', [
GetEnumName(TypeInfo(TsCellBorder), ord(cb)),
GetEnumName(TypeInfo(TsLineStyle), ord(fmt.BorderStyles[cbEast].LineStyle)),
WorksheetGrid.Workbook.GetColorName(fmt.BorderStyles[cbEast].Color)
GetEnumName(TypeInfo(TsLineStyle), ord(fmt.BorderStyles[cb].LineStyle)),
GetColorName(fmt.BorderStyles[cb].Color)
]));
if (ACell=nil) or not (uffBackground in fmt.UsedformattingFields)
then Strings.Add('BackgroundColor=')
else Strings.Add(Format('BackgroundColor=%d (%s)', [
else Strings.Add(Format('BackgroundColor=$%8x (%s)', [
fmt.Background.BgColor,
WorksheetGrid.Workbook.GetColorName(fmt.Background.BgColor)
GetColorName(fmt.Background.BgColor)
]));
if (ACell=nil) or not (uffNumberFormat in fmt.UsedFormattingFields)
then Strings.Add('NumberFormat=')
else Strings.Add(Format('NumberFormat=%s', [GetEnumName(TypeInfo(TsNumberFormat), ord(fmt.NumberFormat))]));
else begin
nfparams := WorksheetGrid.Workbook.GetNumberFormat(fmt.NumberFormatIndex);
if nfparams = nil then
begin
Strings.Add('NumberFormat=General');
Strings.Add('NumberFormatStr=');
end else
begin
Strings.Add(Format('NumberFormat=%s', [GetEnumName(TypeInfo(TsNumberFormat), ord(nfparams.NumFormat))]));
Strings.Add(Format('NumberFormatStr=%s', [nfparams.NumFormatStr]));
end;
end;
{
if (ACell=nil) or not (uffNumberFormat in fmt.UsedFormattingFields)
then Strings.Add('NumberFormatStr=')
else Strings.Add('NumberFormatStr=' + fmt.NumberFormatStr);
if not WorksheetGrid.Worksheet.IsMerged(ACell) then
Strings.Add('Merged range=')
else
begin
}
if not WorksheetGrid.Worksheet.IsMerged(ACell)
then Strings.Add('Merged range=')
else begin
WorksheetGrid.Worksheet.FindMergedRange(ACell, r1, c1, r2, c2);
Strings.Add('Merged range=' + GetCellRangeString(r1, c1, r2, c2));
end;
end;
end;
end;

2
components/fpspreadsheet/examples/visual/spready/spready.lpi
View File

@ -103,7 +103,6 @@
<ComponentName Value="MainFrm"/>
<HasResources Value="True"/>
<ResourceBaseClass Value="Form"/>
<UnitName Value="mainform"/>
</Unit1>
<Unit2>
<Filename Value="..\shared\scsvparamsform.pas"/>
@ -128,6 +127,7 @@
<Unit5>
<Filename Value="..\shared\sctrls.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="sCtrls"/>
</Unit5>
<Unit6>
<Filename Value="..\shared\scurrencyform.pas"/>

1
components/fpspreadsheet/examples/visual/wikitablemaker/wtmain.lfm
View File

@ -9,6 +9,7 @@ object MainFrm: TMainFrm
Menu = MainMenu
OnActivate = FormActivate
OnCreate = FormCreate
OnDestroy = FormDestroy
ShowHint = True
LCLVersion = '1.5'
object MainToolBar: TToolBar

30
components/fpspreadsheet/examples/visual/wikitablemaker/wtmain.pas
View File

@ -9,7 +9,7 @@ uses
StdCtrls, Menus, ExtCtrls, ComCtrls, ActnList, Grids, ColorBox, SynEdit,
SynEditHighlighter, SynHighlighterHTML, SynHighlighterMulti,
SynHighlighterCss, SynGutterCodeFolding, fpspreadsheetgrid,
fpstypes, fpspreadsheet, fpsallformats;
fpstypes, fpspalette, fpspreadsheet, fpsallformats;
type
@ -187,6 +187,7 @@ type
procedure FontSizeComboBoxSelect(Sender: TObject);
procedure FormActivate(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure PageControlChange(Sender: TObject);
procedure TabControlChange(Sender: TObject);
procedure WorksheetGridSelection(Sender: TObject; aCol, aRow: Integer);
@ -194,6 +195,7 @@ type
WorksheetGrid: TsWorksheetGrid;
FCopiedFormat: TCell;
FHighlighter: TSynCustomHighlighter;
FPalette: TsPalette;
procedure LoadFile(const AFileName: String);
procedure SetupBackgroundColorBox;
procedure UpdateBackgroundColorIndex;
@ -543,20 +545,22 @@ begin
if (WorksheetGrid <> nil) and (WorksheetGrid.Workbook <> nil) then begin
Items.Clear;
Items.AddObject('no fill', TObject(PtrInt(clNone)));
for i:=0 to WorksheetGrid.Workbook.GetPaletteSize-1 do begin
clr := WorksheetGrid.Workbook.GetPaletteColor(i);
clrName := WorksheetGrid.Workbook.GetColorName(i);
for i:=0 to FPalette.Count-1 do begin
clr := FPalette[i];
clrName := GetColorName(clr);
Items.AddObject(Format('%d: %s', [i, clrName]), TObject(PtrInt(clr)));
end;
end;
end;
procedure TMainFrm.CbBackgroundColorSelect(Sender: TObject);
var
clr: TsColor;
begin
if CbBackgroundColor.ItemIndex <= 0 then
with WorksheetGrid do BackgroundColors[Selection] := scNotDefined
else
with WorksheetGrid do BackgroundColors[Selection] := CbBackgroundColor.ItemIndex - 1;
with WorksheetGrid do BackgroundColors[Selection] := PtrInt(CbBackgroundColor.Items.Objects[CbBackgroundColor.ItemIndex]);
end;
procedure TMainFrm.FontComboBoxSelect(Sender: TObject);
@ -637,6 +641,9 @@ begin
CbBackgroundColor.ColorRectWidth := CbBackgroundColor.ItemHeight - 6; // to get a square box...
{$ENDIF}
FPalette := TsPalette.Create;
FPalette.AddExcelColors;
// Initialize a new empty workbook
AcNewExecute(nil);
@ -645,6 +652,11 @@ begin
ActiveControl := WorksheetGrid;
end;
procedure TMainFrm.FormDestroy(Sender: TObject);
begin
FPalette.Free;
end;
procedure TMainFrm.PageControlChange(Sender: TObject);
var
stream: TMemoryStream;
@ -726,13 +738,13 @@ end;
procedure TMainFrm.UpdateBackgroundColorIndex;
var
sClr: TsColor;
clr: TsColor;
begin
with WorksheetGrid do sClr := BackgroundColors[Selection];
if sClr = scNotDefined then
with WorksheetGrid do clr := BackgroundColors[Selection];
if (clr = scNotDefined) or (clr = scTransparent) then
CbBackgroundColor.ItemIndex := 0 // no fill
else
CbBackgroundColor.ItemIndex := sClr + 1;
CbBackgroundColor.ItemIndex := CbBackgroundColor.Items.IndexOfObject(TObject(PtrInt(clr)));
end;
procedure TMainFrm.UpdateHorAlignmentActions;

8
components/fpspreadsheet/fpsactions.pas
View File

@ -1078,14 +1078,14 @@ procedure TsActionBorder.ApplyStyle(AWorkbook: TsWorkbook;
out ABorderStyle: TsCellBorderStyle);
begin
ABorderStyle.LineStyle := FLineStyle;
ABorderStyle.Color := AWorkbook.GetPaletteColor(ABorderStyle.Color);
ABorderStyle.Color := ABorderStyle.Color and $00FFFFFF;
end;
procedure TsActionBorder.ExtractStyle(AWorkbook: TsWorkbook;
ABorderStyle: TsCellBorderStyle);
begin
FLineStyle := ABorderStyle.LineStyle;
Color := AWorkbook.AddColorToPalette(ABorderStyle.Color);
Color := ColorToRGB(ABorderStyle.Color);
end;
constructor TsActionBorders.Create;
@ -1575,14 +1575,14 @@ end;
procedure TsBackgroundColorDialogAction.DoAccept;
begin
FBackgroundColor := Workbook.AddColorToPalette(TsColorValue(Dialog.Color));
FBackgroundColor := ColorToRgb(Dialog.Color);
inherited;
end;
procedure TsBackgroundColorDialogAction.DoBeforeExecute;
begin
inherited;
Dialog.Color := Workbook.GetPaletteColor(FBackgroundColor);
Dialog.Color := FBackgroundColor and $00FFFFFF;
end;
procedure TsBackgroundColorDialogAction.ExtractFromCell(ACell: PCell);

6
components/fpspreadsheet/fpsheaderfooterparser.pas
View File

@ -20,11 +20,11 @@ type
FontName: String;
Size: Double;
Style: TsHeaderFooterFontStyles;
Color: TsColorValue;
Color: TsColor;
constructor Create; overload;
constructor Create(AFont: TsFont); overload;
constructor Create(AFontName: String; ASize: Double;
AStyle: TsHeaderFooterFontStyles; AColor: TsColorValue); overload;
AStyle: TsHeaderFooterFontStyles; AColor: TsColor); overload;
procedure Assign(AFont: TObject);
end;
@ -99,7 +99,7 @@ begin
end;
constructor TsHeaderFooterFont.Create(AFontName: String; ASize: Double;
AStyle: TsHeaderFooterFontStyles; AColor: TsColorValue);
AStyle: TsHeaderFooterFontStyles; AColor: TsColor);
begin
FontName := AFontName;
Size := ASize;

96
components/fpspreadsheet/fpsopendocument.pas
View File

@ -108,7 +108,7 @@ type
function ReadFont(ANode: TDOMnode; APreferredIndex: Integer = -1): Integer;
procedure ReadHeaderFooterFont(ANode: TDOMNode; var AFontName: String;
var AFontSize: Double; var AFontStyle: TsHeaderFooterFontStyles;
var AFontColor: TsColorValue);
var AFontColor: TsColor);
function ReadHeaderFooterText(ANode: TDOMNode): String;
procedure ReadRowsAndCells(ATableNode: TDOMNode);
procedure ReadRowStyle(AStyleNode: TDOMNode);
@ -561,7 +561,7 @@ var
n: Integer;
el, nEl: Integer;
ns: Integer;
clr: TsColorvalue;
clr: TsColor;
mask: String;
timeIntervalStr: String;
styleMapStr: String;
@ -607,7 +607,7 @@ begin
case Elements[el].Token of
nftColor:
begin
clr := FWorkbook.GetPaletteColor(Elements[el].IntValue);
clr := TsColor(Elements[el].IntValue);
Result := Result + '<style:text-properties fo:color="' + ColorToHTMLColorStr(clr) + '" />';
end;
@ -679,7 +679,9 @@ begin
// Mixed fraction
if nfkFraction in Kind then
begin
int := Elements[el].IntValue;
if Elements[el].Token = nftIntOptDigit
then int := 0
else int := Elements[el].IntValue;
inc(el);
while (el < nel) and not
(Elements[el].Token in [nftFracNumZeroDigit, nftFracNumOptDigit, nftFracNumSpaceDigit])
@ -874,8 +876,6 @@ begin
FMasterPageList := TFPList.Create;
FHeaderFooterFontList := TObjectList.Create; // frees objects
// Set up the default palette in order to have the default color names correct.
Workbook.UseDefaultPalette;
// Initial base date in case it won't be read from file
FDateMode := dm1899;
end;
@ -1129,7 +1129,7 @@ var
fntName: String;
fntSize: Double;
fntStyle: TsHeaderFooterFontStyles;
fntColor: TsColorValue;
fntColor: TsColor;
begin
if not Assigned(AStylesNode) then
exit;
@ -1683,7 +1683,7 @@ begin
s := GetAttrValue(ANode, 'fo:color');
if s <> '' then
fntColor := FWorkbook.AddColorToPalette(HTMLColorStrToColor(s))
fntColor := HTMLColorStrToColor(s)
else
fntColor := FWorkbook.GetDefaultFont.Color;
@ -1694,10 +1694,6 @@ begin
end else
if (APreferredIndex > -1) then
begin
{ --- wp: No more missing font #4 now !!!
if (APreferredIndex = 4) then
raise Exception.Create('Cannot replace font #4');
}
FWorkbook.ReplaceFont(APreferredIndex, fntName, fntSize, fntStyles, fntColor);
Result := APreferredIndex;
end else
@ -1938,7 +1934,7 @@ end;
procedure TsSpreadOpenDocReader.ReadHeaderFooterFont(ANode: TDOMNode;
var AFontName: String; var AFontSize: Double;
var AFontStyle: TsHeaderFooterFontStyles; var AFontColor: TsColorValue);
var AFontStyle: TsHeaderFooterFontStyles; var AFontColor: TsColor);
var
s: String;
begin
@ -2241,7 +2237,7 @@ procedure TsSpreadOpenDocReader.ReadNumFormats(AStylesNode: TDOMNode);
grouping: Boolean;
nex: Integer;
cs: String;
color: TsColorValue;
color: TsColor;
hasColor: Boolean;
idx: Integer;
begin
@ -2280,14 +2276,14 @@ procedure TsSpreadOpenDocReader.ReadNumFormats(AStylesNode: TDOMNode);
begin
nf := nfFraction;
s := GetAttrValue(node, 'number:min-integer-digits');
if s <> '' then fracInt := StrToInt(s) else fracInt := 0;
if s <> '' then fracInt := StrToInt(s) else fracInt := -1;
s := GetAttrValue(node, 'number:min-numerator-digits');
if s <> '' then fracNum := StrToInt(s) else fracNum := 0;
s := GetAttrValue(node, 'number:min-denominator-digits');
if s <> '' then fracDenom := StrToInt(s) else fracDenom := 0;
s := GetAttrValue(node, 'number:denominator-value');
if s <> '' then fracDenom := -StrToInt(s);
nfs := nfs + BuildFractionFormatString(fracInt > 0, fracNum, fracDenom);
nfs := nfs + BuildFractionFormatString(fracInt > -1, fracNum, fracDenom);
end else
if nodeName = 'number:scientific-number' then
begin
@ -2324,14 +2320,12 @@ procedure TsSpreadOpenDocReader.ReadNumFormats(AStylesNode: TDOMNode);
if s <> '' then
begin
hasColor := true;
// { // currently not needed
color := HTMLColorStrToColor(s);
idx := FWorkbook.AddColorToPalette(color);
if idx < 8 then
nfs := Format('[%s]%s', [FWorkbook.GetColorName(idx), nfs])
else
nfs := Format('[Color%d]%s', [idx, nfs]);
// }
case color of
scBlack, scWhite, scRed, scGreen,
scBlue, scYellow, scMagenta, scCyan:
nfs := Format('[%s]%s', [GetColorName(color), nfs]);
end;
end;
end;
node := node.NextSibling;
@ -2913,7 +2907,7 @@ var
numFmtStr: String;
numFmtIndex: Integer;
numFmtParams: TsNumFormatParams;
clr: TsColorValue;
clr: TsColor;
s: String;
procedure SetBorderStyle(ABorder: TsCellBorder; AStyleValue: String);
@ -2925,7 +2919,7 @@ var
s: String;
wid: Double;
linestyle: String;
rgb: TsColorValue;
rgb: TsColor;
p: Integer;
begin
L := TStringList.Create;
@ -2934,7 +2928,7 @@ var
L.StrictDelimiter := true;
L.DelimitedText := AStyleValue;
wid := 0;
rgb := TsColorValue(-1);
rgb := scNotDefined;
linestyle := '';
for i:=0 to L.Count-1 do
begin
@ -2981,8 +2975,7 @@ var
else
if (linestyle = 'double') then
fmt.BorderStyles[ABorder].LineStyle := lsDouble;
fmt.BorderStyles[ABorder].Color := IfThen(rgb = TsColorValue(-1),
scBlack, Workbook.AddColorToPalette(rgb));
fmt.BorderStyles[ABorder].Color := IfThen(rgb = scNotDefined, scBlack, rgb);
finally
L.Free;
end;
@ -3048,10 +3041,6 @@ begin
fmt.FontIndex := ReadFont(styleChildNode, HYPERLINK_FONTINDEX)
else
fmt.FontIndex := ReadFont(styleChildNode);
{
if fmt.FontIndex = BOLD_FONTINDEX then
Include(fmt.UsedFormattingFields, uffBold)
else }
if fmt.FontIndex > 0 then
Include(fmt.UsedFormattingFields, uffFont);
end else
@ -3062,8 +3051,7 @@ begin
if (s <> '') and (s <> 'transparent') then begin
clr := HTMLColorStrToColor(s);
// ODS does not support background fill patterns!
fmt.Background.FgColor := IfThen(clr = TsColorValue(-1),
scTransparent, Workbook.AddColorToPalette(clr));
fmt.Background.FgColor := IfThen(clr = scNotDefined, scTransparent, clr);
fmt.Background.BgColor := fmt.Background.FgColor;
if (fmt.Background.BgColor <> scTransparent) then
begin
@ -4444,8 +4432,6 @@ end;
-------------------------------------------------------------------------------}
function TsSpreadOpenDocWriter.WriteBackgroundColorStyleXMLAsString(
const AFormat: TsCellFormat): String;
type
TRgb = record r,g,b,a: byte; end;
const // fraction of pattern color in fill pattern
FRACTION: array[TsFillStyle] of Double = (
0.0, 1.0, 0.75, 0.50, 0.25, 0.125, 0.0625, // fsNoFill..fsGray6
@ -4453,8 +4439,8 @@ const // fraction of pattern color in fill pattern
0.25, 0.25, 0.25, 0.25, // fsThinStripeHor..fsThinStripeDiagDown
0.5, 6.0/16, 0.75, 7.0/16); // fsHatchDiag..fsThinHatchHor
var
fc,bc: TsColorValue;
mix: TRgb;
fc,bc: TsColor;
mix: TRgba;
fraction_fc, fraction_bc: Double;
begin
Result := '';
@ -4463,22 +4449,22 @@ begin
exit;
// Foreground and background colors
fc := Workbook.GetPaletteColor(AFormat.Background.FgColor);
fc := AFormat.Background.FgColor;
if Aformat.Background.BgColor = scTransparent then
bc := Workbook.GetPaletteColor(scWhite)
bc := scWhite
else
bc := Workbook.GetPaletteColor(AFormat.Background.BgColor);
bc := AFormat.Background.BgColor;
// Mixing fraction
fraction_fc := FRACTION[AFormat.Background.Style];
fraction_bc := 1.0 - fraction_fc;
// Mixed color
mix.r := Min(round(fraction_fc*TRgb(fc).r + fraction_bc*TRgb(bc).r), 255);
mix.g := Min(round(fraction_fc*TRgb(fc).g + fraction_bc*TRgb(bc).g), 255);
mix.b := Min(round(fraction_fc*TRgb(fc).b + fraction_bc*TRgb(bc).b), 255);
Result := Format('fo:background-color="%s" ', [
ColorToHTMLColorStr(TsColorValue(mix))
]);
// Mixed color
mix.r := Min(round(fraction_fc*TRgba(fc).r + fraction_bc*TRgba(bc).r), 255);
mix.g := Min(round(fraction_fc*TRgba(fc).g + fraction_bc*TRgba(bc).g), 255);
mix.b := Min(round(fraction_fc*TRgba(fc).b + fraction_bc*TRgba(bc).b), 255);
Result := Format('fo:background-color="%s" ', [ColorToHTMLColorStr(TsColor(mix))]);
end;
{@@ ----------------------------------------------------------------------------
@ -4499,7 +4485,7 @@ begin
Result := Result + Format('fo:border-bottom="%s %s %s" ', [
BORDER_LINEWIDTHS[AFormat.BorderStyles[cbSouth].LineStyle],
BORDER_LINESTYLES[AFormat.BorderStyles[cbSouth].LineStyle],
Workbook.GetPaletteColorAsHTMLStr(AFormat.BorderStyles[cbSouth].Color)
ColorToHTMLColorStr(AFormat.BorderStyles[cbSouth].Color)
]);
if AFormat.BorderStyles[cbSouth].LineStyle = lsDouble then
Result := Result + 'style:border-linewidth-bottom="0.002cm 0.035cm 0.002cm" ';
@ -4512,7 +4498,7 @@ begin
Result := Result + Format('fo:border-left="%s %s %s" ', [
BORDER_LINEWIDTHS[AFormat.BorderStyles[cbWest].LineStyle],
BORDER_LINESTYLES[AFormat.BorderStyles[cbWest].LineStyle],
Workbook.GetPaletteColorAsHTMLStr(AFormat.BorderStyles[cbWest].Color)
ColorToHTMLColorStr(AFormat.BorderStyles[cbWest].Color)
]);
if AFormat.BorderStyles[cbWest].LineStyle = lsDouble then
Result := Result + 'style:border-linewidth-left="0.002cm 0.035cm 0.002cm" ';
@ -4525,7 +4511,7 @@ begin
Result := Result + Format('fo:border-right="%s %s %s" ', [
BORDER_LINEWIDTHS[AFormat.BorderStyles[cbEast].LineStyle],
BORDER_LINESTYLES[AFormat.BorderStyles[cbEast].LineStyle],
Workbook.GetPaletteColorAsHTMLStr(AFormat.BorderStyles[cbEast].Color)
ColorToHTMLColorStr(AFormat.BorderStyles[cbEast].Color)
]);
if AFormat.BorderStyles[cbSouth].LineStyle = lsDouble then
Result := Result + 'style:border-linewidth-right="0.002cm 0.035cm 0.002cm" ';
@ -4538,7 +4524,7 @@ begin
Result := Result + Format('fo:border-top="%s %s %s" ', [
BORDER_LINEWIDTHS[AFormat.BorderStyles[cbNorth].LineStyle],
BORDER_LINESTYLES[AFormat.BorderStyles[cbNorth].LineStyle],
Workbook.GetPaletteColorAsHTMLStr(AFormat.BorderStyles[cbNorth].Color)
ColorToHTMLColorStr(AFormat.BorderStyles[cbNorth].Color)
]);
if AFormat.BorderStyles[cbSouth].LineStyle = lsDouble then
Result := Result + 'style:border-linewidth-top="0.002cm 0.035cm 0.002cm" ';
@ -4550,7 +4536,7 @@ begin
Result := Result + Format('style:diagonal-bl-tr="%s %s %s" ', [
BORDER_LINEWIDTHS[AFormat.BorderStyles[cbDiagUp].LineStyle],
BORDER_LINESTYLES[AFormat.BorderStyles[cbDiagUp].LineStyle],
Workbook.GetPaletteColorAsHTMLStr(AFormat.BorderStyles[cbDiagUp].Color)
ColorToHTMLColorStr(AFormat.BorderStyles[cbDiagUp].Color)
]);
end;
@ -4559,7 +4545,7 @@ begin
Result := Result + Format('style:diagonal-tl-br="%s %s %s" ', [
BORDER_LINEWIDTHS[AFormat.BorderStyles[cbDiagDown].LineStyle],
BORDER_LINESTYLES[AFormat.BorderStyles[cbDiagDown].LineStyle],
Workbook.GetPaletteColorAsHTMLStr(AFormat.BorderStyles[cbDiagDown].Color)
ColorToHTMLColorStr(AFormat.BorderStyles[cbDiagDown].Color)
]);
end;
end;
@ -4613,7 +4599,7 @@ begin
Result := Result + 'style:text-line-through-style="solid" ';
if AFont.Color <> defFnt.Color then
Result := Result + Format('fo:color="%s" ', [Workbook.GetPaletteColorAsHTMLStr(AFont.Color)]);
Result := Result + Format('fo:color="%s" ', [ColorToHTMLColorStr(AFont.Color)]);
end;
function TsSpreadOpenDocWriter.WriteFontStyleXMLAsString(

414
components/fpspreadsheet/fpspalette.pas Normal file
View File

@ -0,0 +1,414 @@
{ fpsPalette }
{@@ ----------------------------------------------------------------------------
Palette support for fpspreadsheet file formats
AUTHORS: Werner Pamler, Felipe Monteiro de Carvalho, Reinier Olislagers
LICENSE: See the file COPYING.modifiedLGPL.txt, included in the Lazarus
distribution, for details about the license.
-------------------------------------------------------------------------------}
unit fpsPalette;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, fpstypes, fpspreadsheet;
type
{ TsPalette }
TsPalette = class
private
FColors: array of TsColor;
function GetColor(AIndex: Integer): TsColor;
procedure SetColor(AIndex: Integer; AColor: TsColor);
public
constructor Create;
procedure AddBuiltinColors; virtual;
function AddColor(AColor: TsColor; ABigEndian: Boolean = false): Integer;
procedure AddExcelColors;
function AddUniqueColor(AColor: TsColor; ABigEndian: Boolean = false): Integer;
procedure Clear;
procedure CollectFromWorkbook(AWorkbook: TsWorkbook);
function ColorUsedInWorkbook(APaletteIndex: Integer; AWorkbook: TsWorkbook): Boolean;
function FindClosestColorIndex(AColor: TsColor; AMaxPaletteCount: Integer = -1): Integer;
function FindColor(AColor: TsColor; AMaxPaletteCount: Integer = -1): Integer;
function Count: Integer;
procedure Trim(AMaxSize: Integer);
procedure UseColors(const AColors: array of TsColor; ABigEndian: Boolean = false);
property Colors[AIndex: Integer]: TsColor read GetColor write SetColor; default;
end;
procedure MakeLEPalette(var AColors: array of TsColor);
implementation
uses
fpsutils;
{@@ ----------------------------------------------------------------------------
If a palette is coded as big-endian (e.g. by copying the rgb values from
the OpenOffice documentation) the palette values can be converted by means
of this procedure to little-endian which is required by fpspreadsheet.
@param AColors Color array to be converted.
After conversion, its color values are replaced.
-------------------------------------------------------------------------------}
procedure MakeLEPalette(var AColors: array of TsColor);
var
i: Integer;
begin
for i := 0 to High(AColors) do
AColors[i] := LongRGBToExcelPhysical(AColors[i])
end;
{@@ ----------------------------------------------------------------------------
Constructor of the palette: initializes the color array
-------------------------------------------------------------------------------}
constructor TsPalette.Create;
begin
inherited;
SetLength(FColors, 0);
end;
{@@ ----------------------------------------------------------------------------
Adds an rgb color value to the palette and returns the palette index
of the new color.
Existing colors are not checked.
If ABigEndian is TRUE then the rgb values are assumed to be in big endian
order (r = high byte).
By default, rgb is in little-endian order (r = low byte)
-------------------------------------------------------------------------------}
function TsPalette.AddColor(AColor: TsColor; ABigEndian: Boolean = false): Integer;
begin
if ABigEndian then
AColor := LongRGBToExcelPhysical(AColor);
SetLength(FColors, Length(FColors) + 1);
FColors[High(FColors)] := AColor;
end;
{@@ ----------------------------------------------------------------------------
Adds the built-in colors
-------------------------------------------------------------------------------}
procedure TsPalette.AddBuiltinColors;
begin
AddColor(scBlack); // 0
AddColor(scWhite); // 1
AddColor(scRed); // 2
AddColor(scGreen); // 3
AddColor(scBlue); // 4
AddColor(scYellow); // 5
AddColor(scMagenta); // 6
AddColor(scCyan); // 7
end;
{@@ ----------------------------------------------------------------------------
Adds the standard palette of Excel 8
NOTE: To get the full Excel8 palette call this after AddBuiltinColors
-------------------------------------------------------------------------------}
procedure TsPalette.AddExcelColors;
begin
AddColor($000000, true); // $08: EGA black
AddColor($FFFFFF, true); // $09: EGA white
AddColor($FF0000, true); // $0A: EGA red
AddColor($00FF00, true); // $0B: EGA green
AddColor($0000FF, true); // $0C: EGA blue
AddColor($FFFF00, true); // $0D: EGA yellow
AddColor($FF00FF, true); // $0E: EGA magenta
AddColor($00FFFF, true); // $0F: EGA cyan
AddColor($800000, true); // $10: EGA dark red
AddColor($008000, true); // $11: EGA dark green
AddColor($000080, true); // $12: EGA dark blue
AddColor($808000, true); // $13: EGA olive
AddColor($800080, true); // $14: EGA purple
AddColor($008080, true); // $15: EGA teal
AddColor($C0C0C0, true); // $16: EGA silver
AddColor($808080, true); // $17: EGA gray
AddColor($9999FF, true); // $18:
AddColor($993366, true); // $19:
AddColor($FFFFCC, true); // $1A:
AddColor($CCFFFF, true); // $1B:
AddColor($660066, true); // $1C:
AddColor($FF8080, true); // $1D:
AddColor($0066CC, true); // $1E:
AddColor($CCCCFF, true); // $1F:
AddColor($000080, true); // $20:
AddColor($FF00FF, true); // $21:
AddColor($FFFF00, true); // $22:
AddColor($00FFFF, true); // $23:
AddColor($800080, true); // $24:
AddColor($800000, true); // $25:
AddColor($008080, true); // $26:
AddColor($0000FF, true); // $27:
AddColor($00CCFF, true); // $28:
AddColor($CCFFFF, true); // $29:
AddColor($CCFFCC, true); // $2A:
AddColor($FFFF99, true); // $2B:
AddColor($99CCFF, true); // $2C:
AddColor($FF99CC, true); // $2D:
AddColor($CC99FF, true); // $2E:
AddColor($FFCC99, true); // $2F:
AddColor($3366FF, true); // $30:
AddColor($33CCCC, true); // $31:
AddColor($99CC00, true); // $32:
AddColor($FFCC00, true); // $33:
AddColor($FF9900, true); // $34:
AddColor($FF6600, true); // $35:
AddColor($666699, true); // $36:
AddColor($969696, true); // $37:
AddColor($003366, true); // $38:
AddColor($339966, true); // $39:
AddColor($003300, true); // $3A:
AddColor($333300, true); // $3B:
AddColor($993300, true); // $3C:
AddColor($993366, true); // $3D:
AddColor($333399, true); // $3E:
AddColor($333333, true); // $3F:
end;
{@@ ----------------------------------------------------------------------------
Adds the specified color to the palette if it does not yet exist.
Returns the palette index of the new or existing color
-------------------------------------------------------------------------------}
function TsPalette.AddUniqueColor(AColor: TsColor;
ABigEndian: Boolean = false): Integer;
begin
if ABigEndian then
AColor := LongRGBToExcelPhysical(AColor);
Result := FindColor(AColor);
if Result = -1 then result := AddColor(AColor);
end;
{@@ ----------------------------------------------------------------------------
Clears the palette
-------------------------------------------------------------------------------}
procedure TsPalette.Clear;
begin
SetLength(FColors, 0);
end;
{@@ ----------------------------------------------------------------------------
Collects the colors used in the specified workbook
-------------------------------------------------------------------------------}
procedure TsPalette.CollectFromWorkbook(AWorkbook: TsWorkbook);
var
i: Integer;
sheet: TsWorksheet;
cell: PCell;
fmt: TsCellFormat;
fnt: TsFont;
cb: TsCellBorder;
begin
for i:=0 to AWorkbook.GetWorksheetCount-1 do
begin
sheet := AWorkbook.GetWorksheetByIndex(i);
for cell in sheet.Cells do begin
fmt := sheet.ReadCellFormat(cell);
if (uffBackground in fmt.UsedFormattingFields) then
begin
AddUniqueColor(fmt.Background.BgColor);
AddUniqueColor(fmt.Background.FgColor);
end;
if (uffFont in fmt.UsedFormattingFields) then
begin
fnt := AWorkbook.GetFont(fmt.FontIndex);
AddUniqueColor(fnt.Color);
end;
if (uffBorder in fmt.UsedFormattingFields) then
begin
for cb in TsCellBorder do
if (cb in fmt.Border) then
AddUniqueColor(fmt.BorderStyles[cb].Color);
end;
end;
end;
end;
{@@ ----------------------------------------------------------------------------
Checks whether a given color is used somewhere within the entire workbook
@param APaletteIndex Palette index of the color
@result True if the color is used by at least one cell, false if not.
-------------------------------------------------------------------------------}
function TsPalette.ColorUsedInWorkbook(APaletteIndex: Integer;
AWorkbook: TsWorkbook): Boolean;
var
sheet: TsWorksheet;
cell: PCell;
i: Integer;
fnt: TsFont;
b: TsCellBorder;
fmt: PsCellFormat;
color: TsColor;
begin
color := GetColor(APaletteIndex);
if (color = scNotDefined) or (AWorkbook = nil) then
exit(false);
Result := true;
for i:=0 to AWorkbook.GetWorksheetCount-1 do
begin
sheet := AWorkbook.GetWorksheetByIndex(i);
for cell in sheet.Cells do
begin
fmt := AWorkbook.GetPointerToCellFormat(cell^.FormatIndex);
if (uffBackground in fmt^.UsedFormattingFields) then
begin
if fmt^.Background.BgColor = color then exit;
if fmt^.Background.FgColor = color then exit;
end;
if (uffBorder in fmt^.UsedFormattingFields) then
for b in TsCellBorders do
if (b in fmt^.Border) and (fmt^.BorderStyles[b].Color = color) then
exit;
if (uffFont in fmt^.UsedFormattingFields) then
begin
fnt := AWorkbook.GetFont(fmt^.FontIndex);
if fnt.Color = color then
exit;
end;
end;
end;
Result := false;
end;
{@@ ----------------------------------------------------------------------------
Finds the palette color index which points to a color that is "closest" to a
given color. "Close" means here smallest length of the rgb-difference vector.
@param AColor Rgb color value to be considered
@param AMaxPaletteCount Number of palette entries considered. Example:
BIFF5/BIFF8 can write only 64 colors, i.e
AMaxPaletteCount = 64
@return Palette index of the color closest to AColor
-------------------------------------------------------------------------------}
function TsPalette.FindClosestColorIndex(AColor: TsColor;
AMaxPaletteCount: Integer = -1): Integer;
type
TRGBA = record r,g,b,a: Byte end;
var
rgb: TRGBA;
rgb0: TRGBA absolute AColor;
dist: Double;
minDist: Double;
i: Integer;
n: Integer;
begin
Result := -1;
minDist := 1E108;
n := Length(FColors);
if AMaxPaletteCount > n then n := AMaxPaletteCount;
for i := 0 to n - 1 do
begin
rgb := TRGBA(GetColor(i));
dist := sqr(rgb.r - rgb0.r) + sqr(rgb.g - rgb0.g) + sqr(rgb.b - rgb0.b);
if dist < minDist then
begin
Result := i;
minDist := dist;
end;
end;
end;
{@@ ----------------------------------------------------------------------------
Finds the palette color index which belongs to the specified color.
Returns -1 if the color is not contained in the palette.
@param AColor Rgb color value to be considered
@param AMaxPaletteCount Number of palette entries considered. Example:
BIFF5/BIFF8 can write only 64 colors, i.e
AMaxPaletteCount = 64
@return Palette index of AColor
-------------------------------------------------------------------------------}
function TsPalette.FindColor(AColor: TsColor;
AMaxPaletteCount: Integer = -1): Integer;
var
n: Integer;
begin
n := Length(FColors);
if AMaxPaletteCount > n then n := AMaxPaletteCount;
for Result := 0 to n - 1 do
if GetColor(Result) = AColor then
exit;
Result := -1;
end;
{@@ ----------------------------------------------------------------------------
Reads the rgb color for the given index from the palette.
Can be type-cast to TColor for usage in GUI applications.
@param AIndex Index of the color considered
@return A number containing the rgb components in little-endian notation.
-------------------------------------------------------------------------------}
function TsPalette.GetColor(AIndex: Integer): TsColor;
begin
if (AIndex >= 0) and (AIndex < Length(FColors)) then
Result := FColors[AIndex]
else
Result := scNotDefined;
end;
{@@ ----------------------------------------------------------------------------
Returns the number of palette colors
-------------------------------------------------------------------------------}
function TsPalette.Count: Integer;
begin
Result := Length(FColors);
end;
{@@ ----------------------------------------------------------------------------
Replaces a color value of the palette by a new value.
The color must be given in little-endian notation (ABGR, with A=0).
@param AIndex Palette index of the color to be replaced
@param AColor Number containing the rgb components of the new color
-------------------------------------------------------------------------------}
procedure TsPalette.SetColor(AIndex: Integer; AColor: TsColor);
begin
if (AIndex >= 0) and (AIndex < Length(FColors)) then
FColors[AIndex] := AColor;
end;
{@@ ----------------------------------------------------------------------------
Trims the size of the palette
-------------------------------------------------------------------------------}
procedure TsPalette.Trim(AMaxSize: Integer);
begin
if Length(FColors) > AMaxSize then
SetLength(FColors, AMaxSize);
end;
{@@ ----------------------------------------------------------------------------
Uses the color array to with "APalette" points in the palette.
If ABigEndian is true it is assumed that the input colors are specified in
big-endian notation, i.e. "blue" in the low-value byte.
-------------------------------------------------------------------------------}
procedure TsPalette.UseColors(const AColors: array of TsColor; ABigEndian: Boolean = false);
var
i: Integer;
begin
SetLength(FColors, High(AColors)+1);
if ABigEndian then
for i:=0 to High(AColors) do FColors[i] := LongRGBToExcelPhysical(AColors[i])
else
for i:=0 to High(AColors) do FColors[i] := AColors[i];
end;
end.

209
components/fpspreadsheet/fpspreadsheet.pas
View File

@ -549,7 +549,7 @@ type
FWorksheets: TFPList;
FFormat: TsSpreadsheetFormat;
FBuiltinFontCount: Integer;
FPalette: array of TsColorValue;
//FPalette: array of TsColorValue;
FVirtualColCount: Cardinal;
FVirtualRowCount: Cardinal;
FReadWriteFlag: TsReadWriteFlag;
@ -565,7 +565,7 @@ type
FOnRemoveWorksheet: TsRemoveWorksheetEvent;
FOnRemovingWorksheet: TsWorksheetEvent;
FOnSelectWorksheet: TsWorksheetEvent;
FOnChangePalette: TNotifyEvent;
// FOnChangePalette: TNotifyEvent;
FFileName: String;
FLockCount: Integer;
FLog: TStringList;
@ -668,11 +668,8 @@ type
function AddNumberFormat(AFormatStr: String): Integer;
function GetNumberFormat(AIndex: Integer): TsNumFormatParams;
function GetNumberFormatCount: Integer;
(*
{ Color handling }
function AddColorToPalette(AColorValue: TsColorValue): TsColor;
function FindClosestColor(AColorValue: TsColorValue;
AMaxPaletteCount: Integer = -1): TsColor;
function FPSColorToHexString(AColor: TsColor; ARGBColor: TFPColor): String;
function GetColorName(AColorIndex: TsColor): string; overload;
procedure GetColorName(AColorValue: TsColorValue; out AName: String); overload;
@ -684,6 +681,7 @@ type
procedure UsePalette(APalette: PsPalette; APaletteCount: Word;
ABigEndian: Boolean = false);
function UsesColor(AColorIndex: TsColor): Boolean;
*)
{ Utilities }
procedure UpdateCaches;
@ -708,7 +706,7 @@ type
{@@ This event fires whenever a new worksheet is added }
property OnAddWorksheet: TsWorksheetEvent read FOnAddWorksheet write FOnAddWorksheet;
{@@ This event fires whenever the workbook palette changes. }
property OnChangePalette: TNotifyEvent read FOnChangePalette write FOnChangePalette;
// property OnChangePalette: TNotifyEvent read FOnChangePalette write FOnChangePalette;
{@@ This event fires whenever a worksheet is changed }
property OnChangeWorksheet: TsWorksheetEvent read FOnChangeWorksheet write FOnChangeWorksheet;
{@@ This event fires whenever a workbook is loaded }
@ -778,7 +776,6 @@ type
procedure CopyCellFormat(AFromCell, AToCell: PCell);
procedure CopyCellValue(AFromCell, AToCell: PCell);
procedure MakeLEPalette(APalette: PsPalette; APaletteSize: Integer);
//function SameCellBorders(ACell1, ACell2: PCell): Boolean; overload;
function SameCellBorders(AFormat1, AFormat2: PsCellFormat): Boolean; //overload;
@ -826,7 +823,7 @@ const
DEF_CHART_NEUTRAL_COLORVALUE = $FFFFFF;
DEF_TOOLTIP_TEXT_COLORVALUE = $000000;
DEF_FONT_AUTOMATIC_COLORVALUE = $000000;
(*
var
{@@ RGB colors RGB in "big-endian" notation (red at left). The values are inverted
at initialization to be little-endian at run-time!
@ -883,26 +880,7 @@ var
'beige', // $15
'wheat' // $16
);
{@@ ----------------------------------------------------------------------------
If a palette is coded as big-endian (e.g. by copying the rgb values from
the OpenOffice documentation) the palette values can be converted by means
of this procedure to little-endian which is required internally by TsWorkbook.
@param APalette Pointer to the palette to be converted. After conversion,
its color values are replaced.
@param APaletteSize Number of colors contained in the palette
-------------------------------------------------------------------------------}
procedure MakeLEPalette(APalette: PsPalette; APaletteSize: Integer);
var
i: Integer;
begin
{$PUSH}{$R-}
for i := 0 to APaletteSize-1 do
APalette^[i] := LongRGBToExcelPhysical(APalette^[i])
{$POP}
end;
*)
{@@ ----------------------------------------------------------------------------
Copies the format of a cell to another one.
@ -916,7 +894,6 @@ var
numFmtParams: TsNumFormatParams;
nfs: String;
font: TsFont;
clr: TsColorvalue;
cb: TsCellBorder;
begin
Assert(AFromCell <> nil);
@ -929,6 +906,7 @@ begin
begin
fmt := sourceSheet.ReadCellFormat(AFromCell);
//destSheet.WriteCellFormat(AToCell, fmt);
{
if (uffBackground in fmt.UsedFormattingFields) then
begin
clr := sourceSheet.Workbook.GetPaletteColor(fmt.Background.BgColor);
@ -936,21 +914,26 @@ begin
clr := sourceSheet.Workbook.GetPaletteColor(fmt.Background.FgColor);
fmt.Background.FgColor := destSheet.Workbook.AddColorToPalette(clr);
end;
}
if (uffFont in fmt.UsedFormattingFields) then
begin
font := sourceSheet.ReadCellFont(AFromCell);
{
clr := sourceSheet.Workbook.GetPaletteColor(font.Color);
font.Color := destSheet.Workbook.AddColorToPalette(clr);
}
fmt.FontIndex := destSheet.Workbook.FindFont(font.FontName, font.Size, font.Style, font.Color);
if fmt.FontIndex = -1 then
fmt.FontIndex := destSheet.Workbook.AddFont(font.FontName, font.Size, font.Style, font.Color);
end;
{
if (uffBorder in fmt.UsedFormattingFields) then
for cb in fmt.Border do
begin
clr := sourceSheet.Workbook.GetPaletteColor(fmt.BorderStyles[cb].Color);
fmt.BorderStyles[cb].Color := destSheet.Workbook.AddColorToPalette(clr);
end;
}
if (uffNumberformat in fmt.UsedFormattingFields) then
begin
numFmtParams := sourceSheet.Workbook.GetNumberFormat(fmt.NumberFormatIndex);
@ -1086,7 +1069,8 @@ begin
IfThen(fssItalic in fnt.Style, 'i', '.'),
IfThen(fssUnderline in fnt.Style, 'u', '.'),
IfThen(fssStrikeOut in fnt.Style, 's', '.'),
AWorkbook.GetPaletteColorAsHTMLStr(fnt.Color)
ColorToHTMLColorStr(fnt.Color)
//AWorkbook.GetPaletteColorAsHTMLStr(fnt.Color)
]));
end;
L.SaveToFile(AFileName);
@ -2847,10 +2831,10 @@ begin
end;
{@@ ----------------------------------------------------------------------------
Returns the background color of a cell as index into the workbook's color palette.
Returns the background color of a cell as rbg value
@param ACell Pointer to the cell
@return Index of the cell background color into the workbook's color palette
@return Value containing the rgb bytes in little-endian order
-------------------------------------------------------------------------------}
function TsWorksheet.ReadBackgroundColor(ACell: PCell): TsColor;
var
@ -4857,8 +4841,7 @@ end;
@param ARow The row of the cell
@param ACol The column of the cell
@param AFontColor Index into the workbook's color palette identifying the
new text color.
@param AFontColor RGB value of the new text color
@return Index of the font in the workbook's font list.
-------------------------------------------------------------------------------}
function TsWorksheet.WriteFontColor(ARow, ACol: Cardinal; AFontColor: TsColor): Integer;
@ -4872,8 +4855,7 @@ end;
is created. Returns the index of this font in the font list.
@param ACell Pointer to the cell
@param AFontColor Index into the workbook's color palette identifying the
new text color.
@param AFontColor RGB value of the new text color
@return Index of the font in the workbook's font list.
-------------------------------------------------------------------------------}
function TsWorksheet.WriteFontColor(ACell: PCell; AFontColor: TsColor): Integer;
@ -5093,8 +5075,8 @@ end;
@param ARow Row index of the cell
@param ACol Column index of the cell
@param AFillStyle Fill style to be used - see TsFillStyle
@param APatternColor Palette index of the pattern color
@param ABackgroundColor Palette index of the background color
@param APatternColor RGB value of the pattern color
@param ABackgroundColor RGB value of the background color
@return Pointer to cell
@NOTE Is replaced by uniform fill if WriteBackgroundColor is called later.
@ -5111,8 +5093,8 @@ end;
@param ACell Pointer to the cell
@param AStyle Fill style ("pattern") to be used - see TsFillStyle
@param APatternColor Palette index of the pattern color
@param ABackgroundColor Palette index of the background color
@param APatternColor RGB value of the pattern color
@param ABackgroundColor RGB value of the background color
@NOTE Is replaced by uniform fill if WriteBackgroundColor is called later.
-------------------------------------------------------------------------------}
@ -5147,9 +5129,9 @@ end;
@param ARow Row index of the cell
@param ACol Column index of the cell
@param AColor Index of the new background color into the workbook's
color palette. Use the color index scTransparent to
erase an existing background color.
@param AColor RGB value of the new background color.
Use the value "scTransparent" to clear an existing
background color.
@return Pointer to cell
-------------------------------------------------------------------------------}
function TsWorksheet.WriteBackgroundColor(ARow, ACol: Cardinal;
@ -5163,9 +5145,9 @@ end;
Sets a uniform background color of a cell.
@param ACell Pointer to cell
@param AColor Index of the new background color into the workbook's
color palette. Use the color index scTransparent to
erase an existing background color.
@param AColor RGB value of the new background color.
Use the value "scTransparent" to clear an existing
background color.
-------------------------------------------------------------------------------}
procedure TsWorksheet.WriteBackgroundColor(ACell: PCell; AColor: TsColor);
begin
@ -5185,8 +5167,7 @@ end;
@param ACol Column index of the cell
@param ABorder Indicates to which border (left/top etc) this color is
to be applied
@param AColor Index of the new border color into the workbook's
color palette.
@param AColor RGB value of the new border color
@return Pointer to cell
-------------------------------------------------------------------------------}
function TsWorksheet.WriteBorderColor(ARow, ACol: Cardinal;
@ -5203,8 +5184,7 @@ end;
@param ACell Pointer to cell
@param ABorder Indicates to which border (left/top etc) this color is
to be applied
@param AColor Index of the new border color into the workbook's
color palette.
@param AColor RGB value of the new border color
-------------------------------------------------------------------------------}
procedure TsWorksheet.WriteBorderColor(ACell: PCell; ABorder: TsCellBorder;
AColor: TsColor);
@ -5355,7 +5335,7 @@ end;
@param ACol Column index of the considered cell
@param ABorder Identifier of the border to be modified
@param ALineStyle Identifier for the new line style of the border
@param AColor Palette index for the color of the border line
@param AColor RGB value of the border line color
@return Pointer to cell
@see WriteBorderStyles
@ -5374,7 +5354,7 @@ end;
@param ACell Pointer to cell
@param ABorder Identifier of the border to be modified
@param ALineStyle Identifier for the new line style of the border
@param AColor Palette index for the color of the border line
@param AColor RGB value of the color of the border line
@see WriteBorderStyles
-------------------------------------------------------------------------------}
@ -6302,8 +6282,6 @@ begin
FormatSettings.ShortDateFormat := MakeShortDateFormat(FormatSettings.ShortDateFormat);
FormatSettings.LongDateFormat := MakeLongDateFormat(FormatSettings.ShortDateFormat);
UseDefaultPalette;
FFontList := TFPList.Create;
SetDefaultFont(DEFAULT_FONTNAME, DEFAULT_FONTSIZE);
InitFonts;
@ -7249,7 +7227,7 @@ end;
@param AFontName Name of the font (like 'Arial')
@param ASize Size of the font in points
@param AStyle Style of the font, a combination of TsFontStyle elements
@param AColor Color of the font, given by its index into the workbook's palette.
@param AColor RGB valoe of the font color
@return Index of the font in the workbook's font list
-------------------------------------------------------------------------------}
function TsWorkbook.AddFont(const AFontName: String; ASize: Single;
@ -7301,11 +7279,13 @@ end;
@param AFontName Name of the font (like 'Arial')
@param ASize Size of the font in points
@param AStyle Style of the font, a combination of TsFontStyle elements
@param AColor Color of the font, given by its index into the workbook's palette.
@param AColor RGB value of the font color
@return Index of the font in the font list, or -1 if not found.
-------------------------------------------------------------------------------}
function TsWorkbook.FindFont(const AFontName: String; ASize: Single;
AStyle: TsFontStyles; AColor: TsColor): Integer;
const
EPS = 1e-3;
var
fnt: TsFont;
begin
@ -7314,9 +7294,9 @@ begin
fnt := TsFont(FFontList.Items[Result]);
if (fnt <> nil) and
SameText(AFontName, fnt.FontName) and
(abs(ASize - fnt.Size) < 0.001) and // careful when comparing floating point numbers
SameValue(ASize, fnt.Size, EPS) and // careful when comparing floating point numbers
(AStyle = fnt.Style) and
(AColor = fnt.Color) // Take care of limited palette size!
(AColor = fnt.Color)
then
exit;
end;
@ -7520,7 +7500,7 @@ function TsWorkbook.GetNumberFormatCount: Integer;
begin
Result := FNumFormatList.Count;
end;
(*
{@@ ----------------------------------------------------------------------------
Adds a color to the palette and returns its palette index, but only if the
color does not already exist - in this case, it returns the index of the
@ -7602,7 +7582,7 @@ begin
if Assigned(FOnChangePalette) then FOnChangePalette(self);
end;
*)
{@@ ----------------------------------------------------------------------------
Adds a (simple) error message to an internal list
@ -7639,47 +7619,7 @@ function TsWorkbook.GetErrorMsg: String;
begin
Result := FLog.Text;
end;
{@@ ----------------------------------------------------------------------------
Finds the palette color index which points to a color that is closest to a
given color. "Close" means here smallest length of the rgb-difference vector.
@param AColorValue Rgb color value to be considered
@param AMaxPaletteCount Number of palette entries considered. Example:
BIFF5/BIFF8 can write only 64 colors, i.e
AMaxPaletteCount = 64
@return Palette index of the color closest to AColorValue
-------------------------------------------------------------------------------}
function TsWorkbook.FindClosestColor(AColorValue: TsColorValue;
AMaxPaletteCount: Integer = -1): TsColor;
type
TRGBA = record r,g,b, a: Byte end;
var
rgb: TRGBA;
rgb0: TRGBA absolute AColorValue;
dist: Double;
minDist: Double;
i: Integer;
n: Integer;
begin
Result := scNotDefined;
minDist := 1E108;
if AMaxPaletteCount = -1 then
n := Length(FPalette)
else
n := Min(Length(FPalette), AMaxPaletteCount);
for i:=0 to n-1 do
begin
rgb := TRGBA(GetPaletteColor(i));
dist := sqr(rgb.r - rgb0.r) + sqr(rgb.g - rgb0.g) + sqr(rgb.b - rgb0.b);
if dist < minDist then
begin
Result := i;
minDist := dist;
end;
end;
end;
(*
{@@ ----------------------------------------------------------------------------
Converts a fpspreadsheet color into into a string RRGGBB.
Note that colors are written to xls files as ABGR (where A is 0).
@ -7757,26 +7697,6 @@ begin
AName := Format('%.2x%.2x%.2x', [R, G, B]);
end;
{@@ ----------------------------------------------------------------------------
Reads the rgb color for the given index from the current palette. Can be
type-cast to TColor for usage in GUI applications.
@param AColorIndex Index of the color considered
@return A number containing the rgb components in little-endian notation.
-------------------------------------------------------------------------------}
function TsWorkbook.GetPaletteColor(AColorIndex: TsColor): TsColorValue;
begin
if (AColorIndex >= 0) and (AColorIndex < GetPaletteSize) then
begin
if ((FPalette = nil) or (Length(FPalette) = 0)) then
Result := DEFAULT_PALETTE[AColorIndex]
else
Result := FPalette[AColorIndex];
end
else
Result := $000000; // "black" as default
end;
{@@ ----------------------------------------------------------------------------
Converts the palette color of the given index to a string that can be used
in HTML code. For ODS.
@ -7790,36 +7710,6 @@ begin
Result := ColorToHTMLColorStr(GetPaletteColor(AColorIndex));
end;
{@@ ----------------------------------------------------------------------------
Replaces a color value of the current palette by a new value. The color must
be given as ABGR (little-endian), with A=0).
@param AColorIndex Palette index of the color to be replaced
@param AColorValue Number containing the rgb components of the new color
-------------------------------------------------------------------------------}
procedure TsWorkbook.SetPaletteColor(AColorIndex: TsColor;
AColorValue: TsColorValue);
begin
if (AColorIndex >= 0) and (AColorIndex < GetPaletteSize) then
begin
if ((FPalette = nil) or (Length(FPalette) = 0)) then
DEFAULT_PALETTE[AColorIndex] := AColorValue
else
FPalette[AColorIndex] := AColorValue;
end;
end;
{@@ ----------------------------------------------------------------------------
Returns the count of palette colors
-------------------------------------------------------------------------------}
function TsWorkbook.GetPaletteSize: Integer;
begin
if (FPalette = nil) or (Length(FPalette) = 0) then
Result := High(DEFAULT_PALETTE) + 1
else
Result := Length(FPalette);
end;
{@@ ----------------------------------------------------------------------------
Instructs the workbook to take colors from the default palette. Is called
from ODS reader because ODS does not have a palette. Without a palette the
@ -7919,7 +7809,7 @@ begin
end;
Result := false;
end;
*)
{*******************************************************************************
* TsBasicSpreadReaderWriter *
@ -7963,7 +7853,6 @@ end;
procedure TsBasicSpreadWriter.CheckLimitations;
var
lastCol, lastRow: Cardinal;
i, n: Integer;
begin
Workbook.GetLastRowColIndex(lastRow, lastCol);
@ -7974,22 +7863,10 @@ begin
// Check column count
if lastCol >= FLimitations.MaxColCount then
Workbook.AddErrorMsg(rsMaxColsExceeded, [lastCol+1, FLimitations.MaxColCount]);
// Check color count.
n := Workbook.GetPaletteSize;
if n > FLimitations.MaxPaletteSize then
for i:= FLimitations.MaxPaletteSize to n-1 do
if Workbook.UsesColor(i) then
begin
Workbook.AddErrorMsg(rsTooManyPaletteColors, [n, FLimitations.MaxPaletteSize]);
break;
end;
end;
initialization
// Default palette
MakeLEPalette(@DEFAULT_PALETTE, Length(DEFAULT_PALETTE));
finalization
SetLength(GsSpreadFormats, 0);

69
components/fpspreadsheet/fpspreadsheetctrls.pas
View File

@ -28,7 +28,7 @@ interface
uses
Classes, Graphics, SysUtils, Controls, StdCtrls, ComCtrls, ValEdit, ActnList,
LResources,
fpstypes, fpspreadsheet, {%H-}fpsAllFormats;
fpstypes, fpspalette, fpspreadsheet, {%H-}fpsAllFormats;
type
{@@ Event handler procedure for displaying a message if an error or
@ -42,7 +42,7 @@ type
TsNotificationItem = (lniWorkbook,
lniWorksheet, lniWorksheetAdd, lniWorksheetRemoving, lniWorksheetRemove,
lniWorksheetRename,
lniCell, lniSelection, lniAbortSelection, lniRow, lniPalette);
lniCell, lniSelection, lniAbortSelection, lniRow); //, lniPalette);
{@@ This set accompanies the notification between WorkbookSource and visual
controls and describes which items have changed in the spreadsheet. }
TsNotificationItems = set of TsNotificationItem;
@ -78,7 +78,7 @@ type
AFormat: TsSpreadsheetFormat; AWorksheetIndex: Integer = 0);
procedure SetFileName(const AFileName: TFileName);
procedure SetOptions(AValue: TsWorkbookOptions);
procedure WorkbookChangedPaletteHandler(Sender: TObject);
// procedure WorkbookChangedPaletteHandler(Sender: TObject);
procedure WorkbookOpenedHandler(Sender: TObject);
procedure WorksheetAddedHandler(Sender: TObject; ASheet: TsWorksheet);
procedure WorksheetChangedHandler(Sender: TObject; ASheet: TsWorksheet);
@ -436,6 +436,9 @@ type
property FixedCols default 0;
end;
var
ComboColors: TsPalette = nil;
procedure Register;
@ -445,7 +448,6 @@ uses
Types, Math, TypInfo, LCLType, LCLProc, Dialogs, Forms,
fpsStrings, fpsUtils;
{@@ ----------------------------------------------------------------------------
Registers the spreadsheet components in the Lazarus component palette,
page "FPSpreadsheet".
@ -797,7 +799,7 @@ begin
FWorkbook.OnRemovingWorksheet := @WorksheetRemovingHandler;
FWorkbook.OnRenameWorksheet := @WorksheetRenamedHandler;
FWorkbook.OnSelectWorksheet := @WorksheetSelectedHandler;
FWorkbook.OnChangePalette := @WorkbookChangedPaletteHandler;
// FWorkbook.OnChangePalette := @WorkbookChangedPaletteHandler;
// Pass options to workbook
SetOptions(FOptions);
end;
@ -1240,7 +1242,7 @@ begin
EnableControls;
end;
end;
(*
{@@ ----------------------------------------------------------------------------
Event handler called whenever the palette of the workbook is changed.
-------------------------------------------------------------------------------}
@ -1248,7 +1250,7 @@ procedure TsWorkbookSource.WorkbookChangedPaletteHandler(Sender: TObject);
begin
Unused(Sender);
NotifyListeners([lniPalette]);
end;
end; *)
{@@ ----------------------------------------------------------------------------
Event handler called whenever a new workbook is opened.
@ -1970,7 +1972,7 @@ begin
Brush.Style := bsClear;
end else
begin
Brush.Color := Workbook.GetPaletteColor(clr);
Brush.Color := clr and $00FFFFFF;
Brush.Style := bsSolid;
end;
Pen.Color := clBlack;
@ -2010,6 +2012,7 @@ procedure TsCellCombobox.ExtractFromCell(ACell: PCell);
var
fnt: TsFont;
clr: TsColor;
idx: Integer;
begin
case FFormatItem of
cfiFontName:
@ -2091,7 +2094,7 @@ var
begin
Unused(AData);
if (Worksheet = nil) or
([lniCell, lniSelection, lniPalette]*AChangedItems = [])
([lniCell, lniSelection]*AChangedItems = [])
then
exit;
@ -2100,11 +2103,9 @@ begin
(lniSelection in AChangedItems)
then
ExtractFromCell(activeCell);
if (FFormatItem in [cfiFontColor, cfiBorderColor, cfiBackgroundColor]) and
(lniPalette in AChangedItems)
then
Populate;
{
if (FFormatItem in [cfiFontColor, cfiBorderColor, cfiBackgroundColor]) then
Populate; }
end;
{@@ ----------------------------------------------------------------------------
@ -2136,6 +2137,7 @@ end;
procedure TsCellCombobox.Populate;
var
i: Integer;
clr: TsColor;
begin
if Workbook = nil then
exit;
@ -2145,18 +2147,19 @@ begin
Items.Assign(Screen.Fonts);
cfiFontSize:
Items.CommaText := '8,9,10,11,12,13,14,16,18,20,22,24,26,28,32,36,48,72';
cfiFontColor:
for i:=0 to Workbook.GetPaletteSize-1 do
Items.AddObject(Workbook.GetColorName(i), TObject(PtrInt(i)));
cfiBackgroundColor:
begin
Items.AddObject('(none)', TObject(scTransparent));
for i:=0 to Workbook.GetPaletteSize-1 do
Items.AddObject(Workbook.GetColorName(i), TObject(PtrInt(i)));
end;
cfiBackgroundColor,
cfiFontColor,
cfiBorderColor:
for i:=0 to Workbook.GetPaletteSize-1 do
Items.AddObject(Workbook.GetColorName(i), TObject(PtrInt(i)));
begin
Items.Clear;
if FFormatItem = cfiBackgroundColor then
Items.AddObject('(none)', TObject(scTransparent));
for i:=0 to ComboColors.Count-1 do
begin
clr := ComboColors[i];
Items.AddObject(GetColorName(clr), TObject(PtrInt(clr)));
end;
end;
else
raise Exception.Create('[TsCellCombobox.Populate] Unknown cell format item.');
end;
@ -2673,8 +2676,8 @@ begin
else
AStrings.Add(Format('BorderStyles[%s]=%s, %s', [
GetEnumName(TypeInfo(TsCellBorder), ord(cb)),
GetEnumName(TypeInfo(TsLineStyle), ord(fmt.BorderStyles[cbEast].LineStyle)),
Workbook.GetColorName(fmt.BorderStyles[cbEast].Color)]));
GetEnumName(TypeInfo(TsLineStyle), ord(fmt.BorderStyles[cb].LineStyle)),
GetColorName(fmt.BorderStyles[cb].Color)]));
if (ACell = nil) or not (uffBackground in fmt.UsedformattingFields) then
begin
@ -2685,10 +2688,10 @@ begin
begin
AStrings.Add(Format('Style=%s', [
GetEnumName(TypeInfo(TsFillStyle), ord(fmt.Background.Style))]));
AStrings.Add(Format('PatternColor=%d (%s)', [
fmt.Background.FgColor, Workbook.GetColorName(fmt.Background.FgColor)]));
AStrings.Add(Format('BackgroundColor=%d (%s)', [
fmt.Background.BgColor, Workbook.GetColorName(fmt.Background.BgColor)]));
AStrings.Add(Format('PatternColor=$%.8x (%s)', [
fmt.Background.FgColor, GetColorName(fmt.Background.FgColor)]));
AStrings.Add(Format('BackgroundColor=$%.8x (%s)', [
fmt.Background.BgColor, GetColorName(fmt.Background.BgColor)]));
end;
if (ACell = nil) or not (uffNumberFormat in fmt.UsedFormattingFields) then
@ -2949,12 +2952,16 @@ initialization
CellClipboard := TsCellList.Create;
ComboColors := TsPalette.Create;
ComboColors.AddExcelColors;
RegisterPropertyToSkip(TsSpreadsheetInspector, 'RowHeights', 'For compatibility with older Laz versions.', '');
RegisterPropertyToSkip(TsSpreadsheetInspector, 'ColWidths', 'For compatibility with older Laz versions.', '');
finalization
CellClipboard.Free;
if ComboColors <> nil then ComboColors.Free;
end.

16
components/fpspreadsheet/fpspreadsheetgrid.pas
View File

@ -247,7 +247,6 @@ type
{ Utilities related to Workbooks }
procedure Convert_sFont_to_Font(sFont: TsFont; AFont: TFont);
procedure Convert_Font_to_sFont(AFont: TFont; sFont: TsFont);
function FindNearestPaletteIndex(AColor: TColor): TsColor;
{ Interfacing with WorkbookSource}
procedure ListenerNotification(AChangedItems: TsNotificationItems;
@ -1392,15 +1391,15 @@ begin
fsSolidFill:
begin
Canvas.Brush.Style := bsSolid;
Canvas.Brush.Color := Workbook.GetPaletteColor(fmt^.Background.FgColor);
Canvas.Brush.Color := fmt^.Background.FgColor and $00FFFFFF;
end;
else
if fmt^.Background.BgColor = scTransparent
then bgcolor := Color
else bgcolor := Workbook.GetPaletteColor(fmt^.Background.BgColor);
else bgcolor := fmt^.Background.BgColor and $00FFFFFF;
if fmt^.Background.FgColor = scTransparent
then fgcolor := Color
else fgcolor := Workbook.GetPaletteColor(fmt^.Background.FgColor);
else fgcolor := fmt^.Background.FgColor and $00FFFFFF;
CreateFillPattern(FillPatternBitmap, fmt^.Background.Style, fgColor, bgColor);
Canvas.Brush.Style := bsImage;
Canvas.Brush.Bitmap := FillPatternBitmap;
@ -1424,7 +1423,7 @@ begin
begin
Canvas.Font.Name := fnt.FontName;
Canvas.Font.Size := round(fnt.Size);
Canvas.Font.Color := Workbook.GetPaletteColor(fnt.Color);
Canvas.Font.Color := fnt.Color and $00FFFFFF;
style := [];
if fssBold in fnt.Style then Include(style, fsBold);
if fssItalic in fnt.Style then Include(style, fsItalic);
@ -1444,7 +1443,7 @@ begin
if (nfkHasColor in numFmt.Sections[sidx].Kind) then
begin
clr := numFmt.Sections[sidx].Color;
Canvas.Font.Color := Workbook.GetPaletteColor(clr);
Canvas.Font.Color := clr and $00FFFFFF;
end;
end;
// Wordwrap, text alignment and text rotation are handled by "DrawTextInCell".
@ -1569,7 +1568,7 @@ const
begin
Canvas.Pen.Style := PEN_STYLES[ABorderStyle.LineStyle];
Canvas.Pen.Width := PEN_WIDTHS[ABorderStyle.LineStyle];
Canvas.Pen.Color := Workbook.GetPaletteColor(ABorderStyle.Color);
Canvas.Pen.Color := ABorderStyle.Color and $00FFFFFF;
Canvas.Pen.EndCap := pecSquare;
width3 := (ABorderStyle.LineStyle in [lsThick, lsDouble]);
@ -2282,6 +2281,7 @@ begin
end;
end;
(*
{@@ ----------------------------------------------------------------------------
The "colors" used by the spreadsheet are indexes into the workbook's color
palette. If the user wants to set a color to a particular RGB value this is
@ -2294,7 +2294,7 @@ function TsCustomWorksheetGrid.FindNearestPaletteIndex(AColor: TColor): TsColor;
begin
Result := fpsVisualUtils.FindNearestPaletteIndex(Workbook, AColor);
end;
*)
(*
{@@ ----------------------------------------------------------------------------
Notification by the workbook link that a cell has been modified. --> Repaint.

6
components/fpspreadsheet/fpsreaderwriter.pas
View File

@ -95,7 +95,7 @@ type
procedure AddBuiltinNumFormats; virtual;
function FindNumFormatInList(ANumFormatStr: String): Integer;
function FixColor(AColor: TsColor): TsColor; virtual;
// function FixColor(AColor: TsColor): TsColor; virtual;
procedure FixFormat(ACell: PCell); virtual;
procedure GetSheetDimensions(AWorksheet: TsWorksheet;
out AFirstRow, ALastRow, AFirstCol, ALastCol: Cardinal); virtual;
@ -404,7 +404,7 @@ begin
exit;
Result := -1;
end;
(*
{@@ ----------------------------------------------------------------------------
If a color index is greater then the maximum palette color count this
color is replaced by the closest palette color.
@ -420,7 +420,7 @@ function TsCustomSpreadWriter.FixColor(AColor: TsColor): TsColor;
begin
Result := AColor;
end;
*)
{@@ ----------------------------------------------------------------------------
If formatting features of a cell are not supported by the destination file
format of the writer, here is the place to apply replacements.

60
components/fpspreadsheet/fpsstrings.pas
View File

@ -67,6 +67,66 @@ resourcestring
rsCannotSortMerged = 'The cell range cannot be sorted because it contains merged cells.';
// Colors
rsAqua = 'aqua';
rsBeige = 'beige';
rsBlack = 'black';
rsBlue = 'blue';
rsBlueGray = 'blue gray';
rsBrown = 'brown';
rsCoral = 'coral';
rsCyan = 'cyan';
rsDarkBlue = 'dark blue';
rsDarkGreen = 'dark green';
rsDarkPurple = 'dark purple';
rsDarkRed = 'dark red';
rsDarkTeal = 'dark teal';
rsGold = 'gold';
rsGray = 'gray';
rsGray10pct = '10% gray';
rsGray20pct = '20% gray';
rsGray25pct = '25% gray';
rsGray40pct = '40% gray';
rsGray50pct = '50% gray';
rsGray80pct = '80% gray';
rsGreen = 'green';
rsIceBlue = 'ice blue';
rsIndigo = 'indigo';
rsIvory = 'ivory';
rsLavander = 'lavander';
rsLightBlue = 'light blue';
rsLightGreen = 'light green';
rsLightOrange = 'light orange';
rsLightTurquoise = 'light turquoise';
rsLightYellow = 'light yellow';
rsLime = 'lime';
rsMagenta = 'magenta';
rsNavy = 'navy';
rsOceanBlue = 'ocean blue';
rsOlive = 'olive';
rsOliveGreen = 'olive green';
rsOrange = 'orange';
rsPaleBlue = 'pale blue';
rsPeriwinkle = 'periwinkle';
rsPink = 'pink';
rsPlum = 'plum';
rsPurple = 'purple';
rsRed = 'red';
rsRose = 'rose';
rsSeaGreen = 'sea green';
rsSilver = 'silver';
rsSkyBlue = 'sky blue';
rsTan = 'tan';
rsTeal = 'teal';
rsVeryDarkGreen = 'very dark green';
rsViolet = 'violet';
rsWheat = 'wheat';
rsWhite = 'white';
rsYellow = 'yellow';
rsNotDefined = 'not defined';
rsTransparent = 'transparent';
rsTRUE = 'TRUE'; // wp: Do we really want to translate these strings?
rsFALSE = 'FALSE';
rsErrEmptyIntersection = '#NULL!';

215
components/fpspreadsheet/fpstypes.pas
View File

@ -264,92 +264,147 @@ type
{@@ Indicates vertical text alignment in cells }
TsVertAlignment = (vaDefault, vaTop, vaCenter, vaBottom);
{@@
Colors in fpspreadsheet are given as indices into a palette.
Use the workbook's GetPaletteColor to determine the color rgb value as
little-endian (with "r" being the low-value byte, in agreement with TColor).
The data type for rgb values is TsColorValue. }
TsColor = Word;
{@@ Colors in fpspreadsheet are given as rgb values in little-endian notation
(i.e. "r" is the low-value byte). The highest-value byte, if not zero,
indicates special colors. }
TsColor = DWord;
{@@
These are some constants for color indices into the default palette.
Note, however, that if a different palette is used there may be more colors,
and the names of the color constants may no longer be correct.
}
const
{@@ Index of <b>black</b> color in the standard color palettes }
scBlack = $00;
{@@ Index of <b>white</b> color in the standard color palettes }
scWhite = $01;
{@@ Index of <b>red</b> color in the standard color palettes }
scRed = $02;
{@@ Index of <b>green</b> color in the standard color palettes }
scGreen = $03;
{@@ Index of <b>blue</b> color in the standard color palettes }
scBlue = $04;
{@@ Index of <b>yellow</b> color in the standard color palettes }
scYellow = $05;
{@@ Index of <b>magenta</b> color in the standard color palettes }
scMagenta = $06;
{@@ Index of <b>cyan</b> color in the standard color palettes }
scCyan = $07;
{@@ Index of <b>dark red</b> color in the standard color palettes }
scDarkRed = $08;
{@@ Index of <b>dark green</b> color in the standard color palettes }
scDarkGreen = $09;
{@@ Index of <b>dark blue</b> color in the standard color palettes }
scDarkBlue = $0A;
{@@ Index of <b>"navy"</b> color (dark blue) in the standard color palettes }
scNavy = $0A;
{@@ Index of <b>olive</b> color in the standard color palettes }
scOlive = $0B;
{@@ Index of <b>purple</b> color in the standard color palettes }
scPurple = $0C;
{@@ Index of <b>teal</b> color in the standard color palettes }
scTeal = $0D;
{@@ Index of <b>silver</b> color in the standard color palettes }
scSilver = $0E;
{@@ Index of <b>grey</b> color in the standard color palettes }
scGrey = $0F;
{@@ Index of <b>gray</b> color in the standard color palettes }
scGray = $0F; // redefine to allow different spelling
{@@ Index of a <b>10% grey</b> color in the standard color palettes }
scGrey10pct = $10;
{@@ Index of a <b>10% gray</b> color in the standard color palettes }
scGray10pct = $10;
{@@ Index of a <b>20% grey</b> color in the standard color palettes }
scGrey20pct = $11;
{@@ Index of a <b>20% gray</b> color in the standard color palettes }
scGray20pct = $11;
{@@ Index of <b>orange</b> color in the standard color palettes }
scOrange = $12;
{@@ Index of <b>dark brown</b> color in the standard color palettes }
scDarkbrown = $13;
{@@ Index of <b>brown</b> color in the standard color palettes }
scBrown = $14;
{@@ Index of <b>beige</b> color in the standard color palettes }
scBeige = $15;
{@@ Index of <b>"wheat"</b> color (yellow-orange) in the standard color palettes }
scWheat = $16;
{@@ These are some important rgb color volues.
}
{@@ rgb value of <b>black</b> color, BIFF2 palette index 0, BIFF8 index 8}
scBlack = $00000000;
{@@ rgb value of <b>white</b> color, BIFF2 palette index 1, BIFF8 index 9 }
scWhite = $00FFFFFF;
{@@ rgb value of <b>red</b> color, BIFF2 palette index 2, BIFF8 index 10 }
scRed = $000000FF;
{@@ rgb value of <b>green</b> color, BIFF2 palette index 3, BIFF8 index 11 }
scGreen = $0000FF00;
{@@ rgb value of <b>blue</b> color, BIFF2 palette index 4, BIFF8 indexes 12 and 39}
scBlue = $00FF0000;
{@@ rgb value of <b>yellow</b> color, BIFF2 palette index 5, BIFF8 indexes 13 and 34}
scYellow = $0000FFFF;
{@@ rgb value of <b>magenta</b> color, BIFF2 palette index 6, BIFF8 index 14 and 33}
scMagenta = $00FF00FF;
scPink = $00FE00FE;
{@@ rgb value of <b>cyan</b> color, BIFF2 palette index 7, BIFF8 indexes 15}
scCyan = $00FFFF00;
scTurquoise = scCyan;
{@@ rgb value of <b>dark red</b> color, BIFF8 indexes 16 and 35}
scDarkRed = $00000080;
{@@ rgb value of <b>dark green</b> color, BIFF8 index 17 }
scDarkGreen = $00008000;
{@@ rgb value of <b>dark blue</b> color }
scDarkBlue = $008B0000;
{@@ rgb value of <b>"navy"</b> color, BIFF8 palette indexes 18 and 32 }
scNavy = $00800000;
{@@ rgb value of <b>olive</b> color }
scOlive = $00008080;
{@@ rgb value of <b>purple</b> color, BIFF8 palette indexes 20 and 36 }
scPurple = $00800080;
{@@ rgb value of <b>teal</b> color, BIFF8 palette index 21 and 38 }
scTeal = $00808000;
{@@ rgb value of <b>silver</b> color }
scSilver = $00C0C0C0;
scGray25pct = scSilver;
{@@ rgb value of <b>grey</b> color }
scGray = $00808080;
{@@ rgb value of <b>gray</b> color }
scGrey = scGray; // redefine to allow different spelling
scGray50pct = scGray;
{@@ rgb value of a <b>10% grey</b> color }
scGray10pct = $00E6E6E6;
{@@ rgb value of a <b>10% gray</b> color }
scGrey10pct = scGray10pct;
{@@ rgb value of a <b>20% grey</b> color }
scGray20pct = $00CCCCCC;
{@@ rgb value of a <b>20% gray</b> color }
scGrey20pct = scGray20pct;
{@@ rgb value of <b>periwinkle</b> color, BIFF8 palette index 24 }
scPeriwinkle = $00FF9999;
{@@ rgb value of <b>plum</b> color, BIFF8 palette indexes 25 and 61 }
scPlum = $00663399;
{@@ rgb value of <b>ivory</b> color, BIFF8 palette index 26 }
scIvory = $00CCFFFF;
{@@ rgb value of <b>light turquoise</b> color, BIFF8 palette indexes 27 and 41 }
scLightTurquoise = $00FFFFCC;
{@@ rgb value of <b>dark purple</b> color, BIFF8 palette index 28 }
scDarkPurple = $00660066;
{@@ rgb value of <b>coral</b> color, BIFF8 palette index 29 }
scCoral = $008080FF;
{@@ rgb value of <b>ocean blue</b> color, BIFF8 palette index 30 }
scOceanBlue = $00CC6600;
{@@ rgb value of <b>ice blue</b> color, BIFF8 palette index 31 }
scIceBlue = $00FFCCCC;
{@@ rgb value of <b>sky blue </b>color, BIFF8 palette index 40 }
scSkyBlue = $00FFCC00;
{@@ rgb value of <b>light green</b> color, BIFF8 palette index 42 }
scLightGreen = $00CCFFCC;
{@@ rgb value of <b>light yellow</b> color, BIFF8 palette index 43 }
scLightYellow = $0099FFFF;
{@@ rgb value of <b>pale blue</b> color, BIFF8 palette index 44 }
scPaleBlue = $00FFCC99;
{@@ rgb value of <b>rose</b> color, BIFF8 palette index 45 }
scRose = $00CC99FF;
{@@ rgb value of <b>lavander</b> color, BIFF8 palette index 46 }
scLavander = $00FF99CC;
{@@ rgb value of <b>tan</b> color, BIFF8 palette index 47 }
scTan = $0099CCFF;
{@@ rgb value of <b>light blue</b> color, BIFF8 palette index 48 }
scLightBlue = $00FF6633;
{@@ rgb value of <b>aqua</b> color, BIFF8 palette index 49 }
scAqua = $00CCCC33;
{@@ rgb value of <b>lime</b> color, BIFF8 palette index 50 }
scLime = $0000CC99;
{@@ rgb value of <b>golden</b> color, BIFF8 palette index 51 }
scGold = $0000CCFF;
{@@ rgb value of <b>light orange</b> color, BIFF8 palette index 52 }
scLightOrange = $000099FF;
{@@ rgb value of <b>orange</b> color, BIFF8 palette index 53 }
scOrange = $000066FF;
{@@ rgb value of <b>blue gray</b>, BIFF8 palette index 54 }
scBlueGray = $00996666;
scBlueGrey = scBlueGray;
{@@ rgb value of <b>gray 40%</b>, BIFF8 palette index 55 }
scGray40pct = $00969696;
{@@ rgb value of <b>dark teal</b>, BIFF8 palette index 56 }
scDarkTeal = $00663300;
{@@ rgb value of <b>sea green</b>, BIFF8 palette index 57 }
scSeaGreen = $00669933;
{@@ rgb value of <b>very dark green</b>, BIFF8 palette index 58 }
scVeryDarkGreen = $00003300;
{@@ rgb value of <b>olive green</b> color, BIFF8 palette index 59 }
scOliveGreen = $00003333;
{@@ rgb value of <b>brown</b> color, BIFF8 palette index 60 }
scBrown = $00003399;
{@@ rgb value of <b>indigo</b> color, BIFF8 palette index 62 }
scIndigo = $00993333;
{@@ rgb value of <b>80% gray</b>, BIFF8 palette index 63 }
scGray80pct = $00333333;
scGrey80pct = scGray80pct;
// not sure - but I think the mechanism with scRGBColor is not working...
// Will be removed sooner or later...
scRGBColor = $FFFD;
// {@@ rgb value of <b>orange</b> color }
// scOrange = $0000A5FF;
{@@ rgb value of <b>dark brown</b> color }
scDarkBrown = $002D52A0;
// {@@ rgb value of <b>brown</b> color }
// scBrown = $003F85CD;
{@@ rgb value of <b>beige</b> color }
scBeige = $00DCF5F5;
{@@ rgb value of <b>"wheat"</b> color (yellow-orange) }
scWheat = $00B3DEF5;
{@@ Identifier for transparent color }
scTransparent = $FFFE;
{@@ Identifier for not-defined color }
scNotDefined = $FFFF;
scNotDefined = $40000000;
{@@ Identifier for transparent color }
scTransparent = $20000000;
{@@ Identifier for palette index encoded into the TsColor }
scPaletteIndexMask = $80000000;
{@@ Mask for the rgb components contained in the TsColor }
scRGBMask = $00FFFFFF;
type
{@@ Data type for rgb color values }
TsColorValue = DWord;
{@@ Palette of color values. A "color value" is a DWord value containing
rgb colors. }
TsPalette = array[0..0] of TsColorValue;
PsPalette = ^TsPalette;
{@@ Font style (redefined to avoid usage of "Graphics" }
TsFontStyle = (fssBold, fssItalic, fssStrikeOut, fssUnderline);
@ -365,7 +420,7 @@ type
Size: Single; // in "points"
{@@ Font style, such as bold, italics etc. - see TsFontStyle}
Style: TsFontStyles;
{@@ Text color given by the index into the workbook's color palette }
{@@ Text color given as rgb value }
Color: TsColor;
end;

177
components/fpspreadsheet/fpsutils.pas
View File

@ -28,6 +28,9 @@ type
{@@ Set of characters }
TsDecsChars = set of char;
{@@ Color value, composed of r(ed), g(reen) and b(lue) components }
TRGBA = record r, g, b, a: byte end;
const
{@@ Date formatting string for unambiguous date/time display as strings
Can be used for text output when date/time cell support is not available }
@ -51,8 +54,6 @@ function WordLEtoN(AValue: Word): Word;
function DWordLEtoN(AValue: Cardinal): Cardinal;
function WideStringLEToN(const AValue: WideString): WideString;
function LongRGBToExcelPhysical(const RGB: DWord): DWord;
// Other routines
function ParseIntervalString(const AStr: string;
out AFirstCellRow, AFirstCellCol, ACount: Cardinal;
@ -140,13 +141,18 @@ function pxToPts(AValue, AScreenPixelsPerInch: Integer): Double; inline;
function PtsToPx(AValue: Double; AScreenPixelsPerInch: Integer): Integer; inline;
function HTMLLengthStrToPts(AValue: String; DefaultUnits: String = 'pt'): Double;
function HTMLColorStrToColor(AValue: String): TsColorValue;
function ColorToHTMLColorStr(AValue: TsColorValue; AExcelDialect: Boolean = false): String;
function UTF8TextToXMLText(AText: ansistring): ansistring;
function ValidXMLText(var AText: ansistring; ReplaceSpecialChars: Boolean = true): Boolean;
function TintedColor(AColor: TsColorValue; tint: Double): TsColorValue;
function HighContrastColor(AColorValue: TsColorValue): TsColor;
function ColorToHTMLColorStr(AValue: TsColor; AExcelDialect: Boolean = false): String;
function HTMLColorStrToColor(AValue: String): TsColor;
function GetColorName(AColor: TsColor): String;
function HighContrastColor(AColor: TsColor): TsColor;
function IsPaletteIndex(AColor: TsColor): Boolean;
function LongRGBToExcelPhysical(const RGB: DWord): DWord;
function SetAsPaletteIndex(AIndex: Integer): TsColor;
function TintedColor(AColor: TsColor; tint: Double): TsColor;
function AnalyzeCompareStr(AString: String; out ACompareOp: TsCompareOperation): String;
@ -183,9 +189,6 @@ implementation
uses
Math, lazutf8, fpsStrings;
type
TRGBA = record r, g, b, a: byte end;
const
POS_CURR_FMT: array[0..3] of string = (
// Format parameter 0 is "value", parameter 1 is "currency symbol"
@ -356,29 +359,6 @@ begin
{$ENDIF}
end;
{@@ ----------------------------------------------------------------------------
Converts the RGB part of a LongRGB logical structure to its physical representation.
In other words: RGBA (where A is 0 and omitted in the function call) => ABGR
Needed for conversion of palette colors.
@param RGB DWord value containing RGBA bytes in big endian byte-order
@return DWord containing RGB bytes in little-endian byte-order (A = 0)
-------------------------------------------------------------------------------}
function LongRGBToExcelPhysical(const RGB: DWord): DWord;
begin
{$IFDEF FPC}
{$IFDEF ENDIAN_LITTLE}
result := RGB shl 8; //tags $00 at end for the A byte
result := SwapEndian(result); //flip byte order
{$ELSE}
//Big endian
result := RGB; //leave value as is //todo: verify if this turns out ok
{$ENDIF}
{$ELSE}
// messed up result
{$ENDIF}
end;
{@@ ----------------------------------------------------------------------------
Parses strings like A5:A10 into an selection interval information
@ -1968,13 +1948,83 @@ begin
end;
{@@ ----------------------------------------------------------------------------
Converts a HTML color string to a TsColorValue. Need for the ODS file format.
Determines the name of a color from its rgb value
-------------------------------------------------------------------------------}
function GetColorName(AColor: TsColor): string;
var
rgba: TRGBA absolute AColor;
begin
case AColor of
scAqua : Result := rsAqua;
scBeige : Result := rsBeige;
scBlack : Result := rsBlack;
scBlue : Result := rsBlue;
scBlueGray : Result := rsBlueGray;
scBrown : Result := rsBrown;
scCoral : Result := rsCoral;
scCyan : Result := rsCyan;
scDarkBlue : Result := rsDarkBlue;
scDarkGreen : Result := rsDarkGreen;
scDarkPurple : Result := rsDarkPurple;
scDarkRed : Result := rsDarkRed;
scDarkTeal : Result := rsDarkTeal;
scGold : Result := rsGold;
scGray : Result := rsGray;
scGray10pct : Result := rsGray10pct;
scGray20pct : Result := rsGray20pct;
scGray40pct : Result := rsGray40pct;
scGray80pct : Result := rsGray80pct;
scGreen : Result := rsGreen;
scIceBlue : Result := rsIceBlue;
scIndigo : Result := rsIndigo;
scIvory : Result := rsIvory;
scLavander : Result := rsLavander;
scLightBlue : Result := rsLightBlue;
scLightGreen : Result := rsLightGreen;
scLightOrange: Result := rsLightOrange;
scLightTurquoise: Result := rsLightTurquoise;
scLightYellow: Result := rsLightYellow;
scLime : Result := rsLime;
scMagenta : Result := rsMagenta;
scNavy : Result := rsNavy;
scOceanBlue : Result := rsOceanBlue;
scOlive : Result := rsOlive;
scOliveGreen : Result := rsOliveGreen;
scOrange : Result := rsOrange;
scPaleBlue : Result := rsPaleBlue;
scPeriwinkle : Result := rsPeriwinkle;
scPink : Result := rsPink;
scPlum : Result := rsPlum;
scPurple : Result := rsPurple;
scRed : Result := rsRed;
scRose : Result := rsRose;
scSeaGreen : Result := rsSeaGreen;
scSilver : Result := rsSilver;
scSkyBlue : Result := rsSkyBlue;
scTan : Result := rsTan;
scTeal : Result := rsTeal;
scVeryDarkGreen: Result := rsVeryDarkGreen;
// scViolet : Result := rsViolet;
scWheat : Result := rsWheat;
scWhite : Result := rsWhite;
scYellow : Result := rsYellow;
scTransparent: Result := rsTransparent;
scNotDefined : Result := rsNotDefined;
else if rgba.a = 0 then
Result := Format('r%d g%d b%d', [rgba.r, rgba.g, rgba.b])
else
Result := '';
end;
end;
{@@ ----------------------------------------------------------------------------
Converts a HTML color string to a TsColor alue. Needed for the ODS file format.
@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.
-------------------------------------------------------------------------------}
function HTMLColorStrToColor(AValue: String): TsColorValue;
function HTMLColorStrToColor(AValue: String): TsColor;
begin
if AValue = '' then
Result := scNotDefined
@ -2022,13 +2072,11 @@ end;
i.e. in AARRGGBB notation, like '00FF0000' for "red"
@return HTML-compatible string, like '#FF0000' (AExcelDialect = false)
-------------------------------------------------------------------------------}
function ColorToHTMLColorStr(AValue: TsColorValue; AExcelDialect: Boolean = false): String;
type
TRGB = record r,g,b,a: Byte end;
function ColorToHTMLColorStr(AValue: TsColor;
AExcelDialect: Boolean = false): String;
var
rgb: TRGB;
rgb: TRGBA absolute AValue;
begin
rgb := TRGB(AValue);
if AExcelDialect then
Result := Format('00%.2x%.2x%.2x', [rgb.r, rgb.g, rgb.b])
else
@ -3069,6 +3117,23 @@ begin
end;
end;
{@@ ----------------------------------------------------------------------------
Constructs a TsColor from a palette index. It has bit 15 in the high-order
byte set.
-------------------------------------------------------------------------------}
function SetAsPaletteIndex(AIndex: Integer): TsColor;
begin
Result := (DWord(AIndex) and scRGBMask) or scPaletteIndexMask;
end;
{@@ ----------------------------------------------------------------------------
Checks whether the specified TsColor represents a palette index
-------------------------------------------------------------------------------}
function IsPaletteIndex(AColor: TsColor): Boolean;
begin
Result := AColor and scPaletteIndexMask = scPaletteIndexMask;
end;
{@@ ----------------------------------------------------------------------------
Excel defines theme colors and applies a "tint" factor (-1...+1) to darken
or brighten them.
@ -3082,7 +3147,7 @@ end;
@param tint Factor (-1...+1) to be used for the operation
@return Modified color
-------------------------------------------------------------------------------}
function TintedColor(AColor: TsColorValue; tint: Double): TsColorValue;
function TintedColor(AColor: TsColor; tint: Double): TsColor;
const
HLSMAX = 255;
var
@ -3090,7 +3155,7 @@ var
h, l, s: Byte;
lum: Double;
begin
if tint = 0 then begin
if (tint = 0) or (TRGBA(AColor).a <> 0) then begin
Result := AColor;
exit;
end;
@ -3119,18 +3184,42 @@ end;
Returns the color index for black or white depending on a color being "bright"
or "dark".
@param AColorValue rgb color to be analyzed
@param AColor rgb color to be analyzed
@return The color index for black (scBlack) if AColorValue is a "bright" color,
or white (scWhite) if AColorValue is a "dark" color.
-------------------------------------------------------------------------------}
function HighContrastColor(AColorValue: TsColorvalue): TsColor;
function HighContrastColor(AColor: TsColor): TsColor;
begin
if TRGBA(AColorValue).r + TRGBA(AColorValue).g + TRGBA(AColorValue).b < 3*128 then
if TRGBA(AColor).r + TRGBA(AColor).g + TRGBA(AColor).b < 3*128 then
Result := scWhite
else
Result := scBlack;
end;
{@@ ----------------------------------------------------------------------------
Converts the RGB part of a LongRGB logical structure to its physical representation.
In other words: RGBA (where A is 0 and omitted in the function call) => ABGR
Needed for conversion of palette colors.
@param RGB DWord value containing RGBA bytes in big endian byte-order
@return DWord containing RGB bytes in little-endian byte-order (A = 0)
-------------------------------------------------------------------------------}
function LongRGBToExcelPhysical(const RGB: DWord): DWord;
begin
{$IFDEF FPC}
{$IFDEF ENDIAN_LITTLE}
result := RGB shl 8; //tags $00 at end for the A byte
result := SwapEndian(result); //flip byte order
{$ELSE}
//Big endian
result := RGB; //leave value as is //todo: verify if this turns out ok
{$ENDIF}
{$ELSE}
// messed up result
{$ENDIF}
end;
{$PUSH}{$HINTS OFF}
{@@ Silence warnings due to an unused parameter }
procedure Unused(const A1);

10
components/fpspreadsheet/fpsvisualutils.pas
View File

@ -10,7 +10,7 @@ uses
procedure Convert_sFont_to_Font(AWorkbook: TsWorkbook; sFont: TsFont; AFont: TFont);
procedure Convert_Font_to_sFont(AWorkbook: TsWorkbook; AFont: TFont; sFont: TsFont);
function FindNearestPaletteIndex(AWorkbook: TsWorkbook; AColor: TColor): TsColor;
//function FindNearestPaletteIndex(AWorkbook: TsWorkbook; AColor: TColor): TsColor;
function WrapText(ACanvas: TCanvas; const AText: string; AMaxWidth: integer): string;
@ -36,7 +36,7 @@ begin
if fssItalic in sFont.Style then AFont.Style := AFont.Style + [fsItalic];
if fssUnderline in sFont.Style then AFont.Style := AFont.Style + [fsUnderline];
if fssStrikeout in sFont.Style then AFont.Style := AFont.Style + [fsStrikeout];
AFont.Color := AWorkbook.GetPaletteColor(sFont.Color);
AFont.Color := TColor(sFont.Color and $00FFFFFF);
end;
end;
@ -56,10 +56,10 @@ begin
if fsItalic in AFont.Style then Include(sFont.Style, fssItalic);
if fsUnderline in AFont.Style then Include(sFont.Style, fssUnderline);
if fsStrikeout in AFont.Style then Include(sFont.Style, fssStrikeout);
sFont.Color := FindNearestPaletteIndex(AWorkbook, AFont.Color);
sFont.Color := ColorToRGB(AFont.Color);
end;
end;
(*
function FindNearestPaletteIndex(AWorkbook: TsWorkbook; AColor: TColor): TsColor;
procedure ColorToHSL(RGB: TColor; out H, S, L : double);
@ -148,7 +148,7 @@ begin
end;
end;
end;
*)
{@@ ----------------------------------------------------------------------------
Wraps text by inserting line ending characters so that the lines are not
longer than AMaxWidth.

6
components/fpspreadsheet/laz_fpspreadsheet.lpk
View File

@ -28,7 +28,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="5"/>
<Files Count="34">
<Files Count="35">
<Item1>
<Filename Value="fpolestorage.pas"/>
<UnitName Value="fpolestorage"/>
@ -165,6 +165,10 @@ This package is all you need if you don't want graphical components (like grids
<Filename Value="fpsheaderfooterparser.pas"/>
<UnitName Value="fpsHeaderFooterParser"/>
</Item34>
<Item35>
<Filename Value="fpspalette.pas"/>
<UnitName Value="fpsPalette"/>
</Item35>
</Files>
<RequiredPkgs Count="2">
<Item1>

2
components/fpspreadsheet/laz_fpspreadsheet.pas
View File

@ -13,7 +13,7 @@ uses
uvirtuallayer_ole_helpers, uvirtuallayer_ole_types, uvirtuallayer_stream,
fpolebasic, wikitable, fpsNumFormatParser, fpsfunc, fpsRPN, fpsStrings,
fpscsv, fpsCsvDocument, fpspatches, fpsTypes, xlsEscher, fpsReaderWriter,
fpsNumFormat, fpsclasses, fpsHeaderFooterParser;
fpsNumFormat, fpsclasses, fpsHeaderFooterParser, fpsPalette;
implementation

122
components/fpspreadsheet/tests/colortests.pas
View File

@ -80,8 +80,12 @@ type
procedure TestWriteRead_OOXML_Font_RandomPal; // palette 64, top 56 entries random
end;
implementation
uses
fpsPalette;
const
ColorsSheet = 'Colors';
@ -111,47 +115,41 @@ var
row, col: Integer;
MyCell: PCell;
TempFile: string; //write xls/xml to this file and read back from it
color: TsColor;
expectedRGB: DWord;
currentRGB: DWord;
pal: Array of TsColorValue;
palette: TsPalette;
i: Integer;
begin
TempFile:=GetTempFileName;
// Define palette
palette := TsPalette.Create;
try
case whichPalette of
5: palette.UseColors(PALETTE_BIFF5);
8: palette.UseColors(PALETTE_BIFF8);
999: begin // random palette: testing of color replacement
palette.UseColors(PALETTE_BIFF8);
for i:=8 to 63 do // first 8 colors must not be changed in Excel
palette[i] := random(256) + random(256) shr 8 + random(256) shr 16;
end;
else palette.AddBuiltinColors;
end;
MyWorkbook := TsWorkbook.Create;
try
MyWorkSheet:= MyWorkBook.AddWorksheet(ColorsSheet);
// Define palette
case whichPalette of
5: MyWorkbook.UsePalette(@PALETTE_BIFF5, Length(PALETTE_BIFF5));
8: MyWorkbook.UsePalette(@PALETTE_BIFF8, Length(PALETTE_BIFF8));
999: begin // Random palette: testing of color replacement
MyWorkbook.UsePalette(@PALETTE_BIFF8, Length(PALETTE_BIFF8));
for i:=8 to 63 do // first 8 colors cannot be changed
MyWorkbook.SetPaletteColor(i, random(256) + random(256) shr 8 + random(256) shr 16);
end;
// else use default palette
end;
// Remember all colors because ODS does not have a palette in the file; therefore
// we do not know which colors to expect.
SetLength(pal, MyWorkbook.GetPaletteSize);
for i:=0 to High(pal) do
pal[i] := MyWorkbook.GetPaletteColor(i);
// Write out all colors
row := 0;
col := 0;
for color := 0 to MyWorkbook.GetPaletteSize-1 do begin
for i := 0 to palette.Count-1 do begin
MyWorksheet.WriteUTF8Text(row, col, CELLTEXT);
MyWorksheet.WriteBackgroundColor(row, col, color);
MyCell := MyWorksheet.FindCell(row, col);
MyCell := MyWorksheet.WriteBackgroundColor(row, col, palette[i]);
if MyCell = nil then
fail('Error in test code. Failed to get cell.');
currentRGB := MyWorkbook.GetPaletteColor(MyWorksheet.ReadBackgroundColor(MyCell));
expectedRGB := MyWorkbook.GetPaletteColor(color);
currentRGB := MyWorksheet.ReadBackgroundColor(MyCell);
expectedRGB := palette[i];
CheckEquals(expectedRGB, currentRGB,
'Test unsaved background color, cell ' + CellNotation(MyWorksheet,0,0));
inc(row);
@ -175,9 +173,8 @@ begin
MyCell := MyWorksheet.FindCell(row, col);
if MyCell = nil then
fail('Error in test code. Failed to get cell.');
color := TsColor(row);
currentRGB := MyWorkbook.GetPaletteColor(MyWorksheet.ReadBackgroundColor(MyCell));
expectedRGB := pal[color];
currentRGB := MyWorksheet.ReadBackgroundColor(MyCell);
expectedRGB := palette[row];
CheckEquals(expectedRGB, currentRGB,
'Test saved background color, cell '+CellNotation(MyWorksheet,Row,Col));
end;
@ -185,6 +182,10 @@ begin
MyWorkbook.Free;
DeleteFile(TempFile);
end;
finally
palette.Free
end;
end;
procedure TSpreadWriteReadColorTests.TestWriteReadFontColors(AFormat: TsSpreadsheetFormat;
@ -201,47 +202,41 @@ var
row, col: Integer;
MyCell: PCell;
TempFile: string; //write xls/xml to this file and read back from it
color, colorInFile: TsColor;
expectedRGB, currentRGB: DWord;
pal: Array of TsColorValue;
palette: TsPalette;
i: Integer;
begin
TempFile:=GetTempFileName;
// Define palette
palette := TsPalette.Create;
try
case whichPalette of
5: palette.UseColors(PALETTE_BIFF5);
8: palette.UseColors(PALETTE_BIFF8);
999: begin // random palette: testing of color replacement
palette.UseColors(PALETTE_BIFF8);
for i:=8 to 63 do // first 8 colors must not be changed in Excel
palette[i] := random(256) + random(256) shr 8 + random(256) shr 16;
end;
else palette.AddBuiltinColors;
end;
MyWorkbook := TsWorkbook.Create;
try
MyWorkSheet:= MyWorkBook.AddWorksheet(ColorsSheet);
// Define palette
case whichPalette of
5: MyWorkbook.UsePalette(@PALETTE_BIFF5, High(PALETTE_BIFF5)+1);
8: MyWorkbook.UsePalette(@PALETTE_BIFF8, High(PALETTE_BIFF8)+1);
999: begin // Random palette: testing of color replacement
MyWorkbook.UsePalette(@PALETTE_BIFF8, Length(PALETTE_BIFF8));
for i:=8 to 63 do // first 8 colors cannot be changed
MyWorkbook.SetPaletteColor(i, random(256) + random(256) shr 8 + random(256) shr 16);
end;
// else use default palette
end;
// Remember all colors because ODS does not have a palette in the file;
// therefore we do not know which colors to expect.
SetLength(pal, MyWorkbook.GetPaletteSize);
for color:=0 to High(pal) do
pal[color] := MyWorkbook.GetPaletteColor(color);
// Write out all colors
row := 0;
col := 0;
for color := 0 to MyWorkbook.GetPaletteSize-1 do begin
for i := 0 to palette.Count-1 do begin
MyWorksheet.WriteUTF8Text(row, col, CELLTEXT);
MyWorksheet.WriteFontColor(row, col, color);
MyWorksheet.WriteFontColor(row, col, palette[i]);
MyCell := MyWorksheet.FindCell(row, col);
if MyCell = nil then
fail('Error in test code. Failed to get cell.');
colorInFile := MyWorksheet.ReadCellFont(MyCell).Color;
currentRGB := MyWorkbook.GetPaletteColor(colorInFile);
expectedRGB := MyWorkbook.GetPaletteColor(color);
currentRGB := MyWorksheet.ReadCellFont(MyCell).Color;
expectedRGB := palette[i];
CheckEquals(expectedRGB, currentRGB,
'Test unsaved font color, cell ' + CellNotation(MyWorksheet,row, col));
inc(row);
@ -261,21 +256,18 @@ begin
MyWorksheet := GetWorksheetByName(MyWorkBook, ColorsSheet);
if MyWorksheet=nil then
fail('Error in test code. Failed to get named worksheet');
col := 0;
for row := 0 to MyWorksheet.GetLastRowIndex do begin
MyCell := MyWorksheet.FindCell(row, col);
if MyCell = nil then
fail('Error in test code. Failed to get cell.');
color := TsColor(row);
expectedRGB := pal[color];
colorInFile := MyWorksheet.ReadCellFont(MyCell).Color;
currentRGB := MyWorkbook.GetPaletteColor(colorInFile);
expectedRGB := palette[row];
currentRGB := MyWorksheet.ReadCellFont(MyCell).Color;
// Excel2 cannot write the entire palette. The writer had called "FixColor".
// We simulate that here to get the color correct.
if (AFormat = sfExcel2) and (color >= BIFF2_MAX_PALETTE_SIZE) then begin
color := MyWorkbook.FindClosestColor(expectedRGB, BIFF2_MAX_PALETTE_SIZE);
expectedRGB := MyWorkbook.GetPaletteColor(color);
end;
// Excel2 cannot write the entire palette. We have to look for the
// closest color.
if (AFormat = sfExcel2) then
expectedRGB := palette[palette.FindClosestColorIndex(expectedRGB, BIFF2_MAX_PALETTE_SIZE)];
CheckEquals(expectedRGB, currentRGB,
'Test saved font color, cell '+CellNotation(MyWorksheet,Row,Col));
end;
@ -283,6 +275,10 @@ begin
MyWorkbook.Free;
DeleteFile(TempFile);
end;
finally
palette.Free;
end;
end;
{ Tests for BIFF2 file format }

35
components/fpspreadsheet/tests/errortests.pas
View File

@ -35,7 +35,7 @@ type
implementation
uses
StrUtils, fpsRPN, xlsbiff5;
StrUtils, fpsPalette, fpsRPN, xlsbiff5;
const
ERROR_SHEET = 'ErrorTest'; //worksheet name
@ -67,6 +67,8 @@ var
ErrList: TStringList;
newColor: TsColor;
expected: integer;
palette: TsPalette;
i: Integer;
begin
formula := '=A1';
@ -122,14 +124,28 @@ begin
MyWorkbook := TsWorkbook.Create;
try
// Prepare a full palette
MyWorkbook.UsePalette(@PALETTE_BIFF5[0], Length(PALETTE_BIFF5));
// Add 1 more color - this is one too many for BIFF5 and 8, and a lot
// too many for BIFF2 !
newColor := MyWorkbook.AddColorToPalette($FF7878);
palette := TsPalette.Create;
try
// Create random palette of 65 unique entries - 1 too many for Excel5/8
// and a lot too many for BIFF2
palette.AddBuiltinColors;
for i:=8 to 65 do
begin
repeat
newColor := random(256) + random(256) shl 8 + random(256) shl 16;
until palette.FindColor(newColor) = -1;
palette.AddColor(newColor);
end;
MyWorkSheet:= MyWorkBook.AddWorksheet(ERROR_SHEET);
MyWorksheet.WriteUTF8Text(0, 0, s);
MyWorksheet.WriteFontColor(0, 0, newColor);
// Use all colors in order to have them in the palette to be written
// to file.
for row := 0 to palette.Count-1 do
begin
MyWorksheet.WriteUTF8Text(row, 0, s);
MyWorksheet.WriteFontColor(row, 0, palette[row]);
end;
TempFile:=NewTempFile;
MyWorkBook.WriteToFile(TempFile, AFormat, true);
@ -141,6 +157,11 @@ begin
// no palette in xml --> no error expected
expected := 0;
CheckEquals(expected, ErrList.Count, 'Error count mismatch in test 3');
finally
palette.Free;
end;
finally
MyWorkbook.Free;
DeleteFile(TempFile);

47
components/fpspreadsheet/tests/formattests.pas
View File

@ -156,7 +156,7 @@ type
implementation
uses
TypInfo, fpsPatches, fpsutils, fpsnumformat, fpscsv;
TypInfo, fpsPatches, fpsutils, fpsnumformat, fpspalette, fpscsv;
const
FmtNumbersSheet = 'NumbersFormat'; //let's distinguish it from the regular numbers sheet
@ -311,7 +311,7 @@ begin
SollBorderLineStyles[5] := lsDouble;
SollBorderLineStyles[6] := lsHair;
SollBorderColors[0] := scBlue;
SollBorderColors[0] := scBlack;
SollBorderColors[1] := scRed;
SollBorderColors[2] := scBlue;
SollBorderColors[3] := scGray;
@ -728,7 +728,6 @@ begin
// Write out all test values
MyWorkbook := TsWorkbook.Create;
try
MyWorkbook.UsePalette(@PALETTE_BIFF8, Length(PALETTE_BIFF8));
MyWorkSheet:= MyWorkBook.AddWorksheet(BackgroundSheet);
for style in TsFillStyle do begin
row := ord(style);
@ -752,7 +751,6 @@ begin
MyWorksheet := GetWorksheetByName(MyWorkBook, BackgroundSheet);
if MyWorksheet=nil then
fail('Error in test code. Failed to get named worksheet');
for style in TsFillStyle do begin
row := ord(style);
@ -770,13 +768,13 @@ begin
begin
if PATTERN_COLOR <> patt.FgColor then
CheckEquals(
MyWorkbook.GetColorName(PATTERN_COLOR),
MyWorkbook.GetColorName(patt.FgColor),
GetColorName(PATTERN_COLOR),
GetColorName(patt.FgColor),
'Test saved fill pattern color mismatch, cell ' + CellNotation(MyWorksheet, row, col));
if BK_COLOR <> patt.BgColor then
CheckEquals(
MyWorkbook.GetColorName(BK_COLOR),
MyWorkbook.GetColorName(patt.BgColor),
GetColorName(BK_COLOR),
GetColorName(patt.BgColor),
'Test saved fill background color mismatch, cell ' + CellNotation(MyWorksheet, row, col));
end;
@ -794,20 +792,20 @@ begin
begin
if PATTERN_COLOR <> patt.FgColor then
CheckEquals(
MyWorkbook.GetColorName(PATTERN_COLOR),
MyWorkbook.GetColorName(patt.FgColor),
GetColorName(PATTERN_COLOR),
GetColorName(patt.FgColor),
'Test saved fill pattern color mismatch, cell ' + CellNotation(MyWorksheet, row, col));
// SolidFill is a special case: here the background color is always equal
// to the pattern color - the cell layout does not know this...
if style = fsSolidFill then
CheckEquals(
MyWorkbook.GetColorName(PATTERN_COLOR),
MyWorkbook.GetColorName(patt.BgColor),
GetColorName(PATTERN_COLOR),
GetColorName(patt.BgColor),
'Test saved fill pattern color mismatch, cell ' + CellNotation(MyWorksheet, row, col))
else
CheckEquals(
MyWorkbook.GetColorName(scTransparent),
MyWorkbook.GetColorName(patt.BgColor),
GetColorName(scTransparent),
GetColorName(patt.BgColor),
'Test saved fill background color mismatch, cell ' + CellNotation(MyWorksheet, row, col));
end;
end;
@ -983,11 +981,11 @@ begin
begin
for col := 1 to 10 do
begin
MyWorksheet.WriteBorders(row*2, col*2, borders);
MyWorksheet.WriteBorders(row*2-1, col*2-1, borders);
for b in borders do
begin
MyWorksheet.WriteBorderLineStyle(row*2, col*2, b, SollBorderLineStyles[ls]);
MyWorksheet.WriteBorderColor(row*2, col*2, b, SollBorderColors[c]);
MyWorksheet.WriteBorderLineStyle(row*2-1, col*2-1, b, SollBorderLineStyles[ls]);
MyWorksheet.WriteBorderColor(row*2-1, col*2-1, b, SollBorderColors[c]);
inc(ls);
if ls > High(SollBorderLineStyles) then
begin
@ -1021,7 +1019,7 @@ begin
begin
for col := 1 to 10 do
begin
MyCell := MyWorksheet.FindCell(row*2, col*2);
MyCell := MyWorksheet.FindCell(row*2-1, col*2-1);
if myCell = nil then
fail('Error in test code. Failed to get cell.');
for b in borders do
@ -1591,7 +1589,12 @@ var
fnt: TsFont;
actual, expected: String;
i: Integer;
palette: TsPalette;
begin
palette := TsPalette.Create;
try
palette.AddBuiltinColors;
MyWorkbook := TsWorkbook.Create;
try
MyWorksheet:= MyWorkBook.AddWorksheet(SHEETNAME);
@ -1600,7 +1603,7 @@ begin
begin
MyWorksheet.WriteNumber(r, c, 123);
MyWorksheet.WriteBackgroundColor(r, c, 0);
MyWorksheet.WriteFont(r, c, 'Times New Roman', FontSizes[r], [], c); // Biff2 has only 8 colors --> re-use the black!
MyWorksheet.WriteFont(r, c, 'Times New Roman', FontSizes[r], [], palette[c]); // Biff2 has only 8 colors --> re-use the black!
// --> in total 64 combinations
end;
TempFile:=NewTempFile;
@ -1631,7 +1634,7 @@ begin
actual := FloatToStr(fnt.Size);
CheckEquals(expected, actual,
'Font size mismatch, cell '+ CellNotation(MyWorksheet, r, c));
expected := IntToStr(c);
expected := IntToStr(palette[c]);
actual := IntToStr(fnt.Color);
CheckEquals(expected, actual,
'Font color mismatch, cell '+ CellNotation(MyWorksheet, r, c));
@ -1641,6 +1644,10 @@ begin
MyWorkbook.Free;
DeleteFile(TempFile);
end;
finally
palette.Free;
end;
end;

75
components/fpspreadsheet/tests/manualtests.pas
View File

@ -63,17 +63,20 @@ type
{$ENDIF}
// For BIFF8 format, writes all background colors in A1..A16
procedure TestBiff8CellBackgroundColor;
procedure TestNumberFormats;
end;
implementation
uses
fpstypes, fpsUtils, rpnFormulaUnit;
fpstypes, fpsUtils, fpsPalette, rpnFormulaUnit;
const
COLORSHEETNAME='color_sheet'; //for background color tests
RPNSHEETNAME='rpn_formula_sheet'; //for rpn formula tests
FORMULASHEETNAME='formula_sheet'; // for string formula tests
NUMBERFORMATSHEETNAME='number format sheet'; // for number format tests
OUTPUT_FORMAT = sfExcel8; //change manually if you want to test different formats. To do: automatically output all formats
var
@ -184,6 +187,7 @@ var
Cell : PCell;
i: cardinal;
RowOffset: cardinal;
palette: TsPalette;
begin
if OUTPUT_FORMAT <> sfExcel8 then
Ignore('This test only applies to BIFF8 XLS output format.');
@ -196,15 +200,74 @@ begin
if Workbook = nil then
Workbook := TsWorkbook.Create;
palette := TsPalette.Create;
try
palette.AddBuiltinColors;
palette.AddExcelColors;
Worksheet := Workbook.AddWorksheet(COLORSHEETNAME);
WorkSheet.WriteUTF8Text(0, 1, 'TSpreadManualTests.TestBiff8CellBackgroundColor');
RowOffset := 1;
for i:=0 to Workbook.GetPaletteSize-1 do begin
WorkSheet.WriteUTF8Text(i+RowOffset,0,'BACKGROUND COLOR TEST');
Cell := Worksheet.GetCell(i+RowOffset, 0);
Worksheet.WriteBackgroundColor(Cell, TsColor(i));
WorkSheet.WriteUTF8Text(i+RowOffset,1,'Cell to the left should be '+Workbook.GetColorName(i)+'. Please check.');
for i:=0 to palette.Count-1 do begin
cell := WorkSheet.WriteUTF8Text(i+RowOffset,0,'BACKGROUND COLOR TEST');
Worksheet.WriteBackgroundColor(Cell, palette[i]);
Worksheet.WriteFontColor(cell, HighContrastColor(palette[i]));
WorkSheet.WriteUTF8Text(i+RowOffset,1,'Cell to the left should be '+GetColorName(palette[i])+'. Please check.');
end;
Worksheet.WriteColWidth(0, 30);
Worksheet.WriteColWidth(1, 60);
finally
palette.Free;
end;
end;
procedure TSpreadManualTests.TestNumberFormats();
// source: forum post
// http://forum.lazarus.freepascal.org/index.php/topic,19887.msg134114.html#msg134114
// possible fix for values there too
const
Values: Array[0..4] of Double = (12000.34, -12000.34, 0.0001234, -0.0001234, 0.0);
FormatStrings: array[0..24] of String = (
'General',
'0', '0.00', '0.0000',
'#,##0', '#,##0.00', '#,##0.0000',
'0%', '0.00%', '0.0000%',
'0,', '0.00,', '0.0000,',
'0E+00', '0.00E+00', '0.0000E+00',
'0E-00', '0.00E-00', '0.0000E-00',
'# ?/?', '# ??/??', '# ????/????',
'?/?', '??/??', '????/????'
);
var
Worksheet: TsWorksheet;
Cell : PCell;
i: cardinal;
r, c: Cardinal;
palette: TsPalette;
nfs: String;
begin
if OUTPUT_FORMAT <> sfExcel8 then
Ignore('This test only applies to BIFF8 XLS output format.');
// No worksheets in BIFF2. Since main interest is here in formulas we just jump
// off here - need to change this in the future...
if OUTPUT_FORMAT = sfExcel2 then
Ignore('BIFF2 does not support worksheets. Ignoring manual tests for now');
if Workbook = nil then
Workbook := TsWorkbook.Create;
Worksheet := Workbook.AddWorksheet(NUMBERFORMATSHEETNAME);
WorkSheet.WriteUTF8Text(0, 1, 'Number format tests');
for r:=0 to High(FormatStrings) do
begin
Worksheet.WriteUTF8Text(r+2, 0, FormatStrings[r]);
for c:=0 to High(Values) do
Worksheet.WriteNumber(r+2, c+1, values[c], nfCustom, FormatStrings[r]);
end;
Worksheet.WriteColWidth(0, 20);
end;
{$IFDEF FPSPREAD_HAS_NEWRPNSUPPORT}

12
components/fpspreadsheet/wikitable.pas
View File

@ -270,7 +270,8 @@ begin
if copy(lFormatstr, 1, 6) = 'color:' then
begin
lColorstr := Copy(lFormatstr, 7, Length(lFormatStr));
lCurBackgroundColor := FWorkbook.AddColorToPalette(HTMLColorStrToColor(lColorStr));
lCurBackgroundColor := HTMLColorStrToColor(lColorStr);
// lCurBackgroundColor := FWorkbook.AddColorToPalette(HTMLColorStrToColor(lColorStr));
lUseBackgroundColor := True;
lFormatStr := '';
end;
@ -381,7 +382,8 @@ procedure TsWikiTableWriter.WriteToStrings_WikiMedia(AStrings: TStrings);
clr := fmt^.BorderStyles[ABorder].Color;
Result := Format('border-%s:%s', [BORDERNAMES[ABorder], LINESTYLES[ls]]);
if clr <> scBlack then
Result := Result + ' ' + FWorkbook.GetPaletteColorAsHTMLStr(clr) + '; ';
Result := Result + ' ' + ColorToHTMLColorStr(clr) + '; ';
// Result := Result + ' ' + FWorkbook.GetPaletteColorAsHTMLStr(clr) + '; ';
end;
const
@ -499,8 +501,10 @@ begin
begin
lCurColor := FWorksheet.ReadBackgroundColor(lCell);
lStyleStr := Format('background-color:%s;color:%s;', [
FWorkbook.GetPaletteColorAsHTMLStr(lCurColor),
FWorkbook.GetPaletteColorAsHTMLStr(lFont.Color)
ColorToHTMLColorStr(lCurColor),
ColorToHTMLColorStr(lFont.Color)
// FWorkbook.GetPaletteColorAsHTMLStr(lCurColor),
// FWorkbook.GetPaletteColorAsHTMLStr(lFont.Color)
]);
end;

14
components/fpspreadsheet/xlsbiff2.pas
View File

@ -144,7 +144,7 @@ var
var
{ the palette of the default BIFF2 colors as "big-endian color" values }
PALETTE_BIFF2: array[$0..$07] of TsColorValue = (
PALETTE_BIFF2: array[$0..$07] of TsColor = (
$000000, // $00: black
$FFFFFF, // $01: white
$FF0000, // $02: red
@ -159,7 +159,7 @@ var
implementation
uses
Math, fpsStrings, fpsReaderWriter;
Math, fpsStrings, fpsReaderWriter, fpsPalette;
const
{ Excel record IDs }
@ -419,8 +419,12 @@ begin
end;
procedure TsSpreadBIFF2Reader.ReadFONTCOLOR(AStream: TStream);
var
lColor: Word;
begin
FFont.Color := WordLEToN(AStream.ReadWord);
lColor := WordLEToN(AStream.ReadWord); // Palette index
FFont.Color := IfThen(lColor = SYS_DEFAULT_WINDOW_TEXT_COLOR,
scBlack, FPalette[lColor]);
end;
{@@ ----------------------------------------------------------------------------
@ -1533,7 +1537,7 @@ begin
AStream.WriteWord(WordToLE(2));
{ Font color index, only first 8 palette entries allowed! }
AStream.WriteWord(WordToLE(word(FixColor(font.Color))));
AStream.WriteWord(WordToLE(PaletteIndex(font.Color)));
end;
{@@ ----------------------------------------------------------------------------
@ -1987,6 +1991,6 @@ initialization
{$ENDIF}
RegisterSpreadFormat(TsSpreadBIFF2Reader, TsSpreadBIFF2Writer, sfExcel2);
MakeLEPalette(@PALETTE_BIFF2, Length(PALETTE_BIFF2));
MakeLEPalette(PALETTE_BIFF2);
end.

116
components/fpspreadsheet/xlsbiff5.pas
View File

@ -77,6 +77,7 @@ type
FWorksheetNames: TStringList;
FCurrentWorksheet: Integer;
protected
procedure PopulatePalette; override;
{ Record writing methods }
procedure ReadBoundsheet(AStream: TStream);
procedure ReadFONT(const AStream: TStream);
@ -137,7 +138,7 @@ var
var
// the palette of the default BIFF5 colors as "big-endian color" values
PALETTE_BIFF5: array[$00..$3F] of TsColorValue = (
PALETTE_BIFF5: array[$00..$3F] of TsColor = (
$000000, // $00: black
$FFFFFF, // $01: white
$FF0000, // $02: red
@ -213,7 +214,7 @@ var
implementation
uses
fpsStrings, fpsStreams, fpsReaderWriter;
Math, fpsStrings, fpsStreams, fpsReaderWriter, fpsPalette;
const
{ Excel record IDs }
@ -337,6 +338,15 @@ type
{ TsSpreadBIFF5Reader }
{@@ ----------------------------------------------------------------------------
Populates the reader's default palette using the BIFF5 default colors.
-------------------------------------------------------------------------------}
procedure TsSpreadBIFF5Reader.PopulatePalette;
begin
FPalette.Clear;
FPalette.UseColors(PALETTE_BIFF5);
end;
procedure TsSpreadBIFF5Reader.ReadWorkbookGlobals(AStream: TStream);
var
SectionEOF: Boolean = False;
@ -370,6 +380,9 @@ begin
// Check for the end of the file
if AStream.Position >= AStream.Size then SectionEOF := True;
end;
// Convert palette indexes to rgb colors
FixColors;
end;
procedure TsSpreadBIFF5Reader.ReadWorksheet(AStream: TStream);
@ -606,8 +619,7 @@ procedure TsSpreadBIFF5Reader.ReadXF(AStream: TStream);
var
rec: TBIFF5_XFRecord;
fmt: TsCellFormat;
// nfidx: Integer;
i: Integer;
i, cidx: Integer;
nfparams: TsNumFormatParams;
nfs: String;
b: Byte;
@ -646,28 +658,7 @@ begin
Include(fmt.UsedFormattingFields, uffNumberFormat);
end;
end;
{
// Number format index
nfparams := Workbook.GetNumberFormat(rec.NumFormatIndex);
nfs := nfParams.NumFormatStr[nfdDefault];
if nfs <> '' then begin
fmt.NumberFormatIndex := Workbook.AddNumberFormat(nfs);
fmt.NumberFormat := nfParams.NumFormat;
fmt.NumberFormatStr := nfs;
Include(fmt.UsedFormattingFields, uffNumberFormat);
end;
}
{
nfidx := WordLEToN(rec.NumFormatIndex);
i := NumFormatList.FindByIndex(nfidx);
if i > -1 then begin
nfdata := NumFormatList.Items[i];
fmt.NumberFormat := nfdata.NumFormat;
fmt.NumberFormatStr := nfdata.FormatString;
if nfdata.NumFormat <> nfGeneral then
Include(fmt.UsedFormattingFields, uffNumberFormat);
end;
}
// Horizontal text alignment
b := rec.Align_TextBreak AND MASK_XF_HOR_ALIGN;
if (b <= ord(High(TsHorAlignment))) then
@ -742,10 +733,17 @@ begin
end;
// Border line colors
fmt.BorderStyles[cbWest].Color := (rec.Border_BkGr2 and MASK_XF_BORDER_LEFT_COLOR) shr 16;
fmt.BorderStyles[cbEast].Color := (rec.Border_BkGr2 and MASK_XF_BORDER_RIGHT_COLOR) shr 23;
fmt.BorderStyles[cbNorth].Color := (rec.Border_BkGr2 and MASK_XF_BORDER_TOP_COLOR) shr 9;
fmt.BorderStyles[cbSouth].Color := (rec.Border_BkGr1 and MASK_XF_BORDER_BOTTOM_COLOR) shr 25;
// NOTE: It is possible that the palette is not yet known at this moment.
// Therefore we store the palette index encoded into the colors.
// They will be converted to rgb in "FixColors".
cidx := (rec.Border_BkGr2 and MASK_XF_BORDER_LEFT_COLOR) shr 16;
fmt.BorderStyles[cbWest].Color := IfThen(cidx >= 64, scBlack, SetAsPaletteIndex(cidx));
cidx := (rec.Border_BkGr2 and MASK_XF_BORDER_RIGHT_COLOR) shr 23;
fmt.BorderStyles[cbEast].Color := IfThen(cidx >= 64, scBlack, SetAsPaletteIndex(cidx));
cidx := (rec.Border_BkGr2 and MASK_XF_BORDER_TOP_COLOR) shr 9;
fmt.BorderStyles[cbNorth].Color := IfThen(cidx >= 64, scBlack, SetAsPaletteIndex(cidx));
cidx := (rec.Border_BkGr1 and MASK_XF_BORDER_BOTTOM_COLOR) shr 25;
fmt.BorderStyles[cbSouth].Color := IfThen(cidx >= 64, scBlack, SetAsPaletteIndex(cidx));
// Background
fill := (rec.Border_BkGr1 and MASK_XF_BKGR_FILLPATTERN) shr 16;
@ -758,12 +756,12 @@ begin
// Fill style
fmt.Background.Style := fs;
// Pattern color
fmt.Background.FgColor := rec.Border_BkGr1 and MASK_XF_BKGR_PATTERN_COLOR;
if fmt.Background.FgColor = SYS_DEFAULT_FOREGROUND_COLOR then
fmt.Background.FgColor := scBlack;
fmt.Background.BgColor := (rec.Border_BkGr1 and MASK_XF_BKGR_BACKGROUND_COLOR) shr 7;
if fmt.Background.BgColor = SYS_DEFAULT_BACKGROUND_COLOR then
fmt.Background.BgColor := scTransparent;
cidx := rec.Border_BkGr1 and MASK_XF_BKGR_PATTERN_COLOR; // Palette index
fmt.Background.FgColor := IfThen(cidx = SYS_DEFAULT_FOREGROUND_COLOR,
scBlack, SetAsPaletteIndex(cidx));
cidx := (rec.Border_BkGr1 and MASK_XF_BKGR_BACKGROUND_COLOR) shr 7;
fmt.Background.BgColor := IfThen(cidx = SYS_DEFAULT_BACKGROUND_COLOR,
scTransparent, SetAsPaletteIndex(cidx));
Include(fmt.UsedFormattingFields, uffBackground);
break;
end;
@ -785,14 +783,12 @@ begin
BIFF5EOF := False;
{ Read workbook globals }
ReadWorkbookGlobals(AStream);
// Check for the end of the file
{ Check for the end of the file }
if AStream.Position >= AStream.Size then BIFF5EOF := True;
{ Now read all worksheets }
while (not BIFF5EOF) do
begin
ReadWorksheet(AStream);
@ -807,11 +803,7 @@ begin
// at the end of the file.
end;
if not FPaletteFound then
FWorkbook.UsePalette(@PALETTE_BIFF5, Length(PALETTE_BIFF5));
{ Finalizations }
{ Finalization }
FWorksheetNames.Free;
end;
@ -840,10 +832,21 @@ begin
if lOptions and $0004 <> 0 then Include(font.Style, fssUnderline);
if lOptions and $0008 <> 0 then Include(font.Style, fssStrikeout);
{ Colour index }
{ Color index }
// The problem is that the palette is loaded after the font list; therefore
// we do not know the rgb color of the font here. We store the palette index
// ("SetAsPaletteIndex") and replace it by the rgb color at the end of the
// workbook globals records. As an indicator that the font does not yet
// contain an rgb color a control bit is set in the high-byte of the TsColor.
lColor := WordLEToN(AStream.ReadWord);
//font.Color := TsColor(lColor - 8); // Palette colors have an offset 8
font.Color := tsColor(lColor);
if lColor < 8 then
// Use built-in colors directly otherwise the Workbook's FindFont would not find the font in ReadXF
font.Color := FPalette[lColor]
else
if lColor = SYS_DEFAULT_WINDOW_TEXT_COLOR then
font.Color := scBlack
else
font.Color := SetAsPaletteIndex(lColor);
{ Font weight }
lWeight := WordLEToN(AStream.ReadWord);
@ -1197,6 +1200,7 @@ procedure TsSpreadBIFF5Writer.WriteFont(AStream: TStream; AFont: TsFont);
var
Len: Byte;
optn: Word;
cidx: Integer;
begin
if AFont = nil then // this happens for FONT4 in case of BIFF
exit;
@ -1222,8 +1226,8 @@ begin
if fssStrikeout in AFont.Style then optn := optn or $0008;
AStream.WriteWord(WordToLE(optn));
{ Colour index }
AStream.WriteWord(WordToLE(ord(FixColor(AFont.Color))));
{ Color index }
AStream.WriteWord(WordToLE(PaletteIndex(AFont.Color)));
{ Font weight }
if fssBold in AFont.Style then
@ -1574,19 +1578,19 @@ begin
begin
if (AFormatRecord^.Background.FgColor = scTransparent)
then dw1 := dw1 or (SYS_DEFAULT_FOREGROUND_COLOR and $0000007F)
else dw1 := dw1 or (FixColor(AFormatRecord^.Background.FgColor) and $0000007F);
else dw1 := dw1 or (PaletteIndex(AFormatRecord^.Background.FgColor) and $0000007F);
if AFormatRecord^.Background.BgColor = scTransparent
then dw1 := dw1 or (SYS_DEFAULT_BACKGROUND_COLOR shl 7)
else dw1 := dw1 or (FixColor(AFormatRecord^.Background.BgColor) shl 7);
else dw1 := dw1 or (PaletteIndex(AFormatRecord^.Background.BgColor) shl 7);
dw1 := dw1 or (MASK_XF_FILL_PATT[AFormatRecord^.Background.Style] shl 16);
end;
// Border lines
if (uffBorder in AFormatRecord^.UsedFormattingFields) then
begin
dw1 := dw1 or (AFormatRecord^.BorderStyles[cbSouth].Color shl 25); // Bottom line color
dw2 := (FixColor(AFormatRecord^.BorderStyles[cbNorth].Color) shl 9) or // Top line color
(FixColor(AFormatRecord^.BorderStyles[cbWest].Color) shl 16) or // Left line color
(FixColor(AFormatRecord^.BorderStyles[cbEast].Color) shl 23); // Right line color
dw1 := dw1 or PaletteIndex(AFormatRecord^.BorderStyles[cbSouth].Color) shl 25; // Bottom line color
dw2 := (PaletteIndex(AFormatRecord^.BorderStyles[cbNorth].Color) shl 9) or // Top line color
(PaletteIndex(AFormatRecord^.BorderStyles[cbWest].Color) shl 16) or // Left line color
(PaletteIndex(AFormatRecord^.BorderStyles[cbEast].Color) shl 23); // Right line color
if cbSouth in AFormatRecord^.Border then
dw1 := dw1 or ((DWord(AFormatRecord^.BorderStyles[cbSouth].LineStyle)+1) shl 22);
if cbNorth in AFormatRecord^.Border then
@ -1612,7 +1616,7 @@ initialization
{$ENDIF}
RegisterSpreadFormat(TsSpreadBIFF5Reader, TsSpreadBIFF5Writer, sfExcel5);
MakeLEPalette(@PALETTE_BIFF5, Length(PALETTE_BIFF5));
MakeLEPalette(PALETTE_BIFF5);
end.

213
components/fpspreadsheet/xlsbiff8.pas
View File

@ -84,6 +84,7 @@ type
procedure ReadBoundsheet(AStream: TStream);
function ReadString(const AStream: TStream; const ALength: WORD): String;
protected
procedure PopulatePalette; override;
procedure ReadCONTINUE(const AStream: TStream);
procedure ReadFONT(const AStream: TStream);
procedure ReadFORMAT(AStream: TStream); override;
@ -181,7 +182,7 @@ var
var
// the palette of the 64 default BIFF8 colors as "big-endian color" values
PALETTE_BIFF8: array[$00..$3F] of TsColorValue = (
PALETTE_BIFF8: array[$00..$3F] of TsColor = (
$000000, // $00: black // 8 built-in default colors
$FFFFFF, // $01: white
$FF0000, // $02: red
@ -191,72 +192,73 @@ var
$FF00FF, // $06: magenta
$00FFFF, // $07: cyan
$000000, // $08: EGA black
$FFFFFF, // $09: EGA white
$FF0000, // $0A: EGA red
$00FF00, // $0B: EGA green
$0000FF, // $0C: EGA blue
$FFFF00, // $0D: EGA yellow
$FF00FF, // $0E: EGA magenta
$00FFFF, // $0F: EGA cyan
$000000, // $08: EGA black 1
$FFFFFF, // $09: EGA white 2
$FF0000, // $0A: EGA red 3
$00FF00, // $0B: EGA green 4
$0000FF, // $0C: EGA blue 5
$FFFF00, // $0D: EGA yellow 6
$FF00FF, // $0E: EGA magenta 7 pink
$00FFFF, // $0F: EGA cyan 8 turqoise
$800000, // $10: EGA dark red
$008000, // $11: EGA dark green
$000080, // $12: EGA dark blue
$808000, // $13: EGA olive
$800080, // $14: EGA purple
$008080, // $15: EGA teal
$C0C0C0, // $16: EGA silver
$808080, // $17: EGA gray
$9999FF, // $18:
$993366, // $19:
$FFFFCC, // $1A:
$CCFFFF, // $1B:
$660066, // $1C:
$FF8080, // $1D:
$0066CC, // $1E:
$CCCCFF, // $1F:
$800000, // $10=16: EGA dark red 9
$008000, // $11=17: EGA dark green 10
$000080, // $12=18: EGA dark blue 11
$808000, // $13=19: EGA olive 12 dark yellow
$800080, // $14=20: EGA purple 13 violet
$008080, // $15=21: EGA teal 14
$C0C0C0, // $16=22: EGA silver 15 gray 25%
$808080, // $17=23: EGA gray 16 gray 50%
$9999FF, // $18=24: Periwinkle
$993366, // $19=25: Plum
$FFFFCC, // $1A=26: Ivory
$CCFFFF, // $1B=27: Light turquoise
$660066, // $1C=28: Dark purple
$FF8080, // $1D=29: Coral
$0066CC, // $1E=30: Ocean blue
$CCCCFF, // $1F=31: Ice blue
$000080, // $20:
$FF00FF, // $21:
$FFFF00, // $22:
$00FFFF, // $23:
$800080, // $24:
$800000, // $25:
$008080, // $26:
$0000FF, // $27:
$00CCFF, // $28:
$CCFFFF, // $29:
$CCFFCC, // $2A:
$FFFF99, // $2B:
$99CCFF, // $2C:
$FF99CC, // $2D:
$CC99FF, // $2E:
$FFCC99, // $2F:
$000080, // $20=32: Navy (repeated)
$FF00FF, // $21=33: Pink (magenta repeated)
$FFFF00, // $22=34: Yellow (repeated)
$00FFFF, // $23=35: Turqoise (=cyan repeated)
$800080, // $24=36: Purple (repeated)
$800000, // $25=37: Dark red (repeated)
$008080, // $26=38: Teal (repeated)
$0000FF, // $27=39: Blue (repeated)
$00CCFF, // $28=40: Sky blue
$CCFFFF, // $29=41: Light turquoise (repeated)
$CCFFCC, // $2A=42: Light green
$FFFF99, // $2B=43: Light yellow
$99CCFF, // $2C=44: Pale blue
$FF99CC, // $2D=45: rose
$CC99FF, // $2E=46: lavander
$FFCC99, // $2F=47: tan
$3366FF, // $30:
$33CCCC, // $31:
$99CC00, // $32:
$FFCC00, // $33:
$FF9900, // $34:
$FF6600, // $35:
$666699, // $36:
$969696, // $37:
$003366, // $38:
$339966, // $39:
$003300, // $3A:
$333300, // $3B:
$993300, // $3C:
$993366, // $3D:
$333399, // $3E:
$333333 // $3F:
$3366FF, // $30=48: Light blue
$33CCCC, // $31=49: Aqua
$99CC00, // $32=50: Lime
$FFCC00, // $33=51: Gold
$FF9900, // $34=52: Light orange
$FF6600, // $35=53: Orange
$666699, // $36=54: Blue gray
$969696, // $37=55: Gray 40%
$003366, // $38=56: Dark teal
$339966, // $39=57: Sea green
$003300, // $3A=58: very dark green
$333300, // $3B=59: olive green
$993300, // $3C=60: brown
$993366, // $3D=61: plum
$333399, // $3E=62: indigo
$333333 // $3F=63: gray 80%
);
// color names according to http://dmcritchie.mvps.org/EXCEL/COLORS.HTM
implementation
uses
Math, lconvencoding, LazFileUtils, URIParser,
fpsStrings, fpsStreams, fpsReaderWriter, fpsExprParser, xlsEscher;
fpsStrings, fpsStreams, fpsReaderWriter, fpsPalette, fpsExprParser, xlsEscher;
const
{ Excel record IDs }
@ -429,10 +431,21 @@ begin
inherited;
end;
{ Reads a CONTINUE record. If the Flag "FCommentPending" is active then this
{@@ ----------------------------------------------------------------------------
Populates the reader's default palette using the BIFF8 default colors.
-------------------------------------------------------------------------------}
procedure TsSpreadBIFF8Reader.PopulatePalette;
begin
FPalette.Clear;
FPalette.UseColors(PALETTE_BIFF8);
end;
{@@ ----------------------------------------------------------------------------
Reads a CONTINUE record. If the Flag "FCommentPending" is active then this
record contains the text of a comment assigned to a cell. The length of the
string is taken from the preceeding TXO record, and the ID of the comment is
extracted in another preceeding record, an OBJ record. }
extracted in another preceeding record, an OBJ record.
-------------------------------------------------------------------------------}
procedure TsSpreadBIFF8Reader.ReadCONTINUE(const AStream: TStream);
var
commentStr: String;
@ -657,6 +670,9 @@ begin
// Check for the end of the file
if AStream.Position >= AStream.Size then SectionEOF := True;
end;
// Convert palette indexes to rgb colors
FixColors;
end;
procedure TsSpreadBIFF8Reader.ReadWorksheet(AStream: TStream);
@ -839,9 +855,6 @@ begin
// at the end of the file.
end;
if not FPaletteFound then
FWorkbook.UsePalette(@PALETTE_BIFF8, Length(PALETTE_BIFF8));
{ Finalizations }
FWorksheetNames.Free;
end;
@ -1206,6 +1219,7 @@ var
nfs: String;
nfParams: TsNumFormatParams;
i: Integer;
iclr: Integer;
fnt: TsFont;
begin
InitFormatRecord(fmt);
@ -1326,29 +1340,39 @@ begin
end;
// Border line colors
fmt.BorderStyles[cbWest].Color := (rec.Border_BkGr1 and MASK_XF_BORDER_LEFT_COLOR) shr 16;
fmt.BorderStyles[cbEast].Color := (rec.Border_BkGr1 and MASK_XF_BORDER_RIGHT_COLOR) shr 23;
fmt.BorderStyles[cbNorth].Color := (rec.Border_BkGr2 and MASK_XF_BORDER_TOP_COLOR);
fmt.BorderStyles[cbSouth].Color := (rec.Border_BkGr2 and MASK_XF_BORDER_BOTTOM_COLOR) shr 7;
fmt.BorderStyles[cbDiagUp].Color := (rec.Border_BkGr2 and MASK_XF_BORDER_DIAGONAL_COLOR) shr 14;
// NOTE: It is possible that the palette is not yet known at this moment.
// Therefore we store the palette index encoded into the colorx.
// They will be converted to rgb in "FixColors".
iclr := (rec.Border_BkGr1 and MASK_XF_BORDER_LEFT_COLOR) shr 16;
fmt.BorderStyles[cbWest].Color := IfThen(iclr >= 64, scBlack, SetAsPaletteIndex(iclr));
iclr := (rec.Border_BkGr1 and MASK_XF_BORDER_RIGHT_COLOR) shr 23;
fmt.BorderStyles[cbEast].Color := IfThen(iclr >= 64, scBlack, SetAsPaletteIndex(iclr));
iclr := (rec.Border_BkGr2 and MASK_XF_BORDER_TOP_COLOR);
fmt.BorderStyles[cbNorth].Color := IfThen(iclr >= 64, scBlack, SetAsPaletteIndex(iclr));
iclr := (rec.Border_BkGr2 and MASK_XF_BORDER_BOTTOM_COLOR) shr 7;
fmt.BorderStyles[cbSouth].Color := IfThen(iclr >= 64, scBlack, SetAsPaletteIndex(iclr));
iclr := (rec.Border_BkGr2 and MASK_XF_BORDER_DIAGONAL_COLOR) shr 14;
fmt.BorderStyles[cbDiagUp].Color := IfThen(iclr >= 64, scBlack, SetAsPaletteIndex(iclr));
fmt.BorderStyles[cbDiagDown].Color := fmt.BorderStyles[cbDiagUp].Color;
// Background fill pattern and color
fill := (rec.Border_BkGr2 and MASK_XF_BACKGROUND_PATTERN) shr 26;
if fill <> MASK_XF_FILL_PATT_EMPTY then
begin
rec.BkGr3 := DWordLEToN(rec.BkGr3);
for fs in TsFillStyle do
if fill = MASK_XF_FILL_PATT[fs] then
begin
rec.BkGr3 := DWordLEToN(rec.BkGr3);
// Pattern color
fmt.Background.FgColor := rec.BkGr3 and $007F;
if fmt.Background.FgColor = SYS_DEFAULT_FOREGROUND_COLOR then
fmt.Background.FgColor := scBlack;
iclr := rec.BkGr3 and $007F;
fmt.Background.FgColor := IfThen(iclr = SYS_DEFAULT_FOREGROUND_COLOR,
scBlack, SetAsPaletteIndex(iclr));
// Background color
fmt.Background.BgColor := (rec.BkGr3 and $3F80) shr 7;
if fmt.Background.BgColor = SYS_DEFAULT_BACKGROUND_COLOR then
fmt.Background.BgColor := scTransparent;
iclr := (rec.BkGr3 and $3F80) shr 7;
fmt.Background.BgColor := IfThen(iclr = SYS_DEFAULT_BACKGROUND_COLOR,
scTransparent, SetAsPaletteIndex(iclr));
// Fill style
fmt.Background.Style := fs;
Include(fmt.UsedFormattingFields, uffBackground);
@ -1374,7 +1398,7 @@ begin
font := TsFont.Create;
{ Height of the font in twips = 1/20 of a point }
lHeight := WordLEToN(AStream.ReadWord); // WordToLE(200)
lHeight := WordLEToN(AStream.ReadWord);
font.Size := lHeight/20;
{ Option flags }
@ -1385,10 +1409,21 @@ begin
if lOptions and $0004 <> 0 then Include(font.Style, fssUnderline);
if lOptions and $0008 <> 0 then Include(font.Style, fssStrikeout);
{ Colour index }
{ Color index }
// The problem is that the palette is loaded after the font list; therefore
// we do not know the rgb color of the font here. We store the palette index
// ("SetAsPaletteIndex") and replace it by the rgb color at the end of the
// workbook globals records. As an indicator that the font does not yet
// contain an rgb color a control bit is set in the high-byte of the TsColor.
lColor := WordLEToN(AStream.ReadWord);
//font.Color := TsColor(lColor - 8); // Palette colors have an offset 8
font.Color := tsColor(lColor);
if lColor < 8 then
// Use built-in colors directly otherwise the Workbook's FindFont would not find the font in ReadXF
font.Color := FPalette[lColor]
else
if lColor = SYS_DEFAULT_WINDOW_TEXT_COLOR then
font.Color := scBlack
else
font.Color := SetAsPaletteIndex(lColor);
{ Font weight }
lWeight := WordLEToN(AStream.ReadWord);
@ -1983,8 +2018,8 @@ begin
if fssStrikeout in AFont.Style then optn := optn or $0008;
AStream.WriteWord(WordToLE(optn));
{ Colour index }
AStream.WriteWord(WordToLE(ord(FixColor(AFont.Color))));
{ Color index }
AStream.WriteWord(WordToLE(PaletteIndex(AFont.Color)));
{ Font weight }
if fssBold in AFont.Style then
@ -3005,8 +3040,8 @@ begin
if (AFormatRecord <> nil) and (uffBorder in AFormatRecord^.UsedFormattingFields) then
begin
// Left and right line colors
dw1 := AFormatRecord^.BorderStyles[cbWest].Color shl 16 +
AFormatRecord^.BorderStyles[cbEast].Color shl 23;
dw1 := PaletteIndex(AFormatRecord^.BorderStyles[cbWest].Color) shl 16 +
PaletteIndex(AFormatRecord^.BorderStyles[cbEast].Color) shl 23;
// Border line styles
if cbWest in AFormatRecord^.Border then
dw1 := dw1 or (DWord(AFormatRecord^.BorderStyles[cbWest].LineStyle)+1);
@ -3022,9 +3057,9 @@ begin
dw1 := dw1 or $80000000;
// Top, bottom and diagonal line colors
dw2 := FixColor(AFormatRecord^.BorderStyles[cbNorth].Color) +
FixColor(AFormatRecord^.BorderStyles[cbSouth].Color) shl 7 +
FixColor(AFormatRecord^.BorderStyles[cbDiagUp].Color) shl 14;
dw2 := PaletteIndex(AFormatRecord^.BorderStyles[cbNorth].Color) +
PaletteIndex(AFormatRecord^.BorderStyles[cbSouth].Color) shl 7 +
PaletteIndex(AFormatRecord^.BorderStyles[cbDiagUp].Color) shl 14;
// In BIFF8 both diagonals have the same color - we use the color of the up-diagonal.
// Diagonal line style
@ -3041,11 +3076,11 @@ begin
// Pattern color
if AFormatRecord^.Background.FgColor = scTransparent
then w3 := w3 or SYS_DEFAULT_FOREGROUND_COLOR
else w3 := w3 or FixColor(AFormatRecord^.Background.FgColor);
else w3 := w3 or PaletteIndex(AFormatRecord^.Background.FgColor);
// Background color
if AFormatRecord^.Background.BgColor = scTransparent
then w3 := w3 or SYS_DEFAULT_BACKGROUND_COLOR shl 7
else w3 := w3 or (FixColor(AFormatRecord^.Background.BgColor) shl 7);
else w3 := w3 or (PaletteIndex(AFormatRecord^.Background.BgColor) shl 7);
end;
rec.Border_BkGr1 := DWordToLE(dw1);
@ -3063,7 +3098,7 @@ initialization
RegisterSpreadFormat(TsSpreadBIFF8Reader, TsSpreadBIFF8Writer, sfExcel8);
// Converts the palette to litte-endian
MakeLEPalette(@PALETTE_BIFF8, Length(PALETTE_BIFF8));
MakeLEPalette(PALETTE_BIFF8);
end.

168
components/fpspreadsheet/xlscommon.pas
View File

@ -11,7 +11,7 @@ interface
uses
Classes, SysUtils, DateUtils, lconvencoding,
fpsTypes, fpSpreadsheet, fpsUtils, fpsNumFormatParser,
fpsTypes, fpSpreadsheet, fpsUtils, fpsNumFormatParser, fpsPalette,
fpsReaderWriter;
const
@ -211,7 +211,7 @@ const
{ System colors, for BIFF5-BIFF8 }
SYS_DEFAULT_FOREGROUND_COLOR = $0040;
SYS_DEFAULT_BACKGROUND_COLOR = $0041;
SYS_DEFAULT_WINDOW_TEXT_COLOR = $7FFF;
{ Error codes }
ERR_INTERSECTION_EMPTY = $00; // #NULL!
@ -348,11 +348,11 @@ type
RecordSize: Word;
FCodepage: string; // in a format prepared for lconvencoding.ConvertEncoding
FDateMode: TDateMode;
FPaletteFound: Boolean;
FIncompleteCell: PCell;
FIncompleteNote: String;
FIncompleteNoteLength: Word;
FFirstNumFormatIndexInFile: Integer;
FPalette: TsPalette;
procedure AddBuiltinNumFormats; override;
procedure ApplyCellFormatting(ACell: PCell; XFIndex: Word); virtual; //overload;
// Extracts a number out of an RK value
@ -360,9 +360,12 @@ type
// Returns the numberformat for a given XF record
procedure ExtractNumberFormat(AXFIndex: WORD;
out ANumberFormat: TsNumberFormat; out ANumberFormatStr: String); virtual;
procedure FixColors;
// Tries to find if a number cell is actually a date/datetime/time cell and retrieves the value
function IsDateTime(Number: Double; ANumberFormat: TsNumberFormat;
ANumberFormatStr: String; out ADateTime: TDateTime): Boolean;
procedure PopulatePalette; virtual;
// Here we can add reading of records which didn't change across BIFF5-8 versions
// Read a blank cell
procedure ReadBlank(AStream: TStream); override;
@ -433,6 +436,7 @@ type
public
constructor Create(AWorkbook: TsWorkbook); override;
destructor Destroy; override;
end;
@ -443,12 +447,13 @@ type
FDateMode: TDateMode;
FCodePage: String; // in a format prepared for lconvencoding.ConvertEncoding
FFirstNumFormatIndexInFile: Integer;
FPalette: TsPalette;
procedure AddBuiltinNumFormats; override;
function FindXFIndex(ACell: PCell): Integer; virtual;
function FixColor(AColor: TsColor): TsColor; override;
function GetLastRowIndex(AWorksheet: TsWorksheet): Integer;
function GetLastColIndex(AWorksheet: TsWorksheet): Word;
function GetPrintOptions: Word; virtual;
function PaletteIndex(AColor: TsColor): Word;
// Helper function for writing the BIFF header
procedure WriteBIFFHeader(AStream: TStream; ARecID, ARecSize: Word);
@ -548,6 +553,8 @@ type
public
constructor Create(AWorkbook: TsWorkbook); override;
destructor Destroy; override;
procedure CheckLimitations; override;
end;
procedure AddBuiltinBiffFormats(AList: TStringList;
@ -773,16 +780,31 @@ end;
constructor TsSpreadBIFFReader.Create(AWorkbook: TsWorkbook);
begin
inherited Create(AWorkbook);
FPalette := TsPalette.Create;
PopulatePalette;
FCellFormatList := TsCellFormatList.Create(true);
// Allow duplicates! XF indexes get out of sync if not all format records are in list
// true = allow duplicates! XF indexes get out of sync if not all format records are in list
// Initial base date in case it won't be read from file
FDateMode := dm1900;
// Limitations of BIFF5 and BIFF8 file format
FLimitations.MaxColCount := 256;
FLimitations.MaxRowCount := 65536;
FLimitations.MaxPaletteSize := 64;
end;
{@@ ----------------------------------------------------------------------------
Destructor of the reader class
-------------------------------------------------------------------------------}
destructor TsSpreadBIFFReader.Destroy;
begin
FPalette.Free;
inherited Destroy;
end;
{@@ ----------------------------------------------------------------------------
Adds the built-in number formats to the NumFormatList.
Valid for BIFF5...BIFF8. Needs to be overridden for BIFF2.
@ -814,7 +836,6 @@ begin
end;
end;
{@@ ----------------------------------------------------------------------------
Extracts a number out of an RK value.
Valid since BIFF3.
@ -871,6 +892,47 @@ begin
end;
end;
{@@ ----------------------------------------------------------------------------
It is a problem of the biff file structure that the font is loaded before the
palette. Therefore, when reading the font, we cannot determine its rgb color.
We had stored temporarily the palette index in the font color member and
are replacing it here by the corresponding rgb color. This is possible because
FixFontColors is called at the end of the workbook globals records when
everything is known.
-------------------------------------------------------------------------------}
procedure TsSpreadBIFFReader.FixColors;
var
i: Integer;
fnt: TsFont;
fmt: PsCellFormat;
procedure FixColor(var AColor: TsColor);
begin
if IsPaletteIndex(AColor) then
AColor := FPalette[AColor and $00FFFFFF];
end;
begin
for i:=0 to FWorkbook.GetFontCount - 1 do
begin
fnt := FWorkbook.GetFont(i);
FixColor(fnt.Color);
end;
for i:=0 to FCellFormatList.Count-1 do
begin
fmt := FCellFormatList[i];
FixColor(fmt^.Background.BgColor);
FixColor(fmt^.Background.FgColor);
FixColor(fmt^.BorderStyles[cbEast].Color);
FixColor(fmt^.BorderStyles[cbWest].Color);
FixColor(fmt^.BorderStyles[cbNorth].Color);
FixColor(fmt^.BorderStyles[cbSouth].Color);
FixColor(fmt^.BorderStyles[cbDiagUp].Color);
FixColor(fmt^.BorderStyles[cbDiagDown].Color);
end;
end;
{@@ ----------------------------------------------------------------------------
Converts the number to a date/time and return that if it is
-------------------------------------------------------------------------------}
@ -1463,17 +1525,15 @@ end;
-------------------------------------------------------------------------------}
procedure TsSpreadBIFFReader.ReadPalette(AStream: TStream);
var
i, n: Word;
pal: Array of TsColorValue;
n: Word;
begin
// Read palette size
n := WordLEToN(AStream.ReadWord) + 8;
SetLength(pal, n);
for i:=0 to 7 do
pal[i] := Workbook.GetPaletteColor(i);
for i:=8 to n-1 do
pal[i] := DWordLEToN(AStream.ReadDWord);
Workbook.UsePalette(@pal[0], n, false);
FPaletteFound := true;
FPalette.Clear;
FPalette.AddBuiltinColors;
// Read palette colors and add them to the palette
while FPalette.Count < n do
FPalette.AddColor(DWordLEToN(AStream.ReadDWord));
end;
{@@ ----------------------------------------------------------------------------
@ -2129,6 +2189,15 @@ begin
FWorksheet.Options := FWorksheet.Options - [soHasFrozenPanes];
end;
{@@ ----------------------------------------------------------------------------
Populates the reader's palette by default colors. Will be overwritten if the
file contains a palette on its own
-------------------------------------------------------------------------------}
procedure TsSpreadBIFFReader.PopulatePalette;
begin
FPalette.AddBuiltinColors;
end;
{------------------------------------------------------------------------------}
{ TsSpreadBIFFWriter }
@ -2142,14 +2211,25 @@ constructor TsSpreadBIFFWriter.Create(AWorkbook: TsWorkbook);
begin
inherited Create(AWorkbook);
// Initial base date in case it won't be set otherwise.
// Use 1900 to get a bit more range between 1900..1904.
FDateMode := dm1900;
// Limitations of BIFF5 and BIFF8 file formats
FLimitations.MaxColCount := 256;
FLimitations.MaxRowCount := 65536;
FLimitations.MaxPaletteSize := 64;
// Initial base date in case it won't be set otherwise.
// Use 1900 to get a bit more range between 1900..1904.
FDateMode := dm1900;
// Color palette
FPalette := TsPalette.Create;
FPalette.AddBuiltinColors;
FPalette.CollectFromWorkbook(AWorkbook);
end;
destructor TsSpreadBIFFWriter.Destroy;
begin
FPalette.Free;
inherited Destroy;
end;
{@@ ----------------------------------------------------------------------------
@ -2164,6 +2244,21 @@ begin
);
end;
{@@ ----------------------------------------------------------------------------
Checks limitations of the file format. Overridden to take care of the
color palette which can only contain a given number of entries.
-------------------------------------------------------------------------------}
procedure TsSpreadBIFFWriter.CheckLimitations;
begin
inherited CheckLimitations;
// Check color count.
if FPalette.Count > FLimitations.MaxPaletteSize then
begin
Workbook.AddErrorMsg(rsTooManyPaletteColors, [FPalette.Count, FLimitations.MaxPaletteSize]);
FPalette.Trim(FLimitations.MaxPaletteSize);
end;
end;
{@@ ----------------------------------------------------------------------------
Determines the index of the XF record, according to formatting of the
given cell
@ -2173,17 +2268,6 @@ begin
Result := LAST_BUILTIN_XF + ACell^.FormatIndex;
end;
function TsSpreadBIFFWriter.FixColor(AColor: TsColor): TsColor;
var
rgb: TsColorValue;
begin
if AColor >= Limitations.MaxPaletteSize then begin
rgb := Workbook.GetPaletteColor(AColor);
Result := Workbook.FindClosestColor(rgb, FLimitations.MaxPaletteSize);
end else
Result := AColor;
end;
function TsSpreadBIFFWriter.GetLastRowIndex(AWorksheet: TsWorksheet): Integer;
begin
Result := AWorksheet.GetLastRowIndex;
@ -2234,6 +2318,20 @@ begin
Result := Result or $0080;
end;
{@@ ----------------------------------------------------------------------------
Determines the index of the specified color in the writer's palette, or, if
not found, gets the index of the "closest" color.
-------------------------------------------------------------------------------}
function TsSpreadBIFFWriter.PaletteIndex(AColor: TsColor): Word;
var
idx: Integer;
begin
idx := FPalette.FindColor(AColor, Limitations.MaxPaletteSize);
if idx = -1 then
idx := FPalette.FindClosestColorIndex(AColor, Limitations.MaxPaletteSize);
Result := word(idx);
end;
{@@ ----------------------------------------------------------------------------
Writes the BIFF record header consisting of the record ID and the size of
data to be written immediately afterwards.
@ -2695,14 +2793,14 @@ end;
{@@ ----------------------------------------------------------------------------
Writes the PALETTE record for the color palette.
Valid for BIFF3-BIFF8. BIFF2 has no palette in file.
Valid for BIFF3-BIFF8. BIFF2 has no palette in the file.
-------------------------------------------------------------------------------}
procedure TsSpreadBIFFWriter.WritePalette(AStream: TStream);
const
NUM_COLORS = 56;
var
i, n: Integer;
rgb: TsColorValue;
rgb: TsColor;
begin
{ BIFF Record header }
WriteBIFFHeader(AStream, INT_EXCEL_ID_PALETTE, 2 + 4*NUM_COLORS);
@ -2710,13 +2808,13 @@ begin
{ Number of colors }
AStream.WriteWord(WordToLE(NUM_COLORS));
{ Take the colors from the palette of the Worksheet }
n := Workbook.GetPaletteSize;
{ Take the colors from the internal palette of the writer }
n := FPalette.Count;
{ Skip the first 8 entries - they are hard-coded into Excel }
for i := 8 to 8 + NUM_COLORS - 1 do
begin
rgb := Math.IfThen(i < n, Workbook.GetPaletteColor(i), $FFFFFF);
rgb := Math.IfThen(i < n, FPalette[i], $FFFFFF);
AStream.WriteDWord(DWordToLE(rgb))
end;
end;

188
components/fpspreadsheet/xlsxooxml.pas
View File

@ -43,7 +43,7 @@ uses
{$ELSE}
fpszipper,
{$ENDIF}
fpsTypes, fpSpreadsheet, fpsUtils, fpsReaderWriter, fpsNumFormat,
fpsTypes, fpSpreadsheet, fpsUtils, fpsReaderWriter, fpsNumFormat, fpsPalette,
fpsxmlcommon, xlsCommon;
type
@ -59,7 +59,8 @@ type
FBorderList: TFPList;
FHyperlinkList: TFPList;
FSharedFormulaBaseList: TFPList;
FThemeColors: array of TsColorValue;
FPalette: TsPalette;
FThemeColors: array of TsColor;
FWrittenByFPS: Boolean;
procedure ApplyCellFormatting(ACell: PCell; XfIndex: Integer);
procedure ApplyHyperlinks(AWorksheet: TsWorksheet);
@ -255,81 +256,7 @@ const
MIME_COMMENTS = MIME_SPREADML + '.comments+xml';
MIME_VMLDRAWING = MIME_OFFICEDOCUMENT + '.vmlDrawing';
LAST_PALETTE_COLOR = $3F; // 63
var
// the palette of the 64 default colors as "big-endian color" values
// (identical to BIFF8)
PALETTE_OOXML: array[$00..LAST_PALETTE_COLOR] of TsColorValue = (
$000000, // $00: black // 8 built-in default colors
$FFFFFF, // $01: white
$FF0000, // $02: red
$00FF00, // $03: green
$0000FF, // $04: blue
$FFFF00, // $05: yellow
$FF00FF, // $06: magenta
$00FFFF, // $07: cyan
$000000, // $08: EGA black
$FFFFFF, // $09: EGA white
$FF0000, // $0A: EGA red
$00FF00, // $0B: EGA green
$0000FF, // $0C: EGA blue
$FFFF00, // $0D: EGA yellow
$FF00FF, // $0E: EGA magenta
$00FFFF, // $0F: EGA cyan
$800000, // $10: EGA dark red
$008000, // $11: EGA dark green
$000080, // $12: EGA dark blue
$808000, // $13: EGA olive
$800080, // $14: EGA purple
$008080, // $15: EGA teal
$C0C0C0, // $16: EGA silver
$808080, // $17: EGA gray
$9999FF, // $18:
$993366, // $19:
$FFFFCC, // $1A:
$CCFFFF, // $1B:
$660066, // $1C:
$FF8080, // $1D:
$0066CC, // $1E:
$CCCCFF, // $1F:
$000080, // $20:
$FF00FF, // $21:
$FFFF00, // $22:
$00FFFF, // $23:
$800080, // $24:
$800000, // $25:
$008080, // $26:
$0000FF, // $27:
$00CCFF, // $28:
$CCFFFF, // $29:
$CCFFCC, // $2A:
$FFFF99, // $2B:
$99CCFF, // $2C:
$FF99CC, // $2D:
$CC99FF, // $2E:
$FFCC99, // $2F:
$3366FF, // $30:
$33CCCC, // $31:
$99CC00, // $32:
$FFCC00, // $33:
$FF9900, // $34:
$FF6600, // $35:
$666699, // $36:
$969696, // $37:
$003366, // $38:
$339966, // $39:
$003300, // $3A:
$333300, // $3B:
$993300, // $3C:
$993366, // $3D:
$333399, // $3E:
$333333 // $3F:
);
LAST_PALETTE_INDEX = 63;
type
TFillListData = class
@ -384,8 +311,6 @@ constructor TsSpreadOOXMLReader.Create(AWorkbook: TsWorkbook);
begin
inherited Create(AWorkbook);
FDateMode := XlsxSettings.DateMode;
// Set up the default palette in order to have the default color names correct.
Workbook.UseDefaultPalette;
FSharedStrings := TStringList.Create;
FFillList := TFPList.Create;
@ -395,6 +320,8 @@ begin
// Allow duplicates because xf indexes used in cell records cannot be found any more.
FSharedFormulaBaseList := TFPList.Create;
FPalette := TsPalette.Create;
FPointSeparatorSettings := DefaultFormatSettings;
FPointSeparatorSettings.DecimalSeparator := '.';
end;
@ -417,6 +344,7 @@ begin
// FCellFormatList, FNumFormatList and FFontList are destroyed by ancestor
FPalette.Free;
inherited Destroy;
end;
@ -894,7 +822,7 @@ end;
function TsSpreadOOXMLReader.ReadColor(ANode: TDOMNode): TsColor;
var
s: String;
rgb: TsColorValue;
rgb: TsColor;
idx: Integer;
tint: Double;
n: Integer;
@ -912,16 +840,19 @@ begin
s := GetAttrValue(ANode, 'rgb');
if s <> '' then begin
Result := FWorkbook.AddColorToPalette(HTMLColorStrToColor('#' + s));
Result := HTMLColorStrToColor('#' + s);
exit;
end;
s := GetAttrValue(ANode, 'indexed');
if s <> '' then begin
Result := StrToInt(s);
n := FWorkbook.GetPaletteSize;
if (Result <= LAST_PALETTE_COLOR) and (Result < n) then
n := FPalette.Count;
if (Result <= LAST_PALETTE_INDEX) and (Result < n) then
begin
Result := FPalette[Result];
exit;
end;
// System colors
// taken from OpenOffice docs
case Result of
@ -956,7 +887,7 @@ begin
tint := StrToFloat(s, FPointSeparatorSettings);
rgb := TintedColor(rgb, tint);
end;
Result := FWorkBook.AddColorToPalette(rgb);
Result := rgb;
exit;
end;
end;
@ -1465,36 +1396,42 @@ var
node, colornode: TDOMNode;
nodename: String;
s: string;
clr: TsColor;
rgb: TsColorValue;
cidx: Integer; // color index
rgb: TsColor;
n: Integer;
begin
// OOXML sometimes specifies color by index even if a palette ("indexedColors")
// is not loaeded. Therefore, we use the BIFF8 palette as default because
// the default indexedColors are identical to it.
n := Length(PALETTE_OOXML);
FWorkbook.UsePalette(@PALETTE_OOXML, n);
FPalette.Clear;
FPalette.AddBuiltinColors; // This adds the BIFF2 colors 0..7
FPalette.AddExcelColors; // This adds the BIFF8 colors 8..63
n := FPalette.Count;
if ANode = nil then
exit;
clr := 0;
cidx := 0;
node := ANode.FirstChild;
while Assigned(node) do begin
while Assigned(node) do
begin
nodename := node.NodeName;
if nodename = 'indexedColors' then begin
if nodename = 'indexedColors' then
begin
colornode := node.FirstChild;
while Assigned(colornode) do begin
while Assigned(colornode) do
begin
nodename := colornode.NodeName;
if nodename = 'rgbColor' then begin
s := GetAttrValue(colornode, 'rgb');
if s <> '' then begin
rgb := HTMLColorStrToColor('#' + s);
if clr < n then begin
FWorkbook.SetPaletteColor(clr, rgb);
inc(clr);
if cidx < n then begin
FPalette[cidx] := rgb;
inc(cidx);
end
else
FWorkbook.AddColorToPalette(rgb);
FPalette.AddColor(rgb);
end;
end;
colornode := colorNode.NextSibling;
@ -2078,20 +2015,19 @@ const
"slantDashDot", "mediumDashDot", "mediumDashed", "medium", "thick", "double" }
var
styleName: String;
colorName: String;
rgb: TsColorValue;
colorStr: String;
rgb: TsColor;
begin
if (ABorder in AFormatRecord^.Border) then begin
// Line style
styleName := LINESTYLE_NAME[AFormatRecord^.BorderStyles[ABorder].LineStyle];
// Border color
rgb := Workbook.GetPaletteColor(AFormatRecord^.BorderStyles[ABorder].Color);
//rgb := Workbook.GetPaletteColor(ACell^.BorderStyles[ABorder].Color);
colorName := ColorToHTMLColorStr(rgb, true);
rgb := AFormatRecord^.BorderStyles[ABorder].Color;
colorStr := ColorToHTMLColorStr(rgb, true);
AppendToStream(AStream, Format(
'<%s style="%s"><color rgb="%s" /></%s>',
[ABorderName, styleName, colorName, ABorderName]
[ABorderName, styleName, colorStr, ABorderName]
));
end else
AppendToStream(AStream, Format(
@ -2255,11 +2191,11 @@ begin
if FFillList[i]^.Background.FgColor = scTransparent then
fc := 'auto="1"'
else
fc := Format('rgb="%s"', [Copy(Workbook.GetPaletteColorAsHTMLStr(FFillList[i]^.Background.FgColor), 2, 255)]);
fc := Format('rgb="%s"', [Copy(ColorToHTMLColorStr(FFillList[i]^.Background.FgColor), 2, MaxInt)]);
if FFillList[i]^.Background.BgColor = scTransparent then
bc := 'auto="1"'
else
bc := Format('rgb="%s"', [Copy(Workbook.GetPaletteColorAsHTMLStr(FFillList[i]^.Background.BgColor), 2, 255)]);
bc := Format('rgb="%s"', [Copy(ColorToHTMLColorStr(FFillList[i]^.Background.BgColor), 2, MaxInt)]);
AppendToStream(AStream,
'<fill>');
AppendToStream(AStream, Format(
@ -2283,19 +2219,11 @@ var
i: Integer;
font: TsFont;
s: String;
rgb: TsColorValue;
begin
AppendToStream(FSStyles, Format(
'<fonts count="%d">', [Workbook.GetFontCount]));
for i:=0 to Workbook.GetFontCount-1 do begin
font := Workbook.GetFont(i);
{
if font = 4 then
// if font = nil then
AppendToStream(AStream, '<font />')
// Font #4 is missing in fpspreadsheet due to BIFF compatibility. We write
// an empty node to keep the numbers in sync with the stored font index.
else begin}
s := Format('<sz val="%g" /><name val="%s" />', [font.Size, font.FontName], FPointSeparatorSettings);
if (fssBold in font.Style) then
s := s + '<b />';
@ -2305,17 +2233,10 @@ begin
s := s + '<u />';
if (fssStrikeout in font.Style) then
s := s + '<strike />';
if font.Color <> scBlack then begin
if font.Color < 64 then
s := s + Format('<color indexed="%d" />', [font.Color])
else begin
rgb := Workbook.GetPaletteColor(font.Color);
s := s + Format('<color rgb="%s" />', [Copy(ColorToHTMLColorStr(rgb), 2, 255)]);
end;
end;
if font.Color <> scBlack then
s := s + Format('<color rgb="%s" />', [Copy(ColorToHTMLColorStr(font.Color), 2, MaxInt)]);
AppendToStream(AStream,
'<font>', s, '</font>');
// end;
end;
AppendToStream(AStream,
'</fonts>');
@ -2481,27 +2402,11 @@ begin
);
end;
{ Writes the workbook's color palette to the file }
{ In older versions, the workbook had a color palette which was written here.
Now there is no palette any more. }
procedure TsSpreadOOXMLWriter.WritePalette(AStream: TStream);
var
rgb: TsColorValue;
i: Integer;
begin
AppendToStream(AStream,
'<colors>' +
'<indexedColors>');
// There must not be more than 64 palette entries because the next colors
// are system colors.
for i:=0 to Min(LAST_PALETTE_COLOR, Workbook.GetPaletteSize-1) do begin
rgb := Workbook.GetPaletteColor(i);
AppendToStream(AStream,
'<rgbColor rgb="'+ColorToHTMLColorStr(rgb, true) + '" />');
end;
AppendToStream(AStream,
'</indexedColors>' +
'</colors>');
// just keep it here in case we'd need it later...
end;
procedure TsSpreadOOXMLWriter.WritePageMargins(AStream: TStream;
@ -3636,8 +3541,5 @@ initialization
// Registers this reader / writer on fpSpreadsheet
RegisterSpreadFormat(TsSpreadOOXMLReader, TsSpreadOOXMLWriter, sfOOXML);
// Create color palette for OOXML file format
MakeLEPalette(@PALETTE_OOXML, Length(PALETTE_OOXML));
end.