You've already forked lazarus-ccr
fpspreadsheet: Initial commit for conditional formatting. Based on ideas of forum user "abcthing" (https://forum.lazarus.freepascal.org/index.php/topic,50149.0.html).
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@7492 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
@ -34,7 +34,7 @@
|
||||
This package is all you need if you don't want graphical components (like grids and charts)."/>
|
||||
<License Value="LGPL with static linking exception. This is the same license as is used in the LCL (Lazarus Component Library)."/>
|
||||
<Version Major="1" Minor="13"/>
|
||||
<Files Count="46">
|
||||
<Files Count="48">
|
||||
<Item1>
|
||||
<Filename Value="source\fps.inc"/>
|
||||
<Type Value="Include"/>
|
||||
@ -258,6 +258,14 @@ This package is all you need if you don't want graphical components (like g
|
||||
<Filename Value="source\common\fpscrypto.pas"/>
|
||||
<UnitName Value="fpsCrypto"/>
|
||||
</Item46>
|
||||
<Item47>
|
||||
<Filename Value="source\common\fpsconditionalformat.pas"/>
|
||||
<UnitName Value="fpsConditionalFormat"/>
|
||||
</Item47>
|
||||
<Item48>
|
||||
<Filename Value="source\common\fpspreadsheet_cf.inc"/>
|
||||
<Type Value="Binary"/>
|
||||
</Item48>
|
||||
</Files>
|
||||
<i18n>
|
||||
<EnableI18N Value="True"/>
|
||||
|
||||
299
components/fpspreadsheet/source/common/fpsconditionalformat.pas
Normal file
299
components/fpspreadsheet/source/common/fpsconditionalformat.pas
Normal file
@ -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.
|
||||
|
||||
@ -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
|
||||
|
||||
53
components/fpspreadsheet/source/common/fpspreadsheet_cf.inc
Normal file
53
components/fpspreadsheet/source/common/fpspreadsheet_cf.inc
Normal file
@ -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;
|
||||
|
||||
@ -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 }
|
||||
|
||||
|
||||
@ -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)
|
||||
-------------------------------------------------------------------------------}
|
||||
|
||||
@ -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
|
||||
'</comments>');
|
||||
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(
|
||||
'<conditionalFormatting sqref="%s">', [rangeStr]));
|
||||
for i := 0 to AFormat.RulesCount-1 do
|
||||
begin
|
||||
rule := AFormat.Rules[i];
|
||||
WriteConditionalFormatRule(AStream, rule, APriority);
|
||||
end;
|
||||
AppendToStream(AStream,
|
||||
'</conditionalFormatting>');
|
||||
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(
|
||||
'<cfRule type="cellIs" dxfId="0" priority="%d" operator="%s">' +
|
||||
'<formula>%s</formula>'+
|
||||
'</cfRule>', [
|
||||
APriority, OPERATOR_NAMES_1[ARule.Condition], ARule.Operand1
|
||||
]));
|
||||
|
||||
cfcBetween, cfcNotBetween:
|
||||
AppendToStream(AStream, Format(
|
||||
'<cfRule type="cellIs" dxfId="0" priority="%d" operator="%s">' +
|
||||
'<formula>%s</formula>'+
|
||||
'<formula>%s</formula>'+
|
||||
'</cfRule>', [
|
||||
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 := '<alignment ' + 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 := '<protection ' + 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('</%s>', [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 := '<alignment ' + 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 := '<protection ' + sProtected + '/>';
|
||||
end;
|
||||
|
||||
{ Write everything to stream }
|
||||
if (sAlign = '') and (sProtected = '') then
|
||||
AppendToStream(AStream,
|
||||
'<xf ' + s + '/>')
|
||||
else
|
||||
AppendToStream(AStream,
|
||||
'<xf ' + s + '>',
|
||||
sAlign + sProtected,
|
||||
'</xf>');
|
||||
WriteStyle(AStream, 'xf', fmt);
|
||||
end;
|
||||
|
||||
AppendToStream(FSStyles, Format(
|
||||
@ -4850,9 +5010,10 @@ begin
|
||||
'<cellStyle name="Normal" xfId="0" builtinId="0" />' +
|
||||
'</cellStyles>');
|
||||
|
||||
// Conditional format styles
|
||||
WriteDifferentialFormats(FSStyles);
|
||||
|
||||
// Misc
|
||||
AppendToStream(FSStyles,
|
||||
'<dxfs count="0" />');
|
||||
AppendToStream(FSStyles,
|
||||
'<tableStyles count="0" defaultTableStyle="TableStyleMedium9" defaultPivotStyle="PivotStyleLight16" />');
|
||||
|
||||
@ -5081,6 +5242,138 @@ begin
|
||||
'<definedNames>' + stotal + '</definedNames>');
|
||||
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"><color rgb="%s" /></%s>',
|
||||
[ABorderName, styleName, colorStr, ABorderName]
|
||||
));
|
||||
end else
|
||||
AppendToStream(AStream, Format(
|
||||
'<%s />', [ABorderName]));
|
||||
end;
|
||||
|
||||
var
|
||||
pt, bc, fc, diag: string;
|
||||
font: TsFont;
|
||||
begin
|
||||
AppendToStream(AStream,
|
||||
'<dxf>');
|
||||
|
||||
{ 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,
|
||||
'<fill>' + Format(
|
||||
'<patternFill patternType="%s">', [pt]) + Format(
|
||||
'<fgColor %s />', [fc]) + Format(
|
||||
'<bgColor %s />', [bc]) +
|
||||
'</patternFill>' +
|
||||
'</fill>');
|
||||
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,
|
||||
'<border' + diag + '>');
|
||||
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,
|
||||
'</border>');
|
||||
|
||||
// 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, '<font>');
|
||||
AppendToStream(AStream, Format('<color rgb="%s" />', [fc] ));
|
||||
if fssBold in font.Style then
|
||||
AppendToStream(AStream, '<b />');
|
||||
if fssItalic in font.Style then
|
||||
AppendToStream(AStream, '<i />');
|
||||
if fssStrikeout in font.Style then
|
||||
AppendToStream(AStream, '<strike />');
|
||||
// Font name, font size, and style underline not supported
|
||||
AppendToStream(AStream, '</font>');
|
||||
end;
|
||||
}
|
||||
end;
|
||||
|
||||
AppendToStream(AStream,
|
||||
'</dxf>');
|
||||
end;
|
||||
|
||||
procedure TsSpreadOOXMLWriter.WriteDifferentialFormats(AStream: TStream);
|
||||
var
|
||||
book: TsWorkbook;
|
||||
i: Integer;
|
||||
fmtIndex: Integer;
|
||||
fmt: PsCellFormat;
|
||||
begin
|
||||
if Length(FDifferentialFormatIndexList) = 0 then
|
||||
begin
|
||||
AppendToStream(AStream, '<dxfs count="0" />');
|
||||
exit;
|
||||
end;
|
||||
|
||||
AppendToStream(AStream, Format(
|
||||
'<dxfs count="%d">', [Length(FDifferentialFormatIndexList)]));
|
||||
|
||||
book := TsWorkbook(FWorkbook);
|
||||
for i := 0 to High(FDifferentialFormatIndexList) do
|
||||
begin
|
||||
fmtIndex := FDifferentialFormatIndexList[i];
|
||||
fmt := book.GetPointerToCellFormat(fmtIndex);
|
||||
WriteDifferentialFormat(AStream, fmt);
|
||||
end;
|
||||
|
||||
AppendToStream(AStream,
|
||||
'</dxfs>');
|
||||
{
|
||||
AppendToStream(AStream,
|
||||
'<tableStyles count="0" defaultTableStyle="TableStyleMedium2" defaultPivotStyle="PivotStyleLight16" />');
|
||||
}
|
||||
end;
|
||||
|
||||
procedure TsSpreadOOXMLWriter.WriteWorkbook(AStream: TStream);
|
||||
begin
|
||||
AppendToStream(AStream,
|
||||
@ -5226,6 +5519,7 @@ begin
|
||||
WriteSheetProtection(FSSheets[FCurSheetNum], AWorksheet);
|
||||
WriteMergedCells(FSSheets[FCurSheetNum], AWorksheet);
|
||||
WriteHyperlinks(FSSheets[FCurSheetNum], AWorksheet, rId_FirstHyperlink);
|
||||
WriteConditionalFormats(FSSheets[FCurSheetNum], AWorksheet);
|
||||
|
||||
WritePrintOptions(FSSheets[FCurSheetNum], AWorksheet);
|
||||
WritePageMargins(FSSheets[FCurSheetNum], AWorksheet);
|
||||
@ -5417,6 +5711,7 @@ begin
|
||||
ListAllNumFormats;
|
||||
ListAllFills;
|
||||
ListAllBorders;
|
||||
ListAllDifferentialFormats;
|
||||
|
||||
{ Create the streams that will hold the file contents }
|
||||
CreateStreams;
|
||||
|
||||
Reference in New Issue
Block a user