mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-21 13:09:32 +02:00
+ Further fixes from GertJan Schouten
This commit is contained in:
michael
parent
c72691c843
commit
f296cf3117
@ -174,11 +174,21 @@ var
|
||||
LowerCaseTable: TCaseTranslationTable;
|
||||
|
||||
function AnsiUpperCase(const s: string): string;
|
||||
var len, i: integer;
|
||||
begin
|
||||
len := length(s);
|
||||
SetLength(result, len);
|
||||
for i := 1 to len do
|
||||
result[i] := UpperCaseTable[ord(s[i])];
|
||||
end ;
|
||||
|
||||
function AnsiLowerCase(const s: string): string;
|
||||
var len, i: integer;
|
||||
begin
|
||||
len := length(s);
|
||||
SetLength(result, len);
|
||||
for i := 1 to len do
|
||||
result[i] := LowerCaseTable[ord(s[i])];
|
||||
end ;
|
||||
|
||||
function AnsiCompareStr(const S1, S2: string): integer;
|
||||
@ -207,10 +217,24 @@ end ;
|
||||
|
||||
function AnsiStrLower(Str: PChar): PChar;
|
||||
begin
|
||||
if Str <> Nil then begin
|
||||
while Str^ <> #0 do begin
|
||||
Str^ := LowerCaseTable[byte(Str^)];
|
||||
Str := Str + 1;
|
||||
end ;
|
||||
end ;
|
||||
result := Str;
|
||||
end ;
|
||||
|
||||
function AnsiStrUpper(Str: PChar): PChar;
|
||||
begin
|
||||
if Str <> Nil then begin
|
||||
while Str^ <> #0 do begin
|
||||
Str^ := UpperCaseTable[byte(Str^)];
|
||||
Str := Str + 1;
|
||||
end ;
|
||||
end ;
|
||||
result := Str;
|
||||
end ;
|
||||
|
||||
function AnsiLastChar(const S: string): PChar;
|
||||
@ -454,6 +478,60 @@ for i := 0 to SizeOf(Value) shr 1 - 1 do begin
|
||||
end ;
|
||||
end ;
|
||||
|
||||
{ Case Translation Tables }
|
||||
|
||||
{ Although these tables can be obtained through system calls }
|
||||
{ it is better to not use those, since most implementation are not 100% }
|
||||
|
||||
{ WARNING: }
|
||||
{ before modifying a translation table make sure that the current codepage }
|
||||
{ of the OS corresponds to the one you make changes to }
|
||||
|
||||
const
|
||||
{ upper case translation table for character set 850 }
|
||||
CP850UCT: array[128..255] of char =
|
||||
('€', 'š', '<27>', '¶', 'Ž', '¶', '<27>', '€', 'Ò', 'Ó', 'Ô', 'Ø', '×', 'Þ', 'Ž', '<27>',
|
||||
'<27>', '’', '’', 'â', '™', 'ã', 'ê', 'ë', 'Y', '™', 'š', '<27>', 'œ', '<27>', 'ž', 'Ÿ',
|
||||
'µ', 'Ö', 'à', 'é', '¥', '¥', '¦', '§', '¨', '©', 'ª', '«', '¬', '', '®', '¯',
|
||||
'°', '±', '²', '³', '´', 'µ', '¶', '·', '¸', '¹', 'º', '»', '¼', '½', '¾', '¿',
|
||||
'À', 'Á', 'Â', 'Ã', 'Ä', 'Å', 'Ç', 'Ç', 'È', 'É', 'Ê', 'Ë', 'Ì', 'Í', 'Î', 'Ï',
|
||||
'Ð', 'Ñ', 'Ò', 'Ó', 'Ô', 'Õ', 'Ö', '×', 'Ø', 'Ù', 'Ú', 'Û', 'Ü', 'Ý', 'Þ', 'ß',
|
||||
'à', 'á', 'â', 'ã', 'å', 'å', 'æ', 'í', 'è', 'é', 'ê', 'ë', 'í', 'í', 'î', 'ï',
|
||||
'ð', 'ñ', 'ò', 'ó', 'ô', 'õ', 'ö', '÷', 'ø', 'ù', 'ú', 'û', 'ü', 'ý', 'þ', 'ÿ');
|
||||
|
||||
{ lower case translation table for character set 850 }
|
||||
CP850LCT: array[128..255] of char =
|
||||
('‡', '<27>', '‚', 'ƒ', '„', '…', '†', '‡', 'ˆ', '‰', 'Š', '‹', 'Œ', '<27>', '„', '†',
|
||||
'‚', '‘', '‘', '“', '”', '•', '–', '—', '˜', '”', '<27>', '›', 'œ', '›', 'ž', 'Ÿ',
|
||||
' ', '¡', '¢', '£', '¤', '¤', '¦', '§', '¨', '©', 'ª', '«', '¬', '', '®', '¯',
|
||||
'°', '±', '²', '³', '´', ' ', 'ƒ', '…', '¸', '¹', 'º', '»', '¼', '½', '¾', '¿',
|
||||
'À', 'Á', 'Â', 'Ã', 'Ä', 'Å', 'Æ', 'Æ', 'È', 'É', 'Ê', 'Ë', 'Ì', 'Í', 'Î', 'Ï',
|
||||
'Ð', 'Ñ', 'ˆ', '‰', 'Š', 'Õ', '¡', 'Œ', '‹', 'Ù', 'Ú', 'Û', 'Ü', 'Ý', '<27>', 'ß',
|
||||
'¢', 'á', '“', '•', 'ä', 'ä', 'æ', 'í', 'è', '£', '–', '—', 'ì', 'ì', 'î', 'ï',
|
||||
'ð', 'ñ', 'ò', 'ó', 'ô', 'õ', 'ö', '÷', 'ø', 'ù', 'ú', 'û', 'ü', 'ý', 'þ', 'ÿ');
|
||||
|
||||
{ upper case translation table for character set ISO 8859/1 Latin 1 }
|
||||
CPISO88591UCT: array[192..255] of char =
|
||||
( #192, #193, #194, #195, #196, #197, #198, #199,
|
||||
#200, #201, #202, #203, #204, #205, #206, #207,
|
||||
#208, #209, #210, #211, #212, #213, #214, #215,
|
||||
#216, #217, #218, #219, #220, #221, #222, #223,
|
||||
#192, #193, #194, #195, #196, #197, #198, #199,
|
||||
#200, #201, #202, #203, #204, #205, #206, #207,
|
||||
#208, #209, #210, #211, #212, #213, #214, #247,
|
||||
#216, #217, #218, #219, #220, #221, #222, #89 );
|
||||
|
||||
{ lower case translation table for character set ISO 8859/1 Latin 1 }
|
||||
CPISO88591LCT: array[192..255] of char =
|
||||
( #224, #225, #226, #227, #228, #229, #230, #231,
|
||||
#232, #233, #234, #235, #236, #237, #238, #239,
|
||||
#240, #241, #242, #243, #244, #245, #246, #215,
|
||||
#248, #249, #250, #251, #252, #253, #254, #223,
|
||||
#224, #225, #226, #227, #228, #229, #230, #231,
|
||||
#232, #233, #234, #235, #236, #237, #238, #239,
|
||||
#240, #241, #242, #243, #244, #245, #246, #247,
|
||||
#248, #249, #250, #251, #252, #253, #254, #255 );
|
||||
|
||||
{$IFDEF GO32V2}
|
||||
|
||||
{ Codepage constants }
|
||||
@ -499,35 +577,73 @@ Regs.ES := transfer_buffer div 16;
|
||||
Regs.DI := transfer_buffer and 15;
|
||||
Regs.CX := SizeOf(TCountryInfo);
|
||||
RealIntr($21, Regs);
|
||||
DosMemGet(transfer_buffer div 16, transfer_buffer and 15, CountryInfo, Regs.CX );
|
||||
DosMemGet(transfer_buffer shr 16, transfer_buffer and 65535, CountryInfo, Regs.CX );
|
||||
end ;
|
||||
|
||||
procedure InitAnsi;
|
||||
var CountryInfo: TCountryInfo;
|
||||
var CountryInfo: TCountryInfo; i: integer;
|
||||
begin
|
||||
GetExtendedCountryInfo(2, $FFFF, $FFFF, CountryInfo);
|
||||
{ Fill table entries 0 to 127 }
|
||||
for i := 0 to 96 do
|
||||
UpperCaseTable[i] := chr(i);
|
||||
for i := 97 to 122 do
|
||||
UpperCaseTable[i] := chr(i - 32);
|
||||
for i := 123 to 127 do
|
||||
UpperCaseTable[i] := chr(i);
|
||||
for i := 0 to 64 do
|
||||
LowerCaseTable[i] := chr(i);
|
||||
for i := 65 to 90 do
|
||||
LowerCaseTable[i] := chr(i + 32);
|
||||
for i := 91 to 255 do
|
||||
LowerCaseTable[i] := chr(i);
|
||||
{ Get country and codepage info }
|
||||
GetExtendedCountryInfo(1, $FFFF, $FFFF, CountryInfo);
|
||||
if CountryInfo.CodePage = 850 then begin
|
||||
Move(CP850UCT, UpperCaseTable[128], 128);
|
||||
Move(CP850LCT, LowerCaseTable[128], 128);
|
||||
end
|
||||
else begin
|
||||
{ this needs to be checked !!
|
||||
this is correct only if UpperCaseTable is
|
||||
and Offset:Segment word record (PM) }
|
||||
DosMemGet(CountryInfo.UpperCaseTable shl 16, 2 + (CountryInfo.UpperCaseTable and $FFFF), UpperCaseTable[128], 128);
|
||||
{ get the uppercase table from dosmemory }
|
||||
GetExtendedCountryInfo(2, $FFFF, $FFFF, CountryInfo);
|
||||
DosMemGet(CountryInfo.UpperCaseTable shr 16, 2 + CountryInfo.UpperCaseTable and 65535, UpperCaseTable[128], 128);
|
||||
for i := 128 to 255 do begin
|
||||
if UpperCaseTable[i] <> chr(i) then
|
||||
LowerCaseTable[ord(UpperCaseTable[i])] := chr(i);
|
||||
end ;
|
||||
end ;
|
||||
end ;
|
||||
|
||||
{$ELSE}
|
||||
// {$IFDEF LINUX}
|
||||
|
||||
procedure InitAnsi;
|
||||
begin
|
||||
end ;
|
||||
|
||||
// {$ENDIF}
|
||||
{$ENDIF}
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.3 1998-09-16 14:34:37 pierre
|
||||
Revision 1.4 1998-09-17 12:39:52 michael
|
||||
+ Further fixes from GertJan Schouten
|
||||
|
||||
Revision 1.3 1998/09/16 14:34:37 pierre
|
||||
* go32v2 did not compile
|
||||
* wrong code in systr.inc corrected
|
||||
|
||||
Revision 1.2 1998/09/16 08:28:42 michael
|
||||
Update from gertjan Schouten, plus small fix for linux
|
||||
|
||||
$Log$
|
||||
Revision 1.4 1998-09-17 12:39:52 michael
|
||||
+ Further fixes from GertJan Schouten
|
||||
|
||||
Revision 1.1 1998/04/10 15:17:46 michael
|
||||
+ Initial implementation; Donated by Gertjan Schouten
|
||||
His file was split into several files, to keep it a little bit structured.
|
||||
|
||||
27 April 1998:
|
||||
Function: BCDToInt added
|
||||
}
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user