sysstrh.inc 12 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291
  1. {
  2. *********************************************************************
  3. $Id$
  4. Copyright (C) 1997, 1998 Gertjan Schouten
  5. This program is free software; you can redistribute it and/or modify
  6. it under the terms of the GNU General Public License as published by
  7. the Free Software Foundation; either version 2 of the License, or
  8. (at your option) any later version.
  9. This program is distributed in the hope that it will be useful,
  10. but WITHOUT ANY WARRANTY; without even the implied warranty of
  11. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  12. GNU General Public License for more details.
  13. You should have received a copy of the GNU General Public License
  14. along with this program; if not, write to the Free Software
  15. Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  16. *********************************************************************
  17. System Utilities For Free Pascal
  18. }
  19. {==============================================================================}
  20. { standard functions }
  21. {==============================================================================}
  22. type
  23. PString = ^String;
  24. { For FloatToText }
  25. TFloatFormat = (ffGeneral, ffExponent, ffFixed, ffNumber, ffCurrency);
  26. TFloatValue = (fvExtended, fvCurrency, fvSingle, fvReal, fvDouble, fvComp);
  27. TReplaceFlags = set of (rfReplaceAll, rfIgnoreCase);
  28. TFloatRec = Record
  29. Exponent: Integer;
  30. Negative: Boolean;
  31. Digits: Array[0..18] Of Char;
  32. End;
  33. const
  34. { For floattodatetime }
  35. MinDateTime: TDateTime = -657434.0; { 01/01/0100 12:00:00.000 AM }
  36. MaxDateTime: TDateTime = 2958465.99999; { 12/31/9999 11:59:59.999 PM }
  37. {$ifndef VER1_0}
  38. {$if defined(FPC_HAS_TYPE_EXTENDED) or defined(FPC_HAS_TYPE_FLOAT128)}
  39. MinCurrency: Currency = -922337203685477.5807;
  40. MaxCurrency: Currency = 922337203685477.5807;
  41. {$else}
  42. MinCurrency: Currency = -922337203685477.0000;
  43. MaxCurrency: Currency = 922337203685477.0000;
  44. {$endif}
  45. {$endif VER1_0}
  46. Type
  47. TTextLineBreakStyle = (tlbsLF, tlbsCRLF,tlbsCR); // Must move to system unit, and add Mac tlbsCR too ?
  48. Const
  49. DefaultTextLineBreakStyle: TTextLineBreakStyle =
  50. {$ifdef unix} tlbsLF {$else} {$ifdef macos} tlbsCR {$else} tlbsCRLF {$endif} {$endif} ;
  51. Const
  52. LeadBytes: set of Char = [];
  53. EmptyStr : string = '';
  54. NullStr : PString = @EmptyStr;
  55. {$IFDEF VIRTUALPASCAL}
  56. EmptyWideStr : AnsiString = '';
  57. NullWideStr : PString = @EmptyWideStr;
  58. {$ELSE}
  59. EmptyWideStr : WideString = '';
  60. // NullWideStr : PWideString = @EmptyWideStr;
  61. {$ENDIF}
  62. function NewStr(const S: string): PString;
  63. procedure DisposeStr(S: PString);
  64. procedure AssignStr(var P: PString; const S: string);
  65. procedure AppendStr(var Dest: String; const S: string);
  66. function UpperCase(const s: string): string;
  67. function LowerCase(const s: string): string; overload;
  68. function CompareStr(const S1, S2: string): Integer;
  69. function CompareMemRange(P1, P2: Pointer; Length: cardinal): integer;
  70. function CompareMem(P1, P2: Pointer; Length: cardinal): Boolean;
  71. function CompareText(const S1, S2: string): integer;
  72. function SameText(const s1,s2:String):Boolean;
  73. function AnsiUpperCase(const s: string): string;
  74. function AnsiLowerCase(const s: string): string;
  75. function AnsiCompareStr(const S1, S2: string): integer;
  76. function AnsiCompareText(const S1, S2: string): integer;
  77. function AnsiSameText(const s1,s2:String):Boolean;
  78. function AnsiSameStr(const s1,s2:String):Boolean;
  79. function AnsiStrComp(S1, S2: PChar): integer;
  80. function AnsiStrIComp(S1, S2: PChar): integer;
  81. function AnsiStrLComp(S1, S2: PChar; MaxLen: cardinal): integer;
  82. function AnsiStrLIComp(S1, S2: PChar; MaxLen: cardinal): integer;
  83. function AnsiStrLower(Str: PChar): PChar;
  84. function AnsiStrUpper(Str: PChar): PChar;
  85. function AnsiLastChar(const S: string): PChar;
  86. function AnsiStrLastChar(Str: PChar): PChar;
  87. function Trim(const S: string): string;
  88. function TrimLeft(const S: string): string;
  89. function TrimRight(const S: string): string;
  90. function QuotedStr(const S: string): string;
  91. function AnsiQuotedStr(const S: string; Quote: char): string;
  92. function AnsiExtractQuotedStr(var Src: PChar; Quote: Char): string;
  93. function AdjustLineBreaks(const S: string): string;
  94. function AdjustLineBreaks(const S: string; Style: TTextLineBreakStyle): string;
  95. function IsValidIdent(const Ident: string): boolean;
  96. function IntToStr(Value: integer): string;
  97. {$IFNDEF VIRTUALPASCAL}
  98. function IntToStr(Value: Int64): string;
  99. {$ENDIF}
  100. function IntToStr(Value: QWord): string;
  101. function IntToHex(Value: integer; Digits: integer): string;
  102. function IntToHex(Value: Int64; Digits: integer): string;
  103. function StrToInt(const s: string): integer;
  104. function TryStrToInt(const s: string; var i : integer) : boolean;
  105. {$IFNDEF VIRTUALPASCAL}
  106. function StrToInt64(const s: string): int64;
  107. function TryStrToInt64(const s: string; var i : int64) : boolean;
  108. {$ENDIF}
  109. function StrToIntDef(const S: string; Default: integer): integer;
  110. {$IFNDEF VIRTUALPASCAL}
  111. function StrToInt64Def(const S: string; Default: int64): int64;
  112. {$ENDIF}
  113. function LoadStr(Ident: integer): string;
  114. // function FmtLoadStr(Ident: integer; const Args: array of const): string;
  115. Function Format (Const Fmt : String; const Args : Array of const) : String;
  116. Function FormatBuf (Var Buffer; BufLen : Cardinal; Const Fmt; fmtLen : Cardinal; Const Args : Array of const) : Cardinal;
  117. Function StrFmt(Buffer,Fmt : PChar; Const args: Array of const) : Pchar;
  118. Function StrLFmt(Buffer : PCHar; Maxlen : Cardinal;Fmt : PChar; Const args: Array of const) : Pchar;
  119. Procedure FmtStr(Var Res: String; Const Fmt : String; Const args: Array of const);
  120. Function FloatToStrF(Value: Extended; format: TFloatFormat; Precision, Digits: Integer): String;
  121. Function FloatToStr(Value: Extended): String;
  122. Function StrToFloat(Const S : String) : Extended;
  123. Function StrToFloatDef(Const S: String; Const Default: Extended): Extended;
  124. Function TryStrToFloat(Const S : String; Var Value: Single): Boolean;
  125. Function TryStrToFloat(Const S : String; Var Value: Double): Boolean;
  126. {$ifdef FPC_HAS_TYPE_EXTENDED}
  127. Function TryStrToFloat(Const S : String; Var Value: Extended): Boolean;
  128. {$endif FPC_HAS_TYPE_EXTENDED}
  129. Function TextToFloat(Buffer: PChar; Var Value: Extended): Boolean;
  130. Function TextToFloat(Buffer: PChar; Var Value; ValueType: TFloatValue): Boolean;
  131. Function FloatToText(Buffer: PChar; Value: Extended; format: TFloatFormat; Precision, Digits: Integer): Longint;
  132. Function FloatToDateTime (Const Value : Extended) : TDateTime;
  133. Function FloattoCurr (Const Value : Extended) : Currency;
  134. function TryFloatToCurr(const Value: Extended; var AResult: Currency): Boolean;
  135. Function CurrToStr(Value: Currency): string;
  136. function StrToCurr(const S: string): Currency;
  137. function StrToCurrDef(const S: string; Default : Currency): Currency;
  138. function StrToBool(const S: string): Boolean;
  139. function BoolToStr(B: Boolean): string;
  140. function LastDelimiter(const Delimiters, S: string): Integer;
  141. function StringReplace(const S, OldPattern, NewPattern: string; Flags: TReplaceFlags): string;
  142. Function FloatToTextFmt(Buffer: PChar; Value: Extended; format: PChar): Integer;
  143. Procedure FloatToDecimal(Var Result: TFloatRec; Value: Extended; Precision, Decimals : integer);
  144. Function FormatFloat(Const Format : String; Value : Extended) : String;
  145. Function IsDelimiter(const Delimiters, S: string; Index: Integer): Boolean;
  146. {// MBCS Functions. No MBCS yet, so mostly these are calls to the regular counterparts.}
  147. Type
  148. TMbcsByteType = (mbSingleByte, mbLeadByte, mbTrailByte);
  149. Function ByteType(const S: string; Index: Integer): TMbcsByteType;
  150. Function StrByteType(Str: PChar; Index: Cardinal): TMbcsByteType;
  151. Function ByteToCharLen(const S: string; MaxLen: Integer): Integer;
  152. Function CharToByteLen(const S: string; MaxLen: Integer): Integer;
  153. Function ByteToCharIndex(const S: string; Index: Integer): Integer;
  154. Function StrCharLength(const Str: PChar): Integer;
  155. const
  156. {$ifndef unix}
  157. SwitchChars = ['/','-'];
  158. {$else}
  159. SwitchChars = ['-'];
  160. {$endif}
  161. Type
  162. TSysCharSet = Set of char;
  163. Function FindCmdLineSwitch(const Switch: string; const Chars: TSysCharSet;IgnoreCase: Boolean): Boolean;
  164. Function FindCmdLineSwitch(const Switch: string; IgnoreCase: Boolean): Boolean;
  165. Function FindCmdLineSwitch(const Switch: string): Boolean;
  166. function WrapText(const Line, BreakStr: string; const BreakChars: TSysCharSet; MaxCol: Integer): string;
  167. function WrapText(const Line: string; MaxCol: Integer): string;
  168. {==============================================================================}
  169. { extra functions }
  170. {==============================================================================}
  171. function LeftStr(const S: string; Count: integer): string;
  172. function RightStr(const S: string; Count: integer): string;
  173. function BCDToInt(Value: integer): integer;
  174. {
  175. $Log$
  176. Revision 1.14 2005-02-06 09:38:45 florian
  177. + StrCharLength infrastructure
  178. Revision 1.13 2005/01/17 18:38:48 peter
  179. * extended overload disabled for powerpc
  180. Revision 1.12 2005/01/16 17:53:27 michael
  181. + Patch from Colin Western to implemenet TryStrToFLoat
  182. Revision 1.11 2004/12/19 17:55:38 michael
  183. + Implemented wraptext
  184. Revision 1.10 2004/11/16 18:30:36 marco
  185. * updated ansiexctractquotedstring (more delphi compat, both interface and code)
  186. Revision 1.9 2004/08/30 13:07:03 michael
  187. + Added MACOS linebreakstyle (tlbsCR)
  188. Revision 1.8 2004/08/07 16:56:28 florian
  189. + TryStrToInt* added
  190. Revision 1.7 2004/06/20 20:42:37 florian
  191. * fixed bootstrapping problems
  192. Revision 1.6 2004/06/13 10:49:50 florian
  193. * fixed some bootstrapping problems as well as some 64 bit stuff
  194. Revision 1.5 2004/06/12 13:23:17 michael
  195. + Fixed currency<->string conversion support
  196. Revision 1.4 2004/02/26 08:46:21 michael
  197. + Added AnsiSameStr
  198. Revision 1.3 2003/11/26 22:17:42 michael
  199. + Merged fixbranch fixes, missing in main branch
  200. Revision 1.2 2003/10/07 12:02:47 marco
  201. * sametext and ansisametext added. (simple (ansi)comparetext wrappers)
  202. Revision 1.1 2003/10/06 21:01:06 peter
  203. * moved classes unit to rtl
  204. Revision 1.17 2003/09/06 21:22:08 marco
  205. * More objpas fixes
  206. Revision 1.16 2002/12/24 23:33:37 peter
  207. * export StrToFloatDef
  208. Revision 1.15 2002/12/23 23:12:34 florian
  209. + TextToFloat: D6 compatibility added
  210. Revision 1.14 2002/11/28 22:26:30 michael
  211. + Fixed float<>string conversion routines
  212. Revision 1.13 2002/11/28 20:29:26 michael
  213. + made it compile again
  214. Revision 1.12 2002/09/07 16:01:22 peter
  215. * old logs removed and tabs fixed
  216. Revision 1.1.2.6 2002/11/28 22:25:01 michael
  217. + Fixed float<>string conversion routines
  218. Revision 1.1.2.5 2002/11/28 20:24:12 michael
  219. + merged some fixes from mainbranch
  220. Revision 1.1.2.4 2002/10/29 23:41:06 michael
  221. + Added lots of D4 functions
  222. Revision 1.11 2002/01/24 18:33:58 peter
  223. * overload for lowercase()
  224. Revision 1.10 2002/01/24 12:33:54 jonas
  225. * adapted ranges of native types to int64 (e.g. high cardinal is no
  226. longer longint($ffffffff), but just $fffffff in psystem)
  227. * small additional fix in 64bit rangecheck code generation for 32 bit
  228. processors
  229. * adaption of ranges required the matching talgorithm used for selecting
  230. which overloaded procedure to call to be adapted. It should now always
  231. select the closest match for ordinal parameters.
  232. + inttostr(qword) in sysstr.inc/sysstrh.inc
  233. + abs(int64), sqr(int64), sqr(qword) in systemh.inc/generic.inc (previous
  234. fixes were required to be able to add them)
  235. * is_in_limit() moved from ncal to types unit, should always be used
  236. instead of direct comparisons of low/high values of orddefs because
  237. qword is a special case
  238. }