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

fpspreadsheet: Introduce an include file (fps.inc) with all conditional defines. They are needed to compile the packages with older LCL/FPC versions (tested back to Laz1.0 / FPC2.4). All patched procedures are in fpspatches.pas and turned on/off by these defines.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@3884 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2015-01-13 19:02:57 +00:00
parent 2ef2765646
commit fd627c1fa1
17 changed files with 2167 additions and 434 deletions
Download Patch File Download Diff File Expand all files Collapse all files

6
components/fpspreadsheet/examples/fpschart/worksheetchartsource/mainform.lfm
View File

@ -2,12 +2,12 @@ object FPSChartForm: TFPSChartForm
Left = 259
Height = 382
Top = 146
Width = 700
Width = 699
Caption = 'FPSpreadsheet Chart Example'
ClientHeight = 382
ClientWidth = 700
ClientWidth = 699
OnCreate = FormCreate
LCLVersion = '1.3'
LCLVersion = '1.5'
object MyChart: TChart
Left = 352
Height = 264

2
components/fpspreadsheet/examples/fpschart/worksheetchartsource/mainform.pas
View File

@ -62,6 +62,8 @@ end;
procedure TFPSChartForm.FormCreate(Sender: TObject);
begin
editSourceFile.InitialDir := ExtractFilePath(ParamStr(0));
// Property Text is not published in older versions of Lazarus
editSourceFile.Text := 't1.xls';
end;
end.

4
components/fpspreadsheet/examples/spready/mainform.pas
View File

@ -351,7 +351,7 @@ var
implementation
uses
TypInfo, LCLIntf, LCLType,
TypInfo, LCLIntf, LCLType, LCLVersion,
fpcanvas, fpsutils, fpscsv,
sFormatSettingsForm, sCSVParamsForm, sSortParamsForm, sfCurrencyForm;
@ -958,7 +958,9 @@ begin
// FormatToolbar.ButtonHeight := FormatToolbar.Height - 4;
CbBackgroundColor.ItemHeight := FontCombobox.ItemHeight;
{$IF LCL_FullVersion >= 1020000}
CbBackgroundColor.ColorRectWidth := CbBackgroundColor.ItemHeight - 6; // to get a square box...
{$ENDIF}
InspectorPageControl.ActivePageIndex := 0;

1
components/fpspreadsheet/examples/spready/sformatsettingsform.lfm
View File

@ -98,7 +98,6 @@ object FormatSettingsForm: TFormatSettingsForm
Height = 28
Top = 48
Width = 66
Alignment = taRightJustify
TabOrder = 1
end
object LblPosCurrencyFormat: TLabel

3
components/fpspreadsheet/examples/spready/sformatsettingsform.pas
View File

@ -299,6 +299,9 @@ begin
FSampleDateTime := now();
LblDateTimeSample.Visible := false;
// Published property not available in old Laz versions
EdCurrencyDecimals.Alignment := taRightJustify;
end;
procedure TFormatSettingsForm.OKButtonClick(Sender: TObject);

31
components/fpspreadsheet/fps.inc Normal file
View File

@ -0,0 +1,31 @@
{------------------------------------------------------------------------------}
{ Central definition of conditional defines }
{------------------------------------------------------------------------------}
{ In Unix systems, the unit clocale is automatically added to the uses clause
of fpspreadsheet.pas. This unit sets up localization settings needed for
locale-dependent number and date/time formats. However, this adds a dependence
on the C library to the package.
If this is not wanted, define FPS_DONT_USE_CLOCALE. }
{.$DEFINE FPS_DONT_USE_CLOCALE}
{ The next defines activate code duplicated from new compiler versions in case
an old compiler is used. }
{ Numberformats require an extended version of FormatDateTime (in SysUtils)
which is not available before FPC 3.0. Define FPS_FORMATDATETIME if the
compiler used is older. }
{$DEFINE FPS_FORMATDATETIME}
{ fpspreadsheet requires the function VarIsBool which was introduced by
fpc 2.6.4. If an older FPC versions is used define FPS_VARISBOOL. Keep
undefined for the current FPC version. }
{.$DEFINE FPS_VARISBOOL}
{ fpspreadsheet requires some functions from LazUTF8 which were
introduced by Lazarus 1.2. If an older Lazarus version is used define
FPS_LAZUTF8. Keep undefined for the current Lazarus version. }
{.$DEFINE FPS_LAZUTF8}

