pascal/lazarus-ccr
1
0
Fork 0
Code Issues Releases Activity
Files
8b51f30e1433ea7f1c738773e029dd150c596fb1
lazarus-ccr/components/fpspreadsheet/source/common/fpspatches.pas

1762 lines
60 KiB
ObjectPascal
Raw Blame History

{@@ ----------------------------------------------------------------------------
Provides functions and procedures if FPSpreadsheet is compiled in an older
version of Lazarus / fpc.
LICENSE: See the file COPYING.modifiedLGPL.txt, included in the Lazarus
distribution, for details about the license.
-------------------------------------------------------------------------------}
unit fpspatches;
{$mode objfpc}{$H+}
{$I ..\fps.inc}
interface
uses
Classes, SysUtils;
{$IFDEF FPS_VARISBOOL}
{ Needed only if FPC version is < 2.6.4 }
function VarIsBool(const V: Variant): Boolean;
{$ENDIF}
{$IFDEF FPS_LAZUTF8}
// implemented in LazUTF8 of r43348 (Laz 1.2)
function UTF8LeftStr(const AText: String; const ACount: Integer): String;
function UTF8RightStr(const AText: String; const ACount: Integer): String;
function UTF8StringReplace(const S, OldPattern, NewPattern: String;
Flags: TReplaceFlags; ALanguage: string=''): String;
function UTF8LowerCase(const AInStr: string; ALanguage: string=''): string;
function UTF8UpperCase(const AInStr: string; ALanguage: string=''): string;
// implemented in LazFileUtils (Laz 1.2)
procedure ForcePathDelims(var FileName: String);
{$ENDIF}
{$IFDEF FPS_PTRINT}
type
{$IFDEF CPU64}
PtrInt = Int64;
{$ENDIF}
{$IFDEF CPU32}
PtrInt = Longint;
{$ENDIF}
{$IFDEF CPU16}
{$IF DEFINED(FPC_X86_DATA_FAR) OR DEFINED(FPC_X86_DATA_HUGE)}
PtrInt = Longint;
{$ELSE}
PtrInt = Integer;
{$ENDIF}
{$ENDIF CPU16}
IntPtr = PtrInt;
{$ENDIF}
{$IFDEF FPS_NO_STRING_SPLIT}
type
TStringArray = array of string;
function SplitString(const AString: String; ASeparator: char): TStringArray;
{$ENDIF}
implementation
{$IFDEF FPS_VARISBOOL}
function VarIsBool(const V: Variant): Boolean;
begin
Result := (TVarData(V).vType and varTypeMask) = varboolean;
end;
{$ENDIF}
{$IFDEF FPS_LAZUTF8}
function UTF8CharacterLength(p: PChar): integer;
begin
if p<>nil then begin
if ord(p^)<%11000000 then begin
// regular single byte character (#0 is a character, this is pascal ;)
Result:=1;
end
else begin
// multi byte
if ((ord(p^) and %11100000) = %11000000) then begin
// could be 2 byte character
if (ord(p[1]) and %11000000) = %10000000 then
Result:=2
else
Result:=1;
end
else if ((ord(p^) and %11110000) = %11100000) then begin
// could be 3 byte character
if ((ord(p[1]) and %11000000) = %10000000)
and ((ord(p[2]) and %11000000) = %10000000) then
Result:=3
else
Result:=1;
end
else if ((ord(p^) and %11111000) = %11110000) then begin
// could be 4 byte character
if ((ord(p[1]) and %11000000) = %10000000)
and ((ord(p[2]) and %11000000) = %10000000)
and ((ord(p[3]) and %11000000) = %10000000) then
Result:=4
else
Result:=1;
end
else
Result:=1;
end;
end else
Result:=0;
end;
function UTF8CharStart(UTF8Str: PChar; Len, CharIndex: PtrInt): PChar;
var
CharLen: LongInt;
begin
Result:=UTF8Str;
if Result<>nil then begin
while (CharIndex>0) and (Len>0) do begin
CharLen:=UTF8CharacterLength(Result);
dec(Len,CharLen);
dec(CharIndex);
inc(Result,CharLen);
end;
if (CharIndex<>0) or (Len<0) then
Result:=nil;
end;
end;
function UTF8Copy(const s: string; StartCharIndex, CharCount: PtrInt): string;
// returns substring
var
StartBytePos: PChar;
EndBytePos: PChar;
MaxBytes: PtrInt;
begin
StartBytePos:=UTF8CharStart(PChar(s),length(s),StartCharIndex-1);
if StartBytePos=nil then
Result:=''
else begin
MaxBytes:=PtrInt(PChar(s)+length(s)-StartBytePos);
EndBytePos:=UTF8CharStart(StartBytePos,MaxBytes,CharCount);
if EndBytePos=nil then
Result:=copy(s,StartBytePos-PChar(s)+1,MaxBytes)
else
Result:=copy(s,StartBytePos-PChar(s)+1,EndBytePos-StartBytePos);
end;
end;
function UTF8LeftStr(const AText: String; const ACount: Integer): String;
begin
Result := Utf8Copy(AText,1,ACount);
end;
function UTF8Length(p: PChar; ByteCount: PtrInt): PtrInt;
var
CharLen: LongInt;
begin
Result:=0;
while (ByteCount>0) do begin
inc(Result);
CharLen:=UTF8CharacterLength(p);
inc(p,CharLen);
dec(ByteCount,CharLen);
end;
end;
function UTF8Length(const s: string): PtrInt;
begin
Result:=UTF8Length(PChar(s),length(s));
end;
function Utf8RightStr(const AText: String; const ACount: Integer): String;
var
j,l:integer;
begin
l := Utf8Length(AText);
j := ACount;
if (j > l) then j := l;
Result := Utf8Copy(AText,l-j+1,j);
end;
function UTF8StringReplace(const S, OldPattern, NewPattern: String;
Flags: TReplaceFlags; ALanguage: string): String;
// same algorithm as StringReplace, but using UTF8LowerCase
// for case insensitive search
var
Srch, OldP, RemS: string;
P: Integer;
begin
Srch := S;
OldP := OldPattern;
if rfIgnoreCase in Flags then
begin
Srch := UTF8LowerCase(Srch,ALanguage);
OldP := UTF8LowerCase(OldP,ALanguage);
end;
RemS := S;
Result := '';
while Length(Srch) <> 0 do
begin
P := Pos(OldP, Srch);
if P = 0 then
begin
Result := Result + RemS;
Srch := '';
end
else
begin
Result := Result + Copy(RemS,1,P-1) + NewPattern;
P := P + Length(OldP);
RemS := Copy(RemS, P, Length(RemS)-P+1);
if not (rfReplaceAll in Flags) then
begin
Result := Result + RemS;
Srch := '';
end
else
Srch := Copy(Srch, P, Length(Srch)-P+1);
end;
end;
end;
function UTF8LowerCase(const AInStr: string; ALanguage: string=''): string;
var
CounterDiff: PtrInt;
InStr, InStrEnd, OutStr: PChar;
// Language identification
IsTurkish: Boolean;
c1, c2, c3, new_c1, new_c2, new_c3: Char;
p: SizeInt;
begin
Result:=AInStr;
InStr := PChar(AInStr);
InStrEnd := InStr + length(AInStr); // points behind last char
// Do a fast initial parsing of the string to maybe avoid doing
// UniqueString if the resulting string will be identical
while (InStr < InStrEnd) do
begin
c1 := InStr^;
case c1 of
'A'..'Z': Break;
#$C3..#$FF:
case c1 of
#$C3..#$C9, #$CE, #$CF, #$D0..#$D5, #$E1..#$E2,#$E5:
begin
c2 := InStr[1];
case c1 of
#$C3: if c2 in [#$80..#$9E] then Break;
#$C4:
begin
case c2 of
#$80..#$AF, #$B2..#$B6: if ord(c2) mod 2 = 0 then Break;
#$B8..#$FF: if ord(c2) mod 2 = 1 then Break;
#$B0: Break;
end;
end;
#$C5:
begin
case c2 of
#$8A..#$B7: if ord(c2) mod 2 = 0 then Break;
#$00..#$88, #$B9..#$FF: if ord(c2) mod 2 = 1 then Break;
#$B8: Break;
end;
end;
// Process E5 to avoid stopping on chinese chars
#$E5: if (c2 = #$BC) and (InStr[2] in [#$A1..#$BA]) then Break;
// Others are too complex, better not to pre-inspect them
else
Break;
end;
// already lower, or otherwhise not affected
end;
end;
end;
inc(InStr);
end;
if InStr >= InStrEnd then Exit;
// Language identification
IsTurkish := (ALanguage = 'tr') or (ALanguage = 'az'); // Turkish and Azeri have a special handling
UniqueString(Result);
OutStr := PChar(Result) + (InStr - PChar(AInStr));
CounterDiff := 0;
while InStr < InStrEnd do
begin
c1 := InStr^;
case c1 of
// codepoints UTF-8 range Description Case change
// $0041..$005A $41..$5A Capital ASCII X+$20
'A'..'Z':
begin
{ First ASCII chars }
// Special turkish handling
// capital undotted I to small undotted i
if IsTurkish and (c1 = 'I') then
begin
p:=OutStr - PChar(Result);
SetLength(Result,Length(Result)+1);// Increase the buffer
OutStr := PChar(Result)+p;
OutStr^ := #$C4;
inc(OutStr);
OutStr^ := #$B1;
dec(CounterDiff);
end
else
begin
OutStr^ := chr(ord(c1)+32);
end;
inc(InStr);
inc(OutStr);
end;
// Chars with 2-bytes which might be modified
#$C3..#$D5:
begin
c2 := InStr[1];
new_c1 := c1;
new_c2 := c2;
case c1 of
// Latin Characters 0000–0FFF http://en.wikibooks.org/wiki/Unicode/Character_reference/0000-0FFF
// codepoints UTF-8 range Description Case change
// $00C0..$00D6 C3 80..C3 96 Capital Latin with accents X+$20
// $D7 C3 97 Multiplication Sign N/A
// $00D8..$00DE C3 98..C3 9E Capital Latin with accents X+$20
// $DF C3 9F German beta ß already lowercase
#$C3:
begin
case c2 of
#$80..#$96, #$98..#$9E: new_c2 := chr(ord(c2) + $20)
end;
end;
// $0100..$012F C4 80..C4 AF Capital/Small Latin accents if mod 2 = 0 then X+1
// $0130..$0131 C4 B0..C4 B1 Turkish
// C4 B0 turkish uppercase dotted i -> 'i'
// C4 B1 turkish lowercase undotted ı
// $0132..$0137 C4 B2..C4 B7 Capital/Small Latin accents if mod 2 = 0 then X+1
// $0138 C4 B8 ĸ N/A
// $0139..$024F C4 B9..C5 88 Capital/Small Latin accents if mod 2 = 1 then X+1
#$C4:
begin
case c2 of
#$80..#$AF, #$B2..#$B7: if ord(c2) mod 2 = 0 then new_c2 := chr(ord(c2) + 1);
#$B0: // Turkish
begin
OutStr^ := 'i';
inc(InStr, 2);
inc(OutStr);
inc(CounterDiff, 1);
Continue;
end;
#$B9..#$BE: if ord(c2) mod 2 = 1 then new_c2 := chr(ord(c2) + 1);
#$BF: // This crosses the borders between the first byte of the UTF-8 char
begin
new_c1 := #$C5;
new_c2 := #$80;
end;
end;
end;
// $C589 ʼn
// $C58A..$C5B7: if OldChar mod 2 = 0 then NewChar := OldChar + 1;
// $C5B8: NewChar := $C3BF; // Ÿ
// $C5B9..$C8B3: if OldChar mod 2 = 1 then NewChar := OldChar + 1;
#$C5:
begin
case c2 of
#$8A..#$B7: //0
begin
if ord(c2) mod 2 = 0 then
new_c2 := chr(ord(c2) + 1);
end;
#$00..#$88, #$B9..#$BE: //1
begin
if ord(c2) mod 2 = 1 then
new_c2 := chr(ord(c2) + 1);
end;
#$B8: // Ÿ
begin
new_c1 := #$C3;
new_c2 := #$BF;
end;
end;
end;
{A convoluted part: C6 80..C6 8F
0180;LATIN SMALL LETTER B WITH STROKE;Ll;0;L;;;;;N;LATIN SMALL LETTER B BAR;;0243;;0243
0181;LATIN CAPITAL LETTER B WITH HOOK;Lu;0;L;;;;;N;LATIN CAPITAL LETTER B HOOK;;;0253; => C6 81=>C9 93
0182;LATIN CAPITAL LETTER B WITH TOPBAR;Lu;0;L;;;;;N;LATIN CAPITAL LETTER B TOPBAR;;;0183;
0183;LATIN SMALL LETTER B WITH TOPBAR;Ll;0;L;;;;;N;LATIN SMALL LETTER B TOPBAR;;0182;;0182
0184;LATIN CAPITAL LETTER TONE SIX;Lu;0;L;;;;;N;;;;0185;
0185;LATIN SMALL LETTER TONE SIX;Ll;0;L;;;;;N;;;0184;;0184
0186;LATIN CAPITAL LETTER OPEN O;Lu;0;L;;;;;N;;;;0254; ==> C9 94
0187;LATIN CAPITAL LETTER C WITH HOOK;Lu;0;L;;;;;N;LATIN CAPITAL LETTER C HOOK;;;0188;
0188;LATIN SMALL LETTER C WITH HOOK;Ll;0;L;;;;;N;LATIN SMALL LETTER C HOOK;;0187;;0187
0189;LATIN CAPITAL LETTER AFRICAN D;Lu;0;L;;;;;N;;;;0256; => C9 96
018A;LATIN CAPITAL LETTER D WITH HOOK;Lu;0;L;;;;;N;LATIN CAPITAL LETTER D HOOK;;;0257; => C9 97
018B;LATIN CAPITAL LETTER D WITH TOPBAR;Lu;0;L;;;;;N;LATIN CAPITAL LETTER D TOPBAR;;;018C;
018C;LATIN SMALL LETTER D WITH TOPBAR;Ll;0;L;;;;;N;LATIN SMALL LETTER D TOPBAR;;018B;;018B
018D;LATIN SMALL LETTER TURNED DELTA;Ll;0;L;;;;;N;;;;;
018E;LATIN CAPITAL LETTER REVERSED E;Lu;0;L;;;;;N;LATIN CAPITAL LETTER TURNED E;;;01DD; => C7 9D
018F;LATIN CAPITAL LETTER SCHWA;Lu;0;L;;;;;N;;;;0259; => C9 99
}
#$C6:
begin
case c2 of
#$81:
begin
new_c1 := #$C9;
new_c2 := #$93;
end;
#$82..#$85:
begin
if ord(c2) mod 2 = 0 then
new_c2 := chr(ord(c2) + 1);
end;
#$87..#$88,#$8B..#$8C:
begin
if ord(c2) mod 2 = 1 then
new_c2 := chr(ord(c2) + 1);
end;
#$86:
begin
new_c1 := #$C9;
new_c2 := #$94;
end;
#$89:
begin
new_c1 := #$C9;
new_c2 := #$96;
end;
#$8A:
begin
new_c1 := #$C9;
new_c2 := #$97;
end;
#$8E:
begin
new_c1 := #$C7;
new_c2 := #$9D;
end;
#$8F:
begin
new_c1 := #$C9;
new_c2 := #$99;
end;
{
And also C6 90..C6 9F
0190;LATIN CAPITAL LETTER OPEN E;Lu;0;L;;;;;N;LATIN CAPITAL LETTER EPSILON;;;025B; => C9 9B
0191;LATIN CAPITAL LETTER F WITH HOOK;Lu;0;L;;;;;N;LATIN CAPITAL LETTER F HOOK;;;0192; => +1
0192;LATIN SMALL LETTER F WITH HOOK;Ll;0;L;;;;;N;LATIN SMALL LETTER SCRIPT F;;0191;;0191 <=
0193;LATIN CAPITAL LETTER G WITH HOOK;Lu;0;L;;;;;N;LATIN CAPITAL LETTER G HOOK;;;0260; => C9 A0
0194;LATIN CAPITAL LETTER GAMMA;Lu;0;L;;;;;N;;;;0263; => C9 A3
0195;LATIN SMALL LETTER HV;Ll;0;L;;;;;N;LATIN SMALL LETTER H V;;01F6;;01F6 <=
0196;LATIN CAPITAL LETTER IOTA;Lu;0;L;;;;;N;;;;0269; => C9 A9
0197;LATIN CAPITAL LETTER I WITH STROKE;Lu;0;L;;;;;N;LATIN CAPITAL LETTER BARRED I;;;0268; => C9 A8
0198;LATIN CAPITAL LETTER K WITH HOOK;Lu;0;L;;;;;N;LATIN CAPITAL LETTER K HOOK;;;0199; => +1
0199;LATIN SMALL LETTER K WITH HOOK;Ll;0;L;;;;;N;LATIN SMALL LETTER K HOOK;;0198;;0198 <=
019A;LATIN SMALL LETTER L WITH BAR;Ll;0;L;;;;;N;LATIN SMALL LETTER BARRED L;;023D;;023D <=
019B;LATIN SMALL LETTER LAMBDA WITH STROKE;Ll;0;L;;;;;N;LATIN SMALL LETTER BARRED LAMBDA;;;; <=
019C;LATIN CAPITAL LETTER TURNED M;Lu;0;L;;;;;N;;;;026F; => C9 AF
019D;LATIN CAPITAL LETTER N WITH LEFT HOOK;Lu;0;L;;;;;N;LATIN CAPITAL LETTER N HOOK;;;0272; => C9 B2
019E;LATIN SMALL LETTER N WITH LONG RIGHT LEG;Ll;0;L;;;;;N;;;0220;;0220 <=
019F;LATIN CAPITAL LETTER O WITH MIDDLE TILDE;Lu;0;L;;;;;N;LATIN CAPITAL LETTER BARRED O;;;0275; => C9 B5
}
#$90:
begin
new_c1 := #$C9;
new_c2 := #$9B;
end;
#$91, #$98: new_c2 := chr(ord(c2)+1);
#$93:
begin
new_c1 := #$C9;
new_c2 := #$A0;
end;
#$94:
begin
new_c1 := #$C9;
new_c2 := #$A3;
end;
#$96:
begin
new_c1 := #$C9;
new_c2 := #$A9;
end;
#$97:
begin
new_c1 := #$C9;
new_c2 := #$A8;
end;
#$9C:
begin
new_c1 := #$C9;
new_c2 := #$AF;
end;
#$9D:
begin
new_c1 := #$C9;
new_c2 := #$B2;
end;
#$9F:
begin
new_c1 := #$C9;
new_c2 := #$B5;
end;
{
And also C6 A0..C6 AF
01A0;LATIN CAPITAL LETTER O WITH HORN;Lu;0;L;004F 031B;;;;N;LATIN CAPITAL LETTER O HORN;;;01A1; => +1
01A1;LATIN SMALL LETTER O WITH HORN;Ll;0;L;006F 031B;;;;N;LATIN SMALL LETTER O HORN;;01A0;;01A0 <=
01A2;LATIN CAPITAL LETTER OI;Lu;0;L;;;;;N;LATIN CAPITAL LETTER O I;;;01A3; => +1
01A3;LATIN SMALL LETTER OI;Ll;0;L;;;;;N;LATIN SMALL LETTER O I;;01A2;;01A2 <=
01A4;LATIN CAPITAL LETTER P WITH HOOK;Lu;0;L;;;;;N;LATIN CAPITAL LETTER P HOOK;;;01A5; => +1
01A5;LATIN SMALL LETTER P WITH HOOK;Ll;0;L;;;;;N;LATIN SMALL LETTER P HOOK;;01A4;;01A4 <=
01A6;LATIN LETTER YR;Lu;0;L;;;;;N;LATIN LETTER Y R;;;0280; => CA 80
01A7;LATIN CAPITAL LETTER TONE TWO;Lu;0;L;;;;;N;;;;01A8; => +1
01A8;LATIN SMALL LETTER TONE TWO;Ll;0;L;;;;;N;;;01A7;;01A7 <=
01A9;LATIN CAPITAL LETTER ESH;Lu;0;L;;;;;N;;;;0283; => CA 83
01AA;LATIN LETTER REVERSED ESH LOOP;Ll;0;L;;;;;N;;;;;
01AB;LATIN SMALL LETTER T WITH PALATAL HOOK;Ll;0;L;;;;;N;LATIN SMALL LETTER T PALATAL HOOK;;;; <=
01AC;LATIN CAPITAL LETTER T WITH HOOK;Lu;0;L;;;;;N;LATIN CAPITAL LETTER T HOOK;;;01AD; => +1
01AD;LATIN SMALL LETTER T WITH HOOK;Ll;0;L;;;;;N;LATIN SMALL LETTER T HOOK;;01AC;;01AC <=
01AE;LATIN CAPITAL LETTER T WITH RETROFLEX HOOK;Lu;0;L;;;;;N;LATIN CAPITAL LETTER T RETROFLEX HOOK;;;0288; => CA 88
01AF;LATIN CAPITAL LETTER U WITH HORN;Lu;0;L;0055 031B;;;;N;LATIN CAPITAL LETTER U HORN;;;01B0; => +1
}
#$A0..#$A5,#$AC:
begin
if ord(c2) mod 2 = 0 then
new_c2 := chr(ord(c2) + 1);
end;
#$A7,#$AF:
begin
if ord(c2) mod 2 = 1 then
new_c2 := chr(ord(c2) + 1);
end;
#$A6:
begin
new_c1 := #$CA;
new_c2 := #$80;
end;
#$A9:
begin
new_c1 := #$CA;
new_c2 := #$83;
end;
#$AE:
begin
new_c1 := #$CA;
new_c2 := #$88;
end;
{
And also C6 B0..C6 BF
01B0;LATIN SMALL LETTER U WITH HORN;Ll;0;L;0075 031B;;;;N;LATIN SMALL LETTER U HORN;;01AF;;01AF <= -1
01B1;LATIN CAPITAL LETTER UPSILON;Lu;0;L;;;;;N;;;;028A; => CA 8A
01B2;LATIN CAPITAL LETTER V WITH HOOK;Lu;0;L;;;;;N;LATIN CAPITAL LETTER SCRIPT V;;;028B; => CA 8B
01B3;LATIN CAPITAL LETTER Y WITH HOOK;Lu;0;L;;;;;N;LATIN CAPITAL LETTER Y HOOK;;;01B4; => +1
01B4;LATIN SMALL LETTER Y WITH HOOK;Ll;0;L;;;;;N;LATIN SMALL LETTER Y HOOK;;01B3;;01B3 <=
01B5;LATIN CAPITAL LETTER Z WITH STROKE;Lu;0;L;;;;;N;LATIN CAPITAL LETTER Z BAR;;;01B6; => +1
01B6;LATIN SMALL LETTER Z WITH STROKE;Ll;0;L;;;;;N;LATIN SMALL LETTER Z BAR;;01B5;;01B5 <=
01B7;LATIN CAPITAL LETTER EZH;Lu;0;L;;;;;N;LATIN CAPITAL LETTER YOGH;;;0292; => CA 92
01B8;LATIN CAPITAL LETTER EZH REVERSED;Lu;0;L;;;;;N;LATIN CAPITAL LETTER REVERSED YOGH;;;01B9; => +1
01B9;LATIN SMALL LETTER EZH REVERSED;Ll;0;L;;;;;N;LATIN SMALL LETTER REVERSED YOGH;;01B8;;01B8 <=
01BA;LATIN SMALL LETTER EZH WITH TAIL;Ll;0;L;;;;;N;LATIN SMALL LETTER YOGH WITH TAIL;;;; <=
01BB;LATIN LETTER TWO WITH STROKE;Lo;0;L;;;;;N;LATIN LETTER TWO BAR;;;; X
01BC;LATIN CAPITAL LETTER TONE FIVE;Lu;0;L;;;;;N;;;;01BD; => +1
01BD;LATIN SMALL LETTER TONE FIVE;Ll;0;L;;;;;N;;;01BC;;01BC <=
01BE;LATIN LETTER INVERTED GLOTTAL STOP WITH STROKE;Ll;0;L;;;;;N;LATIN LETTER INVERTED GLOTTAL STOP BAR;;;; X
01BF;LATIN LETTER WYNN;Ll;0;L;;;;;N;;;01F7;;01F7 <=
}
#$B8,#$BC:
begin
if ord(c2) mod 2 = 0 then
new_c2 := chr(ord(c2) + 1);
end;
#$B3..#$B6:
begin
if ord(c2) mod 2 = 1 then
new_c2 := chr(ord(c2) + 1);
end;
#$B1:
begin
new_c1 := #$CA;
new_c2 := #$8A;
end;
#$B2:
begin
new_c1 := #$CA;
new_c2 := #$8B;
end;
#$B7:
begin
new_c1 := #$CA;
new_c2 := #$92;
end;
end;
end;
#$C7:
begin
case c2 of
#$84..#$8C,#$B1..#$B3:
begin
if (ord(c2) and $F) mod 3 = 1 then new_c2 := chr(ord(c2) + 2)
else if (ord(c2) and $F) mod 3 = 2 then new_c2 := chr(ord(c2) + 1);
end;
#$8D..#$9C:
begin
if ord(c2) mod 2 = 1 then
new_c2 := chr(ord(c2) + 1);
end;
#$9E..#$AF,#$B4..#$B5,#$B8..#$BF:
begin
if ord(c2) mod 2 = 0 then
new_c2 := chr(ord(c2) + 1);
end;
{
01F6;LATIN CAPITAL LETTER HWAIR;Lu;0;L;;;;;N;;;;0195;
01F7;LATIN CAPITAL LETTER WYNN;Lu;0;L;;;;;N;;;;01BF;
}
#$B6:
begin
new_c1 := #$C6;
new_c2 := #$95;
end;
#$B7:
begin
new_c1 := #$C6;
new_c2 := #$BF;
end;
end;
end;
{
Codepoints 0200 to 023F
}
#$C8:
begin
// For this one we can simply start with a default and override for some specifics
if (c2 in [#$80..#$B3]) and (ord(c2) mod 2 = 0) then new_c2 := chr(ord(c2) + 1);
case c2 of
#$A0:
begin
new_c1 := #$C6;
new_c2 := #$9E;
end;
#$A1: new_c2 := c2;
{
023A;LATIN CAPITAL LETTER A WITH STROKE;Lu;0;L;;;;;N;;;;2C65; => E2 B1 A5
023B;LATIN CAPITAL LETTER C WITH STROKE;Lu;0;L;;;;;N;;;;023C; => +1
023C;LATIN SMALL LETTER C WITH STROKE;Ll;0;L;;;;;N;;;023B;;023B <=
023D;LATIN CAPITAL LETTER L WITH BAR;Lu;0;L;;;;;N;;;;019A; => C6 9A
023E;LATIN CAPITAL LETTER T WITH DIAGONAL STROKE;Lu;0;L;;;;;N;;;;2C66; => E2 B1 A6
023F;LATIN SMALL LETTER S WITH SWASH TAIL;Ll;0;L;;;;;N;;;2C7E;;2C7E <=
0240;LATIN SMALL LETTER Z WITH SWASH TAIL;Ll;0;L;;;;;N;;;2C7F;;2C7F <=
}
#$BA,#$BE:
begin
p:= OutStr - PChar(Result);
SetLength(Result,Length(Result)+1);// Increase the buffer
OutStr := PChar(Result)+p;
OutStr^ := #$E2;
inc(OutStr);
OutStr^ := #$B1;
inc(OutStr);
if c2 = #$BA then OutStr^ := #$A5
else OutStr^ := #$A6;
dec(CounterDiff);
inc(OutStr);
inc(InStr, 2);
Continue;
end;
#$BD:
begin
new_c1 := #$C6;
new_c2 := #$9A;
end;
#$BB: new_c2 := chr(ord(c2) + 1);
end;
end;
{
Codepoints 0240 to 027F
Here only 0240..024F needs lowercase
}
#$C9:
begin
case c2 of
#$81..#$82:
begin
if ord(c2) mod 2 = 1 then
new_c2 := chr(ord(c2) + 1);
end;
#$86..#$8F:
begin
if ord(c2) mod 2 = 0 then
new_c2 := chr(ord(c2) + 1);
end;
#$83:
begin
new_c1 := #$C6;
new_c2 := #$80;
end;
#$84:
begin
new_c1 := #$CA;
new_c2 := #$89;
end;
#$85:
begin
new_c1 := #$CA;
new_c2 := #$8C;
end;
end;
end;
// $CE91..$CE9F: NewChar := OldChar + $20; // Greek Characters
// $CEA0..$CEA9: NewChar := OldChar + $E0; // Greek Characters
#$CE:
begin
case c2 of
// 0380 = CE 80
#$86: new_c2 := #$AC;
#$88: new_c2 := #$AD;
#$89: new_c2 := #$AE;
#$8A: new_c2 := #$AF;
#$8C: new_c1 := #$CF; // By coincidence new_c2 remains the same
#$8E:
begin
new_c1 := #$CF;
new_c2 := #$8D;
end;
#$8F:
begin
new_c1 := #$CF;
new_c2 := #$8E;
end;
// 0390 = CE 90
#$91..#$9F:
begin
new_c2 := chr(ord(c2) + $20);
end;
// 03A0 = CE A0
#$A0..#$AB:
begin
new_c1 := #$CF;
new_c2 := chr(ord(c2) - $20);
end;
end;
end;
// 03C0 = CF 80
// 03D0 = CF 90
// 03E0 = CF A0
// 03F0 = CF B0
#$CF:
begin
case c2 of
// 03CF;GREEK CAPITAL KAI SYMBOL;Lu;0;L;;;;;N;;;;03D7; CF 8F => CF 97
#$8F: new_c2 := #$97;
// 03D8;GREEK LETTER ARCHAIC KOPPA;Lu;0;L;;;;;N;;;;03D9;
#$98: new_c2 := #$99;
// 03DA;GREEK LETTER STIGMA;Lu;0;L;;;;;N;GREEK CAPITAL LETTER STIGMA;;;03DB;
#$9A: new_c2 := #$9B;
// 03DC;GREEK LETTER DIGAMMA;Lu;0;L;;;;;N;GREEK CAPITAL LETTER DIGAMMA;;;03DD;
#$9C: new_c2 := #$9D;
// 03DE;GREEK LETTER KOPPA;Lu;0;L;;;;;N;GREEK CAPITAL LETTER KOPPA;;;03DF;
#$9E: new_c2 := #$9F;
{
03E0;GREEK LETTER SAMPI;Lu;0;L;;;;;N;GREEK CAPITAL LETTER SAMPI;;;03E1;
03E1;GREEK SMALL LETTER SAMPI;Ll;0;L;;;;;N;;;03E0;;03E0
03E2;COPTIC CAPITAL LETTER SHEI;Lu;0;L;;;;;N;GREEK CAPITAL LETTER SHEI;;;03E3;
03E3;COPTIC SMALL LETTER SHEI;Ll;0;L;;;;;N;GREEK SMALL LETTER SHEI;;03E2;;03E2
...
03EE;COPTIC CAPITAL LETTER DEI;Lu;0;L;;;;;N;GREEK CAPITAL LETTER DEI;;;03EF;
03EF;COPTIC SMALL LETTER DEI;Ll;0;L;;;;;N;GREEK SMALL LETTER DEI;;03EE;;03EE
}
#$A0..#$AF: if ord(c2) mod 2 = 0 then
new_c2 := chr(ord(c2) + 1);
// 03F4;GREEK CAPITAL THETA SYMBOL;Lu;0;L;<compat> 0398;;;;N;;;;03B8;
#$B4:
begin
new_c1 := #$CE;
new_c2 := #$B8;
end;
// 03F7;GREEK CAPITAL LETTER SHO;Lu;0;L;;;;;N;;;;03F8;
#$B7: new_c2 := #$B8;
// 03F9;GREEK CAPITAL LUNATE SIGMA SYMBOL;Lu;0;L;<compat> 03A3;;;;N;;;;03F2;
#$B9: new_c2 := #$B2;
// 03FA;GREEK CAPITAL LETTER SAN;Lu;0;L;;;;;N;;;;03FB;
#$BA: new_c2 := #$BB;
// 03FD;GREEK CAPITAL REVERSED LUNATE SIGMA SYMBOL;Lu;0;L;;;;;N;;;;037B;
#$BD:
begin
new_c1 := #$CD;
new_c2 := #$BB;
end;
// 03FE;GREEK CAPITAL DOTTED LUNATE SIGMA SYMBOL;Lu;0;L;;;;;N;;;;037C;
#$BE:
begin
new_c1 := #$CD;
new_c2 := #$BC;
end;
// 03FF;GREEK CAPITAL REVERSED DOTTED LUNATE SIGMA SYMBOL;Lu;0;L;;;;;N;;;;037D;
#$BF:
begin
new_c1 := #$CD;
new_c2 := #$BD;
end;
end;
end;
// $D080..$D08F: NewChar := OldChar + $110; // Cyrillic alphabet
// $D090..$D09F: NewChar := OldChar + $20; // Cyrillic alphabet
// $D0A0..$D0AF: NewChar := OldChar + $E0; // Cyrillic alphabet
#$D0:
begin
c2 := InStr[1];
case c2 of
#$80..#$8F:
begin
new_c1 := chr(ord(c1)+1);
new_c2 := chr(ord(c2) + $10);
end;
#$90..#$9F:
begin
new_c2 := chr(ord(c2) + $20);
end;
#$A0..#$AF:
begin
new_c1 := chr(ord(c1)+1);
new_c2 := chr(ord(c2) - $20);
end;
end;
end;
// Archaic and non-slavic cyrillic 460-47F = D1A0-D1BF
// These require just adding 1 to get the lowercase
#$D1:
begin
if (c2 in [#$A0..#$BF]) and (ord(c2) mod 2 = 0) then
new_c2 := chr(ord(c2) + 1);
end;
// Archaic and non-slavic cyrillic 480-4BF = D280-D2BF
// These mostly require just adding 1 to get the lowercase
#$D2:
begin
case c2 of
#$80:
begin
new_c2 := chr(ord(c2) + 1);
end;
// #$81 is already lowercase
// #$82-#$89 ???
#$8A..#$BF:
begin
if ord(c2) mod 2 = 0 then
new_c2 := chr(ord(c2) + 1);
end;
end;
end;
{
Codepoints 04C0..04FF
}
#$D3:
begin
case c2 of
#$80: new_c2 := #$8F;
#$81..#$8E:
begin
if ord(c2) mod 2 = 1 then
new_c2 := chr(ord(c2) + 1);
end;
#$90..#$BF:
begin
if ord(c2) mod 2 = 0 then
new_c2 := chr(ord(c2) + 1);
end;
end;
end;
{
Codepoints 0500..053F
Armenian starts in 0531
}
#$D4:
begin
if ord(c2) mod 2 = 0 then
new_c2 := chr(ord(c2) + 1);
// Armenian
if c2 in [#$B1..#$BF] then
begin
new_c1 := #$D5;
new_c2 := chr(ord(c2) - $10);
end;
end;
{
Codepoints 0540..057F
Armenian
}
#$D5:
begin
case c2 of
#$80..#$8F:
begin
new_c2 := chr(ord(c2) + $30);
end;
#$90..#$96:
begin
new_c1 := #$D6;
new_c2 := chr(ord(c2) - $10);
end;
end;
end;
end;
// Common code 2-byte modifiable chars
if (CounterDiff <> 0) then
begin
OutStr^ := new_c1;
OutStr[1] := new_c2;
end
else
begin
if (new_c1 <> c1) then OutStr^ := new_c1;
if (new_c2 <> c2) then OutStr[1] := new_c2;
end;
inc(InStr, 2);
inc(OutStr, 2);
end;
{
Characters with 3 bytes
}
#$E1:
begin
new_c1 := c1;
c2 := InStr[1];
c3 := InStr[2];
new_c2 := c2;
new_c3 := c3;
{
Georgian codepoints 10A0-10C5 => 2D00-2D25
In UTF-8 this is:
E1 82 A0 - E1 82 BF => E2 B4 80 - E2 B4 9F
E1 83 80 - E1 83 85 => E2 B4 A0 - E2 B4 A5
}
case c2 of
#$82:
if (c3 in [#$A0..#$BF]) then
begin
new_c1 := #$E2;
new_c2 := #$B4;
new_c3 := chr(ord(c3) - $20);
end;
#$83:
if (c3 in [#$80..#$85]) then
begin
new_c1 := #$E2;
new_c2 := #$B4;
new_c3 := chr(ord(c3) + $20);
end;
{
Extra chars between 1E00..1EFF
Blocks of chars:
1E00..1E3F E1 B8 80..E1 B8 BF
1E40..1E7F E1 B9 80..E1 B9 BF
1E80..1EBF E1 BA 80..E1 BA BF
1EC0..1EFF E1 BB 80..E1 BB BF
}
#$B8..#$BB:
begin
// Start with a default and change for some particular chars
if ord(c3) mod 2 = 0 then
new_c3 := chr(ord(c3) + 1);
{ Only 1E96..1E9F are different E1 BA 96..E1 BA 9F
1E96;LATIN SMALL LETTER H WITH LINE BELOW;Ll;0;L;0068 0331;;;;N;;;;;
1E97;LATIN SMALL LETTER T WITH DIAERESIS;Ll;0;L;0074 0308;;;;N;;;;;
1E98;LATIN SMALL LETTER W WITH RING ABOVE;Ll;0;L;0077 030A;;;;N;;;;;
1E99;LATIN SMALL LETTER Y WITH RING ABOVE;Ll;0;L;0079 030A;;;;N;;;;;
1E9A;LATIN SMALL LETTER A WITH RIGHT HALF RING;Ll;0;L;<compat> 0061 02BE;;;;N;;;;;
1E9B;LATIN SMALL LETTER LONG S WITH DOT ABOVE;Ll;0;L;017F 0307;;;;N;;;1E60;;1E60
1E9C;LATIN SMALL LETTER LONG S WITH DIAGONAL STROKE;Ll;0;L;;;;;N;;;;;
1E9D;LATIN SMALL LETTER LONG S WITH HIGH STROKE;Ll;0;L;;;;;N;;;;;
1E9E;LATIN CAPITAL LETTER SHARP S;Lu;0;L;;;;;N;;;;00DF; => C3 9F
1E9F;LATIN SMALL LETTER DELTA;Ll;0;L;;;;;N;;;;;
}
if (c2 = #$BA) and (c3 in [#$96..#$9F]) then new_c3 := c3;
// LATIN CAPITAL LETTER SHARP S => to german Beta
if (c2 = #$BA) and (c3 = #$9E) then
begin
inc(InStr, 3);
OutStr^ := #$C3;
inc(OutStr);
OutStr^ := #$9F;
inc(OutStr);
inc(CounterDiff, 1);
Continue;
end;
end;
{
Extra chars between 1F00..1FFF
Blocks of chars:
1E00..1E3F E1 BC 80..E1 BC BF
1E40..1E7F E1 BD 80..E1 BD BF
1E80..1EBF E1 BE 80..E1 BE BF
1EC0..1EFF E1 BF 80..E1 BF BF
}
#$BC:
begin
// Start with a default and change for some particular chars
if (ord(c3) mod $10) div 8 = 1 then
new_c3 := chr(ord(c3) - 8);
end;
#$BD:
begin
// Start with a default and change for some particular chars
case c3 of
#$80..#$8F, #$A0..#$AF: if (ord(c3) mod $10) div 8 = 1 then
new_c3 := chr(ord(c3) - 8);
{
1F50;GREEK SMALL LETTER UPSILON WITH PSILI;Ll;0;L;03C5 0313;;;;N;;;;;
1F51;GREEK SMALL LETTER UPSILON WITH DASIA;Ll;0;L;03C5 0314;;;;N;;;1F59;;1F59
1F52;GREEK SMALL LETTER UPSILON WITH PSILI AND VARIA;Ll;0;L;1F50 0300;;;;N;;;;;
1F53;GREEK SMALL LETTER UPSILON WITH DASIA AND VARIA;Ll;0;L;1F51 0300;;;;N;;;1F5B;;1F5B
1F54;GREEK SMALL LETTER UPSILON WITH PSILI AND OXIA;Ll;0;L;1F50 0301;;;;N;;;;;
1F55;GREEK SMALL LETTER UPSILON WITH DASIA AND OXIA;Ll;0;L;1F51 0301;;;;N;;;1F5D;;1F5D
1F56;GREEK SMALL LETTER UPSILON WITH PSILI AND PERISPOMENI;Ll;0;L;1F50 0342;;;;N;;;;;
1F57;GREEK SMALL LETTER UPSILON WITH DASIA AND PERISPOMENI;Ll;0;L;1F51 0342;;;;N;;;1F5F;;1F5F
1F59;GREEK CAPITAL LETTER UPSILON WITH DASIA;Lu;0;L;03A5 0314;;;;N;;;;1F51;
1F5B;GREEK CAPITAL LETTER UPSILON WITH DASIA AND VARIA;Lu;0;L;1F59 0300;;;;N;;;;1F53;
1F5D;GREEK CAPITAL LETTER UPSILON WITH DASIA AND OXIA;Lu;0;L;1F59 0301;;;;N;;;;1F55;
1F5F;GREEK CAPITAL LETTER UPSILON WITH DASIA AND PERISPOMENI;Lu;0;L;1F59 0342;;;;N;;;;1F57;
}
#$99,#$9B,#$9D,#$9F: new_c3 := chr(ord(c3) - 8);
end;
end;
#$BE:
begin
// Start with a default and change for some particular chars
case c3 of
#$80..#$B9: if (ord(c3) mod $10) div 8 = 1 then
new_c3 := chr(ord(c3) - 8);
{
1FB0;GREEK SMALL LETTER ALPHA WITH VRACHY;Ll;0;L;03B1 0306;;;;N;;;1FB8;;1FB8
1FB1;GREEK SMALL LETTER ALPHA WITH MACRON;Ll;0;L;03B1 0304;;;;N;;;1FB9;;1FB9
1FB2;GREEK SMALL LETTER ALPHA WITH VARIA AND YPOGEGRAMMENI;Ll;0;L;1F70 0345;;;;N;;;;;
1FB3;GREEK SMALL LETTER ALPHA WITH YPOGEGRAMMENI;Ll;0;L;03B1 0345;;;;N;;;1FBC;;1FBC
1FB4;GREEK SMALL LETTER ALPHA WITH OXIA AND YPOGEGRAMMENI;Ll;0;L;03AC 0345;;;;N;;;;;
1FB6;GREEK SMALL LETTER ALPHA WITH PERISPOMENI;Ll;0;L;03B1 0342;;;;N;;;;;
1FB7;GREEK SMALL LETTER ALPHA WITH PERISPOMENI AND YPOGEGRAMMENI;Ll;0;L;1FB6 0345;;;;N;;;;;
1FB8;GREEK CAPITAL LETTER ALPHA WITH VRACHY;Lu;0;L;0391 0306;;;;N;;;;1FB0;
1FB9;GREEK CAPITAL LETTER ALPHA WITH MACRON;Lu;0;L;0391 0304;;;;N;;;;1FB1;
1FBA;GREEK CAPITAL LETTER ALPHA WITH VARIA;Lu;0;L;0391 0300;;;;N;;;;1F70;
1FBB;GREEK CAPITAL LETTER ALPHA WITH OXIA;Lu;0;L;0386;;;;N;;;;1F71;
1FBC;GREEK CAPITAL LETTER ALPHA WITH PROSGEGRAMMENI;Lt;0;L;0391 0345;;;;N;;;;1FB3;
1FBD;GREEK KORONIS;Sk;0;ON;<compat> 0020 0313;;;;N;;;;;
1FBE;GREEK PROSGEGRAMMENI;Ll;0;L;03B9;;;;N;;;0399;;0399
1FBF;GREEK PSILI;Sk;0;ON;<compat> 0020 0313;;;;N;;;;;
}
#$BA:
begin
new_c2 := #$BD;
new_c3 := #$B0;
end;
#$BB:
begin
new_c2 := #$BD;
new_c3 := #$B1;
end;
#$BC: new_c3 := #$B3;
end;
end;
end;
if (CounterDiff <> 0) then
begin
OutStr^ := new_c1;
OutStr[1] := new_c2;
OutStr[2] := new_c3;
end
else
begin
if c1 <> new_c1 then OutStr^ := new_c1;
if c2 <> new_c2 then OutStr[1] := new_c2;
if c3 <> new_c3 then OutStr[2] := new_c3;
end;
inc(InStr, 3);
inc(OutStr, 3);
end;
{
More Characters with 3 bytes, so exotic stuff between:
$2126..$2183 E2 84 A6..E2 86 83
$24B6..$24CF Result:=u+26; E2 92 B6..E2 93 8F
$2C00..$2C2E Result:=u+48; E2 B0 80..E2 B0 AE
$2C60..$2CE2 E2 B1 A0..E2 B3 A2
}
#$E2:
begin
new_c1 := c1;
c2 := InStr[1];
c3 := InStr[2];
new_c2 := c2;
new_c3 := c3;
// 2126;OHM SIGN;Lu;0;L;03A9;;;;N;OHM;;;03C9; E2 84 A6 => CF 89
if (c2 = #$84) and (c3 = #$A6) then
begin
inc(InStr, 3);
OutStr^ := #$CF;
inc(OutStr);
OutStr^ := #$89;
inc(OutStr);
inc(CounterDiff, 1);
Continue;
end
{
212A;KELVIN SIGN;Lu;0;L;004B;;;;N;DEGREES KELVIN;;;006B; E2 84 AA => 6B
}
else if (c2 = #$84) and (c3 = #$AA) then
begin
inc(InStr, 3);
if c3 = #$AA then OutStr^ := #$6B
else OutStr^ := #$E5;
inc(OutStr);
inc(CounterDiff, 2);
Continue;
end
{
212B;ANGSTROM SIGN;Lu;0;L;00C5;;;;N;ANGSTROM UNIT;;;00E5; E2 84 AB => C3 A5
}
else if (c2 = #$84) and (c3 = #$AB) then
begin
inc(InStr, 3);
OutStr^ := #$C3;
inc(OutStr);
OutStr^ := #$A5;
inc(OutStr);
inc(CounterDiff, 1);
Continue;
end
{
2160;ROMAN NUMERAL ONE;Nl;0;L;<compat> 0049;;;1;N;;;;2170; E2 85 A0 => E2 85 B0
2161;ROMAN NUMERAL TWO;Nl;0;L;<compat> 0049 0049;;;2;N;;;;2171;
2162;ROMAN NUMERAL THREE;Nl;0;L;<compat> 0049 0049 0049;;;3;N;;;;2172;
2163;ROMAN NUMERAL FOUR;Nl;0;L;<compat> 0049 0056;;;4;N;;;;2173;
2164;ROMAN NUMERAL FIVE;Nl;0;L;<compat> 0056;;;5;N;;;;2174;
2165;ROMAN NUMERAL SIX;Nl;0;L;<compat> 0056 0049;;;6;N;;;;2175;
2166;ROMAN NUMERAL SEVEN;Nl;0;L;<compat> 0056 0049 0049;;;7;N;;;;2176;
2167;ROMAN NUMERAL EIGHT;Nl;0;L;<compat> 0056 0049 0049 0049;;;8;N;;;;2177;
2168;ROMAN NUMERAL NINE;Nl;0;L;<compat> 0049 0058;;;9;N;;;;2178;
2169;ROMAN NUMERAL TEN;Nl;0;L;<compat> 0058;;;10;N;;;;2179;
216A;ROMAN NUMERAL ELEVEN;Nl;0;L;<compat> 0058 0049;;;11;N;;;;217A;
216B;ROMAN NUMERAL TWELVE;Nl;0;L;<compat> 0058 0049 0049;;;12;N;;;;217B;
216C;ROMAN NUMERAL FIFTY;Nl;0;L;<compat> 004C;;;50;N;;;;217C;
216D;ROMAN NUMERAL ONE HUNDRED;Nl;0;L;<compat> 0043;;;100;N;;;;217D;
216E;ROMAN NUMERAL FIVE HUNDRED;Nl;0;L;<compat> 0044;;;500;N;;;;217E;
216F;ROMAN NUMERAL ONE THOUSAND;Nl;0;L;<compat> 004D;;;1000;N;;;;217F;
}
else if (c2 = #$85) and (c3 in [#$A0..#$AF]) then new_c3 := chr(ord(c3) + $10)
{
2183;ROMAN NUMERAL REVERSED ONE HUNDRED;Lu;0;L;;;;;N;;;;2184; E2 86 83 => E2 86 84
}
else if (c2 = #$86) and (c3 = #$83) then new_c3 := chr(ord(c3) + 1)
{
$24B6..$24CF Result:=u+26; E2 92 B6..E2 93 8F
Ex: 24B6;CIRCLED LATIN CAPITAL LETTER A;So;0;L;<circle> 0041;;;;N;;;;24D0; E2 92 B6 => E2 93 90
}
else if (c2 = #$92) and (c3 in [#$B6..#$BF]) then
begin
new_c3 := #$93;
new_c3 := chr(ord(c3) - $26);
end
else if (c2 = #$93) and (c3 in [#$80..#$8F]) then new_c3 := chr(ord(c3) + 26)
{
$2C00..$2C2E Result:=u+48; E2 B0 80..E2 B0 AE
2C00;GLAGOLITIC CAPITAL LETTER AZU;Lu;0;L;;;;;N;;;;2C30; E2 B0 80 => E2 B0 B0
2C10;GLAGOLITIC CAPITAL LETTER NASHI;Lu;0;L;;;;;N;;;;2C40; E2 B0 90 => E2 B1 80
}
else if (c2 = #$B0) and (c3 in [#$80..#$8F]) then new_c3 := chr(ord(c3) + $30)
else if (c2 = #$B0) and (c3 in [#$90..#$AE]) then
begin
new_c2 := #$B1;
new_c3 := chr(ord(c3) - $10);
end
{
$2C60..$2CE2 E2 B1 A0..E2 B3 A2
2C60;LATIN CAPITAL LETTER L WITH DOUBLE BAR;Lu;0;L;;;;;N;;;;2C61; E2 B1 A0 => +1
2C61;LATIN SMALL LETTER L WITH DOUBLE BAR;Ll;0;L;;;;;N;;;2C60;;2C60
2C62;LATIN CAPITAL LETTER L WITH MIDDLE TILDE;Lu;0;L;;;;;N;;;;026B; => C9 AB
2C63;LATIN CAPITAL LETTER P WITH STROKE;Lu;0;L;;;;;N;;;;1D7D; => E1 B5 BD
2C64;LATIN CAPITAL LETTER R WITH TAIL;Lu;0;L;;;;;N;;;;027D; => C9 BD
2C65;LATIN SMALL LETTER A WITH STROKE;Ll;0;L;;;;;N;;;023A;;023A
2C66;LATIN SMALL LETTER T WITH DIAGONAL STROKE;Ll;0;L;;;;;N;;;023E;;023E
2C67;LATIN CAPITAL LETTER H WITH DESCENDER;Lu;0;L;;;;;N;;;;2C68; => E2 B1 A8
2C68;LATIN SMALL LETTER H WITH DESCENDER;Ll;0;L;;;;;N;;;2C67;;2C67
2C69;LATIN CAPITAL LETTER K WITH DESCENDER;Lu;0;L;;;;;N;;;;2C6A; => E2 B1 AA
2C6A;LATIN SMALL LETTER K WITH DESCENDER;Ll;0;L;;;;;N;;;2C69;;2C69
2C6B;LATIN CAPITAL LETTER Z WITH DESCENDER;Lu;0;L;;;;;N;;;;2C6C; => E2 B1 AC
2C6C;LATIN SMALL LETTER Z WITH DESCENDER;Ll;0;L;;;;;N;;;2C6B;;2C6B
2C6D;LATIN CAPITAL LETTER ALPHA;Lu;0;L;;;;;N;;;;0251; => C9 91
2C6E;LATIN CAPITAL LETTER M WITH HOOK;Lu;0;L;;;;;N;;;;0271; => C9 B1
2C6F;LATIN CAPITAL LETTER TURNED A;Lu;0;L;;;;;N;;;;0250; => C9 90
2C70;LATIN CAPITAL LETTER TURNED ALPHA;Lu;0;L;;;;;N;;;;0252; => C9 92
}
else if (c2 = #$B1) then
begin
case c3 of
#$A0: new_c3 := chr(ord(c3)+1);
#$A2,#$A4,#$AD..#$AF,#$B0:
begin
inc(InStr, 3);
OutStr^ := #$C9;
inc(OutStr);
case c3 of
#$A2: OutStr^ := #$AB;
#$A4: OutStr^ := #$BD;
#$AD: OutStr^ := #$90;
#$AE: OutStr^ := #$B1;
#$AF: OutStr^ := #$90;
#$B0: OutStr^ := #$92;
end;
inc(OutStr);
inc(CounterDiff, 1);
Continue;
end;
#$A3:
begin
new_c2 := #$B5;
new_c3 := #$BD;
end;
#$A7,#$A9,#$AB: new_c3 := chr(ord(c3)+1);
{
2C71;LATIN SMALL LETTER V WITH RIGHT HOOK;Ll;0;L;;;;;N;;;;;
2C72;LATIN CAPITAL LETTER W WITH HOOK;Lu;0;L;;;;;N;;;;2C73;
2C73;LATIN SMALL LETTER W WITH HOOK;Ll;0;L;;;;;N;;;2C72;;2C72
2C74;LATIN SMALL LETTER V WITH CURL;Ll;0;L;;;;;N;;;;;
2C75;LATIN CAPITAL LETTER HALF H;Lu;0;L;;;;;N;;;;2C76;
2C76;LATIN SMALL LETTER HALF H;Ll;0;L;;;;;N;;;2C75;;2C75
2C77;LATIN SMALL LETTER TAILLESS PHI;Ll;0;L;;;;;N;;;;;
2C78;LATIN SMALL LETTER E WITH NOTCH;Ll;0;L;;;;;N;;;;;
2C79;LATIN SMALL LETTER TURNED R WITH TAIL;Ll;0;L;;;;;N;;;;;
2C7A;LATIN SMALL LETTER O WITH LOW RING INSIDE;Ll;0;L;;;;;N;;;;;
2C7B;LATIN LETTER SMALL CAPITAL TURNED E;Ll;0;L;;;;;N;;;;;
2C7C;LATIN SUBSCRIPT SMALL LETTER J;Ll;0;L;<sub> 006A;;;;N;;;;;
2C7D;MODIFIER LETTER CAPITAL V;Lm;0;L;<super> 0056;;;;N;;;;;
2C7E;LATIN CAPITAL LETTER S WITH SWASH TAIL;Lu;0;L;;;;;N;;;;023F; => C8 BF
2C7F;LATIN CAPITAL LETTER Z WITH SWASH TAIL;Lu;0;L;;;;;N;;;;0240; => C9 80
}
#$B2,#$B5: new_c3 := chr(ord(c3)+1);
#$BE,#$BF:
begin
inc(InStr, 3);
case c3 of
#$BE: OutStr^ := #$C8;
#$BF: OutStr^ := #$C9;
end;
OutStr^ := #$C8;
inc(OutStr);
case c3 of
#$BE: OutStr^ := #$BF;
#$BF: OutStr^ := #$80;
end;
inc(OutStr);
inc(CounterDiff, 1);
Continue;
end;
end;
end
{
2C80;COPTIC CAPITAL LETTER ALFA;Lu;0;L;;;;;N;;;;2C81; E2 B2 80 => E2 B2 81
...
2CBE;COPTIC CAPITAL LETTER OLD COPTIC OOU;Lu;0;L;;;;;N;;;;2CBF; E2 B2 BE => E2 B2 BF
2CBF;COPTIC SMALL LETTER OLD COPTIC OOU;Ll;0;L;;;;;N;;;2CBE;;2CBE
...
2CC0;COPTIC CAPITAL LETTER SAMPI;Lu;0;L;;;;;N;;;;2CC1; E2 B3 80 => E2 B2 81
2CC1;COPTIC SMALL LETTER SAMPI;Ll;0;L;;;;;N;;;2CC0;;2CC0
...
2CE2;COPTIC CAPITAL LETTER OLD NUBIAN WAU;Lu;0;L;;;;;N;;;;2CE3; E2 B3 A2 => E2 B3 A3
2CE3;COPTIC SMALL LETTER OLD NUBIAN WAU;Ll;0;L;;;;;N;;;2CE2;;2CE2 <=
}
else if (c2 = #$B2) then
begin
if ord(c3) mod 2 = 0 then new_c3 := chr(ord(c3) + 1);
end
else if (c2 = #$B3) and (c3 in [#$80..#$A3]) then
begin
if ord(c3) mod 2 = 0 then new_c3 := chr(ord(c3) + 1);
end;
if (CounterDiff <> 0) then
begin
OutStr^ := new_c1;
OutStr[1] := new_c2;
OutStr[2] := new_c3;
end
else
begin
if c1 <> new_c1 then OutStr^ := new_c1;
if c2 <> new_c2 then OutStr[1] := new_c2;
if c3 <> new_c3 then OutStr[2] := new_c3;
end;
inc(InStr, 3);
inc(OutStr, 3);
end;
{
FF21;FULLWIDTH LATIN CAPITAL LETTER A;Lu;0;L;<wide> 0041;;;;N;;;;FF41; EF BC A1 => EF BD 81
...
FF3A;FULLWIDTH LATIN CAPITAL LETTER Z;Lu;0;L;<wide> 005A;;;;N;;;;FF5A; EF BC BA => EF BD 9A
}
#$EF:
begin
c2 := InStr[1];
c3 := InStr[2];
if (c2 = #$BC) and (c3 in [#$A1..#$BA]) then
begin
OutStr^ := c1;
OutStr[1] := #$BD;
OutStr[2] := chr(ord(c3) - $20);
end;
if (CounterDiff <> 0) then
begin
OutStr^ := c1;
OutStr[1] := c2;
OutStr[2] := c3;
end;
inc(InStr, 3);
inc(OutStr, 3);
end;
else
// Copy the character if the string was disaligned by previous changes
if (CounterDiff <> 0) then OutStr^:= c1;
inc(InStr);
inc(OutStr);
end; // Case InStr^
end; // while
// Final correction of the buffer size
SetLength(Result,OutStr - PChar(Result));
end;
function UTF8UpperCase(const AInStr: string; ALanguage: string=''): string;
var
i, InCounter, OutCounter: PtrInt;
OutStr: PChar;
CharLen: integer;
CharProcessed: Boolean;
NewCharLen: integer;
NewChar, OldChar: Word;
// Language identification
IsTurkish: Boolean;
procedure CorrectOutStrSize(AOldCharSize, ANewCharSize: Integer);
begin
if not (ANewCharSize > AOldCharSize) then Exit; // no correction needed
if (ANewCharSize > 20) or (AOldCharSize > 20) then Exit; // sanity check
// Fix for bug 23428
// If the string wasn't decreased by previous char changes,
// and our current operation will make it bigger, then for safety
// increase the buffer
if (ANewCharSize > AOldCharSize) and (OutCounter >= InCounter-1) then
begin
SetLength(Result, Length(Result)+ANewCharSize-AOldCharSize);
OutStr := PChar(Result);
end;
end;
begin
// Start with the same string, and progressively modify
Result:=AInStr;
UniqueString(Result);
OutStr := PChar(Result);
// Language identification
IsTurkish := (ALanguage = 'tr') or (ALanguage = 'az'); // Turkish and Azeri have a special handling
InCounter:=1; // for AInStr
OutCounter := 0; // for Result
while InCounter<=length(AInStr) do
begin
{ First ASCII chars }
if (AInStr[InCounter] <= 'z') and (AInStr[InCounter] >= 'a') then
begin
// Special turkish handling
// small dotted i to capital dotted i
if IsTurkish and (AInStr[InCounter] = 'i') then
begin
SetLength(Result,Length(Result)+1);// Increase the buffer
OutStr := PChar(Result);
OutStr[OutCounter]:=#$C4;
OutStr[OutCounter+1]:=#$B0;
inc(InCounter);
inc(OutCounter,2);
end
else
begin
OutStr[OutCounter]:=chr(ord(AInStr[InCounter])-32);
inc(InCounter);
inc(OutCounter);
end;
end
{ Now everything else }
else
begin
CharLen := UTF8CharacterLength(@AInStr[InCounter]);
CharProcessed := False;
NewCharLen := CharLen;
if CharLen = 2 then
begin
OldChar := (Ord(AInStr[InCounter]) shl 8) or Ord(AInStr[InCounter+1]);
NewChar := 0;
// Major processing
case OldChar of
// Latin Characters 0000–0FFF http://en.wikibooks.org/wiki/Unicode/Character_reference/0000-0FFF
$C39F: NewChar := $5353; // ß => SS
$C3A0..$C3B6,$C3B8..$C3BE: NewChar := OldChar - $20;
$C3BF: NewChar := $C5B8; // ÿ
$C481..$C4B0: if OldChar mod 2 = 1 then NewChar := OldChar - 1;
// 0130 = C4 B0
// turkish small undotted i to capital undotted i
$C4B1:
begin
OutStr[OutCounter]:='I';
NewCharLen := 1;
CharProcessed := True;
end;
$C4B2..$C4B7: if OldChar mod 2 = 1 then NewChar := OldChar - 1;
// $C4B8: ĸ without upper/lower
$C4B9..$C4BF: if OldChar mod 2 = 0 then NewChar := OldChar - 1;
$C580: NewChar := $C4BF; // border between bytes
$C581..$C588: if OldChar mod 2 = 0 then NewChar := OldChar - 1;
// $C589 ʼn => ?
$C58A..$C5B7: if OldChar mod 2 = 1 then NewChar := OldChar - 1;
// $C5B8: // Ÿ already uppercase
$C5B9..$C5BE: if OldChar mod 2 = 0 then NewChar := OldChar - 1;
$C5BF: // 017F
begin
OutStr[OutCounter]:='S';
NewCharLen := 1;
CharProcessed := True;
end;
// 0180 = C6 80 -> A convoluted part
$C680: NewChar := $C983;
$C682..$C685: if OldChar mod 2 = 1 then NewChar := OldChar - 1;
$C688: NewChar := $C687;
$C68C: NewChar := $C68B;
// 0190 = C6 90 -> A convoluted part
$C692: NewChar := $C691;
$C695: NewChar := $C7B6;
$C699: NewChar := $C698;
$C69A: NewChar := $C8BD;
$C69E: NewChar := $C8A0;
// 01A0 = C6 A0 -> A convoluted part
$C6A0..$C6A5: if OldChar mod 2 = 1 then NewChar := OldChar - 1;
$C6A8: NewChar := $C6A7;
$C6AD: NewChar := $C6AC;
// 01B0 = C6 B0
$C6B0: NewChar := $C6AF;
$C6B3..$C6B6: if OldChar mod 2 = 0 then NewChar := OldChar - 1;
$C6B9: NewChar := $C6B8;
$C6BD: NewChar := $C6BC;
$C6BF: NewChar := $C7B7;
// 01C0 = C7 80
$C784..$C786: NewChar := $C784;
$C787..$C789: NewChar := $C787;
$C78A..$C78C: NewChar := $C78A;
$C78E: NewChar := $C78D;
// 01D0 = C7 90
$C790: NewChar := $C78F;
$C791..$C79C: if OldChar mod 2 = 0 then NewChar := OldChar - 1;
$C79D: NewChar := $C68E;
$C79F: NewChar := $C79E;
// 01E0 = C7 A0
$C7A0..$C7AF: if OldChar mod 2 = 1 then NewChar := OldChar - 1;
// 01F0 = C7 B0
$C7B2..$C7B3: NewChar := $C7B1;
$C7B5: NewChar := $C7B4;
$C7B8..$C7BF: if OldChar mod 2 = 1 then NewChar := OldChar - 1;
// 0200 = C8 80
// 0210 = C8 90
$C880..$C89F: if OldChar mod 2 = 1 then NewChar := OldChar - 1;
// 0220 = C8 A0
// 0230 = C8 B0
$C8A2..$C8B3: if OldChar mod 2 = 1 then NewChar := OldChar - 1;
$C8BC: NewChar := $C8BB;
$C8BF:
begin
CorrectOutStrSize(2, 3);
OutStr[OutCounter] := #$E2;
OutStr[OutCounter+1]:= #$B1;
OutStr[OutCounter+2]:= #$BE;
NewCharLen := 3;
CharProcessed := True;
end;
// 0240 = C9 80
$C980:
begin
CorrectOutStrSize(2, 3);
OutStr[OutCounter] := #$E2;
OutStr[OutCounter+1]:= #$B1;
OutStr[OutCounter+2]:= #$BF;
NewCharLen := 3;
CharProcessed := True;
end;
$C982: NewChar := $C981;
$C986..$C98F: if OldChar mod 2 = 1 then NewChar := OldChar - 1;
// 0250 = C9 90
$C990:
begin
CorrectOutStrSize(2, 3);
OutStr[OutCounter] := #$E2;
OutStr[OutCounter+1]:= #$B1;
OutStr[OutCounter+2]:= #$AF;
NewCharLen := 3;
CharProcessed := True;
end;
$C991:
begin
CorrectOutStrSize(2, 3);
OutStr[OutCounter] := #$E2;
OutStr[OutCounter+1]:= #$B1;
OutStr[OutCounter+2]:= #$AD;
NewCharLen := 3;
CharProcessed := True;
end;
$C992:
begin
CorrectOutStrSize(2, 3);
OutStr[OutCounter] := #$E2;
OutStr[OutCounter+1]:= #$B1;
OutStr[OutCounter+2]:= #$B0;
NewCharLen := 3;
CharProcessed := True;
end;
$C993: NewChar := $C681;
$C994: NewChar := $C686;
$C996: NewChar := $C689;
$C997: NewChar := $C68A;
$C999: NewChar := $C68F;
$C99B: NewChar := $C690;
// 0260 = C9 A0
$C9A0: NewChar := $C693;
$C9A3: NewChar := $C694;
$C9A5:
begin
CorrectOutStrSize(2, 3);
OutStr[OutCounter] := #$EA;
OutStr[OutCounter+1]:= #$9E;
OutStr[OutCounter+2]:= #$8D;
NewCharLen := 3;
CharProcessed := True;
end;
$C9A8: NewChar := $C697;
$C9A9: NewChar := $C696;
$C9AB:
begin
CorrectOutStrSize(2, 3);
OutStr[OutCounter] := #$E2;
OutStr[OutCounter+1]:= #$B1;
OutStr[OutCounter+2]:= #$A2;
NewCharLen := 3;
CharProcessed := True;
end;
$C9AF: NewChar := $C69C;
// 0270 = C9 B0
$C9B1:
begin
CorrectOutStrSize(2, 3);
OutStr[OutCounter] := #$E2;
OutStr[OutCounter+1]:= #$B1;
OutStr[OutCounter+2]:= #$AE;
NewCharLen := 3;
CharProcessed := True;
end;
$C9B2: NewChar := $C69D;
$C9B5: NewChar := $C69F;
$C9BD:
begin
CorrectOutStrSize(2, 3);
OutStr[OutCounter] := #$E2;
OutStr[OutCounter+1]:= #$B1;
OutStr[OutCounter+2]:= #$A4;
NewCharLen := 3;
CharProcessed := True;
end;
// 0280 = CA 80
$CA80: NewChar := $C6A6;
$CA83: NewChar := $C6A9;
$CA88: NewChar := $C6AE;
$CA89: NewChar := $C984;
$CA8A: NewChar := $C6B1;
$CA8B: NewChar := $C6B2;
$CA8C: NewChar := $C985;
// 0290 = CA 90
$CA92: NewChar := $C6B7;
{
03A0 = CE A0
03AC;GREEK SMALL LETTER ALPHA WITH TONOS;Ll;0;L;03B1 0301;;;;N;GREEK SMALL LETTER ALPHA TONOS;;0386;;0386
03AD;GREEK SMALL LETTER EPSILON WITH TONOS;Ll;0;L;03B5 0301;;;;N;GREEK SMALL LETTER EPSILON TONOS;;0388;;0388
03AE;GREEK SMALL LETTER ETA WITH TONOS;Ll;0;L;03B7 0301;;;;N;GREEK SMALL LETTER ETA TONOS;;0389;;0389
03AF;GREEK SMALL LETTER IOTA WITH TONOS;Ll;0;L;03B9 0301;;;;N;GREEK SMALL LETTER IOTA TONOS;;038A;;038A
}
$CEAC: NewChar := $CE86;
$CEAD: NewChar := $CE88;
$CEAE: NewChar := $CE89;
$CEAF: NewChar := $CE8A;
{
03B0 = CE B0
03B0;GREEK SMALL LETTER UPSILON WITH DIALYTIKA AND TONOS;Ll;0;L;03CB 0301;;;;N;GREEK SMALL LETTER UPSILON DIAERESIS TONOS;;;;
03B1;GREEK SMALL LETTER ALPHA;Ll;0;L;;;;;N;;;0391;;0391
...
03BF;GREEK SMALL LETTER OMICRON;Ll;0;L;;;;;N;;;039F;;039F
}
$CEB1..$CEBF: NewChar := OldChar - $20; // Greek Characters
{
03C0 = CF 80
03C0;GREEK SMALL LETTER PI;Ll;0;L;;;;;N;;;03A0;;03A0 CF 80 => CE A0
03C1;GREEK SMALL LETTER RHO;Ll;0;L;;;;;N;;;03A1;;03A1
03C2;GREEK SMALL LETTER FINAL SIGMA;Ll;0;L;;;;;N;;;03A3;;03A3
03C3;GREEK SMALL LETTER SIGMA;Ll;0;L;;;;;N;;;03A3;;03A3
03C4;GREEK SMALL LETTER TAU;Ll;0;L;;;;;N;;;03A4;;03A4
....
03CB;GREEK SMALL LETTER UPSILON WITH DIALYTIKA;Ll;0;L;03C5 0308;;;;N;GREEK SMALL LETTER UPSILON DIAERESIS;;03AB;;03AB
03CC;GREEK SMALL LETTER OMICRON WITH TONOS;Ll;0;L;03BF 0301;;;;N;GREEK SMALL LETTER OMICRON TONOS;;038C;;038C
03CD;GREEK SMALL LETTER UPSILON WITH TONOS;Ll;0;L;03C5 0301;;;;N;GREEK SMALL LETTER UPSILON TONOS;;038E;;038E
03CE;GREEK SMALL LETTER OMEGA WITH TONOS;Ll;0;L;03C9 0301;;;;N;GREEK SMALL LETTER OMEGA TONOS;;038F;;038F
03CF;GREEK CAPITAL KAI SYMBOL;Lu;0;L;;;;;N;;;;03D7;
}
$CF80,$CF81,$CF83..$CF8B: NewChar := OldChar - $E0; // Greek Characters
$CF82: NewChar := $CEA3;
$CF8C: NewChar := $CE8C;
$CF8D: NewChar := $CE8E;
$CF8E: NewChar := $CE8F;
{
03D0 = CF 90
03D0;GREEK BETA SYMBOL;Ll;0;L;<compat> 03B2;;;;N;GREEK SMALL LETTER CURLED BETA;;0392;;0392 CF 90 => CE 92
03D1;GREEK THETA SYMBOL;Ll;0;L;<compat> 03B8;;;;N;GREEK SMALL LETTER SCRIPT THETA;;0398;;0398 => CE 98
03D5;GREEK PHI SYMBOL;Ll;0;L;<compat> 03C6;;;;N;GREEK SMALL LETTER SCRIPT PHI;;03A6;;03A6 => CE A6
03D6;GREEK PI SYMBOL;Ll;0;L;<compat> 03C0;;;;N;GREEK SMALL LETTER OMEGA PI;;03A0;;03A0 => CE A0
03D7;GREEK KAI SYMBOL;Ll;0;L;;;;;N;;;03CF;;03CF => CF 8F
03D9;GREEK SMALL LETTER ARCHAIC KOPPA;Ll;0;L;;;;;N;;;03D8;;03D8
03DB;GREEK SMALL LETTER STIGMA;Ll;0;L;;;;;N;;;03DA;;03DA
03DD;GREEK SMALL LETTER DIGAMMA;Ll;0;L;;;;;N;;;03DC;;03DC
03DF;GREEK SMALL LETTER KOPPA;Ll;0;L;;;;;N;;;03DE;;03DE
}
$CF90: NewChar := $CE92;
$CF91: NewChar := $CE98;
$CF95: NewChar := $CEA6;
$CF96: NewChar := $CEA0;
$CF97: NewChar := $CF8F;
$CF99..$CF9F: if OldChar mod 2 = 1 then NewChar := OldChar - 1;
// 03E0 = CF A0
$CFA0..$CFAF: if OldChar mod 2 = 1 then NewChar := OldChar - 1;
{
03F0 = CF B0
03F0;GREEK KAPPA SYMBOL;Ll;0;L;<compat> 03BA;;;;N;GREEK SMALL LETTER SCRIPT KAPPA;;039A;;039A => CE 9A
03F1;GREEK RHO SYMBOL;Ll;0;L;<compat> 03C1;;;;N;GREEK SMALL LETTER TAILED RHO;;03A1;;03A1 => CE A1
03F2;GREEK LUNATE SIGMA SYMBOL;Ll;0;L;<compat> 03C2;;;;N;GREEK SMALL LETTER LUNATE SIGMA;;03F9;;03F9
03F5;GREEK LUNATE EPSILON SYMBOL;Ll;0;L;<compat> 03B5;;;;N;;;0395;;0395 => CE 95
03F8;GREEK SMALL LETTER SHO;Ll;0;L;;;;;N;;;03F7;;03F7
03FB;GREEK SMALL LETTER SAN;Ll;0;L;;;;;N;;;03FA;;03FA
}
$CFB0: NewChar := $CE9A;
$CFB1: NewChar := $CEA1;
$CFB2: NewChar := $CFB9;
$CFB5: NewChar := $CE95;
$CFB8: NewChar := $CFB7;
$CFBB: NewChar := $CFBA;
// 0400 = D0 80 ... 042F everything already uppercase
// 0430 = D0 B0
$D0B0..$D0BF: NewChar := OldChar - $20; // Cyrillic alphabet
// 0440 = D1 80
$D180..$D18F: NewChar := OldChar - $E0; // Cyrillic alphabet
// 0450 = D1 90
$D190..$D19F: NewChar := OldChar - $110; // Cyrillic alphabet
end;
if NewChar <> 0 then
begin
OutStr[OutCounter] := Chr(Hi(NewChar));
OutStr[OutCounter+1]:= Chr(Lo(NewChar));
CharProcessed := True;
end;
end;
// Copy the character if the string was disaligned by previous changed
// and no processing was done in this character
if (InCounter <> OutCounter+1) and (not CharProcessed) then
begin
for i := 0 to CharLen-1 do
OutStr[OutCounter+i] :=AInStr[InCounter+i];
end;
inc(InCounter, CharLen);
inc(OutCounter, NewCharLen);
end;
end; // while
// Final correction of the buffer size
SetLength(Result,OutCounter);
end;
procedure ForcePathDelims(var FileName: string);
var
i: Integer;
begin
for i:=1 to Length(FileName) do
{$IFDEF Windows}
if Filename[i]='/' then
Filename[i]:='\';
{$ELSE}
if Filename[i]='\' then
Filename[i]:='/';
{$ENDIF}
end;
{$ENDIF}
{$IFDEF FPS_NO_STRING_SPLIT}
function SplitString(const AString: String; ASeparator: char): TStringArray;
var
L: TStrings;
i: Integer;
begin
L := TStringList.Create;
try
L.Delimiter := ASeparator;
L.StrictDelimiter := true;
L.DelimitedText := AString;
SetLength(Result, L.Count);
for i := 0 to L.Count-1 do
Result[i] := L[i];
finally
L.Free;
end;
end;
{$ENDIF}
end.
Reference in New Issue View Git Blame Copy Permalink