character.pas 29 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822
  1. unit character;
  2. interface
  3. {$ifndef VER2_4}
  4. {$mode objfpc}
  5. {$H+}
  6. {$PACKENUM 1}
  7. {$SCOPEDENUMS ON}
  8. type
  9. // Unicode General Category
  10. TUnicodeCategory = (
  11. ucUppercaseLetter, // Lu = Letter, uppercase
  12. ucLowercaseLetter, // Ll = Letter, lowercase
  13. ucTitlecaseLetter, // Lt = Letter, titlecase
  14. ucModifierLetter, // Lm = Letter, modifier
  15. ucOtherLetter, // Lo = Letter, other
  16. ucNonSpacingMark, // Mn = Mark, nonspacing
  17. ucCombiningMark, // Mc = Mark, spacing combining
  18. ucEnclosingMark, // Me = Mark, enclosing
  19. ucDecimalNumber, // Nd = Number, decimal digit
  20. ucLetterNumber, // Nl = Number, letter
  21. ucOtherNumber, // No = Number, other
  22. ucConnectPunctuation, // Pc = Punctuation, connector
  23. ucDashPunctuation, // Pd = Punctuation, dash
  24. ucOpenPunctuation, // Ps = Punctuation, open
  25. ucClosePunctuation, // Pe = Punctuation, close
  26. ucInitialPunctuation, // Pi = Punctuation, initial quote (may behave like Ps or Pe depending on usage)
  27. ucFinalPunctuation, // Pf = Punctuation, final quote (may behave like Ps or Pe depending on usage)
  28. ucOtherPunctuation, // Po = Punctuation, other
  29. ucMathSymbol, // Sm = Symbol, math
  30. ucCurrencySymbol, // Sc = Symbol, currency
  31. ucModifierSymbol, // Sk = Symbol, modifier
  32. ucOtherSymbol, // So = Symbol, other
  33. ucSpaceSeparator, // Zs = Separator, space
  34. ucLineSeparator, // Zl = Separator, line
  35. ucParagraphSeparator, // Zp = Separator, paragraph
  36. ucControl, // Cc = Other, control
  37. ucFormat, // Cf = Other, format
  38. ucSurrogate, // Cs = Other, surrogate
  39. ucPrivateUse, // Co = Other, private use
  40. ucUnassigned // Cn = Other, not assigned (including noncharacters)
  41. );
  42. { TCharacter }
  43. TCharacter = class sealed
  44. public
  45. constructor Create;
  46. class function ConvertFromUtf32(AChar : UCS4Char) : UnicodeString; static;
  47. class function ConvertToUtf32(const AString : UnicodeString; AIndex : Integer) : UCS4Char; overload; static;
  48. class function ConvertToUtf32(const AString : UnicodeString; AIndex : Integer; out ACharLength : Integer) : UCS4Char; overload; static;
  49. class function ConvertToUtf32(const AHighSurrogate, ALowSurrogate : UnicodeChar) : UCS4Char; overload; static;
  50. class function GetNumericValue(AChar : UnicodeChar) : Double; static; overload;
  51. class function GetNumericValue(const AString : UnicodeString; AIndex : Integer) : Double; overload; static;
  52. class function GetUnicodeCategory(AChar : UnicodeChar) : TUnicodeCategory; overload; static;
  53. class function GetUnicodeCategory(const AString : UnicodeString; AIndex : Integer) : TUnicodeCategory; overload; static;
  54. class function IsControl(AChar : UnicodeChar) : Boolean; overload; static;
  55. class function IsControl(const AString : UnicodeString; AIndex : Integer) : Boolean; overload; static;
  56. class function IsDigit(AChar : UnicodeChar) : Boolean; overload; static;
  57. class function IsDigit(const AString : UnicodeString; AIndex : Integer) : Boolean; overload; static;
  58. class function IsSurrogate(AChar : UnicodeChar) : Boolean; overload; static;
  59. class function IsSurrogate(const AString : UnicodeString; AIndex : Integer) : Boolean; overload; static;
  60. class function IsHighSurrogate(AChar : UnicodeChar) : Boolean; overload; static;
  61. class function IsHighSurrogate(const AString : UnicodeString; AIndex : Integer) : Boolean; overload; static;
  62. class function IsLowSurrogate(AChar : UnicodeChar) : Boolean; overload; static;
  63. class function IsLowSurrogate(const AString : UnicodeString; AIndex : Integer) : Boolean; overload; static;
  64. class function IsSurrogatePair(const AHighSurrogate, ALowSurrogate : UnicodeChar) : Boolean; overload; static; inline;
  65. class function IsSurrogatePair(const AString : UnicodeString; AIndex : Integer) : Boolean; overload; static;
  66. class function IsLetter(AChar : UnicodeChar) : Boolean; overload; static;
  67. class function IsLetter(const AString : UnicodeString; AIndex : Integer) : Boolean; overload; static;
  68. class function IsLetterOrDigit(AChar : UnicodeChar) : Boolean; overload; static;
  69. class function IsLetterOrDigit(const AString : UnicodeString; AIndex : Integer) : Boolean; overload; static;
  70. class function IsLower(AChar : UnicodeChar) : Boolean; overload; static;
  71. class function IsLower(const AString : UnicodeString; AIndex : Integer) : Boolean; overload; static;
  72. class function IsNumber(AChar : UnicodeChar) : Boolean; overload; static;
  73. class function IsNumber(const AString : UnicodeString; AIndex : Integer) : Boolean; overload; static;
  74. class function IsPunctuation(AChar : UnicodeChar) : Boolean; overload; static;
  75. class function IsPunctuation(const AString : UnicodeString; AIndex : Integer) : Boolean; overload; static;
  76. class function IsSeparator(AChar : UnicodeChar) : Boolean; overload; static;
  77. class function IsSeparator(const AString : UnicodeString; AIndex : Integer) : Boolean; overload; static;
  78. class function IsSymbol(AChar : UnicodeChar) : Boolean; overload; static;
  79. class function IsSymbol(const AString : UnicodeString; AIndex : Integer) : Boolean; overload; static;
  80. class function IsUpper(AChar : UnicodeChar) : Boolean; overload; static;
  81. class function IsUpper(const AString : UnicodeString; AIndex : Integer) : Boolean; overload; static;
  82. class function IsWhiteSpace(AChar : UnicodeChar) : Boolean; overload; static;
  83. class function IsWhiteSpace(const AString : UnicodeString; AIndex : Integer) : Boolean; overload; static;
  84. class function ToLower(AChar : UnicodeChar) : UnicodeChar; overload; static;
  85. class function ToLower(const AString : UnicodeString) : UnicodeString; overload; static;
  86. class function ToUpper(AChar : UnicodeChar) : UnicodeChar; overload; static;
  87. class function ToUpper(const AString : UnicodeString) : UnicodeString; overload; static;
  88. end;
  89. // flat functions
  90. function ConvertFromUtf32(AChar : UCS4Char) : UnicodeString;
  91. function ConvertToUtf32(const AString : UnicodeString; AIndex : Integer) : UCS4Char; overload;
  92. function ConvertToUtf32(const AString : UnicodeString; AIndex : Integer; out ACharLength : Integer) : UCS4Char; overload;
  93. function ConvertToUtf32(const AHighSurrogate, ALowSurrogate : UnicodeChar) : UCS4Char; overload;
  94. function GetNumericValue(AChar : UnicodeChar) : Double; overload;
  95. function GetNumericValue(const AString : UnicodeString; AIndex : Integer) : Double; overload;
  96. function GetUnicodeCategory(AChar : UnicodeChar) : TUnicodeCategory; overload;
  97. function GetUnicodeCategory(const AString : UnicodeString; AIndex : Integer) : TUnicodeCategory; overload;
  98. function IsControl(AChar : UnicodeChar) : Boolean; overload;
  99. function IsControl(const AString : UnicodeString; AIndex : Integer) : Boolean; overload;
  100. function IsDigit(AChar : UnicodeChar) : Boolean; overload;
  101. function IsDigit(const AString : UnicodeString; AIndex : Integer) : Boolean; overload;
  102. function IsSurrogate(AChar : UnicodeChar) : Boolean; overload;
  103. function IsSurrogate(const AString : UnicodeString; AIndex : Integer) : Boolean; overload;
  104. function IsHighSurrogate(AChar : UnicodeChar) : Boolean; overload;
  105. function IsHighSurrogate(const AString : UnicodeString; AIndex : Integer) : Boolean; overload;
  106. function IsLowSurrogate(AChar : UnicodeChar) : Boolean; overload;
  107. function IsLowSurrogate(const AString : UnicodeString; AIndex : Integer) : Boolean; overload;
  108. function IsSurrogatePair(const AHighSurrogate, ALowSurrogate : UnicodeChar) : Boolean; overload;
  109. function IsSurrogatePair(const AString : UnicodeString; AIndex : Integer) : Boolean; overload;
  110. function IsLetter(AChar : UnicodeChar) : Boolean; overload;
  111. function IsLetter(const AString : UnicodeString; AIndex : Integer) : Boolean; overload;
  112. function IsLetterOrDigit(AChar : UnicodeChar) : Boolean; overload;
  113. function IsLetterOrDigit(const AString : UnicodeString; AIndex : Integer) : Boolean; overload;
  114. function IsLower(AChar : UnicodeChar) : Boolean; overload;
  115. function IsLower(const AString : UnicodeString; AIndex : Integer) : Boolean; overload;
  116. function IsNumber(AChar : UnicodeChar) : Boolean; overload;
  117. function IsNumber(const AString : UnicodeString; AIndex : Integer) : Boolean; overload;
  118. function IsPunctuation(AChar : UnicodeChar) : Boolean; overload;
  119. function IsPunctuation(const AString : UnicodeString; AIndex : Integer) : Boolean; overload;
  120. function IsSeparator(AChar : UnicodeChar) : Boolean; overload;
  121. function IsSeparator(const AString : UnicodeString; AIndex : Integer) : Boolean; overload;
  122. function IsSymbol(AChar : UnicodeChar) : Boolean; overload;
  123. function IsSymbol(const AString : UnicodeString; AIndex : Integer) : Boolean; overload;
  124. function IsUpper(AChar : UnicodeChar) : Boolean; overload;
  125. function IsUpper(const AString : UnicodeString; AIndex : Integer) : Boolean; overload;
  126. function IsWhiteSpace(AChar : UnicodeChar) : Boolean; overload;
  127. function IsWhiteSpace(const AString : UnicodeString; AIndex : Integer) : Boolean; overload;
  128. function ToLower(AChar : UnicodeChar) : UnicodeChar; overload;
  129. function ToLower(const AString : UnicodeString) : UnicodeString; overload;
  130. function ToUpper(AChar : UnicodeChar) : UnicodeChar; overload;
  131. function ToUpper(const AString : UnicodeString) : UnicodeString; overload;
  132. {$endif VER2_4}
  133. implementation
  134. {$ifndef VER2_4}
  135. uses
  136. SysUtils,
  137. RtlConsts;
  138. type
  139. PUC_Prop = ^TUC_Prop;
  140. TUC_Prop = packed record
  141. Category : TUnicodeCategory;
  142. NumericValue : Double;
  143. SimpleUpperCase : DWord;
  144. SimpleLowerCase : DWord;
  145. WhiteSpace : Boolean;
  146. end;
  147. {$INCLUDE unicodedata.inc}
  148. const
  149. LOW_SURROGATE_BEGIN = Word($DC00);
  150. LOW_SURROGATE_END = Word($DFFF);
  151. HIGH_SURROGATE_BEGIN = Word($D800);
  152. HIGH_SURROGATE_END = Word($DBFF);
  153. UCS4_HALF_BASE = LongWord($10000);
  154. UCS4_HALF_MASK = Word($3FF);
  155. MAX_LEGAL_UTF32 = $10FFFF;
  156. const
  157. LETTER_CATEGORIES = [
  158. TUnicodeCategory.ucUppercaseLetter, TUnicodeCategory.ucLowercaseLetter,
  159. TUnicodeCategory.ucTitlecaseLetter, TUnicodeCategory.ucModifierLetter,
  160. TUnicodeCategory.ucOtherLetter
  161. ];
  162. LETTER_OR_DIGIT_CATEGORIES =
  163. LETTER_CATEGORIES +
  164. [TUnicodeCategory.ucDecimalNumber,TUnicodeCategory.ucLetterNumber];
  165. NUMBER_CATEGORIES =
  166. [ TUnicodeCategory.ucDecimalNumber, TUnicodeCategory.ucLetterNumber,
  167. TUnicodeCategory.ucOtherNumber
  168. ];
  169. PUNCTUATION_CATEGORIES = [
  170. TUnicodeCategory.ucConnectPunctuation, TUnicodeCategory.ucDashPunctuation,
  171. TUnicodeCategory.ucOpenPunctuation, TUnicodeCategory.ucClosePunctuation,
  172. TUnicodeCategory.ucInitialPunctuation, TUnicodeCategory.ucFinalPunctuation,
  173. TUnicodeCategory.ucOtherPunctuation
  174. ];
  175. SEPARATOR_CATEGORIES =
  176. [ TUnicodeCategory.ucSpaceSeparator, TUnicodeCategory.ucLineSeparator,
  177. TUnicodeCategory.ucParagraphSeparator
  178. ];
  179. SYMBOL_CATEGORIES =
  180. [ TUnicodeCategory.ucMathSymbol, TUnicodeCategory.ucCurrencySymbol,
  181. TUnicodeCategory.ucModifierSymbol, TUnicodeCategory.ucOtherSymbol
  182. ];
  183. class function GetProps(const ACodePoint : Word) : PUC_Prop; inline;
  184. begin
  185. Result:=
  186. @UC_PROP_ARRAY[
  187. UC_TABLE_2[
  188. (UC_TABLE_1[WordRec(ACodePoint).Hi] * 256) +
  189. WordRec(ACodePoint).Lo
  190. ]
  191. ];
  192. end;
  193. function ConvertFromUtf32(AChar: UCS4Char): UnicodeString;
  194. begin
  195. Result := TCharacter.ConvertFromUtf32(AChar);
  196. end;
  197. function ConvertToUtf32(const AString: UnicodeString; AIndex: Integer): UCS4Char;
  198. begin
  199. Result := TCharacter.ConvertToUtf32(AString, AIndex);
  200. end;
  201. function ConvertToUtf32(const AString: UnicodeString; AIndex: Integer; out ACharLength: Integer): UCS4Char;
  202. begin
  203. Result := TCharacter.ConvertToUtf32(AString, AIndex, ACharLength);
  204. end;
  205. function ConvertToUtf32(const AHighSurrogate, ALowSurrogate: UnicodeChar): UCS4Char;
  206. begin
  207. Result := TCharacter.ConvertToUtf32(AHighSurrogate, ALowSurrogate);
  208. end;
  209. function GetNumericValue(AChar: UnicodeChar): Double;
  210. begin
  211. Result := TCharacter.GetNumericValue(AChar);
  212. end;
  213. function GetNumericValue(const AString: UnicodeString; AIndex: Integer): Double;
  214. begin
  215. Result := TCharacter.GetNumericValue(AString, AIndex);
  216. end;
  217. function GetUnicodeCategory(AChar: UnicodeChar): TUnicodeCategory;
  218. begin
  219. Result := TCharacter.GetUnicodeCategory(AChar);
  220. end;
  221. function GetUnicodeCategory(const AString: UnicodeString; AIndex: Integer): TUnicodeCategory;
  222. begin
  223. Result := TCharacter.GetUnicodeCategory(AString, AIndex);
  224. end;
  225. function IsControl(AChar: UnicodeChar): Boolean;
  226. begin
  227. Result := TCharacter.IsControl(AChar);
  228. end;
  229. function IsControl(const AString: UnicodeString; AIndex: Integer): Boolean;
  230. begin
  231. Result := TCharacter.IsControl(AString, AIndex);
  232. end;
  233. function IsDigit(AChar: UnicodeChar): Boolean;
  234. begin
  235. Result := TCharacter.IsDigit(AChar);
  236. end;
  237. function IsDigit(const AString: UnicodeString; AIndex: Integer): Boolean;
  238. begin
  239. Result := TCharacter.IsDigit(AString, AIndex);
  240. end;
  241. function IsSurrogate(AChar: UnicodeChar): Boolean;
  242. begin
  243. Result := TCharacter.IsSurrogate(AChar);
  244. end;
  245. function IsSurrogate(const AString: UnicodeString; AIndex: Integer): Boolean;
  246. begin
  247. Result := TCharacter.IsSurrogate(AString, AIndex);
  248. end;
  249. function IsHighSurrogate(AChar: UnicodeChar): Boolean;
  250. begin
  251. Result := TCharacter.IsHighSurrogate(AChar);
  252. end;
  253. function IsHighSurrogate(const AString: UnicodeString; AIndex: Integer): Boolean;
  254. begin
  255. Result := TCharacter.IsHighSurrogate(AString, AIndex);
  256. end;
  257. function IsLowSurrogate(AChar: UnicodeChar): Boolean;
  258. begin
  259. Result := TCharacter.IsLowSurrogate(AChar);
  260. end;
  261. function IsLowSurrogate(const AString: UnicodeString; AIndex: Integer): Boolean;
  262. begin
  263. Result := TCharacter.IsLowSurrogate(AString, AIndex);
  264. end;
  265. function IsSurrogatePair(const AHighSurrogate, ALowSurrogate: UnicodeChar): Boolean;
  266. begin
  267. Result := TCharacter.IsSurrogatePair(AHighSurrogate, ALowSurrogate);
  268. end;
  269. function IsSurrogatePair(const AString: UnicodeString; AIndex: Integer): Boolean;
  270. begin
  271. Result := TCharacter.IsSurrogatePair(AString, AIndex);
  272. end;
  273. function IsLetter(AChar: UnicodeChar): Boolean;
  274. begin
  275. Result := TCharacter.IsLetter(AChar);
  276. end;
  277. function IsLetter(const AString: UnicodeString; AIndex: Integer): Boolean;
  278. begin
  279. Result := TCharacter.IsLetter(AString, AIndex);
  280. end;
  281. function IsLetterOrDigit(AChar: UnicodeChar): Boolean;
  282. begin
  283. Result := TCharacter.IsLetterOrDigit(AChar);
  284. end;
  285. function IsLetterOrDigit(const AString: UnicodeString; AIndex: Integer): Boolean;
  286. begin
  287. Result := TCharacter.IsLetterOrDigit(AString, AIndex);
  288. end;
  289. function IsLower(AChar: UnicodeChar): Boolean;
  290. begin
  291. Result := TCharacter.IsLower(AChar);
  292. end;
  293. function IsLower(const AString: UnicodeString; AIndex: Integer): Boolean;
  294. begin
  295. Result := TCharacter.IsLower(AString, AIndex);
  296. end;
  297. function IsNumber(AChar: UnicodeChar): Boolean;
  298. begin
  299. Result := TCharacter.IsNumber(AChar);
  300. end;
  301. function IsNumber(const AString: UnicodeString; AIndex: Integer): Boolean;
  302. begin
  303. Result := TCharacter.IsNumber(AString, AIndex);
  304. end;
  305. function IsPunctuation(AChar: UnicodeChar): Boolean;
  306. begin
  307. Result := TCharacter.IsPunctuation(AChar);
  308. end;
  309. function IsPunctuation(const AString: UnicodeString; AIndex: Integer): Boolean;
  310. begin
  311. Result := TCharacter.IsPunctuation(AString, AIndex);
  312. end;
  313. function IsSeparator(AChar: UnicodeChar): Boolean;
  314. begin
  315. Result := TCharacter.IsSeparator(AChar);
  316. end;
  317. function IsSeparator(const AString: UnicodeString; AIndex: Integer): Boolean;
  318. begin
  319. Result := TCharacter.IsSeparator(AString, AIndex);
  320. end;
  321. function IsSymbol(AChar: UnicodeChar): Boolean;
  322. begin
  323. Result := TCharacter.IsSymbol(AChar);
  324. end;
  325. function IsSymbol(const AString: UnicodeString; AIndex: Integer): Boolean;
  326. begin
  327. Result := TCharacter.IsSymbol(AString, AIndex);
  328. end;
  329. function IsUpper(AChar: UnicodeChar): Boolean;
  330. begin
  331. Result := TCharacter.IsUpper(AChar);
  332. end;
  333. function IsUpper(const AString: UnicodeString; AIndex: Integer): Boolean;
  334. begin
  335. Result := TCharacter.IsUpper(AString, AIndex);
  336. end;
  337. function IsWhiteSpace(AChar: UnicodeChar): Boolean;
  338. begin
  339. Result := TCharacter.IsWhiteSpace(AChar);
  340. end;
  341. function IsWhiteSpace(const AString: UnicodeString; AIndex: Integer): Boolean;
  342. begin
  343. Result := TCharacter.IsWhiteSpace(AString, AIndex);
  344. end;
  345. function ToLower(AChar: UnicodeChar): UnicodeChar;
  346. begin
  347. Result := TCharacter.ToLower(AChar);
  348. end;
  349. function ToLower(const AString: UnicodeString): UnicodeString;
  350. begin
  351. Result := TCharacter.ToLower(AString);
  352. end;
  353. function ToUpper(AChar: UnicodeChar): UnicodeChar;
  354. begin
  355. Result := TCharacter.ToUpper(AChar);
  356. end;
  357. function ToUpper(const AString: UnicodeString): UnicodeString;
  358. begin
  359. Result := TCharacter.ToUpper(AString);
  360. end;
  361. { TCharacter }
  362. constructor TCharacter.Create;
  363. begin
  364. raise ENoConstructException.CreateFmt(SClassCantBeConstructed, [ClassName]);
  365. end;
  366. class function TCharacter.ConvertFromUtf32(AChar : UCS4Char) : UnicodeString; static;
  367. begin
  368. if AChar < UCS4_HALF_BASE then
  369. begin
  370. if IsSurrogate(UnicodeChar(AChar)) then
  371. raise EArgumentOutOfRangeException.CreateFmt(SInvalidUTF32Char, [AChar]);
  372. Result := UnicodeChar(AChar);
  373. end
  374. else
  375. begin
  376. if AChar > MAX_LEGAL_UTF32 then
  377. raise EArgumentOutOfRangeException.CreateFmt(SInvalidUTF32Char, [AChar]);
  378. SetLength(Result, 2);
  379. AChar := AChar - UCS4_HALF_BASE;
  380. Result[1] := UnicodeChar((AChar shr 10) + HIGH_SURROGATE_BEGIN);
  381. Result[2] := UnicodeChar((AChar and UCS4_HALF_MASK) + LOW_SURROGATE_BEGIN);
  382. end;
  383. end;
  384. class function TCharacter.ConvertToUtf32(const AString : UnicodeString; AIndex : Integer) : UCS4Char; overload; static;
  385. begin
  386. if (AIndex < 1) or (AIndex > Length(AString)) then
  387. raise EArgumentOutOfRangeException.CreateFmt(SStringIndexOutOfRange, [AIndex, Length(AString)]);
  388. Result := Word(AString[AIndex]);
  389. if IsHighSurrogate(UnicodeChar(Result)) then
  390. begin
  391. if Length(AString) < Succ(AIndex) then
  392. raise EArgumentException.CreateFmt(SInvalidHighSurrogate, [AIndex]);
  393. Result := ConvertToUtf32(UnicodeChar(Result), AString[Succ(AIndex)]);
  394. end;
  395. end;
  396. class function TCharacter.ConvertToUtf32(const AString : UnicodeString; AIndex : Integer; out ACharLength : Integer) : UCS4Char; overload; static;
  397. begin
  398. if (AIndex < 1) or (AIndex > Length(AString)) then
  399. raise EArgumentOutOfRangeException.CreateFmt(SStringIndexOutOfRange, [AIndex, Length(AString)]);
  400. Result := Word(AString[AIndex]);
  401. if IsHighSurrogate(UnicodeChar(Result)) then
  402. begin
  403. if Length(AString) < Succ(AIndex) then
  404. raise EArgumentException.CreateFmt(SInvalidHighSurrogate, [AIndex]);
  405. Result := ConvertToUtf32(UnicodeChar(Result), AString[Succ(AIndex)]);
  406. ACharLength := 2;
  407. end
  408. else
  409. ACharLength := 1;
  410. end;
  411. class function TCharacter.ConvertToUtf32(const AHighSurrogate, ALowSurrogate : UnicodeChar) : UCS4Char; overload; static;
  412. begin
  413. if not IsHighSurrogate(AHighSurrogate) then
  414. raise EArgumentOutOfRangeException.CreateFmt(SHighSurrogateOutOfRange, [Word(AHighSurrogate)]);
  415. if not IsLowSurrogate(ALowSurrogate) then
  416. raise EArgumentOutOfRangeException.CreateFmt(SLowSurrogateOutOfRange, [Word(ALowSurrogate)]);
  417. Result := (UCS4Char(AHighSurrogate) - HIGH_SURROGATE_BEGIN) shl 10 + (UCS4Char(ALowSurrogate) - LOW_SURROGATE_BEGIN) + UCS4_HALF_BASE;
  418. end;
  419. class function TCharacter.GetNumericValue(AChar : UnicodeChar) : Double; static;
  420. begin
  421. Result := GetProps(Word(AChar))^.NumericValue;
  422. end;
  423. class function TCharacter.GetNumericValue(
  424. const AString : UnicodeString;
  425. AIndex : Integer
  426. ) : Double; static;
  427. begin
  428. if (AIndex < 1) or (AIndex > Length(AString)) then
  429. raise EArgumentOutOfRangeException.CreateFmt(SStringIndexOutOfRange, [AIndex, Length(AString)]);
  430. Result := GetNumericValue(AString[AIndex]);
  431. end;
  432. class function TCharacter.GetUnicodeCategory(AChar : UnicodeChar) : TUnicodeCategory; static;
  433. begin
  434. Result := GetProps(Word(AChar))^.Category;
  435. end;
  436. class function TCharacter.GetUnicodeCategory(
  437. const AString : UnicodeString;
  438. AIndex : Integer
  439. ) : TUnicodeCategory; static;
  440. begin
  441. if (AIndex < 1) or (AIndex > Length(AString)) then
  442. raise EArgumentOutOfRangeException.CreateFmt(SStringIndexOutOfRange, [AIndex, Length(AString)]);
  443. Result := GetUnicodeCategory(AString[AIndex]);
  444. end;
  445. class function TCharacter.IsControl(AChar : UnicodeChar) : Boolean; static;
  446. begin
  447. Result := (GetProps(Word(AChar))^.Category = TUnicodeCategory.ucControl);
  448. end;
  449. class function TCharacter.IsControl(
  450. const AString : UnicodeString;
  451. AIndex : Integer
  452. ) : Boolean; static;
  453. begin
  454. if (AIndex < 1) or (AIndex > Length(AString)) then
  455. raise EArgumentOutOfRangeException.CreateFmt(SStringIndexOutOfRange, [AIndex, Length(AString)]);
  456. Result := IsControl(AString[AIndex]);
  457. end;
  458. class function TCharacter.IsDigit(AChar : UnicodeChar) : Boolean; static;
  459. begin
  460. Result := (GetProps(Word(AChar))^.Category = TUnicodeCategory.ucDecimalNumber);
  461. end;
  462. class function TCharacter.IsDigit(
  463. const AString : UnicodeString;
  464. AIndex : Integer
  465. ) : Boolean; static;
  466. begin
  467. if (AIndex < 1) or (AIndex > Length(AString)) then
  468. raise EArgumentOutOfRangeException.CreateFmt(SStringIndexOutOfRange, [AIndex, Length(AString)]);
  469. Result := IsDigit(AString[AIndex]);
  470. end;
  471. class function TCharacter.IsSurrogate(AChar : UnicodeChar) : Boolean; static;
  472. begin
  473. Result := (GetProps(Word(AChar))^.Category = TUnicodeCategory.ucSurrogate);
  474. end;
  475. class function TCharacter.IsSurrogate(
  476. const AString : UnicodeString;
  477. AIndex : Integer
  478. ) : Boolean; static;
  479. begin
  480. if (AIndex < 1) or (AIndex > Length(AString)) then
  481. raise EArgumentOutOfRangeException.CreateFmt(SStringIndexOutOfRange, [AIndex, Length(AString)]);
  482. Result := IsSurrogate(AString[AIndex]);
  483. end;
  484. class function TCharacter.IsHighSurrogate(AChar : UnicodeChar) : Boolean; static;
  485. begin
  486. Result := (GetProps(Word(AChar))^.Category = TUnicodeCategory.ucSurrogate) and
  487. (Word(AChar) >= HIGH_SURROGATE_BEGIN) and
  488. (Word(AChar) <= HIGH_SURROGATE_END);
  489. end;
  490. class function TCharacter.IsHighSurrogate(
  491. const AString : UnicodeString;
  492. AIndex : Integer
  493. ) : Boolean; static;
  494. begin
  495. if (AIndex < 1) or (AIndex > Length(AString)) then
  496. raise EArgumentOutOfRangeException.CreateFmt(SStringIndexOutOfRange, [AIndex, Length(AString)]);
  497. Result := IsHighSurrogate(AString[AIndex]);
  498. end;
  499. class function TCharacter.IsLowSurrogate(AChar : UnicodeChar) : Boolean; static;
  500. begin
  501. Result := (GetProps(Word(AChar))^.Category = TUnicodeCategory.ucSurrogate) and
  502. (Word(AChar) >= LOW_SURROGATE_BEGIN) and
  503. (Word(AChar) <= LOW_SURROGATE_END);
  504. end;
  505. class function TCharacter.IsLowSurrogate(
  506. const AString : UnicodeString;
  507. AIndex : Integer
  508. ) : Boolean; static;
  509. begin
  510. if (AIndex < 1) or (AIndex > Length(AString)) then
  511. raise EArgumentOutOfRangeException.CreateFmt(SStringIndexOutOfRange, [AIndex, Length(AString)]);
  512. Result := IsLowSurrogate(AString[AIndex]);
  513. end;
  514. class function TCharacter.IsSurrogatePair(
  515. const AHighSurrogate,
  516. ALowSurrogate : UnicodeChar
  517. ) : Boolean;static;
  518. begin
  519. Result :=
  520. ( (Word(AHighSurrogate) >= HIGH_SURROGATE_BEGIN) and
  521. (Word(AHighSurrogate) <= HIGH_SURROGATE_END)
  522. ) and
  523. ( (Word(ALowSurrogate) >= LOW_SURROGATE_BEGIN) and
  524. (Word(ALowSurrogate) <= LOW_SURROGATE_END)
  525. )
  526. end;
  527. class function TCharacter.IsSurrogatePair(
  528. const AString : UnicodeString;
  529. AIndex : Integer
  530. ) : Boolean;static;
  531. begin
  532. if (AIndex < 1) or (AIndex > Length(AString)) then
  533. raise EArgumentOutOfRangeException.CreateFmt(SStringIndexOutOfRange, [AIndex, Length(AString)]);
  534. Result := IsSurrogatePair(AString[AIndex],AString[AIndex+1]);
  535. end;
  536. class function TCharacter.IsLetter(AChar : UnicodeChar) : Boolean; static;
  537. begin
  538. Result := (GetProps(Word(AChar))^.Category in LETTER_CATEGORIES);
  539. end;
  540. class function TCharacter.IsLetter(
  541. const AString : UnicodeString;
  542. AIndex : Integer
  543. ) : Boolean; static;
  544. begin
  545. if (AIndex < 1) or (AIndex > Length(AString)) then
  546. raise EArgumentOutOfRangeException.CreateFmt(SStringIndexOutOfRange, [AIndex, Length(AString)]);
  547. Result := IsLetter(AString[AIndex]);
  548. end;
  549. class function TCharacter.IsLetterOrDigit(AChar : UnicodeChar) : Boolean; static;
  550. begin
  551. Result := (GetProps(Word(AChar))^.Category in LETTER_OR_DIGIT_CATEGORIES);
  552. end;
  553. class function TCharacter.IsLetterOrDigit(
  554. const AString : UnicodeString;
  555. AIndex : Integer
  556. ) : Boolean; static;
  557. begin
  558. if (AIndex < 1) or (AIndex > Length(AString)) then
  559. raise EArgumentOutOfRangeException.CreateFmt(SStringIndexOutOfRange, [AIndex, Length(AString)]);
  560. Result := IsLetterOrDigit(AString[AIndex]);
  561. end;
  562. class function TCharacter.IsLower(AChar : UnicodeChar) : Boolean; static;
  563. begin
  564. Result := (GetProps(Word(AChar))^.Category = TUnicodeCategory.ucLowercaseLetter);
  565. end;
  566. class function TCharacter.IsLower(
  567. const AString : UnicodeString;
  568. AIndex : Integer
  569. ) : Boolean; static;
  570. begin
  571. if (AIndex < 1) or (AIndex > Length(AString)) then
  572. raise EArgumentOutOfRangeException.CreateFmt(SStringIndexOutOfRange, [AIndex, Length(AString)]);
  573. Result := IsLower(AString[AIndex]);
  574. end;
  575. class function TCharacter.IsNumber(AChar : UnicodeChar) : Boolean; static;
  576. begin
  577. Result := (GetProps(Word(AChar))^.Category in NUMBER_CATEGORIES);
  578. end;
  579. class function TCharacter.IsNumber(
  580. const AString : UnicodeString;
  581. AIndex : Integer
  582. ) : Boolean;static;
  583. begin
  584. if (AIndex < 1) or (AIndex > Length(AString)) then
  585. raise EArgumentOutOfRangeException.CreateFmt(SStringIndexOutOfRange, [AIndex, Length(AString)]);
  586. Result := IsNumber(AString[AIndex]);
  587. end;
  588. class function TCharacter.IsPunctuation(AChar : UnicodeChar) : Boolean;static;
  589. begin
  590. Result := (GetProps(Word(AChar))^.Category in PUNCTUATION_CATEGORIES);
  591. end;
  592. class function TCharacter.IsPunctuation(
  593. const AString : UnicodeString;
  594. AIndex : Integer
  595. ) : Boolean;static;
  596. begin
  597. if (AIndex < 1) or (AIndex > Length(AString)) then
  598. raise EArgumentOutOfRangeException.CreateFmt(SStringIndexOutOfRange, [AIndex, Length(AString)]);
  599. Result := IsPunctuation(AString[AIndex]);
  600. end;
  601. class function TCharacter.IsSeparator(AChar: UnicodeChar): Boolean;static;
  602. begin
  603. Result := (GetProps(Word(AChar))^.Category in SEPARATOR_CATEGORIES);
  604. end;
  605. class function TCharacter.IsSeparator(
  606. const AString : UnicodeString;
  607. AIndex : Integer
  608. ) : Boolean;static;
  609. begin
  610. if (AIndex < 1) or (AIndex > Length(AString)) then
  611. raise EArgumentOutOfRangeException.CreateFmt(SStringIndexOutOfRange, [AIndex, Length(AString)]);
  612. Result := IsSeparator(AString[AIndex]);
  613. end;
  614. class function TCharacter.IsSymbol(AChar: UnicodeChar): Boolean;static;
  615. begin
  616. Result := (GetProps(Word(AChar))^.Category in SYMBOL_CATEGORIES);
  617. end;
  618. class function TCharacter.IsSymbol(
  619. const AString : UnicodeString;
  620. AIndex : Integer
  621. ) : Boolean;static;
  622. begin
  623. if (AIndex < 1) or (AIndex > Length(AString)) then
  624. raise EArgumentOutOfRangeException.CreateFmt(SStringIndexOutOfRange, [AIndex, Length(AString)]);
  625. Result := IsSymbol(AString[AIndex]);
  626. end;
  627. class function TCharacter.IsUpper(AChar : UnicodeChar) : Boolean;static;
  628. begin
  629. Result := (GetProps(Word(AChar))^.Category = TUnicodeCategory.ucUppercaseLetter);
  630. end;
  631. class function TCharacter.IsUpper(
  632. const AString : UnicodeString;
  633. AIndex : Integer
  634. ) : Boolean;static;
  635. begin
  636. if (AIndex < 1) or (AIndex > Length(AString)) then
  637. raise EArgumentOutOfRangeException.CreateFmt(SStringIndexOutOfRange, [AIndex, Length(AString)]);
  638. Result := IsUpper(AString[AIndex]);
  639. end;
  640. class function TCharacter.IsWhiteSpace(AChar : UnicodeChar) : Boolean;static;
  641. begin
  642. Result := GetProps(Word(AChar))^.WhiteSpace;
  643. end;
  644. class function TCharacter.IsWhiteSpace(
  645. const AString : UnicodeString;
  646. AIndex : Integer
  647. ) : Boolean;static;
  648. begin
  649. if (AIndex < 1) or (AIndex > Length(AString)) then
  650. raise EArgumentOutOfRangeException.CreateFmt(SStringIndexOutOfRange, [AIndex, Length(AString)]);
  651. Result := IsWhiteSpace(AString[AIndex]);
  652. end;
  653. class function TCharacter.ToLower(AChar : UnicodeChar) : UnicodeChar;static;
  654. begin
  655. Result := UnicodeChar(GetProps(Word(AChar))^.SimpleLowerCase);
  656. if (Result = UnicodeChar(0)) then
  657. Result := AChar;
  658. end;
  659. class function TCharacter.ToLower(const AString : UnicodeString) : UnicodeString;static;
  660. var
  661. i, c : SizeInt;
  662. pp, pr : PUnicodeChar;
  663. begin
  664. c := Length(AString);
  665. SetLength(Result,c);
  666. if (c > 0) then begin
  667. pp := @AString[1];
  668. pr := @Result[1];
  669. for i := 1 to c do begin
  670. pr^ := ToLower(pp^);
  671. Inc(pp);
  672. Inc(pr);
  673. end;
  674. end;
  675. end;
  676. class function TCharacter.ToUpper(AChar : UnicodeChar) : UnicodeChar;static;
  677. begin
  678. Result := UnicodeChar(GetProps(Word(AChar))^.SimpleUpperCase);
  679. if (Result = UnicodeChar(0)) then
  680. Result := AChar;
  681. end;
  682. class function TCharacter.ToUpper(const AString : UnicodeString) : UnicodeString;static;
  683. var
  684. i, c : SizeInt;
  685. pp, pr : PUnicodeChar;
  686. begin
  687. c := Length(AString);
  688. SetLength(Result,c);
  689. if (c > 0) then begin
  690. pp := @AString[1];
  691. pr := @Result[1];
  692. for i := 1 to c do begin
  693. pr^ := ToUpper(pp^);
  694. Inc(pp);
  695. Inc(pr);
  696. end;
  697. end;
  698. end;
  699. {$endif VER2_4}
  700. end.