1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
|
{
*********************************************************************
$Id: sysstrh.inc,v 1.18 2005/04/28 09:15:44 florian Exp $
Copyright (C) 1997, 1998 Gertjan Schouten
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
*********************************************************************
System Utilities For Free Pascal
}
{==============================================================================}
{ standard functions }
{==============================================================================}
type
PString = ^String;
{ For FloatToText }
TFloatFormat = (ffGeneral, ffExponent, ffFixed, ffNumber, ffCurrency);
TFloatValue = (fvExtended, fvCurrency, fvSingle, fvReal, fvDouble, fvComp);
TReplaceFlags = set of (rfReplaceAll, rfIgnoreCase);
TFloatRec = Record
Exponent: Integer;
Negative: Boolean;
Digits: Array[0..18] Of Char;
End;
const
{ For floattodatetime }
MinDateTime: TDateTime = -657434.0; { 01/01/0100 12:00:00.000 AM }
MaxDateTime: TDateTime = 2958465.99999; { 12/31/9999 11:59:59.999 PM }
{$ifndef VER1_0}
{$if defined(FPC_HAS_TYPE_EXTENDED) or defined(FPC_HAS_TYPE_FLOAT128)}
MinCurrency: Currency = -922337203685477.5807;
MaxCurrency: Currency = 922337203685477.5807;
{$else}
MinCurrency: Currency = -922337203685477.0000;
MaxCurrency: Currency = 922337203685477.0000;
{$endif}
{$endif VER1_0}
Type
TTextLineBreakStyle = (tlbsLF, tlbsCRLF,tlbsCR); // Must move to system unit, and add Mac tlbsCR too ?
Const
DefaultTextLineBreakStyle: TTextLineBreakStyle =
{$ifdef unix} tlbsLF {$else} {$ifdef macos} tlbsCR {$else} tlbsCRLF {$endif} {$endif} ;
Const
LeadBytes: set of Char = [];
EmptyStr : string = '';
NullStr : PString = @EmptyStr;
{$IFDEF VIRTUALPASCAL}
EmptyWideStr : AnsiString = '';
NullWideStr : PString = @EmptyWideStr;
{$ELSE}
EmptyWideStr : WideString = '';
// NullWideStr : PWideString = @EmptyWideStr;
{$ENDIF}
function NewStr(const S: string): PString;
procedure DisposeStr(S: PString);
procedure AssignStr(var P: PString; const S: string);
procedure AppendStr(var Dest: String; const S: string);
function UpperCase(const s: string): string;
function LowerCase(const s: string): string; overload;
function CompareStr(const S1, S2: string): Integer;
function CompareMemRange(P1, P2: Pointer; Length: cardinal): integer;
function CompareMem(P1, P2: Pointer; Length: cardinal): Boolean;
function CompareText(const S1, S2: string): integer;
function SameText(const s1,s2:String):Boolean;
function AnsiUpperCase(const s: string): string;{$ifdef SYSUTILSINLINE}inline;{$endif}
function AnsiLowerCase(const s: string): string;{$ifdef SYSUTILSINLINE}inline;{$endif}
function AnsiCompareStr(const S1, S2: string): integer;{$ifdef SYSUTILSINLINE}inline;{$endif}
function AnsiCompareText(const S1, S2: string): integer;{$ifdef SYSUTILSINLINE}inline;{$endif}
function AnsiSameText(const s1,s2:String):Boolean;{$ifdef SYSUTILSINLINE}inline;{$endif}
function AnsiSameStr(const s1,s2:String):Boolean;{$ifdef SYSUTILSINLINE}inline;{$endif}
function AnsiStrComp(S1, S2: PChar): integer;{$ifdef SYSUTILSINLINE}inline;{$endif}
function AnsiStrIComp(S1, S2: PChar): integer;{$ifdef SYSUTILSINLINE}inline;{$endif}
function AnsiStrLComp(S1, S2: PChar; MaxLen: cardinal): integer;{$ifdef SYSUTILSINLINE}inline;{$endif}
function AnsiStrLIComp(S1, S2: PChar; MaxLen: cardinal): integer;{$ifdef SYSUTILSINLINE}inline;{$endif}
function AnsiStrLower(Str: PChar): PChar;{$ifdef SYSUTILSINLINE}inline;{$endif}
function AnsiStrUpper(Str: PChar): PChar;{$ifdef SYSUTILSINLINE}inline;{$endif}
function AnsiLastChar(const S: string): PChar;
function AnsiStrLastChar(Str: PChar): PChar;
function Trim(const S: string): string;
function TrimLeft(const S: string): string;
function TrimRight(const S: string): string;
function QuotedStr(const S: string): string;
function AnsiQuotedStr(const S: string; Quote: char): string;
function AnsiExtractQuotedStr(var Src: PChar; Quote: Char): string;
function AdjustLineBreaks(const S: string): string;
function AdjustLineBreaks(const S: string; Style: TTextLineBreakStyle): string;
function IsValidIdent(const Ident: string): boolean;
function IntToStr(Value: integer): string;
{$IFNDEF VIRTUALPASCAL}
function IntToStr(Value: Int64): string;
{$ENDIF}
function IntToStr(Value: QWord): string;
function IntToHex(Value: integer; Digits: integer): string;
function IntToHex(Value: Int64; Digits: integer): string;
function StrToInt(const s: string): integer;
function TryStrToInt(const s: string; var i : integer) : boolean;
{$IFNDEF VIRTUALPASCAL}
function StrToInt64(const s: string): int64;
function TryStrToInt64(const s: string; var i : int64) : boolean;
{$ENDIF}
function StrToIntDef(const S: string; Default: integer): integer;
{$IFNDEF VIRTUALPASCAL}
function StrToInt64Def(const S: string; Default: int64): int64;
{$ENDIF}
function LoadStr(Ident: integer): string;
// function FmtLoadStr(Ident: integer; const Args: array of const): string;
Function Format (Const Fmt : String; const Args : Array of const) : String;
Function FormatBuf (Var Buffer; BufLen : Cardinal; Const Fmt; fmtLen : Cardinal; Const Args : Array of const) : Cardinal;
Function StrFmt(Buffer,Fmt : PChar; Const args: Array of const) : Pchar;
Function StrLFmt(Buffer : PCHar; Maxlen : Cardinal;Fmt : PChar; Const args: Array of const) : Pchar;
Procedure FmtStr(Var Res: String; Const Fmt : String; Const args: Array of const);
Function FloatToStrF(Value: Extended; format: TFloatFormat; Precision, Digits: Integer): String;
Function FloatToStr(Value: Extended): String;
Function StrToFloat(Const S : String) : Extended;
Function StrToFloatDef(Const S: String; Const Default: Extended): Extended;
Function TryStrToFloat(Const S : String; Var Value: Single): Boolean;
Function TryStrToFloat(Const S : String; Var Value: Double): Boolean;
{$ifdef FPC_HAS_TYPE_EXTENDED}
Function TryStrToFloat(Const S : String; Var Value: Extended): Boolean;
{$endif FPC_HAS_TYPE_EXTENDED}
Function TextToFloat(Buffer: PChar; Var Value: Extended): Boolean;
Function TextToFloat(Buffer: PChar; Var Value; ValueType: TFloatValue): Boolean;
Function FloatToText(Buffer: PChar; Value: Extended; format: TFloatFormat; Precision, Digits: Integer): Longint;
Function FloatToDateTime (Const Value : Extended) : TDateTime;
Function FloattoCurr (Const Value : Extended) : Currency;
function TryFloatToCurr(const Value: Extended; var AResult: Currency): Boolean;
Function CurrToStr(Value: Currency): string;
function StrToCurr(const S: string): Currency;
function TryStrToCurr(const S: string;Var Value : Currency): Boolean;
function StrToCurrDef(const S: string; Default : Currency): Currency;
function StrToBool(const S: string): Boolean;
function BoolToStr(B: Boolean): string;
function LastDelimiter(const Delimiters, S: string): Integer;
function StringReplace(const S, OldPattern, NewPattern: string; Flags: TReplaceFlags): string;
Function FloatToTextFmt(Buffer: PChar; Value: Extended; format: PChar): Integer;
Procedure FloatToDecimal(Var Result: TFloatRec; Value: Extended; Precision, Decimals : integer);
Function FormatFloat(Const Format : String; Value : Extended) : String;
Function IsDelimiter(const Delimiters, S: string; Index: Integer): Boolean;
function FormatCurr(const Format: string; Value: Currency): string;
{// MBCS Functions. No MBCS yet, so mostly these are calls to the regular counterparts.}
Type
TMbcsByteType = (mbSingleByte, mbLeadByte, mbTrailByte);
Function ByteType(const S: string; Index: Integer): TMbcsByteType;
Function StrByteType(Str: PChar; Index: Cardinal): TMbcsByteType;
Function ByteToCharLen(const S: string; MaxLen: Integer): Integer;
Function CharToByteLen(const S: string; MaxLen: Integer): Integer;
Function ByteToCharIndex(const S: string; Index: Integer): Integer;
Function StrCharLength(const Str: PChar): Integer;
const
{$ifndef unix}
SwitchChars = ['/','-'];
{$else}
SwitchChars = ['-'];
{$endif}
Type
TSysCharSet = Set of char;
Function FindCmdLineSwitch(const Switch: string; const Chars: TSysCharSet;IgnoreCase: Boolean): Boolean;
Function FindCmdLineSwitch(const Switch: string; IgnoreCase: Boolean): Boolean;
Function FindCmdLineSwitch(const Switch: string): Boolean;
function WrapText(const Line, BreakStr: string; const BreakChars: TSysCharSet; MaxCol: Integer): string;
function WrapText(const Line: string; MaxCol: Integer): string;
{==============================================================================}
{ extra functions }
{==============================================================================}
function LeftStr(const S: string; Count: integer): string;
function RightStr(const S: string; Count: integer): string;
function BCDToInt(Value: integer): integer;
{
$Log: sysstrh.inc,v $
Revision 1.18 2005/04/28 09:15:44 florian
+ variants: string -> float/int casts
Revision 1.17 2005/04/26 16:40:51 michael
+ Added FormatCurr by Uberto Barbini
Revision 1.16 2005/03/12 14:56:22 florian
+ added Ansi* routines to widestring manager
* made them using OS calls on windows
Revision 1.15 2005/02/14 17:13:31 peter
* truncate log
Revision 1.14 2005/02/06 09:38:45 florian
+ StrCharLength infrastructure
Revision 1.13 2005/01/17 18:38:48 peter
* extended overload disabled for powerpc
Revision 1.12 2005/01/16 17:53:27 michael
+ Patch from Colin Western to implemenet TryStrToFLoat
}
|
