diff --git a/components/fpspreadsheet/laz_fpspreadsheet.lpk b/components/fpspreadsheet/laz_fpspreadsheet.lpk
index 3e5192abb..92ca967ba 100644
--- a/components/fpspreadsheet/laz_fpspreadsheet.lpk
+++ b/components/fpspreadsheet/laz_fpspreadsheet.lpk
@@ -34,7 +34,7 @@
This package is all you need if you don't want graphical components (like grids and charts)."/>
-
+
@@ -258,6 +258,14 @@ This package is all you need if you don't want graphical components (like g
+
+
+
+
+
+
+
+
diff --git a/components/fpspreadsheet/source/common/fpsconditionalformat.pas b/components/fpspreadsheet/source/common/fpsconditionalformat.pas
new file mode 100644
index 000000000..050aa2aca
--- /dev/null
+++ b/components/fpspreadsheet/source/common/fpsconditionalformat.pas
@@ -0,0 +1,299 @@
+unit fpsConditionalFormat;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+ Classes, Contnrs, SysUtils, Variants, fpsTypes;
+
+type
+ TsCFRule = class
+ public
+ procedure Assign(ASource: TsCFRule); virtual; abstract;
+ end;
+
+ { Cell is... }
+ TsCFCondition = (
+ cfcEqual, cfcNotEqual,
+ cfcGreaterThan, cfcLessThan, cfcGreaterEqual, cfcLessEqual,
+ cfcBetween, cfcNotBetween,
+ cfcAboveAverage, cfcBelowAverage,
+ cfcBeginsWidth, cfcEndsWith,
+ cfcDuplicate, cfcUnique,
+ cfcContainsText, cfcNotContaisText,
+ cfcContainsErrors, cfcNotContainsErrors
+ );
+
+ {cellIs
+ expression
+ colorScale, dataBar, iconSet
+ containsText, notContainsText, beginsWith, endsWith, containsBlanks, notContainsBlanks, containsErrors, notContainsErrors
+ }
+
+ TsCFCellRule = class(TsCFRule)
+ public
+ Condition: TsCFCondition;
+ Operand1: Variant;
+ Operand2: Variant;
+ FormatIndex: Integer;
+ procedure Assign(ASource: TsCFRule); override;
+ end;
+
+ { Color range }
+ TsCFColorRangeValue = (crvMin, crvMax, crvPercentile);
+
+ TsCFColorRangeRule = class(TsCFRule)
+ StartValue: TsCFColorRangeValue;
+ CenterValue: TsCFColorRangeValue;
+ EndValue: TsCFColorRangeValue;
+ StartValueParam: Double;
+ CenterValueParam: Double;
+ EndValueParam: Double;
+ StartColor: TsColor;
+ CenterColor: TsColor;
+ EndColor: TsColor;
+ procedure Assign(ASource: TsCFRule); override;
+ end;
+
+ { DataBars }
+ TsCFDatabarRule = class(TsCFRule)
+ procedure Assign(ASource: TsCFRule); override;
+ end;
+
+ { Rules }
+ TsCFRules = class(TFPObjectList)
+ private
+ function GetItem(AIndex: Integer): TsCFRule;
+ function GetPriority(AIndex: Integer): Integer;
+ procedure SetItem(AIndex: Integer; const AValue: TsCFRule);
+ public
+ property Items[AIndex: Integer]: TsCFRule read GetItem write SetItem; default;
+ property Priority[AIndex: Integer]: Integer read GetPriority;
+ end;
+
+ { Conditional format item }
+ TsConditionalFormat = class
+ private
+ FCellRange: TsCellRange;
+ FRules: TsCFRules;
+ function GetRules(AIndex: Integer): TsCFRule;
+ function GetRulesCount: Integer;
+ public
+ constructor Create(ACellRange: TsCellRange);
+ destructor Destroy; override;
+
+ property CellRange: TsCellRange read FCellRange;
+ property Rules[AIndex: Integer]: TsCFRule read GetRules;
+ property RulesCount: Integer read GetRulesCount;
+ end;
+
+ TsConditionalFormatList = class(TFPObjectList)
+ protected
+ function AddRule(ARange: TsCellRange; ARule: TsCFRule): Integer;
+ public
+ function AddCellRule(ARange: TsCellRange; ACondition: TsCFCondition;
+ ACellFormatIndex: Integer): Integer; overload;
+ function AddCellRule(ARange: TsCellRange; ACondition: TsCFCondition;
+ AParam: Variant; ACellFormatIndex: Integer): Integer; overload;
+ function AddCellRule(ARange: TsCellRange; ACondition: TsCFCondition;
+ AParam1, AParam2: Variant; ACellFormatIndex: Integer): Integer; overload;
+ procedure AddColorRangeRule(ARange: TsCellRange);
+ procedure AddDataBarRule(ARange: TsCellRange);
+ function Find(ARange: TsCellRange): Integer;
+ end;
+
+
+implementation
+
+procedure TsCFCellRule.Assign(ASource: TsCFRule);
+begin
+ if ASource is TsCFCellRule then
+ begin
+ Condition := TsCFCellRule(ASource).Condition;
+ Operand1 := TsCFCellRule(ASource).Operand1;
+ Operand2 := TsCFCellRule(ASource).Operand2;
+ FormatIndex := TsCFCellRule(ASource).FormatIndex;
+ end else
+ raise Exception.Create('Source cannot be assigned to TCVCellRule');
+end;
+
+procedure TsCFDataBarRule.Assign(ASource: TsCFRule);
+begin
+ if ASource is TsCFDataBarRule then
+ begin
+ //
+ end else
+ raise Exception.Create('Source cannot be assigned to TCVDataBarRule');
+end;
+
+procedure TsCFColorRangeRule.Assign(ASource: TsCFRule);
+begin
+ if ASource is TsCFColorRangeRule then
+ begin
+ StartValue := TsCFColorRangeRule(ASource).StartValue;
+ CenterValue := TsCFColorRangeRule(ASource).CenterValue;
+ EndValue := TsCFColorRangeRule(ASource).EndValue;
+ StartValueParam := TsCFColorRangeRule(ASource).StartValueParam;
+ CenterValueParam := TsCFColorRangeRule(ASource).CenterValueParam;
+ EndValueParam := TsCFColorRangeRule(ASource).EndValueParam;
+ StartColor := TsCFColorRangeRule(ASource).StartColor;
+ CenterColor := TsCFColorRangeRule(ASource).CenterColor;
+ EndColor := TsCFColorRangeRule(ASource).EndColor;
+ end else
+ raise Exception.Create('Source cannot be assigned to TCVDataBarRule');
+end;
+
+
+{ TCFRule }
+
+function TsCFRules.GetItem(AIndex: Integer): TsCFRule;
+begin
+ Result := TsCFRule(inherited Items[AIndex]);
+end;
+
+function TsCFRules.GetPriority(AIndex: Integer): Integer;
+begin
+ Result := Count - AIndex;
+end;
+
+procedure TsCFRules.SetItem(AIndex: Integer; const AValue: TsCFRule);
+var
+ item: TsCFRule;
+begin
+ item := GetItem(AIndex);
+ item.Assign(AValue);
+ inherited Items[AIndex] := item;
+end;
+
+
+{ TsConditonalFormat }
+
+constructor TsConditionalFormat.Create(ACellRange: TsCellRange);
+begin
+ inherited Create;
+ FCellRange := ACellRange;
+ FRules := TsCFRules.Create;
+end;
+
+destructor TsConditionalFormat.Destroy;
+begin
+ FRules.Free;
+ inherited;
+end;
+
+function TsConditionalFormat.GetRules(AIndex: Integer): TsCFRule;
+begin
+ Result := FRules[AIndex];
+end;
+
+function TsConditionalFormat.GetRulesCount: Integer;
+begin
+ Result := FRules.Count;
+end;
+
+
+{ TsConditionalFormatList }
+
+{@@ ----------------------------------------------------------------------------
+ Adds a new conditional format to the list.
+ The format is specified by the cell range to which it is applied and by
+ the rule describing the format.
+ The rules are grouped for the same cell ranges.
+-------------------------------------------------------------------------------}
+function TsConditionalFormatList.AddRule(ARange: TsCellRange;
+ ARule: TsCFRule): Integer;
+var
+ CF: TsConditionalFormat;
+ idx: Integer;
+begin
+ idx := Find(ARange);
+ if idx = -1 then begin
+ CF := TsConditionalFormat.Create(ARange);
+ idx := Add(CF);
+ end else
+ CF := TsConditionalFormat(Items[idx]);
+ CF.FRules.Add(ARule);
+ Result := idx;
+end;
+
+// TODO: Add pre-checks for compatibility of condition and operands
+
+function TsConditionalFormatList.AddCellRule(ARange: TsCellRange;
+ ACondition: TsCFCondition; ACellFormatIndex: Integer): Integer;
+var
+ rule: TsCFCellRule;
+begin
+ rule := TsCFCellRule.Create;
+ rule.Condition := ACondition;
+ rule.Operand1 := varNull;
+ rule.Operand2 := varNull;
+ rule.FormatIndex := ACellFormatIndex;
+ Result := AddRule(ARange, rule);
+end;
+
+function TsConditionalFormatList.AddCellRule(ARange: TsCellRange;
+ ACondition: TsCFCondition; AParam: Variant; ACellFormatIndex: Integer): Integer;
+var
+ rule: TsCFCellRule;
+begin
+ rule := TsCFCellRule.Create;
+ rule.Condition := ACondition;
+ rule.Operand1 := AParam;
+ rule.Operand2 := varNull;
+ rule.FormatIndex := ACellFormatIndex;
+ Result := AddRule(ARange, rule);
+end;
+
+function TsConditionalFormatList.AddCellRule(ARange: TsCellRange;
+ ACondition: TsCFCondition; AParam1, AParam2: Variant;
+ ACellFormatIndex: Integer): Integer;
+var
+ rule: TsCFCellRule;
+begin
+ rule := TsCFCellRule.Create;
+ rule.Condition := ACondition;
+ rule.Operand1 := AParam1;
+ rule.Operand2 := AParam2;
+ rule.FormatIndex := ACellFormatIndex;
+ Result := AddRule(ARange, rule);
+end;
+
+procedure TsConditionalFormatList.AddColorRangeRule(ARange: TsCellRange);
+begin
+ raise EXception.Create('ColorRange not yet implemented.');
+end;
+
+procedure TsConditionalFormatlist.AddDataBarRule(ARange: TsCellRange);
+begin
+ raise Exception.Create('DataBars not yet implemented.');
+end;
+
+
+{@@ ----------------------------------------------------------------------------
+ The conditional format list must be unique regarding cell ranges.
+ This function searches all format item whether a given cell ranges is
+ already listed.
+-------------------------------------------------------------------------------}
+function TsConditionalFormatList.Find(ARange: TsCellRange): Integer;
+var
+ i: Integer;
+ CF: TsConditionalFormat;
+ CFRange: TsCellRange;
+begin
+ for i := 0 to Count-1 do
+ begin
+ CF := TsConditionalFormat(Items[i]);
+ CFRange := CF.CellRange;
+ if (CFRange.Row1 = ARange.Row1) and (CFRange.Row2 = ARange.Row2) and
+ (CFRange.Col1 = ARange.Col1) and (CFRange.Col2 = ARange.Col2) then
+ begin
+ Result := i;
+ exit;
+ end;
+ end;
+ Result := -1;
+end;
+
+end.
+
diff --git a/components/fpspreadsheet/source/common/fpspreadsheet.pas b/components/fpspreadsheet/source/common/fpspreadsheet.pas
index 41e565453..19ada966e 100644
--- a/components/fpspreadsheet/source/common/fpspreadsheet.pas
+++ b/components/fpspreadsheet/source/common/fpspreadsheet.pas
@@ -24,7 +24,7 @@ uses
{$endif}{$endif}{$endif}
Classes, SysUtils, fpimage, avglvltree, lconvencoding,
fpsTypes, fpsExprParser, fpsClasses, fpsNumFormat, fpsPageLayout,
- fpsImages;
+ fpsImages, fpsConditionalFormat;
type
{ Forward declarations }
@@ -75,6 +75,7 @@ type
FHyperlinks: TsHyperlinks;
FFormulas: TsFormulas;
FImages: TFPList;
+ FConditionalFormats: TsConditionalFormatList;
FRows, FCols: TIndexedAVLTree; // This lists contain only rows or cols with styles different from default
FActiveCellRow: Cardinal;
FActiveCellCol: Cardinal;
@@ -108,6 +109,7 @@ type
FOnWriteCellData: TsWorksheetWriteCellDataEvent;
{ Setter/Getter }
+ function GetConditionalFormatCount: Integer;
function GetDefaultColWidth: Single;
function GetDefaultRowHeight: Single;
function GetFormatSettings: TFormatSettings;
@@ -383,6 +385,15 @@ type
procedure WriteCellProtection(ACell: PCell;
AValue: TsCellProtections); overload;
+ { Conditional formatting }
+ function ReadConditionalFormat(AIndex: Integer): TsConditionalFormat;
+ function WriteConditionalCellFormat(ARange: TsCellRange; ACondition: TsCFCondition;
+ ACellFormatIndex: Integer): Integer; overload;
+ function WriteConditionalCellFormat(ARange: TsCellRange; ACondition: TsCFCondition;
+ AParam: Variant; ACellFormatIndex: Integer): Integer; overload;
+ function WriteConditionalCellFormat(ARange: TsCellRange; ACondition: TsCFCondition;
+ AParam1, AParam2: Variant; ACellFormatIndex: Integer): Integer; overload;
+
{ Formulas }
function BuildRPNFormula(ACell: PCell; ADestCell: PCell = nil): TsRPNFormula;
procedure CalcFormula(AFormula: PsFormula);
@@ -599,6 +610,8 @@ type
property Cells: TsCells read FCells;
{@@ List of all column records of the worksheet having a non-standard column width }
property Cols: TIndexedAVLTree read FCols;
+ {@@ Count of conditional format entries }
+ property ConditionalFormatCount: Integer read GetConditionalFormatCount;
{@@ Information how the worksheet is encrypted }
property CryptoInfo: TsCryptoInfo read FCryptoInfo write FCryptoInfo;
{@@ List of all comment records }
@@ -816,7 +829,8 @@ type
function AddFont(const AFontName: String; ASize: Single; AStyle: TsFontStyles;
AColor: TsColor; APosition: TsFontPosition = fpNormal): Integer; overload;
function AddFont(const AFont: TsFont): Integer; overload;
- procedure DeleteFont(AFontIndex: Integer);
+ function CloneFont(const AFontIndex: Integer): TsFont;
+ procedure DeleteFont(const AFontIndex: Integer);
function FindFont(const AFontName: String; ASize: Single; AStyle: TsFontStyles;
AColor: TsColor; APosition: TsFontPosition = fpNormal): Integer;
function GetBuiltinFontCount: Integer;
@@ -1171,6 +1185,7 @@ begin
FHyperlinks := TsHyperlinks.Create;
FFormulas := TsFormulas.Create;
FImages := TFPList.Create;
+ FConditionalFormats := TsConditionalFormatList.Create;
FPageLayout := TsPageLayout.Create(self);
@@ -1214,6 +1229,7 @@ begin
FHyperlinks.Free;
FFormulas.Free;
FImages.Free;
+ FConditionalFormats.Free;
inherited Destroy;
end;
@@ -8501,6 +8517,8 @@ begin
end;
end;
+{$include fpspreadsheet_CF.inc} // conditional formatting
+
{==============================================================================}
{ TsWorkbook }
@@ -9880,13 +9898,32 @@ begin
result := FFontList.Add(AFont);
end;
+{@@ ----------------------------------------------------------------------------
+ Creates a new font as a copy of the font at the specified index.
+ The new font is NOT YET added to the font list.
+ If the user does not add the font to the font list he is responsibile for
+ destroying it.
+-------------------------------------------------------------------------------}
+function TsWorkbook.CloneFont(const AFontIndex: Integer): TsFont;
+var
+ fnt: TsFont;
+begin
+ Result := TsFont.Create;
+ fnt := GetFont(AFontIndex);
+ Result.FontName := fnt.FontName;
+ Result.Size := fnt.Size;
+ Result.Style := fnt.Style;
+ Result.Color := fnt.Color;
+ Result.Position := fnt.Position;
+end;
+
{@@ ----------------------------------------------------------------------------
Deletes a font.
Use with caution because this will screw up the font assignment to cells.
The only legal reason to call this method is from a reader of a file format
in which the missing font #4 of BIFF does exist.
-------------------------------------------------------------------------------}
-procedure TsWorkbook.DeleteFont(AFontIndex: Integer);
+procedure TsWorkbook.DeleteFont(const AFontIndex: Integer);
var
fnt: TsFont;
begin
diff --git a/components/fpspreadsheet/source/common/fpspreadsheet_cf.inc b/components/fpspreadsheet/source/common/fpspreadsheet_cf.inc
new file mode 100644
index 000000000..0e94f9bfe
--- /dev/null
+++ b/components/fpspreadsheet/source/common/fpspreadsheet_cf.inc
@@ -0,0 +1,53 @@
+{ Included by fpspreadsheet.pas }
+
+{ Returns the count of conditional format items }
+function TsWorksheet.GetConditionalFormatCount: Integer;
+begin
+ Result := FConditionalFormats.Count;
+end;
+
+{@@ ----------------------------------------------------------------------------
+ Returns the conditional format item stored in the CF list at the specified
+ index.
+-------------------------------------------------------------------------------}
+function TsWorksheet.ReadConditionalFormat(AIndex: Integer): TsConditionalFormat;
+begin
+ Result := TsConditionalFormat(FConditionalFormats[AIndex]);
+end;
+
+{@@ ----------------------------------------------------------------------------
+ Creates a conditional format item for the cells given by ARange.
+ The condition specified must not require parameters, e.g. cfcEmpty
+-------------------------------------------------------------------------------}
+function TsWorksheet.WriteConditionalCellFormat(ARange: TsCellRange;
+ ACondition: TsCFCondition; ACellFormatIndex: Integer): Integer;
+begin
+ Result := FConditionalFormats.AddCellRule(ARange, ACondition,
+ ACellFormatIndex);
+end;
+
+{@@ ----------------------------------------------------------------------------
+ Creates a conditional format item for the cells given by ARange.
+ The condition specified must require one parameter, e.g. cfcEqual,
+ and the parameter must be specified as AParam.
+-------------------------------------------------------------------------------}
+function TsWorksheet.WriteConditionalCellFormat(ARange: TsCellRange;
+ ACondition: TsCFCondition; AParam: Variant; ACellFormatIndex: Integer): Integer;
+begin
+ Result := FConditionalFormats.AddCellRule(ARange, ACondition,
+ AParam, ACellFormatIndex);
+end;
+
+{@@ ----------------------------------------------------------------------------
+ Creates a conditional format item for the cells given by ARange.
+ The condition specified must requored two parameters, e.g. cfcBetween,
+ and the parameters must be specified as AParam1 and AParam2.
+-------------------------------------------------------------------------------}
+function TsWorksheet.WriteConditionalCellFormat(ARange: TsCellRange;
+ ACondition: TsCFCondition; AParam1, AParam2: Variant;
+ ACellFormatIndex: Integer): Integer;
+begin
+ Result := FConditionalFormats.AddCellRule(ARange, ACondition,
+ AParam1, AParam2, ACellFormatIndex);
+end;
+
diff --git a/components/fpspreadsheet/source/common/fpstypes.pas b/components/fpspreadsheet/source/common/fpstypes.pas
index ccd7493fc..c7fefa84c 100644
--- a/components/fpspreadsheet/source/common/fpstypes.pas
+++ b/components/fpspreadsheet/source/common/fpstypes.pas
@@ -10,6 +10,8 @@
unit fpsTypes;
{$mode objfpc}{$H+}
+{$modeswitch advancedrecords}
+
{$include fps.inc}
interface
@@ -719,6 +721,10 @@ type
// next two are deprecated...
NumberFormat: TsNumberFormat;
NumberFormatStr: String;
+ procedure SetBackgroundColor(AColor: TsColor);
+ procedure SetBorders(ABorders: TsCellBorders;
+ AColor: TsColor = scBlack; ALineStyle: TsLineStyle = lsThin);
+ procedure SetFont(AFontIndex: Integer);
end;
{@@ Pointer to a format record }
@@ -1059,6 +1065,44 @@ begin
end;
end;
+{ TsCellFormat }
+
+procedure TsCellFormat.SetBackgroundColor(AColor: TsColor);
+begin
+ UsedFormattingFields := UsedFormattingFields + [uffBackground];
+ Background.FgColor := AColor;
+ Background.BgColor := AColor;
+ Background.Style := fsSolidFill;
+end;
+
+procedure TsCellFormat.SetBorders(ABorders: TsCellBorders;
+ AColor: TsColor = scBlack; ALineStyle: TsLineStyle = lsThin);
+var
+ cb: TsCellBorder;
+begin
+ for cb in ABorders do
+ begin
+ if (AColor = scNone) or (AColor = scTransparent) then
+ Exclude(Border, cb)
+ else
+ begin
+ Include(Border, cb);
+ BorderStyles[cb].LineStyle := ALineStyle;
+ BorderStyles[cb].Color := AColor;
+ end;
+ end;
+ if Border = [] then
+ UsedFormattingFields := UsedFormattingfields - [uffBorder]
+ else
+ UsedFormattingFields := UsedFormattingfields + [uffBorder];
+end;
+
+procedure TsCellFormat.SetFont(AFontIndex: Integer);
+begin
+ FontIndex := AFontIndex;
+ UsedFormattingFields := UsedFormattingFields + [uffFont];
+end;
+
{ TsFont }
diff --git a/components/fpspreadsheet/source/common/fpsutils.pas b/components/fpspreadsheet/source/common/fpsutils.pas
index 61f9dec40..39269d8fd 100644
--- a/components/fpspreadsheet/source/common/fpsutils.pas
+++ b/components/fpspreadsheet/source/common/fpsutils.pas
@@ -1129,9 +1129,9 @@ const
function GetCellString(ARow, ACol: Cardinal;
AFlags: TsRelFlags = [rfRelRow, rfRelCol]): String;
begin
- Result := Format('%s%s%s%d', [
+ Result := Format('%s%s%s%s', [
RELCHAR[rfRelCol in AFlags], GetColString(ACol),
- RELCHAR[rfRelRow in AFlags], ARow+1
+ RELCHAR[rfRelRow in AFlags], GetRowString(ARow)
]);
end;
@@ -2188,7 +2188,7 @@ end;
@param AValue RGB color value (compatible with the TColor data type
of the graphics unit)
- @param AExcelDialect If TRUE, returned string is in Excels format for xlsx,
+ @param AExcelDialect If TRUE, returned string is in Excel's format for xlsx,
i.e. in AARRGGBB notation, like '00FF0000' for "red"
@return HTML-compatible string, like '#FF0000' (AExcelDialect = false)
-------------------------------------------------------------------------------}
diff --git a/components/fpspreadsheet/source/common/xlsxooxml.pas b/components/fpspreadsheet/source/common/xlsxooxml.pas
index 023285614..e4476ff0c 100644
--- a/components/fpspreadsheet/source/common/xlsxooxml.pas
+++ b/components/fpspreadsheet/source/common/xlsxooxml.pas
@@ -42,6 +42,7 @@ uses
fpszipper,
{$ENDIF}
fpsTypes, fpsUtils, fpsReaderWriter, fpsNumFormat, fpsPalette,
+ fpsConditionalFormat,
fpsxmlcommon, xlsCommon;
type
@@ -123,6 +124,7 @@ type
FSharedStringsCount: Integer;
FFillList: array of PsCellFormat;
FBorderList: array of PsCellFormat;
+ FDifferentialFormatIndexList: array of Integer;
function GetActiveTab: String;
procedure Get_rId(AWorksheet: TsBasicWorksheet;
out AComment_rId, AFirstHyperlink_rId, ADrawing_rId, ADrawingHF_rId: Integer);
@@ -134,6 +136,7 @@ type
function FindFillInList(AFormat: PsCellFormat): Integer;
function GetStyleIndex(ACell: PCell): Cardinal;
procedure ListAllBorders;
+ procedure ListAllDifferentialFormats;
procedure ListAllFills;
function PrepareFormula(const AFormula: String): String;
procedure ResetStreams;
@@ -141,7 +144,13 @@ type
procedure WriteColBreaks(AStream: TStream; AWorksheet: TsBasicWorksheet);
procedure WriteCols(AStream: TStream; AWorksheet: TsBasicWorksheet);
procedure WriteComments(AWorksheet: TsBasicWorksheet);
+ procedure WriteConditionalFormat(AStream: TStream; AFormat: TsConditionalFormat; var APriority: Integer);
+ procedure WriteConditionalFormatCellRule(AStream: TStream; ARule: TsCFCellRule; APriority: Integer);
+ procedure WriteConditionalFormatRule(AStream: TStream; ARule: TsCFRule; var APriority: Integer);
+ procedure WriteConditionalFormats(AStream: TStream; AWorksheet: TsBasicWorksheet);
procedure WriteDefinedNames(AStream: TStream);
+ procedure WriteDifferentialFormat(AStream: TStream; AFormat: PsCellFormat);
+ procedure WriteDifferentialFormats(AStream: TStream);
procedure WriteDimension(AStream: TStream; AWorksheet: TsBasicWorksheet);
procedure WriteDrawings(AWorksheet: TsBasicWorksheet);
procedure WriteDrawingRels(AWorksheet: TsBasicWorksheet);
@@ -164,6 +173,7 @@ type
procedure WriteSheetProtection(AStream: TStream; AWorksheet: TsBasicWorksheet);
procedure WriteSheets(AStream: TStream);
procedure WriteSheetViews(AStream: TStream; AWorksheet: TsBasicWorksheet);
+ procedure WriteStyle(AStream: TStream; ANodeName: String; AFormat: PsCellFormat);
procedure WriteStyleList(AStream: TStream; ANodeName: String);
procedure WriteVmlDrawings(AWorksheet: TsBasicWorksheet);
procedure WriteVMLDrawings_Comments(AWorksheet: TsBasicWorksheet);
@@ -313,6 +323,9 @@ type
BorderStyles: TsCellBorderStyles;
end;
+ TDifferentialFormatData = class
+ end;
+
THyperlinkListData = class
ID: String;
CellRef: String;
@@ -359,6 +372,21 @@ const
'lightGrid' // fsHatchThinHor
);
+ LINESTYLE_TYPES: array[TsLineStyle] of String = (
+ 'thin', // lsThin
+ 'medium', // lsMedium
+ 'dashed', // lsDashed
+ 'dotted', // lsDotted
+ 'thick', // lsThick
+ 'double', // lsDouble
+ 'hair', // lsHair
+ 'mediumDashed', // lsMediumDash
+ 'dashDot', // lsDashDot
+ 'mediumDashDot', // lsMediumDashDot
+ 'dashDotDot', // lsDashDotDot
+ 'mediumDashDotDot', // lsMediumDashDotDot
+ 'slantDashDot' // lsSlantDashDot
+ );
procedure InitOOXMLLimitations(out ALimitations: TsSpreadsheetFormatLimitations);
begin
@@ -3035,6 +3063,49 @@ begin
end;
end;
+{ FDifferentialFormatIndexList stores the indexes of the cells formats used
+ in conditional formatting. }
+procedure TsSpreadOOXMLWriter.ListAllDifferentialFormats;
+var
+ book: TsWorkbook;
+ sheet: TsWorksheet;
+ n: Integer;
+ idx: Integer;
+ i, j, k, r, d: Integer;
+ CF: TsConditionalFormat;
+ rule: TsCFCellRule;
+begin
+ n := 0;
+ SetLength(FDifferentialFormatIndexList, n);
+
+ book := TsWorkbook(FWorkbook);
+ for i:=0 to book.GetWorksheetCount-1 do begin
+ sheet := book.GetWorksheetByIndex(i);
+ for j := 0 to sheet.ConditionalFormatCount-1 do
+ begin
+ CF := sheet.ReadConditionalFormat(j);
+ for k := 0 to CF.RulesCount-1 do
+ if CF.Rules[k] is TsCFCellRule then
+ begin
+ rule := TsCFCellRule(CF.Rules[k]);
+ idx := -1;
+ for d := 0 to High(FDifferentialFormatIndexList) do
+ if FDifferentialFormatIndexList[d] = rule.FormatIndex then
+ begin
+ idx := d;
+ break;
+ end;
+ if idx = -1 then
+ begin
+ SetLength(FDifferentialFormatIndexList, n+1);
+ FDifferentialFormatIndexList[n] := rule.FormatIndex;
+ inc(n);
+ end;
+ end;
+ end;
+ end;
+end;
+
{ Creates a list of all fill styles found in the workbook.
The list contains indexes into the array FFormattingStyles for each unique
combination of fill attributes.
@@ -3067,13 +3138,6 @@ begin
end;
procedure TsSpreadOOXMLWriter.WriteBorderList(AStream: TStream);
-const
- // lsThin, lsMedium, lsDashed, lsDotted, lsThick, lsDouble, lsHair,
- // lsMediumDash, lsDashDot, lsMediumDashDot, lsDashDotDot, lsMediumDashDotDot,
- // lsSlantDashDot
- LINESTYLE_NAME: Array[TsLineStyle] of String = (
- 'thin', 'medium', 'dashed', 'dotted', 'thick', 'double', 'hair',
- 'mediumDashed', 'dashDot', 'mediumDashDot', 'dashDotDot', 'mediumDashDotDot', 'slantDashDot');
procedure WriteBorderStyle(AStream: TStream; AFormatRecord: PsCellFormat;
ABorder: TsCellBorder; ABorderName: String);
@@ -3087,7 +3151,7 @@ const
begin
if (ABorder in AFormatRecord^.Border) then begin
// Line style
- styleName := LINESTYLE_NAME[AFormatRecord^.BorderStyles[ABorder].LineStyle];
+ styleName := LINESTYLE_TYPES[AFormatRecord^.BorderStyles[ABorder].LineStyle];
// Border color
rgb := AFormatRecord^.BorderStyles[ABorder].Color;
@@ -3254,6 +3318,89 @@ begin
'');
end;
+procedure TsSpreadOOXMLWriter.WriteConditionalFormat(AStream: TStream;
+ AFormat: TsConditionalFormat; var APriority: Integer);
+var
+ rangeStr: String;
+ i: Integer;
+ rule: TsCFRule;
+begin
+ with AFormat.CellRange do
+ rangeStr := GetCellRangeString(Row1, Col1, Row2, Col2,rfAllRel, true);
+ AppendToStream(AStream, Format(
+ '', [rangeStr]));
+ for i := 0 to AFormat.RulesCount-1 do
+ begin
+ rule := AFormat.Rules[i];
+ WriteConditionalFormatRule(AStream, rule, APriority);
+ end;
+ AppendToStream(AStream,
+ '');
+end;
+
+procedure TsSpreadOOXMLWriter.WriteConditionalFormatCellRule(AStream: TStream;
+ ARule: TsCFCellRule; APriority: Integer);
+const
+ OPERATOR_NAMES_1: array[cfcEqual..cfcLessEqual] of String =
+ ('equal', 'notEqual', 'greaterThan', 'lessThan', 'greaterThanOrEqual', 'lessThanOrEqual');
+ OPERATOR_NAMES_2: array[cfcBetween..cfcNotBetween] of String =
+ ('between', 'notBetween');
+begin
+ case ARule.Condition of
+ cfcEqual..cfcLessEqual:
+ AppendToStream(AStream, Format(
+ '' +
+ '%s'+
+ '', [
+ APriority, OPERATOR_NAMES_1[ARule.Condition], ARule.Operand1
+ ]));
+
+ cfcBetween, cfcNotBetween:
+ AppendToStream(AStream, Format(
+ '' +
+ '%s'+
+ '%s'+
+ '', [
+ APriority, OPERATOR_NAMES_1[ARule.Condition], ARule.Operand1, ARule.Operand2
+ ]));
+
+ else
+ FWorkbook.AddErrorMsg('ConditionalFormat operator not supported.');
+ end;
+end;
+
+procedure TsSpreadOOXMLWriter.WriteConditionalFormatRule(AStream: TStream;
+ ARule: TsCFRule; var APriority: Integer);
+begin
+ if ARule is TsCFCellRule then begin
+ WriteConditionalFormatCellRule(AStream, TsCFCellRule(ARule), APriority);
+ dec(APriority);
+ end;
+end;
+
+procedure TsSpreadOOXMLWriter.WriteConditionalFormats(AStream: TStream;
+ AWorksheet: TsBasicWorksheet);
+var
+ worksheet: TsWorksheet absolute AWorksheet;
+ i: Integer;
+ CF: TsConditionalFormat;
+ priority: Integer = 0;
+begin
+ if worksheet.ConditionalFormatCount = 0 then
+ exit;
+
+ for i := 0 to worksheet.ConditionalFormatCount-1 do
+ begin
+ CF := worksheet.ReadConditionalFormat(i);
+ inc(priority, CF.RulesCount);
+ end;
+
+ for i := 0 to worksheet.ConditionalFormatCount-1 do begin
+ CF := worksheet.ReadConditionalFormat(i);
+ WriteConditionalFormat(AStream, CF, priority);
+ end;
+end;
+
procedure TsSpreadOOXMLWriter.WriteDimension(AStream: TStream;
AWorksheet: TsBasicWorksheet);
var
@@ -4035,16 +4182,137 @@ begin
end;
end;
+procedure TsSpreadOOXMLWriter.WriteStyle(AStream: TStream; ANodeName: String;
+ AFormat: PsCellFormat);
+var
+ s: String;
+ sAlign: String;
+ sProtected: String;
+ book: TsWorkbook;
+ numFmtParams: TsNumFormatParams;
+ numFmtStr: String;
+ fontID: Integer;
+ fillID: Integer;
+ borderID: Integer;
+ idx: Integer;
+begin
+ book := TsWorkbook(FWorkbook);
+
+ s := '';
+ sAlign := '';
+ sProtected := '';
+
+ { Number format }
+ if (uffNumberFormat in AFormat^.UsedFormattingFields) then
+ begin
+ numFmtParams := book.GetNumberFormat(AFormat^.NumberFormatIndex);
+ if numFmtParams <> nil then
+ begin
+ numFmtStr := numFmtParams.NumFormatStr;
+ idx := NumFormatList.IndexOf(numFmtStr);
+ end else
+ idx := 0; // "General" format is at index 0
+ s := s + Format('numFmtId="%d" applyNumberFormat="1" ', [idx]);
+ end else
+ s := s + 'numFmtId="0" ';
+
+ { Font }
+ fontId := 0;
+ if (uffFont in AFormat^.UsedFormattingFields) then
+ fontID := AFormat^.FontIndex;
+ s := s + Format('fontId="%d" ', [fontId]);
+ if fontID > 0 then s := s + 'applyFont="1" ';
+
+ if ANodeName = 'xf' then s := s + 'xfId="0" ';
+// if ANodeName = 'cellXfs' then s := s + 'xfId="0" ';
+
+ { Text rotation }
+ if (uffTextRotation in AFormat^.UsedFormattingFields) then
+ case AFormat^.TextRotation of
+ trHorizontal:
+ ;
+ rt90DegreeClockwiseRotation:
+ sAlign := sAlign + Format('textRotation="%d" ', [180]);
+ rt90DegreeCounterClockwiseRotation:
+ sAlign := sAlign + Format('textRotation="%d" ', [90]);
+ rtStacked:
+ sAlign := sAlign + Format('textRotation="%d" ', [255]);
+ end;
+
+ { Text alignment }
+ if (uffHorAlign in AFormat^.UsedFormattingFields) and (AFormat^.HorAlignment <> haDefault)
+ then
+ case AFormat^.HorAlignment of
+ haLeft : sAlign := sAlign + 'horizontal="left" ';
+ haCenter: sAlign := sAlign + 'horizontal="center" ';
+ haRight : sAlign := sAlign + 'horizontal="right" ';
+ end;
+
+ if (uffVertAlign in AFormat^.UsedFormattingFields) and (AFormat^.VertAlignment <> vaDefault)
+ then
+ case AFormat^.VertAlignment of
+ vaTop : sAlign := sAlign + 'vertical="top" ';
+ vaCenter: sAlign := sAlign + 'vertical="center" ';
+ vaBottom: sAlign := sAlign + 'vertical="bottom" ';
+ end;
+
+ { Word wrap }
+ if (uffWordWrap in AFormat^.UsedFormattingFields) then
+ sAlign := sAlign + 'wrapText="1" ';
+
+ { BiDi mode }
+ if (uffBiDi in Aformat^.UsedFormattingFields) and (AFormat^.BiDiMode <> bdDefault) then
+ sAlign := sAlign + Format('readingOrder="%d" ', [Ord(AFormat^.BiDiMode)]);
+
+ if sAlign <> '' then
+ begin
+ s := s + 'applyAlignment="1" ';
+ sAlign := '';
+ end;
+
+ { Fill }
+ if (uffBackground in AFormat^.UsedFormattingFields) then
+ begin
+ fillID := FindFillInList(AFormat);
+ if fillID = -1 then fillID := 0;
+ s := s + Format('fillId="%d" applyFill="1" ', [fillID]);
+ end;
+
+ { Border }
+ if (uffBorder in AFormat^.UsedFormattingFields) then
+ begin
+ borderID := FindBorderInList(AFormat);
+ if borderID = -1 then borderID := 0;
+ s := s + Format('borderId="%d" applyBorder="1" ', [borderID]);
+ end;
+
+ { Protection }
+ if not (cpLockCell in AFormat^.Protection) then
+ sProtected := 'locked="0" ';
+
+ if (cpHideFormulas in AFormat^.Protection) then
+ sProtected := sProtected + 'hidden="1" ';
+
+ if sProtected <> '' then
+ begin
+ s := s + 'applyProtection="1" ';
+ sProtected := '';
+ end;
+
+ { Write everything to stream }
+ if (sAlign = '') and (sProtected = '') then
+ AppendToStream(AStream,
+ Format('<%s %s />', [ANodeName, s]))
+ else
+ AppendToStream(AStream,
+ Format('<%s %s>', [ANodeName, s]),
+ sAlign + sProtected,
+ Format('', [ANodeName]));
+end;
+
{ Writes the style list which the workbook has collected in its FormatList }
procedure TsSpreadOOXMLWriter.WriteStyleList(AStream: TStream; ANodeName: String);
var
- s, sAlign, sProtected: String;
- fontID: Integer;
- numFmtParams: TsNumFormatParams;
- numFmtStr: String;
- fillId: Integer;
- borderId: Integer;
- idx: Integer;
fmt: PsCellFormat;
i: Integer;
book: TsWorkbook;
@@ -4057,115 +4325,7 @@ begin
for i:=0 to book.GetNumCellFormats-1 do
begin
fmt := book.GetPointerToCellFormat(i);
- s := '';
- sAlign := '';
- sProtected := '';
-
- { Number format }
- if (uffNumberFormat in fmt^.UsedFormattingFields) then
- begin
- numFmtParams := book.GetNumberFormat(fmt^.NumberFormatIndex);
- if numFmtParams <> nil then
- begin
- numFmtStr := numFmtParams.NumFormatStr;
- idx := NumFormatList.IndexOf(numFmtStr);
- end else
- idx := 0; // "General" format is at index 0
- s := s + Format('numFmtId="%d" applyNumberFormat="1" ', [idx]);
- end else
- s := s + 'numFmtId="0" ';
-
- { Font }
- fontId := 0;
- if (uffFont in fmt^.UsedFormattingFields) then
- fontID := fmt^.FontIndex;
- s := s + Format('fontId="%d" ', [fontId]);
- if fontID > 0 then s := s + 'applyFont="1" ';
-
- if ANodeName = 'cellXfs' then s := s + 'xfId="0" ';
-
- { Text rotation }
- if (uffTextRotation in fmt^.UsedFormattingFields) then
- case fmt^.TextRotation of
- trHorizontal:
- ;
- rt90DegreeClockwiseRotation:
- sAlign := sAlign + Format('textRotation="%d" ', [180]);
- rt90DegreeCounterClockwiseRotation:
- sAlign := sAlign + Format('textRotation="%d" ', [90]);
- rtStacked:
- sAlign := sAlign + Format('textRotation="%d" ', [255]);
- end;
-
- { Text alignment }
- if (uffHorAlign in fmt^.UsedFormattingFields) and (fmt^.HorAlignment <> haDefault)
- then
- case fmt^.HorAlignment of
- haLeft : sAlign := sAlign + 'horizontal="left" ';
- haCenter: sAlign := sAlign + 'horizontal="center" ';
- haRight : sAlign := sAlign + 'horizontal="right" ';
- end;
-
- if (uffVertAlign in fmt^.UsedFormattingFields) and (fmt^.VertAlignment <> vaDefault)
- then
- case fmt^.VertAlignment of
- vaTop : sAlign := sAlign + 'vertical="top" ';
- vaCenter: sAlign := sAlign + 'vertical="center" ';
- vaBottom: sAlign := sAlign + 'vertical="bottom" ';
- end;
-
- { Word wrap }
- if (uffWordWrap in fmt^.UsedFormattingFields) then
- sAlign := sAlign + 'wrapText="1" ';
-
- { BiDi mode }
- if (uffBiDi in fmt^.UsedFormattingFields) and (fmt^.BiDiMode <> bdDefault) then
- sAlign := sAlign + Format('readingOrder="%d" ', [Ord(fmt^.BiDiMode)]);
-
- if sAlign <> '' then
- begin
- s := s + 'applyAlignment="1" ';
- sAlign := '';
- end;
-
- { Fill }
- if (uffBackground in fmt^.UsedFormattingFields) then
- begin
- fillID := FindFillInList(fmt);
- if fillID = -1 then fillID := 0;
- s := s + Format('fillId="%d" applyFill="1" ', [fillID]);
- end;
-
- { Border }
- if (uffBorder in fmt^.UsedFormattingFields) then
- begin
- borderID := FindBorderInList(fmt);
- if borderID = -1 then borderID := 0;
- s := s + Format('borderId="%d" applyBorder="1" ', [borderID]);
- end;
-
- { Protection }
- if not (cpLockCell in fmt^.Protection) then
- sProtected := 'locked="0" ';
-
- if (cpHideFormulas in fmt^.Protection) then
- sProtected := sProtected + 'hidden="1" ';
-
- if sProtected <> '' then
- begin
- s := s + 'applyProtection="1" ';
- sProtected := '';
- end;
-
- { Write everything to stream }
- if (sAlign = '') and (sProtected = '') then
- AppendToStream(AStream,
- '')
- else
- AppendToStream(AStream,
- '',
- sAlign + sProtected,
- '');
+ WriteStyle(AStream, 'xf', fmt);
end;
AppendToStream(FSStyles, Format(
@@ -4850,9 +5010,10 @@ begin
'' +
'');
+ // Conditional format styles
+ WriteDifferentialFormats(FSStyles);
+
// Misc
- AppendToStream(FSStyles,
- '');
AppendToStream(FSStyles,
'');
@@ -5081,6 +5242,138 @@ begin
'' + stotal + '');
end;
+procedure TsSpreadOOXMLWriter.WriteDifferentialFormat(AStream: TStream;
+ AFormat: PsCellFormat);
+
+ procedure WriteBorderStyle(AStream: TStream; AFormatRecord: PsCellFormat;
+ ABorder: TsCellBorder; ABorderName: String);
+ { border names found in xlsx files for Excel selections:
+ "thin", "hair", "dotted", "dashed", "dashDotDot", "dashDot", "mediumDashDotDot",
+ "slantDashDot", "mediumDashDot", "mediumDashed", "medium", "thick", "double" }
+ var
+ styleName: String;
+ colorStr: String;
+ rgb: TsColor;
+ begin
+ if (ABorder in AFormatRecord^.Border) then begin
+ // Line style
+ styleName := LINESTYLE_TYPES[AFormatRecord^.BorderStyles[ABorder].LineStyle];
+
+ // Border color
+ rgb := AFormatRecord^.BorderStyles[ABorder].Color;
+ colorStr := ColorToHTMLColorStr(rgb, true);
+ AppendToStream(AStream, Format(
+ '<%s style="%s">',
+ [ABorderName, styleName, colorStr, ABorderName]
+ ));
+ end else
+ AppendToStream(AStream, Format(
+ '<%s />', [ABorderName]));
+ end;
+
+var
+ pt, bc, fc, diag: string;
+ font: TsFont;
+begin
+ AppendToStream(AStream,
+ '');
+
+ { background fill }
+ if (uffBackground in AFormat^.UsedFormattingFields) then
+ begin
+ pt := PATTERN_TYPES[AFormat^.Background.Style];
+ if AFormat^.Background.FgColor <> scTransparent then
+ fc := Format('rgb="%s"', [Copy(ColorToHTMLColorStr(AFormat^.Background.FgColor), 2, MaxInt)]);
+ if AFormat^.Background.BgColor = scTransparent then
+ bc := 'auto="1"'
+ else
+ bc := Format('rgb="%s"', [Copy(ColorToHTMLColorStr(AFormat^.Background.BgColor), 2, MaxInt)]);
+ AppendToStream(AStream,
+ '' + Format(
+ '', [pt]) + Format(
+ '', [fc]) + Format(
+ '', [bc]) +
+ '' +
+ '');
+ end;
+
+ { cell borders }
+ if (uffBorder in AFormat^.UsedFormattingFields) then
+ begin
+ diag := '';
+ if (cbDiagUp in AFormat^.Border) then
+ diag := diag + ' diagonalUp="1"';
+ if (cbDiagDown in AFormat^.Border) then
+ diag := diag + ' diagonalDown="1"';
+ AppendToStream(AStream,
+ '');
+ WriteBorderStyle(AStream, AFormat, cbWest, 'left');
+ WriteBorderStyle(AStream, AFormat, cbEast, 'right');
+ WriteBorderStyle(AStream, AFormat, cbNorth, 'top');
+ WriteBorderStyle(AStream, AFormat, cbSouth, 'bottom');
+ // OOXML uses the same border style for both diagonals. In agreement with
+ // the biff implementation we select the style from the diagonal-up line.
+ WriteBorderStyle(AStream, AFormat, cbDiagUp, 'diagonal');
+ AppendToStream(AStream,
+ '');
+
+ // TODO: Fix font handling: although correct in syntax something seems to be missing...
+ { font }
+ {
+ font := TsWorkbook(FWorkbook).GetFont(AFormat^.FontIndex);
+ if font <> nil then
+ begin
+ fc := ColorToHTMLColorStr(font.Color, true);
+ AppendToStream(AStream, '');
+ AppendToStream(AStream, Format('', [fc] ));
+ if fssBold in font.Style then
+ AppendToStream(AStream, '');
+ if fssItalic in font.Style then
+ AppendToStream(AStream, '');
+ if fssStrikeout in font.Style then
+ AppendToStream(AStream, '