sysstrh.inc 9.6 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237
  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. Type
  38. TTextLineBreakStyle = (tlbsLF, tlbsCRLF); // Must move to system unit, and add Mac tlbsCR too ?
  39. Const
  40. DefaultTextLineBreakStyle: TTextLineBreakStyle = {$ifdef unix} tlbsLF {$else} tlbsCRLF {$endif};
  41. Const
  42. LeadBytes: set of Char = [];
  43. EmptyStr : string = '';
  44. NullStr : PString = @EmptyStr;
  45. {$IFDEF VIRTUALPASCAL}
  46. EmptyWideStr : AnsiString = '';
  47. NullWideStr : PString = @EmptyWideStr;
  48. {$ELSE}
  49. EmptyWideStr : WideString = '';
  50. // NullWideStr : PWideString = @EmptyWideStr;
  51. {$ENDIF}
  52. function NewStr(const S: string): PString;
  53. procedure DisposeStr(S: PString);
  54. procedure AssignStr(var P: PString; const S: string);
  55. procedure AppendStr(var Dest: String; const S: string);
  56. function UpperCase(const s: string): string;
  57. function LowerCase(const s: string): string; overload;
  58. function CompareStr(const S1, S2: string): Integer;
  59. function CompareMemRange(P1, P2: Pointer; Length: cardinal): integer;
  60. function CompareMem(P1, P2: Pointer; Length: cardinal): Boolean;
  61. function CompareText(const S1, S2: string): integer;
  62. function SameText(const s1,s2:String):Boolean;
  63. function AnsiUpperCase(const s: string): string;
  64. function AnsiLowerCase(const s: string): string;
  65. function AnsiCompareStr(const S1, S2: string): integer;
  66. function AnsiCompareText(const S1, S2: string): integer;
  67. function AnsiSameText(const s1,s2:String):Boolean;
  68. function AnsiSameStr(const s1,s2:String):Boolean;
  69. function AnsiStrComp(S1, S2: PChar): integer;
  70. function AnsiStrIComp(S1, S2: PChar): integer;
  71. function AnsiStrLComp(S1, S2: PChar; MaxLen: cardinal): integer;
  72. function AnsiStrLIComp(S1, S2: PChar; MaxLen: cardinal): integer;
  73. function AnsiStrLower(Str: PChar): PChar;
  74. function AnsiStrUpper(Str: PChar): PChar;
  75. function AnsiLastChar(const S: string): PChar;
  76. function AnsiStrLastChar(Str: PChar): PChar;
  77. function Trim(const S: string): string;
  78. function TrimLeft(const S: string): string;
  79. function TrimRight(const S: string): string;
  80. function QuotedStr(const S: string): string;
  81. function AnsiQuotedStr(const S: string; Quote: char): string;
  82. function AnsiExtractQuotedStr(Const Src: PChar; Quote: Char): string;
  83. function AdjustLineBreaks(const S: string): string;
  84. function AdjustLineBreaks(const S: string; Style: TTextLineBreakStyle): string;
  85. function IsValidIdent(const Ident: string): boolean;
  86. function IntToStr(Value: integer): string;
  87. {$IFNDEF VIRTUALPASCAL}
  88. function IntToStr(Value: Int64): string;
  89. {$ENDIF}
  90. function IntToStr(Value: QWord): string;
  91. function IntToHex(Value: integer; Digits: integer): string;
  92. function IntToHex(Value: Int64; Digits: integer): string;
  93. function StrToInt(const s: string): integer;
  94. {$IFNDEF VIRTUALPASCAL}
  95. function StrToInt64(const s: string): int64;
  96. {$ENDIF}
  97. function StrToIntDef(const S: string; Default: integer): integer;
  98. {$IFNDEF VIRTUALPASCAL}
  99. function StrToInt64Def(const S: string; Default: int64): int64;
  100. {$ENDIF}
  101. function LoadStr(Ident: integer): string;
  102. // function FmtLoadStr(Ident: integer; const Args: array of const): string;
  103. Function Format (Const Fmt : String; const Args : Array of const) : String;
  104. Function FormatBuf (Var Buffer; BufLen : Cardinal; Const Fmt; fmtLen : Cardinal; Const Args : Array of const) : Cardinal;
  105. Function StrFmt(Buffer,Fmt : PChar; Const args: Array of const) : Pchar;
  106. Function StrLFmt(Buffer : PCHar; Maxlen : Cardinal;Fmt : PChar; Const args: Array of const) : Pchar;
  107. Procedure FmtStr(Var Res: String; Const Fmt : String; Const args: Array of const);
  108. Function FloatToStrF(Value: Extended; format: TFloatFormat; Precision, Digits: Integer): String;
  109. Function FloatToStr(Value: Extended): String;
  110. Function StrToFloat(Const S : String) : Extended;
  111. Function StrToFloatDef(Const S: String; Const Default: Extended): Extended;
  112. Function TextToFloat(Buffer: PChar; Var Value: Extended): Boolean;
  113. Function TextToFloat(Buffer: PChar; Var Value; ValueType: TFloatValue): Boolean;
  114. Function FloatToText(Buffer: PChar; Value: Extended; format: TFloatFormat; Precision, Digits: Integer): Longint;
  115. Function FloatToDateTime (Const Value : Extended) : TDateTime;
  116. Function FloattoCurr (Const Value : Extended) : Currency;
  117. Function CurrToStr(Value: Currency): string;
  118. function StrToCurr(const S: string): Currency;
  119. function StrToBool(const S: string): Boolean;
  120. function BoolToStr(B: Boolean): string;
  121. function LastDelimiter(const Delimiters, S: string): Integer;
  122. function StringReplace(const S, OldPattern, NewPattern: string; Flags: TReplaceFlags): string;
  123. Function FloatToTextFmt(Buffer: PChar; Value: Extended; format: PChar): Integer;
  124. Procedure FloatToDecimal(Var Result: TFloatRec; Value: Extended; Precision, Decimals : integer);
  125. Function FormatFloat(Const Format : String; Value : Extended) : String;
  126. Function IsDelimiter(const Delimiters, S: string; Index: Integer): Boolean;
  127. {// MBCS Functions. No MBCS yet, so mostly these are calls to the regular counterparts.}
  128. Type
  129. TMbcsByteType = (mbSingleByte, mbLeadByte, mbTrailByte);
  130. Function ByteType(const S: string; Index: Integer): TMbcsByteType;
  131. Function StrByteType(Str: PChar; Index: Cardinal): TMbcsByteType;
  132. Function ByteToCharLen(const S: string; MaxLen: Integer): Integer;
  133. Function CharToByteLen(const S: string; MaxLen: Integer): Integer;
  134. Function ByteToCharIndex(const S: string; Index: Integer): Integer;
  135. const
  136. {$ifndef unix}
  137. SwitchChars = ['/','-'];
  138. {$else}
  139. SwitchChars = ['-'];
  140. {$endif}
  141. Type
  142. TSysCharSet = Set of char;
  143. Function FindCmdLineSwitch(const Switch: string; const Chars: TSysCharSet;IgnoreCase: Boolean): Boolean;
  144. Function FindCmdLineSwitch(const Switch: string; IgnoreCase: Boolean): Boolean;
  145. Function FindCmdLineSwitch(const Switch: string): Boolean;
  146. {==============================================================================}
  147. { extra functions }
  148. {==============================================================================}
  149. function LeftStr(const S: string; Count: integer): string;
  150. function RightStr(const S: string; Count: integer): string;
  151. function BCDToInt(Value: integer): integer;
  152. {
  153. $Log$
  154. Revision 1.4 2004-02-26 08:46:21 michael
  155. + Added AnsiSameStr
  156. Revision 1.3 2003/11/26 22:17:42 michael
  157. + Merged fixbranch fixes, missing in main branch
  158. Revision 1.2 2003/10/07 12:02:47 marco
  159. * sametext and ansisametext added. (simple (ansi)comparetext wrappers)
  160. Revision 1.1 2003/10/06 21:01:06 peter
  161. * moved classes unit to rtl
  162. Revision 1.17 2003/09/06 21:22:08 marco
  163. * More objpas fixes
  164. Revision 1.16 2002/12/24 23:33:37 peter
  165. * export StrToFloatDef
  166. Revision 1.15 2002/12/23 23:12:34 florian
  167. + TextToFloat: D6 compatibility added
  168. Revision 1.14 2002/11/28 22:26:30 michael
  169. + Fixed float<>string conversion routines
  170. Revision 1.13 2002/11/28 20:29:26 michael
  171. + made it compile again
  172. Revision 1.12 2002/09/07 16:01:22 peter
  173. * old logs removed and tabs fixed
  174. Revision 1.1.2.6 2002/11/28 22:25:01 michael
  175. + Fixed float<>string conversion routines
  176. Revision 1.1.2.5 2002/11/28 20:24:12 michael
  177. + merged some fixes from mainbranch
  178. Revision 1.1.2.4 2002/10/29 23:41:06 michael
  179. + Added lots of D4 functions
  180. Revision 1.11 2002/01/24 18:33:58 peter
  181. * overload for lowercase()
  182. Revision 1.10 2002/01/24 12:33:54 jonas
  183. * adapted ranges of native types to int64 (e.g. high cardinal is no
  184. longer longint($ffffffff), but just $fffffff in psystem)
  185. * small additional fix in 64bit rangecheck code generation for 32 bit
  186. processors
  187. * adaption of ranges required the matching talgorithm used for selecting
  188. which overloaded procedure to call to be adapted. It should now always
  189. select the closest match for ordinal parameters.
  190. + inttostr(qword) in sysstr.inc/sysstrh.inc
  191. + abs(int64), sqr(int64), sqr(qword) in systemh.inc/generic.inc (previous
  192. fixes were required to be able to add them)
  193. * is_in_limit() moved from ncal to types unit, should always be used
  194. instead of direct comparisons of low/high values of orddefs because
  195. qword is a special case
  196. }