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

fpspreadsheet: Make number format parser independent of workbook. Some cleanup.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@4167 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2015-05-31 16:06:22 +00:00
parent 61a55feef8
commit f8f72e3847
16 changed files with 99 additions and 266 deletions
Download Patch File Download Diff File Expand all files Collapse all files

4
components/fpspreadsheet/examples/visual/fpsctrls/main.lfm
View File

@ -116,6 +116,10 @@ object MainForm: TMainForm
WorkbookSource = WorkbookSource
Mode = imWorkbook
ExtendedColSizing = True
ColWidths = (
138
139
)
end
end
object InspectorSplitter: TSplitter

1
components/fpspreadsheet/examples/visual/fpsctrls/main.pas
View File

@ -371,6 +371,7 @@ begin
Result := TMemIniFile.Create(GetAppConfigFile(false));
end;
{ TMainForm }
{ Adds a column before the active cell }

40
components/fpspreadsheet/examples/visual/shared/snumformatform.pas
View File

@ -7,7 +7,7 @@ interface
uses
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ButtonPanel,
ExtCtrls, StdCtrls, Spin, Buttons, types, contnrs, inifiles,
fpsTypes, fpSpreadsheet, fpsNumFormat;
fpsTypes, fpSpreadsheet;
type
TsNumFormatCategory = (nfcNumber, nfcPercent, nfcScientific, nfcFraction,
@ -342,8 +342,6 @@ end;
{ TNumFormatForm }
constructor TNumFormatForm.Create(AOwner: TComponent);
var
cat: TsNumFormatCategory;
begin
inherited Create(AOwner);
FGenerator[nfcNumber] := -1234.123456;
@ -359,7 +357,6 @@ end;
procedure TNumFormatForm.BtnAddCurrSymbolClick(Sender: TObject);
var
F: TCurrencyForm;
i: Integer;
begin
F := TCurrencyForm.Create(nil);
try
@ -400,7 +397,6 @@ var
idx: Integer;
nfs: String;
n, i: Integer;
nfp: TsNumFormatParams;
begin
if LbCategory.ItemIndex > -1 then begin
// Find in internal template list
@ -476,7 +472,7 @@ begin
exit;
if EdNumFormatStr.Text = '' then nfs := 'General' else nfs := EdNumFormatStr.Text;
nfp := CreateNumFormatParams(FWorkbook, nfs);
nfp := CreateNumFormatParams(nfs, FWorkbook.FormatSettings);
if nfp <> nil then
try
nfp.SetNegativeRed(CbNegRed.Checked);
@ -497,7 +493,7 @@ begin
exit;
if EdNumFormatStr.Text = '' then nfs := 'General' else nfs := EdNumFormatStr.Text;
nfp := CreateNumFormatParams(FWorkbook, nfs);
nfp := CreateNumFormatParams(nfs, FWorkbook.FormatSettings);
if nfp <> nil then
try
nfp.SetThousandSep(CbThousandSep.Checked);
@ -520,7 +516,7 @@ procedure TNumFormatForm.EdNumFormatStrChange(Sender: TObject);
var
nfp: TsNumFormatParams;
begin
nfp := CreateNumFormatParams(FWorkbook, EdNumFormatStr.Text);
nfp := CreateNumFormatParams(EdNumFormatStr.Text, FWorkbook.FormatSettings);
try
UpdateControls(nfp);
finally
@ -601,7 +597,7 @@ begin
s := LbFormat.Items[Index];
idx := PtrInt(LbFormat.Items.Objects[Index]);
nfs := NumFormats.Strings[idx];
nfp := CreateNumFormatParams(FWorkbook, nfs);
nfp := CreateNumFormatParams(nfs, FWorkbook.FormatSettings);
try
if (nfp <> nil) and (Length(nfp.Sections) > 1) and (nfp.Sections[1].Color = scRed) then
LbFormat.Canvas.Font.Color := clRed;
@ -616,11 +612,9 @@ end;
procedure TNumFormatForm.ReplaceCurrSymbol;
var
s, cs: String;
i, el: Integer;
section: TsNumFormatSection;
cs: String;
i: Integer;
nfp: TsNumFormatParams;
list: TObjectList;
data: PtrInt;
cat: TsNumFormatCategory;
begin
@ -634,14 +628,10 @@ begin
cat := TsNumFormatCategory(data - BUILTIN_OFFSET);
if cat = nfcCurrency then
begin
nfp := CreateNumFormatParams(FWorkbook, NumFormats.Strings[i]);
nfp := CreateNumFormatParams(NumFormats.Strings[i], FWorkbook.FormatSettings);
if (nfp <> nil) then
try
nfp.SetCurrSymbol(cs);
{
if PtrInt(LbFormat.Items.Objects[LbFormat.ItemIndex]) = i then
UpdateSample(nfp);
}
finally
nfp.Free;
end;
@ -652,16 +642,12 @@ end;
procedure TNumFormatForm.ReplaceDecs;
var
s, cs: String;
i, el, e: Integer;
section: TsNumFormatSection;
nfp: TsNumFormatParams;
list: TObjectList;
begin
if EdDecimals.Text = '' then
exit;
nfp := CreateNumFormatParams(FWorkbook, EdNumFormatStr.Text);
nfp := CreateNumFormatParams(EdNumFormatStr.Text, FWorkbook.FormatSettings);
try
nfp.SetDecimals(EdDecimals.Value);
EdNumFormatStr.Text := nfp.NumFormatStr;
@ -693,7 +679,7 @@ begin
cat := TsNumFormatCategory(data - BUILTIN_OFFSET);
if cat = ACategory then
begin
nfp := CreateNumFormatParams(FWorkbook, NumFormats.Strings[i]);
nfp := CreateNumFormatParams(NumFormats.Strings[i], FWorkbook.FormatSettings);
try
genValue := FGenerator[ACategory];
if nfkTimeInterval in nfp.Sections[0].Kind then
@ -746,7 +732,7 @@ begin
LbFormat.ItemIndex := AIndex;
if AIndex >= 0 then begin
FNumFormatStrOfList := NumFormats.Strings[PtrInt(LbFormat.Items.Objects[AIndex])];
nfp := CreateNumFormatParams(FWorkbook, FNumFormatStrOfList);
nfp := CreateNumFormatParams(FNumFormatStrOfList, FWorkbook.FormatSettings);
try
UpdateControls(nfp);
finally
@ -776,9 +762,7 @@ var
nfs: String;
nfp: TsNumFormatParams;
cat: TsNumFormatCategory;
j: Integer;
i: Integer;
data: PtrInt;
begin
if AValue = '' then
i := NumFormats.IndexOf('General')
@ -788,7 +772,7 @@ begin
exit;
nfs := NumFormats.Strings[i];
nfp := CreateNumFormatParams(FWorkbook, nfs);
nfp := CreateNumFormatParams(nfs, FWorkbook.FormatSettings);
try
if nfkPercent in nfp.Sections[0].Kind then
cat := nfcPercent

2
components/fpspreadsheet/fpsactions.pas
View File

@ -1077,6 +1077,7 @@ end;
procedure TsActionBorder.ApplyStyle(AWorkbook: TsWorkbook;
out ABorderStyle: TsCellBorderStyle);
begin
Unused(AWorkbook);
ABorderStyle.LineStyle := FLineStyle;
ABorderStyle.Color := ABorderStyle.Color and $00FFFFFF;
end;
@ -1084,6 +1085,7 @@ end;
procedure TsActionBorder.ExtractStyle(AWorkbook: TsWorkbook;
ABorderStyle: TsCellBorderStyle);
begin
Unused(AWorkbook);
FLineStyle := ABorderStyle.LineStyle;
Color := ColorToRGB(ABorderStyle.Color);
end;

8
components/fpspreadsheet/fpsnumformat.pas
View File

@ -111,7 +111,7 @@ function IsDateTimeFormat(AFormatStr: string): Boolean;
var
parser: TsNumFormatParser;
begin
parser := TsNumFormatParser.Create(nil, AFormatStr);
parser := TsNumFormatParser.Create(AFormatStr, DefaultFormatSettings);
try
Result := parser.IsDateTimeFormat;
finally
@ -166,7 +166,7 @@ function IsTimeFormat(AFormatStr: String): Boolean;
var
parser: TsNumFormatParser;
begin
parser := TsNumFormatParser.Create(nil, AFormatStr);
parser := TsNumFormatParser.Create(AFormatStr, DefaultFormatSettings);
try
Result := parser.IsTimeFormat;
finally
@ -250,7 +250,7 @@ var
newSections: TsNumFormatSections;
i: Integer;
begin
parser := TsNumFormatParser.Create(FWorkbook, AFormatStr);
parser := TsNumFormatParser.Create(AFormatStr, FWorkbook.FormatSettings);
try
SetLength(newSections, parser.ParsedSectionCount);
for i:=0 to High(newSections) do
@ -301,7 +301,7 @@ function TsNumFormatList.Find(AFormatStr: String): Integer;
var
nfp: TsNumFormatParams;
begin
nfp := CreateNumFormatParams(FWorkbook, AFormatStr);
nfp := CreateNumFormatParams(AFormatStr, FWorkbook.FormatSettings);
if nfp = nil then
Result := -1
else

53
components/fpspreadsheet/fpsnumformatparser.pas
View File

@ -7,7 +7,7 @@ unit fpsNumFormatParser;
interface
uses
Classes, SysUtils, fpstypes, fpspreadsheet;
Classes, SysUtils, fpstypes;
const
@ -50,7 +50,7 @@ type
procedure SetDecimals(AValue: Byte);
protected
FWorkbook: TsWorkbook;
FFormatSettings: TFormatSettings;
FSections: TsNumFormatSections;
{ Administration while scanning }
@ -92,7 +92,8 @@ type
function BuildFormatString: String; virtual;
public
constructor Create(AWorkbook: TsWorkbook; const AFormatString: String);
constructor Create(const AFormatString: String;
const AFormatSettings: TFormatSettings);
destructor Destroy; override;
procedure ClearAll;
function GetDateTimeCode(ASection: Integer): String;
@ -113,10 +114,11 @@ type
end;
function CreateNumFormatParams(AWorkbook: TsWorkbook;
ANumFormatStr: String): TsNumFormatParams;
function ParamsOfNumFormatStr(AWorkbook: TsWorkbook;
ANumFormatStr: String; var AResult: TsNumFormatParams): Integer;
function CreateNumFormatParams(ANumFormatStr: String;
const AFormatSettings: TFormatSettings): TsNumFormatParams;
function ParamsOfNumFormatStr(ANumFormatStr: String;
const AFormatSettings: TFormatSettings; var AResult: TsNumFormatParams): Integer;
implementation
@ -125,36 +127,33 @@ uses
TypInfo, Math, LazUTF8, fpsutils, fpsCurrency;
function CreateNumFormatParams(AWorkbook: TsWorkbook;
ANumFormatStr: String): TsNumFormatParams;
function CreateNumFormatParams(ANumFormatStr: String;
const AFormatSettings: TFormatSettings): TsNumFormatParams;
begin
Result := TsNumFormatParams.Create;
ParamsOfNumFormatStr(AWorkbook, ANumFormatStr, result);
ParamsOfNumFormatStr(ANumFormatStr, AFormatSettings, result);
end;
function ParamsOfNumFormatStr(AWorkbook: TsWorkbook;
ANumFormatStr: String; var AResult: TsNumFormatParams): Integer;
function ParamsOfNumFormatStr(ANumFormatStr: String;
const AFormatSettings: TFormatSettings; var AResult: TsNumFormatParams): Integer;
var
parser: TsNumFormatParser;
begin
Assert(AResult <> nil);
if ANumFormatstr = 'General' then ANumFormatStr := '';
parser := TsNumFormatParser.Create(AWorkbook, ANumFormatStr);
parser := TsNumFormatParser.Create(ANumFormatStr, AFormatSettings);
try
Result := parser.Status;
AResult.Sections := parser.FSections;
{
SetLength(AResult.Sections, parser.ParsedSectionCount);
for i:=0 to parser.ParsedSectionCount-1 do
AResult.Sections[i] := parser.ParsedSections[i];
}
finally
parser.Free;
end;
end;
{ TsNumFormatParser }
{------------------------------------------------------------------------------}
{ TsNumFormatParser }
{------------------------------------------------------------------------------}
{@@ ----------------------------------------------------------------------------
Creates a number format parser for analyzing a formatstring that has been
@ -163,11 +162,11 @@ end;
If ALocalized is true then the formatstring contains localized decimal
separator etc.
-------------------------------------------------------------------------------}
constructor TsNumFormatParser.Create(AWorkbook: TsWorkbook;
const AFormatString: String);
constructor TsNumFormatParser.Create(const AFormatString: String;
const AFormatSettings: TFormatSettings);
begin
inherited Create;
FWorkbook := AWorkbook;
FFormatSettings := AFormatSettings;
Parse(AFormatString);
CheckSections;
if AFormatString = '' then FSections[0].NumFormat := nfGeneral;
@ -259,7 +258,7 @@ end;
function TsNumFormatParser.AnalyzeCurrency(const AValue: String): Boolean;
begin
if (FWorkbook = nil) or (FWorkbook.FormatSettings.CurrencyString = '') then
if (FFormatSettings.CurrencyString = '') then
Result := false
else
Result := CurrencyRegistered(AValue);
@ -404,7 +403,7 @@ begin
nfShortTime, nfLongTimeAM, nfShortTimeAM, nfDayMonth, nfMonthYear];
for nf in formats do
begin
nfsTest := BuildDateTimeFormatString(nf, FWorkbook.FormatSettings);
nfsTest := BuildDateTimeFormatString(nf, FFormatSettings);
if Length(nfsTest) = Length(nfs) then
begin
if SameText(nfs, nfsTest) then
@ -415,8 +414,8 @@ begin
for i := 1 to Length(nfsTest) do
case nfsTest[i] of
'/': if not (nf in [nfLongTimeAM, nfShortTimeAM]) then
nfsTest[i] := FWorkbook.FormatSettings.DateSeparator;
':': nfsTest[i] := FWorkbook.FormatSettings.TimeSeparator;
nfsTest[i] := FFormatSettings.DateSeparator;
':': nfsTest[i] := FFormatSettings.TimeSeparator;
'n': nfsTest[i] := 'm';
end;
if SameText(nfs, nfsTest) then
@ -437,7 +436,7 @@ begin
begin
formats := [nfFixed, nfFixedTh, nfPercentage, nfExp];
for nf in formats do begin
nfsTest := BuildNumberFormatString(nf, FWorkbook.FormatSettings, section^.Decimals);
nfsTest := BuildNumberFormatString(nf, FFormatSettings, section^.Decimals);
if SameText(nfs, nfsTest) then
begin
section^.NumFormat := nf;

