paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-20 11:09:42 +02:00
Code Issues Packages Projects Releases Wiki Activity

classes: add TStrings.Options (Delphi-compatibility)

Browse Source 
git-svn-id: trunk@43841 -
This commit is contained in:
ondrej 2020-01-02 18:55:19 +00:00
parent 6796434268
commit 5d58ced92b
2 changed files with 92 additions and 31 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

20
rtl/objpas/classes/classesh.inc
View File

@ -610,6 +610,8 @@ type
TStringsForEachMethod = procedure(const CurrentValue: string) of object;
TMissingNameValueSeparatorAction = (mnvaValue,mnvaName,mnvaEmpty,mnvaError);
TMissingNameValueSeparatorActions = set of TMissingNameValueSeparatorAction;
TStringsOption = (soStrictDelimiter,soWriteBOM,soTrailingLineBreak,soUseLocale);
TStringsOptions = set of TStringsOption;
TStrings = class(TPersistent)
private
@ -624,16 +626,17 @@ type
FUpdateCount: Integer;
FAdapter: IStringsAdapter;
FLBS : TTextLineBreakStyle;
FSkipLastLineBreak : Boolean;
FStrictDelimiter : Boolean;
FOptions : TStringsOptions;
FLineBreak : String;
FWriteBOM: Boolean;
function GetCommaText: string;
function GetLineBreakCharLBS: string;
function GetMissingNameValueSeparatorAction: TMissingNameValueSeparatorAction;
function GetName(Index: Integer): string;
function GetStrictDelimiter: Boolean;
function GetTrailingLineBreak: Boolean;
function GetUseLocale: Boolean;
function GetValue(const Name: string): string;
function GetWriteBOM: Boolean;
Function GetLBS : TTextLineBreakStyle;
procedure SetDefaultEncoding(const ADefaultEncoding: TEncoding);
procedure SetEncoding(const AEncoding: TEncoding);
@ -642,7 +645,10 @@ type
procedure SetCommaText(const Value: string);
procedure SetMissingNameValueSeparatorAction(AValue: TMissingNameValueSeparatorAction);
procedure SetStringsAdapter(const Value: IStringsAdapter);
procedure SetStrictDelimiter(AValue: Boolean);
procedure SetTrailingLineBreak(AValue: Boolean);
procedure SetUseLocale(AValue: Boolean);
procedure SetWriteBOM(AValue: Boolean);
procedure SetValue(const Name, Value: string);
procedure SetDelimiter(c:Char);
procedure SetQuoteChar(c:Char);
@ -658,6 +664,7 @@ type
procedure SetSkipLastLineBreak(const AValue : Boolean);
Procedure DoSetDelimitedText(const AValue: string; DoClear,aStrictDelimiter : Boolean; aQuoteChar,aDelimiter : Char);
protected
function CompareStrings(const s1,s2 : string) : Integer; virtual;
procedure DefineProperties(Filer: TFiler); override;
procedure Error(const Msg: string; Data: Integer);
procedure Error(const Msg: pstring; Data: Integer);
@ -763,18 +770,20 @@ type
property Names[Index: Integer]: string read GetName;
Property NameValueSeparator : Char Read GetNameValueSeparator Write SetNameValueSeparator;
property Objects[Index: Integer]: TObject read GetObject write PutObject;
property Options: TStringsOptions read FOptions write FOptions;
property QuoteChar: Char read GetQuoteChar write SetQuoteChar;
Property SkipLastLineBreak : Boolean Read GetSkipLastLineBreak Write SetSkipLastLineBreak;
// Same as SkipLastLineBreak but for Delphi compatibility. Note it has opposite meaning.
Property TrailingLineBreak : Boolean Read GetTrailingLineBreak Write SetTrailingLineBreak;
Property StrictDelimiter : Boolean Read FStrictDelimiter Write FStrictDelimiter;
Property StrictDelimiter : Boolean Read GetStrictDelimiter Write SetStrictDelimiter;
property Strings[Index: Integer]: string read Get write Put; default;
property StringsAdapter: IStringsAdapter read FAdapter write SetStringsAdapter;
property Text: string read GetTextStr write SetTextStr;
Property TextLineBreakStyle : TTextLineBreakStyle Read GetLBS Write SetLBS;
Property UseLocale : Boolean Read GetUseLocale Write SetUseLocale;
property ValueFromIndex[Index: Integer]: string read GetValueFromIndex write SetValueFromIndex;
property Values[const Name: string]: string read GetValue write SetValue;
property WriteBOM: Boolean read FWriteBOM write FWriteBOM;
property WriteBOM: Boolean read GetWriteBOM write SetWriteBOM;
end;
TStringsClass = Class of TStrings;
@ -833,7 +842,6 @@ type
procedure InsertItem(Index: Integer; const S: string); virtual;
procedure InsertItem(Index: Integer; const S: string; O: TObject); virtual;
Function DoCompareText(const s1,s2 : string) : PtrInt; override;
function CompareStrings(const s1,s2 : string) : Integer; virtual;
public
destructor Destroy; override;