5
components/fpspreadsheet/fpsfunc.pas
View File

@ -11,13 +11,14 @@ interface
uses
Classes, SysUtils, fpspreadsheet;
procedure RegisterStdBuiltins(AManager: TComponent); //TsBuiltInExpressionManager);
procedure RegisterStdBuiltins(AManager: TComponent);
implementation
uses
Math, lazutf8, StrUtils, DateUtils, xlsconst, fpsUtils, fpsexprparser;
Math, lazutf8, StrUtils, DateUtils,
xlsconst, fpsPatches, fpsUtils, fpsexprparser;
{------------------------------------------------------------------------------}

2
components/fpspreadsheet/fpsopendocument.pas
View File

@ -203,7 +203,7 @@ type
implementation
uses
StrUtils, Variants, fpsStrings, fpsStreams, fpsExprParser;
StrUtils, Variants, fpsPatches, fpsStrings, fpsStreams, fpsExprParser;
const
{ OpenDocument general XML constants }

2105
components/fpspreadsheet/fpspatches.pas Normal file
View File

File diff suppressed because it is too large Load Diff

7
components/fpspreadsheet/fpspreadsheet.pas
View File

@ -14,6 +14,8 @@ unit fpspreadsheet;
{$mode delphi}{$H+}
{$endif}
{$include fps.inc}
interface
uses
@ -24,7 +26,7 @@ uses
type
{@@ File formats supported by fpspreadsheet }
TsSpreadsheetFormat = (sfExcel2, {sfExcel3, sfExcel4,} sfExcel5, sfExcel8,
TsSpreadsheetFormat = (sfExcel2, sfExcel5, sfExcel8,
sfOOXML, sfOpenDocument, sfCSV, sfWikiTable_Pipes, sfWikiTable_WikiMedia);
{@@ Record collection limitations of a particular file format }
@ -1359,7 +1361,8 @@ implementation
uses
Math, StrUtils, TypInfo, lazutf8,
fpsStrings, fpsStreams, fpsUtils, fpsCurrency, fpsNumFormatParser, fpsExprParser;
fpsPatches, fpsStrings, fpsStreams, fpsUtils, fpsCurrency,
fpsNumFormatParser, fpsExprParser;
const
{ These are reserved system colors by Microsoft

1
components/fpspreadsheet/fpspreadsheetgrid.pas
View File

@ -1137,6 +1137,7 @@ procedure TsCustomWorksheetGrid.DefineProperties(Filer: TFiler);
begin
// Don't call inherited, this is where to ColWidths/RwoHeights are stored in
// the lfm file - we don't need them, we get them from the workbook!
Unused(Filer);
end;
procedure TsCustomWorksheetGrid.DoOnResize;

419
components/fpspreadsheet/fpsutils.pas
View File

@ -28,16 +28,6 @@ type
{@@ Set of characters }
TsDecsChars = set of char;
{@@ Options for the FormatDateTime function to activate time interval strings
with more than 24 hours.
Will be removed when this feature is in the stable release of FPC }
TFormatDateTimeOption = (fdoInterval);
{@@ Options for the FormatDateTime function to activate time interval strings
with more than 24 hours.
Will be removed when this feature is in the stable release of FPC }
TFormatDateTimeOptions = set of TFormatDateTimeOption;
const
{@@ Date formatting string for unambiguous date/time display as strings
Can be used for text output when date/time cell support is not available }
@ -132,12 +122,6 @@ procedure SplitFormatString(const AFormatString: String; out APositivePart,
procedure MakeTimeIntervalMask(Src: String; var Dest: String);
// These two functions are copies of fpc trunk until they are available in stable fpc.
function FormatDateTime(const FormatStr: string; DateTime: TDateTime;
Options : TFormatDateTimeOptions = []): string;
function FormatDateTime(const FormatStr: string; DateTime: TDateTime;
const FormatSettings: TFormatSettings; Options : TFormatDateTimeOptions = []): string;
function TryStrToFloatAuto(AText: String; out ANumber: Double;
out ADecimalSeparator, AThousandSeparator: Char; out AWarning: String): Boolean;
@ -177,12 +161,6 @@ procedure Unused(const A1, A2, A3);
{ For debugging purposes }
procedure DumpFontsToFile(AWorkbook: TsWorkbook; AFileName: String);
{ Needed only if FPC version is < 2.6.4 }
{$IF FPC_FULLVERSION < 020604}
function VarIsBool(const V: Variant): Boolean;
{$ENDIF}
var
{@@ Default value for the screen pixel density (pixels per inch). Is needed
for conversion of distances to pixels}
@ -193,7 +171,6 @@ var
implementation
uses
//LCLVersion,
Math, lazutf8, fpsStrings;
type
@ -2020,395 +1997,6 @@ begin
end;
{******************************************************************************}
{******************************************************************************}
{ Patch for SysUtils.FormatDateTime }
{ Remove when the feature of square brackets in time format masks is in rtl }
{******************************************************************************}
{******************************************************************************}
{@@
Applies a formatting string to a date/time value and converts the number
to a date/time string.
This functionality is available in the SysUtils unit. But it is duplicated
here to add a patch which is not available in stable fpc.
}
procedure DateTimeToString(out Result: string; const FormatStr: string; const DateTime: TDateTime;
const FormatSettings: TFormatSettings; Options : TFormatDateTimeOptions = []);
// Copied from "fpc/rtl/objpas/sysutils/datei.inc"
var
ResultLen: integer;
ResultBuffer: array[0..255] of char;
ResultCurrent: pchar;
(* ---- not needed here ---
{$IFDEF MSWindows}
isEnable_E_Format : Boolean;
isEnable_G_Format : Boolean;
eastasiainited : boolean;
procedure InitEastAsia;
var ALCID : LCID;
PriLangID , SubLangID : Word;
begin
ALCID := GetThreadLocale;
PriLangID := ALCID and $3FF;
if (PriLangID>0) then
SubLangID := (ALCID and $FFFF) shr 10
else
begin
PriLangID := SysLocale.PriLangID;
SubLangID := SysLocale.SubLangID;
end;
isEnable_E_Format := (PriLangID = LANG_JAPANESE)
or
(PriLangID = LANG_KOREAN)
or
((PriLangID = LANG_CHINESE)
and
(SubLangID = SUBLANG_CHINESE_TRADITIONAL)
);
isEnable_G_Format := (PriLangID = LANG_JAPANESE)
or
((PriLangID = LANG_CHINESE)
and
(SubLangID = SUBLANG_CHINESE_TRADITIONAL)
);
eastasiainited :=true;
end;
{$ENDIF MSWindows}
*)
procedure StoreStr(Str: PChar; Len: Integer);
begin
if ResultLen + Len < SizeOf(ResultBuffer) then
begin
StrMove(ResultCurrent, Str, Len);
ResultCurrent := ResultCurrent + Len;
ResultLen := ResultLen + Len;
end;
end;
procedure StoreString(const Str: string);
var Len: integer;
begin
Len := Length(Str);
if ResultLen + Len < SizeOf(ResultBuffer) then
begin
StrMove(ResultCurrent, pchar(Str), Len);
ResultCurrent := ResultCurrent + Len;
ResultLen := ResultLen + Len;
end;
end;
procedure StoreInt(Value, Digits: Integer);
var
S: string[16];
Len: integer;
begin
System.Str(Value:Digits, S);
for Len := 1 to Length(S) do
begin
if S[Len] = ' ' then
S[Len] := '0'
else
Break;
end;
StoreStr(pchar(@S[1]), Length(S));
end ;
var
Year, Month, Day, DayOfWeek, Hour, Minute, Second, MilliSecond: word;
procedure StoreFormat(const FormatStr: string; Nesting: Integer; TimeFlag: Boolean);
var
Token, lastformattoken, prevlasttoken: char;
FormatCurrent: pchar;
FormatEnd: pchar;
Count: integer;
Clock12: boolean;
P: pchar;
tmp: integer;
isInterval: Boolean;
begin
if Nesting > 1 then // 0 is original string, 1 is included FormatString
Exit;
FormatCurrent := PChar(FormatStr);
FormatEnd := FormatCurrent + Length(FormatStr);
Clock12 := false;
isInterval := false;
P := FormatCurrent;
// look for unquoted 12-hour clock token
while P < FormatEnd do
begin
Token := P^;
case Token of
'''', '"':
begin
Inc(P);
while (P < FormatEnd) and (P^ <> Token) do
Inc(P);
end;
'A', 'a':
begin
if (StrLIComp(P, 'A/P', 3) = 0) or
(StrLIComp(P, 'AMPM', 4) = 0) or
(StrLIComp(P, 'AM/PM', 5) = 0) then
begin
Clock12 := true;
break;
end;
end;
end; // case
Inc(P);
end ;
token := #255;
lastformattoken := ' ';
prevlasttoken := 'H';
while FormatCurrent < FormatEnd do
begin
Token := UpCase(FormatCurrent^);
Count := 1;
P := FormatCurrent + 1;
case Token of
'''', '"':
begin
while (P < FormatEnd) and (p^ <> Token) do
Inc(P);
Inc(P);
Count := P - FormatCurrent;
StoreStr(FormatCurrent + 1, Count - 2);
end ;
'A':
begin
if StrLIComp(FormatCurrent, 'AMPM', 4) = 0 then
begin
Count := 4;
if Hour < 12 then
StoreString(FormatSettings.TimeAMString)
else
StoreString(FormatSettings.TimePMString);
end
else if StrLIComp(FormatCurrent, 'AM/PM', 5) = 0 then
begin
Count := 5;
if Hour < 12 then StoreStr(FormatCurrent, 2)
else StoreStr(FormatCurrent+3, 2);
end
else if StrLIComp(FormatCurrent, 'A/P', 3) = 0 then
begin
Count := 3;
if Hour < 12 then StoreStr(FormatCurrent, 1)
else StoreStr(FormatCurrent+2, 1);
end
else
raise EConvertError.Create('Illegal character in format string');
end ;
'/': StoreStr(@FormatSettings.DateSeparator, 1);
':': StoreStr(@FormatSettings.TimeSeparator, 1);
'[': if (fdoInterval in Options) then isInterval := true else StoreStr(FormatCurrent, 1);
']': if (fdoInterval in Options) then isInterval := false else StoreStr(FormatCurrent, 1);
' ', 'C', 'D', 'H', 'M', 'N', 'S', 'T', 'Y', 'Z', 'F' :
begin
while (P < FormatEnd) and (UpCase(P^) = Token) do
Inc(P);
Count := P - FormatCurrent;
case Token of
' ': StoreStr(FormatCurrent, Count);
'Y': begin
if Count > 2 then
StoreInt(Year, 4)
else
StoreInt(Year mod 100, 2);
end;
'M': begin
if isInterval and ((prevlasttoken = 'H') or TimeFlag) then
StoreInt(Minute + (Hour + trunc(abs(DateTime))*24)*60, 0)
else
if (lastformattoken = 'H') or TimeFlag then
begin
if Count = 1 then
StoreInt(Minute, 0)
else
StoreInt(Minute, 2);
end
else
begin
case Count of
1: StoreInt(Month, 0);
2: StoreInt(Month, 2);
3: StoreString(FormatSettings.ShortMonthNames[Month]);
else
StoreString(FormatSettings.LongMonthNames[Month]);
end;
end;
end;
'D': begin
case Count of
1: StoreInt(Day, 0);
2: StoreInt(Day, 2);
3: StoreString(FormatSettings.ShortDayNames[DayOfWeek]);
4: StoreString(FormatSettings.LongDayNames[DayOfWeek]);
5: StoreFormat(FormatSettings.ShortDateFormat, Nesting+1, False);
else
StoreFormat(FormatSettings.LongDateFormat, Nesting+1, False);
end ;
end ;
'H':
if isInterval then
StoreInt(Hour + trunc(abs(DateTime))*24, 0)
else
if Clock12 then
begin
tmp := hour mod 12;
if tmp=0 then tmp:=12;
if Count = 1 then
StoreInt(tmp, 0)
else
StoreInt(tmp, 2);
end
else begin
if Count = 1 then
StoreInt(Hour, 0)
else
StoreInt(Hour, 2);
end;
'N': if isInterval then
StoreInt(Minute + (Hour + trunc(abs(DateTime))*24)*60, 0)
else
if Count = 1 then
StoreInt(Minute, 0)
else
StoreInt(Minute, 2);
'S': if isInterval then
StoreInt(Second + (Minute + (Hour + trunc(abs(DateTime))*24)*60)*60, 0)
else
if Count = 1 then
StoreInt(Second, 0)
else
StoreInt(Second, 2);
'Z': if Count = 1 then
StoreInt(MilliSecond, 0)
else
StoreInt(MilliSecond, 3);
'T': if Count = 1 then
StoreFormat(FormatSettings.ShortTimeFormat, Nesting+1, True)
else
StoreFormat(FormatSettings.LongTimeFormat, Nesting+1, True);
'C': begin
StoreFormat(FormatSettings.ShortDateFormat, Nesting+1, False);
if (Hour<>0) or (Minute<>0) or (Second<>0) then
begin
StoreString(' ');
StoreFormat(FormatSettings.LongTimeFormat, Nesting+1, True);
end;
end;
'F': begin
StoreFormat(FormatSettings.ShortDateFormat, Nesting+1, False);
StoreString(' ');
StoreFormat(FormatSettings.LongTimeFormat, Nesting+1, True);
end;
(* ------------ not needed here...
{$IFDEF MSWindows}
'E':
begin
if not Eastasiainited then InitEastAsia;
if Not(isEnable_E_Format) then StoreStr(@FormatCurrent^, 1)
else
begin
while (P < FormatEnd) and (UpCase(P^) = Token) do
P := P + 1;
Count := P - FormatCurrent;
StoreString(ConvertEraYearString(Count,Year,Month,Day));
end;
prevlasttoken := lastformattoken;
lastformattoken:=token;
end;
'G':
begin
if not Eastasiainited then InitEastAsia;
if Not(isEnable_G_Format) then StoreStr(@FormatCurrent^, 1)
else
begin
while (P < FormatEnd) and (UpCase(P^) = Token) do
P := P + 1;
Count := P - FormatCurrent;
StoreString(ConvertEraString(Count,Year,Month,Day));
end;
prevlasttoken := lastformattoken;
lastformattoken:=token;
end;
{$ENDIF MSWindows}
*)
end;
prevlasttoken := lastformattoken;
lastformattoken := token;
end;
else
StoreStr(@Token, 1);
end ;
Inc(FormatCurrent, Count);
end;
end;
begin (*
{$ifdef MSWindows}
eastasiainited:=false;
{$endif MSWindows}
*)
DecodeDateFully(DateTime, Year, Month, Day, DayOfWeek);
DecodeTime(DateTime, Hour, Minute, Second, MilliSecond);
ResultLen := 0;
ResultCurrent := @ResultBuffer[0];
if FormatStr <> '' then
StoreFormat(FormatStr, 0, False)
else
StoreFormat('C', 0, False);
ResultBuffer[ResultLen] := #0;
result := StrPas(@ResultBuffer[0]);
end ;
{@@
Applies a formatting string to a date/time value and converts the number
to a date/time string.
This functionality is available in the SysUtils unit. But it is duplicated
here to add a patch which is not available in stable fpc.
}
procedure DateTimeToString(out Result: string; const FormatStr: string;
const DateTime: TDateTime; Options : TFormatDateTimeOptions = []);
begin
DateTimeToString(Result, FormatStr, DateTime, DefaultFormatSettings, Options);
end;
{@@
Applies a formatting string to a date/time value and converts the number
to a date/time string.
This functionality is available in the SysUtils unit. But it is duplicated
here to add a patch which is not available in stable fpc.
}
function FormatDateTime(const FormatStr: string; DateTime: TDateTime;
Options : TFormatDateTimeOptions = []): string;
begin
DateTimeToString(Result, FormatStr, DateTime, DefaultFormatSettings,Options);
end;
{@@
Applies a formatting string to a date/time value and converts the number
to a date/time string.
This functionality is available in the SysUtils unit. But it is duplicated
here to add a patch which is not available in stable fpc.
}
function FormatDateTime(const FormatStr: string; DateTime: TDateTime;
const FormatSettings: TFormatSettings; Options : TFormatDateTimeOptions = []): string;
begin
DateTimeToString(Result, FormatStr, DateTime, FormatSettings,Options);
end;
{@@ ----------------------------------------------------------------------------
Extracts compare information from an input string such as "<2.4".
Is needed for some Excel-strings.
@ -2761,13 +2349,6 @@ begin
end;
end;
{$IF FPC_FULLVERSION < 020604}
function VarIsBool(const V: Variant): Boolean;
begin
Result := (TVarData(V).vType and varTypeMask) = varboolean;
end;
{$ENDIF}
initialization
InitUTF8FormatSettings;

7
components/fpspreadsheet/laz_fpspreadsheet.lpk
View File

@ -18,6 +18,7 @@
</Parsing>
<Other>
<CustomOptions Value="$(IDEBuildOptions)"/>
<CompilerPath Value="$(CompPath)"/>
</Other>
</CompilerOptions>
<Description Value="laz_fpspreadsheet is a non-visual component that allows you to use the fpspreadsheet package to read/write spreadsheet files in .xls (BIFF/Excel), .ods OpenDocument (LibreOffice/OpenOffice) and .xlsx Open XML (Excel) formats.
@ -25,7 +26,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="5"/>
<Files Count="27">
<Files Count="28">
<Item1>
<Filename Value="fpolestorage.pas"/>
<UnitName Value="fpolestorage"/>
@ -134,6 +135,10 @@ This package is all you need if you don't want graphical components (like grids
<Filename Value="fpscsvdocument.pas"/>
<UnitName Value="fpsCsvDocument"/>
</Item27>
<Item28>
<Filename Value="fpspatches.pas"/>
<UnitName Value="fpspatches"/>
</Item28>
</Files>
<RequiredPkgs Count="2">
<Item1>

2
components/fpspreadsheet/laz_fpspreadsheet.pas
View File

@ -12,7 +12,7 @@ uses
fpsutils, fpszipper, uvirtuallayer_types, uvirtuallayer, uvirtuallayer_ole,
uvirtuallayer_ole_helpers, uvirtuallayer_ole_types, uvirtuallayer_stream,
fpolebasic, wikitable, fpsNumFormatParser, fpsfunc, fpsRPN, fpsStrings,
fpscsv, fpsCsvDocument;
fpscsv, fpsCsvDocument, fpspatches;
implementation

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

@ -146,7 +146,7 @@ type
implementation
uses
TypInfo, fpsutils, fpscsv;
TypInfo, fpsPatches, fpsutils, fpscsv;
const
FmtNumbersSheet = 'NumbersFormat'; //let's distinguish it from the regular numbers sheet

2
components/fpspreadsheet/xlscommon.pas
View File

@ -407,7 +407,7 @@ implementation
uses
AVL_Tree, Math, Variants,
xlsConst, fpsNumFormatParser, fpsrpn, fpsExprParser;
fpspatches, xlsConst, fpsNumFormatParser, fpsrpn, fpsExprParser;
const
{ Helper table for rpn formulas:

2
components/fpspreadsheet/xlsxooxml.pas
View File

@ -176,7 +176,7 @@ implementation
uses
variants, fileutil, strutils, math, lazutf8,
fpsStrings, fpsStreams, fpsNumFormatParser;
fpsPatches, fpsStrings, fpsStreams, fpsNumFormatParser;
const
{ OOXML general XML constants }