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 WorkbookSource = WorkbookSource
Mode = imWorkbook Mode = imWorkbook
ExtendedColSizing = True ExtendedColSizing = True
ColWidths = (
138
139
)
end end
end end
object InspectorSplitter: TSplitter object InspectorSplitter: TSplitter

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

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

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

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

2
components/fpspreadsheet/fpsactions.pas
View File

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

8
components/fpspreadsheet/fpsnumformat.pas
View File

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

51
components/fpspreadsheet/fpsnumformatparser.pas
View File

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

9
components/fpspreadsheet/fpsopendocument.pas
View File

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

67
components/fpspreadsheet/fpspreadsheet.pas
View File

@ -793,6 +793,7 @@ uses
fpsUtils, fpsreaderwriter, fpsCurrency, fpsExprParser, fpsUtils, fpsreaderwriter, fpsCurrency, fpsExprParser,
fpsNumFormat, fpsNumFormatParser; fpsNumFormat, fpsNumFormatParser;
(*
const const
{ These are reserved system colors by Microsoft { These are reserved system colors by Microsoft
0x0040 - Default foreground color - window text color in the sheet display. 0x0040 - Default foreground color - window text color in the sheet display.
@ -823,64 +824,8 @@ const
DEF_CHART_NEUTRAL_COLORVALUE = $FFFFFF; DEF_CHART_NEUTRAL_COLORVALUE = $FFFFFF;
DEF_TOOLTIP_TEXT_COLORVALUE = $000000; DEF_TOOLTIP_TEXT_COLORVALUE = $000000;
DEF_FONT_AUTOMATIC_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. Copies the format of a cell to another one.
@ -2208,7 +2153,7 @@ begin
if ACell <> nil then if ACell <> nil then
begin begin
ReadNumFormat(ACell, nf, nfs); ReadNumFormat(ACell, nf, nfs);
parser := TsNumFormatParser.Create(FWorkbook, nfs); parser := TsNumFormatParser.Create(nfs, FWorkbook.FormatSettings);
try try
if parser.Status = psOK then if parser.Status = psOK then
begin begin
@ -3826,7 +3771,7 @@ var
fmt: TsCellFormat; fmt: TsCellFormat;
begin begin
if ACell <> nil then begin if ACell <> nil then begin
parser := TsNumFormatParser.Create(Workbook, ANumFormatString); parser := TsNumFormatParser.Create(ANumFormatString, FWorkbook.FormatSettings);
try try
// Format string ok? // Format string ok?
if parser.Status <> psOK then if parser.Status <> psOK then
@ -4250,7 +4195,7 @@ begin
// Check whether the formatstring is for date/times. // Check whether the formatstring is for date/times.
if ANumFormatStr <> '' then begin if ANumFormatStr <> '' then begin
parser := TsNumFormatParser.Create(Workbook, ANumFormatStr); parser := TsNumFormatParser.Create(ANumFormatStr, Workbook.FormatSettings);
try try
// Format string ok? // Format string ok?
if parser.Status <> psOK then if parser.Status <> psOK then
@ -4419,7 +4364,7 @@ begin
numFmtStr := numFmt.NumFormatStr numFmtStr := numFmt.NumFormatStr
else else
numFmtStr := '0.00'; numFmtStr := '0.00';
parser := TsNumFormatParser.Create(Workbook, numFmtStr); parser := TsNumFormatParser.Create(numFmtStr, Workbook.FormatSettings);
try try
parser.Decimals := ADecimals; parser.Decimals := ADecimals;
numFmtStr := parser.FormatString; numFmtStr := parser.FormatString;

1
components/fpspreadsheet/fpspreadsheetctrls.pas
View File

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

111
components/fpspreadsheet/fpsvisualutils.pas
View File

@ -8,25 +8,27 @@ uses
Classes, SysUtils, Graphics, Classes, SysUtils, Graphics,
fpstypes, fpspreadsheet; fpstypes, fpspreadsheet;
procedure Convert_sFont_to_Font(AWorkbook: TsWorkbook; sFont: TsFont; AFont: TFont); procedure Convert_sFont_to_Font(sFont: TsFont; AFont: TFont); overload;
procedure Convert_Font_to_sFont(AWorkbook: TsWorkbook; AFont: TFont; sFont: TsFont); procedure Convert_sFont_to_Font(AWorkbook: TsWorkbook; sFont: TsFont; AFont: TFont); overload; deprecated;
//function FindNearestPaletteIndex(AWorkbook: TsWorkbook; AColor: TColor): TsColor;
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; function WrapText(ACanvas: TCanvas; const AText: string; AMaxWidth: integer): string;
implementation implementation
uses uses
Types, LCLType, LCLIntf, Math; Types, LCLType, LCLIntf, fpsUtils;
{@@ ---------------------------------------------------------------------------- {@@ ----------------------------------------------------------------------------
Converts a spreadsheet font to a font used for painting (TCanvas.Font). 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 sFont Font as used by fpspreadsheet (input)
@param AFont Font as used by TCanvas for painting (output) @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 begin
if Assigned(AFont) and Assigned(sFont) then begin if Assigned(AFont) and Assigned(sFont) then begin
AFont.Name := sFont.FontName; AFont.Name := sFont.FontName;
@ -40,13 +42,19 @@ begin
end; end;
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. Converts a font used for painting (TCanvas.Font) to a spreadsheet font.
@param AFont Font as used by TCanvas for painting (input) @param AFont Font as used by TCanvas for painting (input)
@param sFont Font as used by fpspreadsheet (output) @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 begin
if Assigned(AFont) and Assigned(sFont) then begin if Assigned(AFont) and Assigned(sFont) then begin
sFont.FontName := AFont.Name; sFont.FontName := AFont.Name;
@ -59,96 +67,13 @@ begin
sFont.Color := ColorToRGB(AFont.Color); sFont.Color := ColorToRGB(AFont.Color);
end; end;
end; end;
(*
function FindNearestPaletteIndex(AWorkbook: TsWorkbook; AColor: TColor): TsColor;
procedure ColorToHSL(RGB: TColor; out H, S, L : double); procedure Convert_Font_to_sFont(AWorkbook: TsWorkbook; AFont: TFont; sFont: TsFont);
// 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 begin
R := GetRValue(RGB) / 255; Unused(AWorkbook);
G := GetGValue(RGB) / 255; Convert_Font_to_sFont(AFont, sFont);
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; 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;
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;
end;
*)
{@@ ---------------------------------------------------------------------------- {@@ ----------------------------------------------------------------------------
Wraps text by inserting line ending characters so that the lines are not Wraps text by inserting line ending characters so that the lines are not
longer than AMaxWidth. 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 MyWorkbook := TsWorkbook.Create; // needed to provide the FormatSettings for the parser
try try
for i:=0 to High(ParserTestData) do begin for i:=0 to High(ParserTestData) do begin
parser := TsNumFormatParser.Create(MyWorkbook, ParserTestData[i].FormatString); parser := TsNumFormatParser.Create(ParserTestData[i].FormatString, MyWorkbook.FormatSettings);
try try
actual := parser.FormatString; actual := parser.FormatString;
CheckEquals(ParserTestData[i].SollFormatString, actual, CheckEquals(ParserTestData[i].SollFormatString, actual,

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

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

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

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

36
components/fpspreadsheet/xlsbiff2.pas
View File

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

4
components/fpspreadsheet/xlscommon.pas
View File

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

15
components/fpspreadsheet/xlsxooxml.pas
View File

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