9
components/fpspreadsheet/fpsopendocument.pas
View File

@ -828,8 +828,8 @@ begin
nftDateTimeSep:
case Elements[el].TextValue of
'/': Result := Result + '<number:text>' + FWorkbook.FormatSettings.DateSeparator + '</number:text>';
':': Result := Result + '<number:text>' + FWorkbook.FormatSettings.TimeSeparator + '</number:text>';
'/': Result := Result + '<number:text>' + FFormatSettings.DateSeparator + '</number:text>';
':': Result := Result + '<number:text>' + FFormatSettings.TimeSeparator + '</number:text>';
' ': Result := Result + '<number:text><![CDATA[ ]]></number:text>';
else Result := Result + '<number:text>' + Elements[el].TextValue + '</number:text>';
end;
@ -2175,7 +2175,7 @@ procedure TsSpreadOpenDocReader.ReadNumFormats(AStylesNode: TDOMNode);
fmt := NumFormatList[styleIndex];
fmt := Copy(fmt, pos(':', fmt)+1, Length(fmt));
parser := TsNumFormatParser.Create(Workbook, fmt);
parser := TsNumFormatParser.Create(fmt, Workbook.FormatSettings);
try
nf := parser.NumFormat;
if (nf = nfCurrency) and (parser.ParsedSections[0].Color = scRed) then
@ -2242,7 +2242,6 @@ procedure TsSpreadOpenDocReader.ReadNumFormats(AStylesNode: TDOMNode);
cs: String;
color: TsColor;
hasColor: Boolean;
idx: Integer;
begin
nfs := '';
cs := '';
@ -4012,7 +4011,7 @@ begin
p := pos(':', numFmtStr);
numFmtName := Copy(numFmtStr, 1, p-1);
numFmtStr := Copy(numFmtStr, p+1, Length(numFmtStr));
parser := TsSpreadOpenDocNumFormatParser.Create(Workbook, numFmtStr);
parser := TsSpreadOpenDocNumFormatParser.Create(numFmtStr, Workbook.FormatSettings);
try
numFmtXML := parser.BuildXMLAsString(numFmtName);
if numFmtXML <> '' then