103
rtl/objpas/classes/stringl.inc
View File

@ -83,15 +83,13 @@ end;
Function TStrings.GetSkipLastLineBreak : Boolean;
begin
CheckSpecialChars;
Result:=FSkipLastLineBreak;
Result:=not TrailingLineBreak;
end;
procedure TStrings.SetSkipLastLineBreak(const AValue : Boolean);
begin
CheckSpecialChars;
FSkipLastLineBreak:=AValue;
TrailingLineBreak:=not AValue;
end;
Function TStrings.GetLBS : TTextLineBreakStyle;
@ -459,9 +457,24 @@ begin
GetNameValue(Index,Result,V);
end;
function TStrings.GetStrictDelimiter: Boolean;
begin
Result:=soStrictDelimiter in FOptions;
end;
function TStrings.GetTrailingLineBreak: Boolean;
begin
Result:=Not SkipLastLineBreak;
Result:=soTrailingLineBreak in FOptions;
end;
function TStrings.GetUseLocale: Boolean;
begin
Result:=soUseLocale in FOptions;
end;
function TStrings.GetWriteBOM: Boolean;
begin
Result:=soWriteBOM in FOptions;
end;
Function TStrings.GetValue(const Name: string): string;
@ -519,7 +532,7 @@ Procedure TStrings.SetDelimitedText(const AValue: string);
begin
CheckSpecialChars;
DoSetDelimitedText(aValue,True,FStrictDelimiter,FQuoteChar,FDelimiter);
DoSetDelimitedText(aValue,True,StrictDelimiter,FQuoteChar,FDelimiter);
end;
Procedure TStrings.DoSetDelimitedText(const AValue: string; DoClear,aStrictDelimiter : Boolean; aQuoteChar,aDelimiter : Char);
@ -652,9 +665,36 @@ Procedure TStrings.SetStringsAdapter(const Value: IStringsAdapter);
begin
end;
procedure TStrings.SetStrictDelimiter(AValue: Boolean);
begin
if AValue then
Include(FOptions,soStrictDelimiter)
else
Exclude(FOptions,soStrictDelimiter);
end;
procedure TStrings.SetTrailingLineBreak(AValue: Boolean);
begin
SkipLastLineBreak:=Not aValue;
if AValue then
Include(FOptions,soTrailingLineBreak)
else
Exclude(FOptions,soTrailingLineBreak);
end;
procedure TStrings.SetUseLocale(AValue: Boolean);
begin
if AValue then
Include(FOptions,soUseLocale)
else
Exclude(FOptions,soUseLocale);
end;
procedure TStrings.SetWriteBOM(AValue: Boolean);
begin
if AValue then
Include(FOptions,soWriteBOM)
else
Exclude(FOptions,soWriteBOM);
end;
@ -701,6 +741,13 @@ end;
function TStrings.CompareStrings(const s1,s2 : string) : Integer;
begin
Result := DoCompareText(s1, s2);
end;
procedure TStrings.DefineProperties(Filer: TFiler);
var
HasData: Boolean;
@ -758,7 +805,7 @@ begin
NLS:=Length(NL);
For I:=0 to count-1 do
L:=L+Length(Strings[I])+NLS;
if FSkipLastLineBreak then
if SkipLastLineBreak then
Dec(L,NLS);
Setlength(Result,L);
P:=Pointer(Result);
@ -769,7 +816,7 @@ begin
if L<>0 then
System.Move(Pointer(S)^,P^,L);
P:=P+L;
if (I<Count-1) or Not FSkipLastLineBreak then
if (I<Count-1) or Not SkipLastLineBreak then
For L:=1 to NLS do
begin
P^:=NL[L];
@ -951,7 +998,7 @@ end;
procedure TStrings.AddDelimitedText(const S: String);
begin
CheckSpecialChars;
DoSetDelimitedText(S,False,FStrictDelimiter,FQuoteChar,FDelimiter);
DoSetDelimitedText(S,False,StrictDelimiter,FQuoteChar,FDelimiter);
end;
Procedure TStrings.SetUpdateState(Updating: Boolean);
@ -977,7 +1024,7 @@ begin
inherited Create;
FDefaultEncoding:=TEncoding.Default;
FEncoding:=nil;
FWriteBOM:=True;
FOptions := [soWriteBOM,soTrailingLineBreak,soUseLocale];
FAlwaysQuote:=False;
end;
@ -1091,7 +1138,7 @@ begin
FNameValueSeparator:=S.FNameValueSeparator;
FLBS:=S.FLBS;
FLineBreak:=S.FLineBreak;
FWriteBOM:=S.FWriteBOM;
FOptions:=S.FOptions;
DefaultEncoding:=S.DefaultEncoding;
SetEncoding(S.Encoding);
AddStrings(S);
@ -1186,7 +1233,10 @@ end;
Function TStrings.DoCompareText(const s1,s2 : string) : PtrInt;
begin
result:=CompareText(s1,s2);
if UseLocale then
result:=AnsiCompareText(s1,s2)
else
result:=CompareText(s1,s2);
end;
@ -1489,7 +1539,7 @@ begin
L:=Length(S);
if L<>0 then
Stream.WriteBuffer(S[1], L*SizeOf(Char));
if (I<Count-1) or Not FSkipLastLineBreak then
if (I<Count-1) or Not SkipLastLineBreak then
Stream.WriteBuffer(NL[1], NLS);
end;
end;
@ -1506,7 +1556,7 @@ Var B,BNL : TBytes;
begin
if AEncoding=nil then
AEncoding:=FDefaultEncoding;
if FWriteBOM then
if WriteBOM then
begin
B:=AEncoding.GetPreamble;
if Length(B)>0 then
@ -1524,7 +1574,7 @@ begin
B:=AEncoding.GetAnsiBytes(S);
Stream.WriteBuffer(B[0],Length(B));
end;
if (I<Count-1) or Not FSkipLastLineBreak then
if (I<Count-1) or Not SkipLastLineBreak then
Stream.WriteBuffer(BNL[0],BNLS);
end;
end;
@ -1884,15 +1934,18 @@ end;
function TStringList.DoCompareText(const s1, s2: string): PtrInt;
begin
if FCaseSensitive then
result:=AnsiCompareStr(s1,s2)
else
result:=AnsiCompareText(s1,s2);
end;
function TStringList.CompareStrings(const s1,s2 : string) : Integer;
begin
Result := DoCompareText(s1, s2);
begin
if UseLocale then
result:=AnsiCompareStr(s1,s2)
else
result:=CompareStr(s1,s2);
end else
begin
if UseLocale then
result:=AnsiCompareText(s1,s2)
else
result:=CompareText(s1,s2);
end;
end;