diff --git a/components/fpspreadsheet/examples/other/demo_recursive_calc.pas b/components/fpspreadsheet/examples/other/demo_recursive_calc.pas index ce565af72..f53f2aa20 100644 --- a/components/fpspreadsheet/examples/other/demo_recursive_calc.pas +++ b/components/fpspreadsheet/examples/other/demo_recursive_calc.pas @@ -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; diff --git a/components/fpspreadsheet/examples/read_write/excel5demo/excel5write.lpr b/components/fpspreadsheet/examples/read_write/excel5demo/excel5write.lpr index 92805ca70..646c16c06 100644 --- a/components/fpspreadsheet/examples/read_write/excel5demo/excel5write.lpr +++ b/components/fpspreadsheet/examples/read_write/excel5demo/excel5write.lpr @@ -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 - MyWorksheet.WriteBlank(i, 0); - Myworksheet.WriteBackgroundColor(i, 0, TsColor(i)); - MyWorksheet.WriteUTF8Text(i, 1, MyWorkbook.GetColorName(i)); + 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, palette[i]); + MyWorksheet.WriteUTF8Text(i, 1, GetColorName(palette[i])); + end; + finally + palette.Free; end; // Save the spreadsheet to a file diff --git a/components/fpspreadsheet/examples/read_write/excel8demo/excel8write.lpr b/components/fpspreadsheet/examples/read_write/excel8demo/excel8write.lpr index 96da10b56..2a2ab14ec 100644 --- a/components/fpspreadsheet/examples/read_write/excel8demo/excel8write.lpr +++ b/components/fpspreadsheet/examples/read_write/excel8demo/excel8write.lpr @@ -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]; diff --git a/components/fpspreadsheet/examples/read_write/wikitabledemo/wikitablewrite.lpr b/components/fpspreadsheet/examples/read_write/wikitabledemo/wikitablewrite.lpr index 9af2dcd12..ce3940f06 100644 --- a/components/fpspreadsheet/examples/read_write/wikitabledemo/wikitablewrite.lpr +++ b/components/fpspreadsheet/examples/read_write/wikitabledemo/wikitablewrite.lpr @@ -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); diff --git a/components/fpspreadsheet/examples/visual/spready/mainform.lfm b/components/fpspreadsheet/examples/visual/spready/mainform.lfm index 1f53e80ec..04ef93744 100644 --- a/components/fpspreadsheet/examples/visual/spready/mainform.lfm +++ b/components/fpspreadsheet/examples/visual/spready/mainform.lfm @@ -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 diff --git a/components/fpspreadsheet/examples/visual/spready/mainform.pas b/components/fpspreadsheet/examples/visual/spready/mainform.pas index e182f585c..5f91945bf 100644 --- a/components/fpspreadsheet/examples/visual/spready/mainform.pas +++ b/components/fpspreadsheet/examples/visual/spready/mainform.pas @@ -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 - WorksheetGrid.Worksheet.FindMergedRange(ACell, r1, c1, r2, c2); - Strings.Add('Merged range=' + GetCellRangeString(r1, c1, r2, c2)); - end; - + } + 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; diff --git a/components/fpspreadsheet/examples/visual/spready/spready.lpi b/components/fpspreadsheet/examples/visual/spready/spready.lpi index 10e09fd9f..9e0af4b47 100644 --- a/components/fpspreadsheet/examples/visual/spready/spready.lpi +++ b/components/fpspreadsheet/examples/visual/spready/spready.lpi @@ -103,7 +103,6 @@ - @@ -128,6 +127,7 @@ + diff --git a/components/fpspreadsheet/examples/visual/wikitablemaker/wtmain.lfm b/components/fpspreadsheet/examples/visual/wikitablemaker/wtmain.lfm index 6777607f1..fecd89c90 100644 --- a/components/fpspreadsheet/examples/visual/wikitablemaker/wtmain.lfm +++ b/components/fpspreadsheet/examples/visual/wikitablemaker/wtmain.lfm @@ -9,6 +9,7 @@ object MainFrm: TMainFrm Menu = MainMenu OnActivate = FormActivate OnCreate = FormCreate + OnDestroy = FormDestroy ShowHint = True LCLVersion = '1.5' object MainToolBar: TToolBar diff --git a/components/fpspreadsheet/examples/visual/wikitablemaker/wtmain.pas b/components/fpspreadsheet/examples/visual/wikitablemaker/wtmain.pas index 02e33ba66..0399d6d86 100644 --- a/components/fpspreadsheet/examples/visual/wikitablemaker/wtmain.pas +++ b/components/fpspreadsheet/examples/visual/wikitablemaker/wtmain.pas @@ -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; diff --git a/components/fpspreadsheet/fpsactions.pas b/components/fpspreadsheet/fpsactions.pas index 0dc403637..7a3a5f40d 100644 --- a/components/fpspreadsheet/fpsactions.pas +++ b/components/fpspreadsheet/fpsactions.pas @@ -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); diff --git a/components/fpspreadsheet/fpsheaderfooterparser.pas b/components/fpspreadsheet/fpsheaderfooterparser.pas index 50468334a..8a967a208 100644 --- a/components/fpspreadsheet/fpsheaderfooterparser.pas +++ b/components/fpspreadsheet/fpsheaderfooterparser.pas @@ -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; diff --git a/components/fpspreadsheet/fpsopendocument.pas b/components/fpspreadsheet/fpsopendocument.pas index 726506987..a5c62f0b7 100755 --- a/components/fpspreadsheet/fpsopendocument.pas +++ b/components/fpspreadsheet/fpsopendocument.pas @@ -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 + ''; 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( diff --git a/components/fpspreadsheet/fpspalette.pas b/components/fpspreadsheet/fpspalette.pas new file mode 100644 index 000000000..984b7e787 --- /dev/null +++ b/components/fpspreadsheet/fpspalette.pas @@ -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. diff --git a/components/fpspreadsheet/fpspreadsheet.pas b/components/fpspreadsheet/fpspreadsheet.pas index 7460ce42f..bedc66915 100755 --- a/components/fpspreadsheet/fpspreadsheet.pas +++ b/components/fpspreadsheet/fpspreadsheet.pas @@ -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 + @param ACell Pointer to the cell + @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); diff --git a/components/fpspreadsheet/fpspreadsheetctrls.pas b/components/fpspreadsheet/fpspreadsheetctrls.pas index 9c86b0d36..e99f4cee6 100644 --- a/components/fpspreadsheet/fpspreadsheetctrls.pas +++ b/components/fpspreadsheet/fpspreadsheetctrls.pas @@ -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. diff --git a/components/fpspreadsheet/fpspreadsheetgrid.pas b/components/fpspreadsheet/fpspreadsheetgrid.pas index eb0c7b10b..642b4114d 100644 --- a/components/fpspreadsheet/fpspreadsheetgrid.pas +++ b/components/fpspreadsheet/fpspreadsheetgrid.pas @@ -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. diff --git a/components/fpspreadsheet/fpsreaderwriter.pas b/components/fpspreadsheet/fpsreaderwriter.pas index 1314e29bf..35dd59999 100644 --- a/components/fpspreadsheet/fpsreaderwriter.pas +++ b/components/fpspreadsheet/fpsreaderwriter.pas @@ -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. diff --git a/components/fpspreadsheet/fpsstrings.pas b/components/fpspreadsheet/fpsstrings.pas index 1efafed55..41892224f 100644 --- a/components/fpspreadsheet/fpsstrings.pas +++ b/components/fpspreadsheet/fpsstrings.pas @@ -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!'; diff --git a/components/fpspreadsheet/fpstypes.pas b/components/fpspreadsheet/fpstypes.pas index 6f8798f06..03698ae2d 100644 --- a/components/fpspreadsheet/fpstypes.pas +++ b/components/fpspreadsheet/fpstypes.pas @@ -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 black color in the standard color palettes } - scBlack = $00; - {@@ Index of white color in the standard color palettes } - scWhite = $01; - {@@ Index of red color in the standard color palettes } - scRed = $02; - {@@ Index of green color in the standard color palettes } - scGreen = $03; - {@@ Index of blue color in the standard color palettes } - scBlue = $04; - {@@ Index of yellow color in the standard color palettes } - scYellow = $05; - {@@ Index of magenta color in the standard color palettes } - scMagenta = $06; - {@@ Index of cyan color in the standard color palettes } - scCyan = $07; - {@@ Index of dark red color in the standard color palettes } - scDarkRed = $08; - {@@ Index of dark green color in the standard color palettes } - scDarkGreen = $09; - {@@ Index of dark blue color in the standard color palettes } - scDarkBlue = $0A; - {@@ Index of "navy" color (dark blue) in the standard color palettes } - scNavy = $0A; - {@@ Index of olive color in the standard color palettes } - scOlive = $0B; - {@@ Index of purple color in the standard color palettes } - scPurple = $0C; - {@@ Index of teal color in the standard color palettes } - scTeal = $0D; - {@@ Index of silver color in the standard color palettes } - scSilver = $0E; - {@@ Index of grey color in the standard color palettes } - scGrey = $0F; - {@@ Index of gray color in the standard color palettes } - scGray = $0F; // redefine to allow different spelling - {@@ Index of a 10% grey color in the standard color palettes } - scGrey10pct = $10; - {@@ Index of a 10% gray color in the standard color palettes } - scGray10pct = $10; - {@@ Index of a 20% grey color in the standard color palettes } - scGrey20pct = $11; - {@@ Index of a 20% gray color in the standard color palettes } - scGray20pct = $11; - {@@ Index of orange color in the standard color palettes } - scOrange = $12; - {@@ Index of dark brown color in the standard color palettes } - scDarkbrown = $13; - {@@ Index of brown color in the standard color palettes } - scBrown = $14; - {@@ Index of beige color in the standard color palettes } - scBeige = $15; - {@@ Index of "wheat" color (yellow-orange) in the standard color palettes } - scWheat = $16; + {@@ These are some important rgb color volues. + } + {@@ rgb value of black color, BIFF2 palette index 0, BIFF8 index 8} + scBlack = $00000000; + {@@ rgb value of white color, BIFF2 palette index 1, BIFF8 index 9 } + scWhite = $00FFFFFF; + {@@ rgb value of red color, BIFF2 palette index 2, BIFF8 index 10 } + scRed = $000000FF; + {@@ rgb value of green color, BIFF2 palette index 3, BIFF8 index 11 } + scGreen = $0000FF00; + {@@ rgb value of blue color, BIFF2 palette index 4, BIFF8 indexes 12 and 39} + scBlue = $00FF0000; + {@@ rgb value of yellow color, BIFF2 palette index 5, BIFF8 indexes 13 and 34} + scYellow = $0000FFFF; + {@@ rgb value of magenta color, BIFF2 palette index 6, BIFF8 index 14 and 33} + scMagenta = $00FF00FF; + scPink = $00FE00FE; + {@@ rgb value of cyan color, BIFF2 palette index 7, BIFF8 indexes 15} + scCyan = $00FFFF00; + scTurquoise = scCyan; + {@@ rgb value of dark red color, BIFF8 indexes 16 and 35} + scDarkRed = $00000080; + {@@ rgb value of dark green color, BIFF8 index 17 } + scDarkGreen = $00008000; + {@@ rgb value of dark blue color } + scDarkBlue = $008B0000; + {@@ rgb value of "navy" color, BIFF8 palette indexes 18 and 32 } + scNavy = $00800000; + {@@ rgb value of olive color } + scOlive = $00008080; + {@@ rgb value of purple color, BIFF8 palette indexes 20 and 36 } + scPurple = $00800080; + {@@ rgb value of teal color, BIFF8 palette index 21 and 38 } + scTeal = $00808000; + {@@ rgb value of silver color } + scSilver = $00C0C0C0; + scGray25pct = scSilver; + {@@ rgb value of grey color } + scGray = $00808080; + {@@ rgb value of gray color } + scGrey = scGray; // redefine to allow different spelling + scGray50pct = scGray; + {@@ rgb value of a 10% grey color } + scGray10pct = $00E6E6E6; + {@@ rgb value of a 10% gray color } + scGrey10pct = scGray10pct; + {@@ rgb value of a 20% grey color } + scGray20pct = $00CCCCCC; + {@@ rgb value of a 20% gray color } + scGrey20pct = scGray20pct; + {@@ rgb value of periwinkle color, BIFF8 palette index 24 } + scPeriwinkle = $00FF9999; + {@@ rgb value of plum color, BIFF8 palette indexes 25 and 61 } + scPlum = $00663399; + {@@ rgb value of ivory color, BIFF8 palette index 26 } + scIvory = $00CCFFFF; + {@@ rgb value of light turquoise color, BIFF8 palette indexes 27 and 41 } + scLightTurquoise = $00FFFFCC; + {@@ rgb value of dark purple color, BIFF8 palette index 28 } + scDarkPurple = $00660066; + {@@ rgb value of coral color, BIFF8 palette index 29 } + scCoral = $008080FF; + {@@ rgb value of ocean blue color, BIFF8 palette index 30 } + scOceanBlue = $00CC6600; + {@@ rgb value of ice blue color, BIFF8 palette index 31 } + scIceBlue = $00FFCCCC; + {@@ rgb value of sky blue color, BIFF8 palette index 40 } + scSkyBlue = $00FFCC00; + {@@ rgb value of light green color, BIFF8 palette index 42 } + scLightGreen = $00CCFFCC; + {@@ rgb value of light yellow color, BIFF8 palette index 43 } + scLightYellow = $0099FFFF; + {@@ rgb value of pale blue color, BIFF8 palette index 44 } + scPaleBlue = $00FFCC99; + {@@ rgb value of rose color, BIFF8 palette index 45 } + scRose = $00CC99FF; + {@@ rgb value of lavander color, BIFF8 palette index 46 } + scLavander = $00FF99CC; + {@@ rgb value of tan color, BIFF8 palette index 47 } + scTan = $0099CCFF; + {@@ rgb value of light blue color, BIFF8 palette index 48 } + scLightBlue = $00FF6633; + {@@ rgb value of aqua color, BIFF8 palette index 49 } + scAqua = $00CCCC33; + {@@ rgb value of lime color, BIFF8 palette index 50 } + scLime = $0000CC99; + {@@ rgb value of golden color, BIFF8 palette index 51 } + scGold = $0000CCFF; + {@@ rgb value of light orange color, BIFF8 palette index 52 } + scLightOrange = $000099FF; + {@@ rgb value of orange color, BIFF8 palette index 53 } + scOrange = $000066FF; + {@@ rgb value of blue gray, BIFF8 palette index 54 } + scBlueGray = $00996666; + scBlueGrey = scBlueGray; + {@@ rgb value of gray 40%, BIFF8 palette index 55 } + scGray40pct = $00969696; + {@@ rgb value of dark teal, BIFF8 palette index 56 } + scDarkTeal = $00663300; + {@@ rgb value of sea green, BIFF8 palette index 57 } + scSeaGreen = $00669933; + {@@ rgb value of very dark green, BIFF8 palette index 58 } + scVeryDarkGreen = $00003300; + {@@ rgb value of olive green color, BIFF8 palette index 59 } + scOliveGreen = $00003333; + {@@ rgb value of brown color, BIFF8 palette index 60 } + scBrown = $00003399; + {@@ rgb value of indigo color, BIFF8 palette index 62 } + scIndigo = $00993333; + {@@ rgb value of 80% gray, 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 orange color } +// scOrange = $0000A5FF; + {@@ rgb value of dark brown color } + scDarkBrown = $002D52A0; + +// {@@ rgb value of brown color } +// scBrown = $003F85CD; + {@@ rgb value of beige color } + scBeige = $00DCF5F5; + {@@ rgb value of "wheat" 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; diff --git a/components/fpspreadsheet/fpsutils.pas b/components/fpspreadsheet/fpsutils.pas index 7181bb1a3..6c0758565 100644 --- a/components/fpspreadsheet/fpsutils.pas +++ b/components/fpspreadsheet/fpsutils.pas @@ -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); diff --git a/components/fpspreadsheet/fpsvisualutils.pas b/components/fpspreadsheet/fpsvisualutils.pas index 56108ddb1..953a357f3 100644 --- a/components/fpspreadsheet/fpsvisualutils.pas +++ b/components/fpspreadsheet/fpsvisualutils.pas @@ -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. diff --git a/components/fpspreadsheet/laz_fpspreadsheet.lpk b/components/fpspreadsheet/laz_fpspreadsheet.lpk index 695f264a8..b2e39f87f 100644 --- a/components/fpspreadsheet/laz_fpspreadsheet.lpk +++ b/components/fpspreadsheet/laz_fpspreadsheet.lpk @@ -28,7 +28,7 @@ This package is all you need if you don't want graphical components (like grids and charts)."/> - + @@ -165,6 +165,10 @@ This package is all you need if you don't want graphical components (like grids + + + + diff --git a/components/fpspreadsheet/laz_fpspreadsheet.pas b/components/fpspreadsheet/laz_fpspreadsheet.pas index 9bfbb97f5..f1a5d79b3 100644 --- a/components/fpspreadsheet/laz_fpspreadsheet.pas +++ b/components/fpspreadsheet/laz_fpspreadsheet.pas @@ -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 diff --git a/components/fpspreadsheet/tests/colortests.pas b/components/fpspreadsheet/tests/colortests.pas index 0e7ebba9e..31a7253b7 100644 --- a/components/fpspreadsheet/tests/colortests.pas +++ b/components/fpspreadsheet/tests/colortests.pas @@ -80,8 +80,12 @@ type procedure TestWriteRead_OOXML_Font_RandomPal; // palette 64, top 56 entries random end; + implementation +uses + fpsPalette; + const ColorsSheet = 'Colors'; @@ -111,79 +115,76 @@ 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; - MyWorkbook := TsWorkbook.Create; + // Define palette + palette := TsPalette.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); + 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 use default palette + else palette.AddBuiltinColors; 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); + MyWorkbook := TsWorkbook.Create; + try + MyWorkSheet:= MyWorkBook.AddWorksheet(ColorsSheet); - // Write out all colors - row := 0; - col := 0; - for color := 0 to MyWorkbook.GetPaletteSize-1 do begin - MyWorksheet.WriteUTF8Text(row, col, CELLTEXT); - MyWorksheet.WriteBackgroundColor(row, col, color); - MyCell := MyWorksheet.FindCell(row, col); - if MyCell = nil then - fail('Error in test code. Failed to get cell.'); - currentRGB := MyWorkbook.GetPaletteColor(MyWorksheet.ReadBackgroundColor(MyCell)); - expectedRGB := MyWorkbook.GetPaletteColor(color); - CheckEquals(expectedRGB, currentRGB, - 'Test unsaved background color, cell ' + CellNotation(MyWorksheet,0,0)); - inc(row); + // Write out all colors + row := 0; + col := 0; + for i := 0 to palette.Count-1 do begin + MyWorksheet.WriteUTF8Text(row, col, CELLTEXT); + MyCell := MyWorksheet.WriteBackgroundColor(row, col, palette[i]); + if MyCell = nil then + fail('Error in test code. Failed to get cell.'); + currentRGB := MyWorksheet.ReadBackgroundColor(MyCell); + expectedRGB := palette[i]; + CheckEquals(expectedRGB, currentRGB, + 'Test unsaved background color, cell ' + CellNotation(MyWorksheet,0,0)); + inc(row); + end; + MyWorkBook.WriteToFile(TempFile, AFormat, true); + finally + MyWorkbook.Free; end; - MyWorkBook.WriteToFile(TempFile, AFormat, true); + + // Open the spreadsheet + MyWorkbook := TsWorkbook.Create; + try + MyWorkbook.ReadFromFile(TempFile, AFormat); + if AFormat = sfExcel2 then + MyWorksheet := MyWorkbook.GetFirstWorksheet + else + MyWorksheet := GetWorksheetByName(MyWorkBook, ColorsSheet); + if MyWorksheet=nil then + fail('Error in test code. Failed to get named worksheet'); + 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.'); + currentRGB := MyWorksheet.ReadBackgroundColor(MyCell); + expectedRGB := palette[row]; + CheckEquals(expectedRGB, currentRGB, + 'Test saved background color, cell '+CellNotation(MyWorksheet,Row,Col)); + end; + finally + MyWorkbook.Free; + DeleteFile(TempFile); + end; + finally - MyWorkbook.Free; - end; - - // Open the spreadsheet - MyWorkbook := TsWorkbook.Create; - try - MyWorkbook.ReadFromFile(TempFile, AFormat); - if AFormat = sfExcel2 then - MyWorksheet := MyWorkbook.GetFirstWorksheet - else - MyWorksheet := GetWorksheetByName(MyWorkBook, ColorsSheet); - if MyWorksheet=nil then - fail('Error in test code. Failed to get named worksheet'); - 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); - currentRGB := MyWorkbook.GetPaletteColor(MyWorksheet.ReadBackgroundColor(MyCell)); - expectedRGB := pal[color]; - CheckEquals(expectedRGB, currentRGB, - 'Test saved background color, cell '+CellNotation(MyWorksheet,Row,Col)); - end; - finally - MyWorkbook.Free; - DeleteFile(TempFile); + palette.Free end; end; @@ -201,87 +202,82 @@ 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; - MyWorkbook := TsWorkbook.Create; + // Define palette + palette := TsPalette.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 + 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; - // 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); + MyWorkbook := TsWorkbook.Create; + try + MyWorkSheet:= MyWorkBook.AddWorksheet(ColorsSheet); - // Write out all colors - row := 0; - col := 0; - for color := 0 to MyWorkbook.GetPaletteSize-1 do begin - MyWorksheet.WriteUTF8Text(row, col, CELLTEXT); - MyWorksheet.WriteFontColor(row, col, color); - 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); - CheckEquals(expectedRGB, currentRGB, - 'Test unsaved font color, cell ' + CellNotation(MyWorksheet,row, col)); - inc(row); - end; - MyWorkBook.WriteToFile(TempFile, AFormat, true); - finally - MyWorkbook.Free; - end; - - // Open the spreadsheet - MyWorkbook := TsWorkbook.Create; - try - MyWorkbook.ReadFromFile(TempFile, AFormat); - if AFormat = sfExcel2 then - MyWorksheet := MyWorkbook.GetFirstWorksheet - else - MyWorksheet := GetWorksheetByName(MyWorkBook, ColorsSheet); - if MyWorksheet=nil then - fail('Error in test code. Failed to get named worksheet'); - 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); - - // 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); + // Write out all colors + row := 0; + col := 0; + for i := 0 to palette.Count-1 do begin + MyWorksheet.WriteUTF8Text(row, col, CELLTEXT); + MyWorksheet.WriteFontColor(row, col, palette[i]); + MyCell := MyWorksheet.FindCell(row, col); + if MyCell = nil then + fail('Error in test code. Failed to get cell.'); + currentRGB := MyWorksheet.ReadCellFont(MyCell).Color; + expectedRGB := palette[i]; + CheckEquals(expectedRGB, currentRGB, + 'Test unsaved font color, cell ' + CellNotation(MyWorksheet,row, col)); + inc(row); end; - CheckEquals(expectedRGB, currentRGB, - 'Test saved font color, cell '+CellNotation(MyWorksheet,Row,Col)); + MyWorkBook.WriteToFile(TempFile, AFormat, true); + finally + MyWorkbook.Free; end; + + // Open the spreadsheet + MyWorkbook := TsWorkbook.Create; + try + MyWorkbook.ReadFromFile(TempFile, AFormat); + if AFormat = sfExcel2 then + MyWorksheet := MyWorkbook.GetFirstWorksheet + else + 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.'); + expectedRGB := palette[row]; + currentRGB := MyWorksheet.ReadCellFont(MyCell).Color; + + // 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; + finally + MyWorkbook.Free; + DeleteFile(TempFile); + end; + finally - MyWorkbook.Free; - DeleteFile(TempFile); + palette.Free; end; end; diff --git a/components/fpspreadsheet/tests/errortests.pas b/components/fpspreadsheet/tests/errortests.pas index 84c512f61..8bcebc503 100644 --- a/components/fpspreadsheet/tests/errortests.pas +++ b/components/fpspreadsheet/tests/errortests.pas @@ -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,25 +124,44 @@ 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); + MyWorkSheet:= MyWorkBook.AddWorksheet(ERROR_SHEET); + + // 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); + ErrList.Text := MyWorkbook.ErrorMsg; + // Palette usage in biff --> expecting error due to too large palette + if (TTestFormat(AFormat) in [sfExcel2, sfExcel5, sfExcel8]) then + expected := 1 + else + // no palette in xml --> no error expected + expected := 0; + CheckEquals(expected, ErrList.Count, 'Error count mismatch in test 3'); + + finally + palette.Free; + end; - TempFile:=NewTempFile; - MyWorkBook.WriteToFile(TempFile, AFormat, true); - ErrList.Text := MyWorkbook.ErrorMsg; - // Palette usage in biff --> expecting error due to too large palette - if (TTestFormat(AFormat) in [sfExcel2, sfExcel5, sfExcel8]) then - expected := 1 - else - // no palette in xml --> no error expected - expected := 0; - CheckEquals(expected, ErrList.Count, 'Error count mismatch in test 3'); finally MyWorkbook.Free; DeleteFile(TempFile); diff --git a/components/fpspreadsheet/tests/formattests.pas b/components/fpspreadsheet/tests/formattests.pas index 6d50e5641..dcf954cc9 100644 --- a/components/fpspreadsheet/tests/formattests.pas +++ b/components/fpspreadsheet/tests/formattests.pas @@ -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,8 +751,7 @@ 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 + for style in TsFillStyle do begin row := ord(style); // Column B has BK_COLOR as backgroundcolor of the patterns @@ -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 @@ -1034,8 +1032,8 @@ begin expected := ord(SollBorderLineStyles[ls]); if AFormat in [sfExcel8, sfOOXML] then case b of - cbDiagUp : diagUp_ls := expected; - cbDiagDown: expected := diagUp_ls; + cbDiagUp : diagUp_ls := expected; + cbDiagDown : expected := diagUp_ls; end; CheckEquals(expected, current, 'Test saved border line style mismatch, cell ' + CellNotation(MyWorksheet, row*2, col*2)); @@ -1046,8 +1044,8 @@ begin // in the "diagonal-down" case. if AFormat in [sfExcel8, sfOOXML] then case b of - cbDiagUp : diagUp_clr := expected; - cbDiagDown: expected := diagUp_clr; + cbDiagUp : diagUp_clr := expected; + cbDiagDown : expected := diagUp_clr; end; CheckEquals(expected, current, 'Test saved border color mismatch, cell ' + CellNotation(MyWorksheet, row*2, col*2)); @@ -1591,55 +1589,64 @@ var fnt: TsFont; actual, expected: String; i: Integer; + palette: TsPalette; begin - MyWorkbook := TsWorkbook.Create; + palette := TsPalette.Create; try - MyWorksheet:= MyWorkBook.AddWorksheet(SHEETNAME); - for r := 0 to 7 do // each row has a different font size - for c := 0 to 7 do // each column has a different font color - 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! - // --> in total 64 combinations - end; - TempFile:=NewTempFile; - MyWorkBook.WriteToFile(TempFile, AFormat, true); - finally - MyWorkbook.Free; - end; + palette.AddBuiltinColors; - // Open the spreadsheet - MyWorkbook := TsWorkbook.Create; - try - MyWorkbook.ReadFromFile(TempFile, AFormat); + MyWorkbook := TsWorkbook.Create; + try + MyWorksheet:= MyWorkBook.AddWorksheet(SHEETNAME); + for r := 0 to 7 do // each row has a different font size + for c := 0 to 7 do // each column has a different font color + begin + MyWorksheet.WriteNumber(r, c, 123); + MyWorksheet.WriteBackgroundColor(r, c, 0); + 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; + MyWorkBook.WriteToFile(TempFile, AFormat, true); + finally + MyWorkbook.Free; + end; - // 1st sheet: merged cells with text - if AFormat = sfExcel2 then - MyWorksheet := MyWorkbook.GetFirstWorksheet - else - MyWorksheet := GetWorksheetByName(MyWorkBook, SHEETNAME); - if MyWorksheet=nil then - fail('Error in test code. Failed to get named worksheet ' + SHEETNAME); + // Open the spreadsheet + MyWorkbook := TsWorkbook.Create; + try + MyWorkbook.ReadFromFile(TempFile, AFormat); - for r:=0 to MyWorksheet.GetLastRowIndex do - for c := 0 to MyWorksheet.GetLastColIndex do - begin - cell := MyWorksheet.FindCell(r, c); - fnt := MyWorksheet.ReadCellFont(cell); - expected := FloatToStr(FontSizes[r]); - actual := FloatToStr(fnt.Size); - CheckEquals(expected, actual, - 'Font size mismatch, cell '+ CellNotation(MyWorksheet, r, c)); - expected := IntToStr(c); - actual := IntToStr(fnt.Color); - CheckEquals(expected, actual, - 'Font color mismatch, cell '+ CellNotation(MyWorksheet, r, c)); - end; + // 1st sheet: merged cells with text + if AFormat = sfExcel2 then + MyWorksheet := MyWorkbook.GetFirstWorksheet + else + MyWorksheet := GetWorksheetByName(MyWorkBook, SHEETNAME); + if MyWorksheet=nil then + fail('Error in test code. Failed to get named worksheet ' + SHEETNAME); + + for r:=0 to MyWorksheet.GetLastRowIndex do + for c := 0 to MyWorksheet.GetLastColIndex do + begin + cell := MyWorksheet.FindCell(r, c); + fnt := MyWorksheet.ReadCellFont(cell); + expected := FloatToStr(FontSizes[r]); + actual := FloatToStr(fnt.Size); + CheckEquals(expected, actual, + 'Font size mismatch, cell '+ CellNotation(MyWorksheet, r, c)); + expected := IntToStr(palette[c]); + actual := IntToStr(fnt.Color); + CheckEquals(expected, actual, + 'Font color mismatch, cell '+ CellNotation(MyWorksheet, r, c)); + end; + + finally + MyWorkbook.Free; + DeleteFile(TempFile); + end; finally - MyWorkbook.Free; - DeleteFile(TempFile); + palette.Free; end; end; diff --git a/components/fpspreadsheet/tests/manualtests.pas b/components/fpspreadsheet/tests/manualtests.pas index 83a1104c6..be0f196f9 100644 --- a/components/fpspreadsheet/tests/manualtests.pas +++ b/components/fpspreadsheet/tests/manualtests.pas @@ -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,17 +200,76 @@ begin if Workbook = nil then Workbook := TsWorkbook.Create; - 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.'); + palette := TsPalette.Create; + try + palette.AddBuiltinColors; + palette.AddExcelColors; + + Worksheet := Workbook.AddWorksheet(COLORSHEETNAME); + WorkSheet.WriteUTF8Text(0, 1, 'TSpreadManualTests.TestBiff8CellBackgroundColor'); + RowOffset := 1; + 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} // As described in bug 25718: Feature request & patch: Implementation of writing more functions procedure TSpreadManualTests.TestRPNFormula; diff --git a/components/fpspreadsheet/wikitable.pas b/components/fpspreadsheet/wikitable.pas index f63306c89..ac3b6ea53 100644 --- a/components/fpspreadsheet/wikitable.pas +++ b/components/fpspreadsheet/wikitable.pas @@ -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; diff --git a/components/fpspreadsheet/xlsbiff2.pas b/components/fpspreadsheet/xlsbiff2.pas index f5af49cd6..4a9bed11e 100755 --- a/components/fpspreadsheet/xlsbiff2.pas +++ b/components/fpspreadsheet/xlsbiff2.pas @@ -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. diff --git a/components/fpspreadsheet/xlsbiff5.pas b/components/fpspreadsheet/xlsbiff5.pas index d004f75aa..40dc84665 100755 --- a/components/fpspreadsheet/xlsbiff5.pas +++ b/components/fpspreadsheet/xlsbiff5.pas @@ -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; @@ -352,14 +362,14 @@ begin CurStreamPos := AStream.Position; case RecordType of - INT_EXCEL_ID_BOF : ; - INT_EXCEL_ID_BOUNDSHEET : ReadBoundSheet(AStream); - INT_EXCEL_ID_CODEPAGE : ReadCodePage(AStream); - INT_EXCEL_ID_FONT : ReadFont(AStream); - INT_EXCEL_ID_FORMAT : ReadFormat(AStream); - INT_EXCEL_ID_XF : ReadXF(AStream); - INT_EXCEL_ID_PALETTE : ReadPalette(AStream); - INT_EXCEL_ID_EOF : SectionEOF := True; + INT_EXCEL_ID_BOF : ; + INT_EXCEL_ID_BOUNDSHEET : ReadBoundSheet(AStream); + INT_EXCEL_ID_CODEPAGE : ReadCodePage(AStream); + INT_EXCEL_ID_FONT : ReadFont(AStream); + INT_EXCEL_ID_FORMAT : ReadFormat(AStream); + INT_EXCEL_ID_XF : ReadXF(AStream); + INT_EXCEL_ID_PALETTE : ReadPalette(AStream); + INT_EXCEL_ID_EOF : SectionEOF := True; else // nothing end; @@ -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. diff --git a/components/fpspreadsheet/xlsbiff8.pas b/components/fpspreadsheet/xlsbiff8.pas index cfff9a43c..c91160227 100755 --- a/components/fpspreadsheet/xlsbiff8.pas +++ b/components/fpspreadsheet/xlsbiff8.pas @@ -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. diff --git a/components/fpspreadsheet/xlscommon.pas b/components/fpspreadsheet/xlscommon.pas index de9deac8e..aba75881c 100644 --- a/components/fpspreadsheet/xlscommon.pas +++ b/components/fpspreadsheet/xlscommon.pas @@ -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; diff --git a/components/fpspreadsheet/xlsxooxml.pas b/components/fpspreadsheet/xlsxooxml.pas index 262deb09e..8f9fdf387 100755 --- a/components/fpspreadsheet/xlsxooxml.pas +++ b/components/fpspreadsheet/xlsxooxml.pas @@ -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">', - [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, ''); AppendToStream(AStream, Format( @@ -2283,39 +2219,24 @@ var i: Integer; font: TsFont; s: String; - rgb: TsColorValue; begin AppendToStream(FSStyles, Format( '', [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 #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('', [font.Size, font.FontName], FPointSeparatorSettings); - if (fssBold in font.Style) then - s := s + ''; - if (fssItalic in font.Style) then - s := s + ''; - if (fssUnderline in font.Style) then - s := s + ''; - if (fssStrikeout in font.Style) then - s := s + ''; - if font.Color <> scBlack then begin - if font.Color < 64 then - s := s + Format('', [font.Color]) - else begin - rgb := Workbook.GetPaletteColor(font.Color); - s := s + Format('', [Copy(ColorToHTMLColorStr(rgb), 2, 255)]); - end; - end; - AppendToStream(AStream, - '', s, ''); -// end; + s := Format('', [font.Size, font.FontName], FPointSeparatorSettings); + if (fssBold in font.Style) then + s := s + ''; + if (fssItalic in font.Style) then + s := s + ''; + if (fssUnderline in font.Style) then + s := s + ''; + if (fssStrikeout in font.Style) then + s := s + ''; + if font.Color <> scBlack then + s := s + Format('', [Copy(ColorToHTMLColorStr(font.Color), 2, MaxInt)]); + AppendToStream(AStream, + '', s, ''); end; AppendToStream(AStream, ''); @@ -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, - '' + - ''); - - // 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, - ''); - end; - - AppendToStream(AStream, - '' + - ''); + // 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.