mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-04-22 10:59:29 +02:00
Merged revision(s) 49121 #336bdda458, 49154 #a16431b3ac from trunk:
LazReport, when formatting numbers check that value is really numeric, issue #28114 ........ LazReport, fix loading of old binary reports (older than version 28), modified patch from Tsvetoslav, issue #27179 ........ git-svn-id: branches/fixes_1_4@49183 -
This commit is contained in:
parent
1b4b1ad15a
commit
85167083fc
@ -20,7 +20,7 @@ uses
|
||||
Dialogs, Menus, Variants, DB, Graphics, Printers, osPrinters, LazUTF8, DOM,
|
||||
XMLWrite, XMLRead, XMLConf, LCLType, LCLIntf, TypInfo, LR_View, LR_Pars,
|
||||
LR_Intrp, LR_DSet, LR_DBSet, LR_DBRel, LR_Const, DbCtrls, LazUtf8Classes,
|
||||
LazLoggerBase;
|
||||
LCLProc;
|
||||
|
||||
const
|
||||
// object flags
|
||||
@ -2708,12 +2708,13 @@ var
|
||||
i : Integer;
|
||||
begin
|
||||
{$IFDEF DebugLR}
|
||||
DebugLn('%s.TfrView.LoadFromStream begin StreamMode=%d ClassName=%s',
|
||||
[name,Ord(StreamMode),ClassName]);
|
||||
DebugLn('%s.TfrView.LoadFromStream begin StreamMode=%d ClassName=%s Stream.Position=%d',
|
||||
[name,Ord(StreamMode),ClassName, Stream.Position]);
|
||||
{$ENDIF}
|
||||
with Stream do
|
||||
begin
|
||||
// if StreamMode = smDesigning then
|
||||
|
||||
if (frVersion>27) or ((frVersion=27) and lrCanReadName(Stream)) or (StreamMode = smDesigning) then
|
||||
begin
|
||||
if frVersion >= 23 then
|
||||
fName := ReadString(Stream)
|
||||
@ -2787,7 +2788,7 @@ begin
|
||||
|
||||
end;
|
||||
{$IFDEF DebugLR}
|
||||
DebugLn('%s.TfrView.LoadFromStream end',[name]);
|
||||
DebugLn('%s.TfrView.LoadFromStream end Position=%d',[name, Stream.Position]);
|
||||
{$ENDIF}
|
||||
end;
|
||||
|
||||
@ -9690,6 +9691,8 @@ var
|
||||
f1, f2: Integer;
|
||||
c: Char;
|
||||
s: String;
|
||||
Dummy: Extended;
|
||||
IsNumeric: Boolean;
|
||||
begin
|
||||
if (TVarData(v).VType = varEmpty) {VarIsEmpty(v)} or VarIsNull(v) then
|
||||
begin
|
||||
@ -9715,7 +9718,8 @@ begin
|
||||
end;
|
||||
fmtNumber:
|
||||
begin
|
||||
if not VarIsNumeric(v) then
|
||||
IsNumeric := VarIsNumeric(v) or TryStrToFloat(v, Dummy);
|
||||
if not IsNumeric then
|
||||
result := v
|
||||
else begin
|
||||
DefaultFormatSettings.DecimalSeparator := Chr(AFormat and $FF);
|
||||
|
@ -69,6 +69,7 @@ function lrStrToDateTime(AValue: string): TDateTime;
|
||||
function lrExpandVariables(const S:string):string;
|
||||
procedure lrNormalizeLocaleFloats(DisableLocale: boolean);
|
||||
function lrConfigFolderName(ACreatePath: boolean): string;
|
||||
function lrCanReadName(Stream: TStream): boolean;
|
||||
|
||||
// utf8 tools
|
||||
function UTF8Desc(S:string; var Desc: string): Integer; deprecated;
|
||||
@ -919,6 +920,34 @@ begin
|
||||
raise EInOutError.Create(SysUtils.Format(lrsUnableToCreateConfigDirectoryS,[Result]));
|
||||
end;
|
||||
|
||||
function lrCanReadName(Stream: TStream): boolean;
|
||||
var
|
||||
oldPosition: Int64;
|
||||
aName: string;
|
||||
n: Integer;
|
||||
begin
|
||||
// normally stream is seek-able so this should work....
|
||||
oldPosition := stream.Position;
|
||||
result := false;
|
||||
try
|
||||
try
|
||||
n := stream.ReadWord;
|
||||
setLength(aName, n);
|
||||
stream.Read(aName[1], n);
|
||||
if (n>0) and (stream.ReadByte=0) then begin
|
||||
// unfortunately, objects names are not validated
|
||||
// only check standard names here
|
||||
while (n>0) and (aName[n] in ['a'..'z','A'..'Z','0'..'9','_']) do
|
||||
dec(n);
|
||||
result := (n=0);
|
||||
end;
|
||||
except
|
||||
end;
|
||||
finally
|
||||
Stream.Position := oldPosition;
|
||||
end;
|
||||
end;
|
||||
|
||||
function UTF8Desc(S: string; var Desc: string): Integer;
|
||||
// create Desc as an array with Desc[i] is the size of the UTF-8 codepoint
|
||||
var
|
||||
|
Loading…
Reference in New Issue
Block a user