67
components/fpspreadsheet/fpspreadsheet.pas
View File

@ -793,6 +793,7 @@ uses
fpsUtils, fpsreaderwriter, fpsCurrency, fpsExprParser,
fpsNumFormat, fpsNumFormatParser;
(*
const
{ These are reserved system colors by Microsoft
0x0040 - Default foreground color - window text color in the sheet display.
@ -823,64 +824,8 @@ 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!
The indices into this palette are named as scXXXX color constants. }
DEFAULT_PALETTE: array[$00..$16] of TsColorValue = (
$000000, // $00: black
$FFFFFF, // $01: white
$FF0000, // $02: red
$00FF00, // $03: green
$0000FF, // $04: blue
$FFFF00, // $05: yellow
$FF00FF, // $06: magenta
$00FFFF, // $07: cyan
$800000, // $08: dark red
$008000, // $09: dark green
$000080, // $0A: dark blue
$808000, // $0B: olive
$800080, // $0C: purple
$008080, // $0D: teal
$C0C0C0, // $0E: silver
$808080, // $0F: gray
$E6E6E6, // $10: gray 10%
$CCCCCC, // $11: gray 20%
$FFA500, // $12: orange
$A0522D, // $13: dark brown
$CD853F, // $14: brown
$F5F5DC, // $15: beige
$F5DEB3 // $16: wheat
);
*)
{@@ Names of the colors of the DEFAULT_PALETTE }
DEFAULT_COLORNAMES: array[$00..$16] of string = (
'black', // 0
'white', // 1
'red', // 2
'green', // 3
'blue', // 4
'yellow', // 5
'magenta', // 6
'cyan', // 7
'dark red', // 8
'dark green', // 9
'dark blue', // $0A
'olive', // $0B
'purple', // $0C
'teal', // $0D
'silver', // $0E
'gray', // $0F
'gray 10%', // $10
'gray 20%', // $11
'orange', // $12
'dark brown', // $13
'brown', // $14
'beige', // $15
'wheat' // $16
);
*)
{@@ ----------------------------------------------------------------------------
Copies the format of a cell to another one.
@ -2208,7 +2153,7 @@ begin
if ACell <> nil then
begin
ReadNumFormat(ACell, nf, nfs);
parser := TsNumFormatParser.Create(FWorkbook, nfs);
parser := TsNumFormatParser.Create(nfs, FWorkbook.FormatSettings);
try
if parser.Status = psOK then
begin
@ -3826,7 +3771,7 @@ var
fmt: TsCellFormat;
begin
if ACell <> nil then begin
parser := TsNumFormatParser.Create(Workbook, ANumFormatString);
parser := TsNumFormatParser.Create(ANumFormatString, FWorkbook.FormatSettings);
try
// Format string ok?
if parser.Status <> psOK then
@ -4250,7 +4195,7 @@ begin
// Check whether the formatstring is for date/times.
if ANumFormatStr <> '' then begin
parser := TsNumFormatParser.Create(Workbook, ANumFormatStr);
parser := TsNumFormatParser.Create(ANumFormatStr, Workbook.FormatSettings);
try
// Format string ok?
if parser.Status <> psOK then
@ -4419,7 +4364,7 @@ begin
numFmtStr := numFmt.NumFormatStr
else
numFmtStr := '0.00';
parser := TsNumFormatParser.Create(Workbook, numFmtStr);
parser := TsNumFormatParser.Create(numFmtStr, Workbook.FormatSettings);
try
parser.Decimals := ADecimals;
numFmtStr := parser.FormatString;

1
components/fpspreadsheet/fpspreadsheetctrls.pas
View File

@ -2024,7 +2024,6 @@ procedure TsCellCombobox.ExtractFromCell(ACell: PCell);
var
fnt: TsFont;
clr: TsColor;
idx: Integer;
begin
case FFormatItem of
cfiFontName:

113
components/fpspreadsheet/fpsvisualutils.pas
View File

@ -8,25 +8,27 @@ uses
Classes, SysUtils, Graphics,
fpstypes, fpspreadsheet;
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;
procedure Convert_sFont_to_Font(sFont: TsFont; AFont: TFont); overload;
procedure Convert_sFont_to_Font(AWorkbook: TsWorkbook; sFont: TsFont; AFont: TFont); overload; deprecated;
procedure Convert_Font_to_sFont(AFont: TFont; sFont: TsFont); overload;
procedure Convert_Font_to_sFont(AWorkbook: TsWorkbook; AFont: TFont; sFont: TsFont); overload; deprecated;
function WrapText(ACanvas: TCanvas; const AText: string; AMaxWidth: integer): string;
implementation
uses
Types, LCLType, LCLIntf, Math;
Types, LCLType, LCLIntf, fpsUtils;
{@@ ----------------------------------------------------------------------------
Converts a spreadsheet font to a font used for painting (TCanvas.Font).
@param AWorkbook Workbook in which the font is used
@param sFont Font as used by fpspreadsheet (input)
@param AFont Font as used by TCanvas for painting (output)
-------------------------------------------------------------------------------}
procedure Convert_sFont_to_Font(AWorkbook: TsWorkbook; sFont: TsFont; AFont: TFont);
procedure Convert_sFont_to_Font(sFont: TsFont; AFont: TFont);
begin
if Assigned(AFont) and Assigned(sFont) then begin
AFont.Name := sFont.FontName;
@ -40,13 +42,19 @@ begin
end;
end;
procedure Convert_sFont_to_Font(AWorkbook: TsWorkbook; sFont: TsFont; AFont: TFont);
begin
Unused(AWorkbook);
Convert_sFont_to_Font(sFont, AFont);
end;
{@@ ----------------------------------------------------------------------------
Converts a font used for painting (TCanvas.Font) to a spreadsheet font.
@param AFont Font as used by TCanvas for painting (input)
@param sFont Font as used by fpspreadsheet (output)
-------------------------------------------------------------------------------}
procedure Convert_Font_to_sFont(AWorkbook: TsWorkbook; AFont: TFont; sFont: TsFont);
procedure Convert_Font_to_sFont(AFont: TFont; sFont: TsFont);
begin
if Assigned(AFont) and Assigned(sFont) then begin
sFont.FontName := AFont.Name;
@ -59,96 +67,13 @@ begin
sFont.Color := ColorToRGB(AFont.Color);
end;
end;
(*
function FindNearestPaletteIndex(AWorkbook: TsWorkbook; AColor: TColor): TsColor;
procedure ColorToHSL(RGB: TColor; out H, S, L : double);
// Taken from https://code.google.com/p/thtmlviewer/source/browse/trunk/source/HSLUtils.pas?r=277
// The procedure in GraphUtils crashes for some colors in Laz < 1.3
var
R, G, B, D, Cmax, Cmin: double;
begin
R := GetRValue(RGB) / 255;
G := GetGValue(RGB) / 255;
B := GetBValue(RGB) / 255;
Cmax := Max(R, Max(G, B));
Cmin := Min(R, Min(G, B));
// calculate luminosity
L := (Cmax + Cmin) / 2;
if Cmax = Cmin then begin // it's grey
H := 0; // it's actually undefined
S := 0
end else
begin
D := Cmax - Cmin;
// calculate Saturation
if L < 0.5 then
S := D / (Cmax + Cmin)
else
S := D / (2 - Cmax - Cmin);
// calculate Hue
if R = Cmax then
H := (G - B) / D
else
if G = Cmax then
H := 2 + (B - R) /D
else
H := 4 + (R - G) / D;
H := H / 6;
if H < 0 then
H := H + 1
end
end;
function ColorDistance(color1, color2: TColor): Double;
var
H1,S1,L1, H2,S2,L2: Double;
begin
ColorToHSL(color1, H1, S1, L1);
ColorToHSL(color2, H2, S2, L2);
Result := sqr(H1-H2) + sqr(S1-S2) + sqr(L1-L2);
end;
{
// To be activated when Lazarus 1.4 is available. (RgbToHLS bug in Laz < 1.3)
function ColorDistance(color1, color2: TColor): Integer;
type
TRGBA = packed record R, G, B, A: Byte end;
var
H1,L1,S1, H2,L2,S2: Byte;
begin
ColorToHLS(color1, H1,L1,S1);
ColorToHLS(color2, H2,L2,S2);
result := sqr(Integer(H1)-H2) + sqr(Integer(L1)-L2) + sqr(Integer(S1)-S2);
end;
}
var
i: Integer;
dist, mindist: Double;
procedure Convert_Font_to_sFont(AWorkbook: TsWorkbook; AFont: TFont; sFont: TsFont);
begin
Result := 0;
if AWorkbook <> nil then
begin
mindist := 1E308;
for i:=0 to AWorkbook.GetPaletteSize-1 do
begin
dist := ColorDistance(AColor, TColor(AWorkbook.GetPaletteColor(i)));
if dist < mindist then
begin
mindist := dist;
Result := i;
end;
end;
end;
Unused(AWorkbook);
Convert_Font_to_sFont(AFont, sFont);
end;
*)
{@@ ----------------------------------------------------------------------------
Wraps text by inserting line ending characters so that the lines are not
longer than AMaxWidth.

2
components/fpspreadsheet/tests/numformatparsertests.pas
View File

@ -258,7 +258,7 @@ begin
MyWorkbook := TsWorkbook.Create; // needed to provide the FormatSettings for the parser
try
for i:=0 to High(ParserTestData) do begin
parser := TsNumFormatParser.Create(MyWorkbook, ParserTestData[i].FormatString);
parser := TsNumFormatParser.Create(ParserTestData[i].FormatString, MyWorkbook.FormatSettings);
try
actual := parser.FormatString;
CheckEquals(ParserTestData[i].SollFormatString, actual,

8
components/fpspreadsheet/tests/spreadtestcli.lpi
View File

@ -69,7 +69,7 @@
<PackageName Value="LCLBase"/>
</Item1>
</RequiredPackages>
<Units Count="24">
<Units Count="25">
<Unit0>
<Filename Value="spreadtestcli.lpr"/>
<IsPartOfProject Value="True"/>
@ -141,7 +141,6 @@
<Unit17>
<Filename Value="dbexporttests.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="dbexporttests"/>
</Unit17>
<Unit18>
<Filename Value="sortingtests.pas"/>
@ -166,8 +165,11 @@
<Unit23>
<Filename Value="hyperlinktests.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="hyperlinktests"/>
</Unit23>
<Unit24>
<Filename Value="pagelayouttests.pas"/>
<IsPartOfProject Value="True"/>
</Unit24>
</Units>
</ProjectOptions>
<CompilerOptions>

2
components/fpspreadsheet/tests/spreadtestcli.lpr
View File

@ -15,7 +15,7 @@ uses
formattests, colortests, emptycelltests, insertdeletetests, errortests,
numberstests, fonttests, formulatests, numformatparsertests, optiontests,
virtualmodetests, dbexporttests, sortingtests, copytests, celltypetests,
commenttests, enumeratortests, hyperlinktests;
commenttests, enumeratortests, hyperlinktests, pagelayouttests;
const
ShortOpts = 'ac:dhlpr:x';

36
components/fpspreadsheet/xlsbiff2.pas
View File

@ -161,7 +161,7 @@ var
implementation
uses
Math, fpsStrings, fpsReaderWriter, fpsPalette, fpsNumFormatParser;
Math, fpsStrings, fpsReaderWriter, fpsPalette;
const
{ Excel record IDs }
@ -444,7 +444,6 @@ var
len: byte;
fmtString: AnsiString;
nfs: String;
parser: TsNumFormatParser;
begin
// number format string
len := AStream.ReadByte;
@ -453,17 +452,7 @@ begin
// We need the format string as utf8 and non-localized
nfs := ConvertEncoding(fmtString, FCodePage, encodingUTF8);
{
if not SameText(nfs, 'General') then
begin
parser := TsNumFormatParser.Create(FWorkbook, nfs, true);
try
nfs := parser.FormatString;
finally
parser.Free;
end;
end;
}
// Add to the end of the list.
NumFormatList.Add(nfs);
end;
@ -1416,9 +1405,6 @@ procedure TsSpreadBIFF2Writer.WriteXF(AStream: TStream;
var
rec: TBIFF2_XFRecord;
b: Byte;
j: Integer;
nfParams: TsNumFormatParams;
nfs: String;
formatIdx, fontIdx: Integer;
begin
Unused(XFType_Prot);
@ -1578,24 +1564,10 @@ var
s: ansistring;
rec: TNumFormatRecord;
buf: array of byte;
parser: TsNumFormatParser;
begin
//Unused(ANumFormatStr);
Unused(AFormatIndex);
{if (AFormatIndex = 0) then
s := 'General'
else begin
parser := TsNumFormatParser.Create(FWorkbook, NumFormatList[AFormatIndex]);
try
parser.Localize;
s := parser.FormatString;
s := ConvertEncoding(s, encodingUTF8, FCodePage);
finally
parser.Free;
end;
end;
}
// s := ConvertEncoding(NumFormatList[AFormatIndex], encodingUTF8, FCodePage);
{ Convert format string to code page used by the writer }
s := ConvertEncoding(ANumFormatStr, encodingUTF8, FCodePage);
len := Length(s);

4
components/fpspreadsheet/xlscommon.pas
View File

@ -952,7 +952,7 @@ begin
if ANumberFormat = nfTimeInterval then
ADateTime := Number
else begin
parser := TsNumFormatParser.Create(Workbook, ANumberFormatStr);
parser := TsNumFormatParser.Create(ANumberFormatStr, Workbook.FormatSettings);
try
if (parser.Status = psOK) and parser.IsDateTimeFormat then
ADateTime := ConvertExcelDateTimeToDateTime(Number, FDateMode)
@ -2669,7 +2669,7 @@ begin
for i:= FFirstNumFormatIndexInFile to NumFormatList.Count-1 do
begin
fmtStr := NumFormatList[i];
parser := TsNumFormatParser.Create(Workbook, fmtStr);
parser := TsNumFormatParser.Create(fmtStr, Workbook.FormatSettings);
try
fmtStr := parser.FormatString;
WriteFORMAT(AStream, fmtStr, i);

15
components/fpspreadsheet/xlsxooxml.pas
View File

@ -825,7 +825,7 @@ var
rgb: TsColor;
idx: Integer;
tint: Double;
n: Integer;
n, i: Integer;
begin
Assert(ANode <> nil);
@ -846,16 +846,16 @@ begin
s := GetAttrValue(ANode, 'indexed');
if s <> '' then begin
Result := StrToInt(s);
i := StrToInt(s);
n := FPalette.Count;
if (Result <= LAST_PALETTE_INDEX) and (Result < n) then
if (i <= LAST_PALETTE_INDEX) and (i < n) then
begin
Result := FPalette[Result];
Result := FPalette[i];
exit;
end;
// System colors
// taken from OpenOffice docs
case Result of
case i of
$0040: Result := scBlack; // Default border color
$0041: Result := scWhite; // Default background color
$0043: Result := scGray; // Dialog background color
@ -864,7 +864,7 @@ begin
$004F: Result := scBlack; // Automatic color for chart border lines
$0050: Result := scBlack; // ???
$0051: Result := scBlack; // ??
$7FFF: Result := scBlack; // ??
$7FFF: Result := scBlack; // Automatic text color
else Result := scBlack;
end;
exit;
@ -2383,7 +2383,7 @@ begin
for i:= FFirstNumFormatIndexInFile to NumFormatList.Count-1 do
begin
numFmtStr := NumFormatList[i];
parser := TsNumFormatParser.Create(Workbook, numFmtStr);
parser := TsNumFormatParser.Create(numFmtStr, Workbook.FormatSettings);
try
numFmtStr := UTF8TextToXMLText(parser.FormatString);
xmlStr := xmlStr + Format('<numFmt numFmtId="%d" formatCode="%s" />',
@ -2407,6 +2407,7 @@ end;
procedure TsSpreadOOXMLWriter.WritePalette(AStream: TStream);
begin
// just keep it here in case we'd need it later...
Unused(AStream);
end;
procedure TsSpreadOOXMLWriter.WritePageMargins(AStream: TStream;