sysstrh.inc 9.5 KB

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