paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-13 09:59:25 +02:00
Code Issues Packages Projects Releases Wiki Activity

+ WC_NO_BEST_FIT_CHARS

Browse Source 
* use WC_NO_BEST_FIT_CHARS when calling WideCharToMultiByte
* made tiwde6 more verbose

git-svn-id: trunk@9481 -
This commit is contained in:
florian 2007-12-16 13:45:09 +00:00
parent 3a60391838
commit 86e3e79e67
7 changed files with 50 additions and 34 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
rtl/inc/wstringh.inc
View File

@ -41,6 +41,8 @@ procedure DefaultWide2AnsiMove(source:pwidechar;var dest:ansistring;len:SizeInt)
procedure DefaultAnsi2WideMove(source:pchar;var dest:widestring;len:SizeInt);
Type
{ hooks for internationalization
please add new procedures at the end, it makes it easier to detect new procedures }
TWideStringManager = record
Wide2AnsiMoveProc : procedure(source:pwidechar;var dest:ansistring;len:SizeInt);
Ansi2WideMoveProc : procedure(source:pchar;var dest:widestring;len:SizeInt);

2
rtl/win/sysutils.pp
View File

@ -1079,7 +1079,6 @@ end;
Target Dependent WideString stuff
****************************************************************************}
function Win32CompareWideString(const s1, s2 : WideString) : PtrInt;
begin
SetLastError(0);
@ -1182,6 +1181,7 @@ function Win32AnsiStrUpper(Str: PChar): PChar;
are relevant already for the system unit }
procedure InitWin32Widestrings;
begin
//!!! CharLengthPCharProc : function(const Str: PChar): PtrInt;
widestringmanager.CompareWideStringProc:=@Win32CompareWideString;
widestringmanager.CompareTextWideStringProc:=@Win32CompareTextWideString;
widestringmanager.UpperAnsiStringProc:=@Win32AnsiUpperCase;

5
rtl/win/wininc/defines.inc
View File

@ -2809,6 +2809,7 @@
WC_DISCARDNS = 16;
WC_SEPCHARS = 32;
WC_DEFAULTCHAR = 64;
WC_NO_BEST_FIT_CHARS = $400;
{ WinHelp }
HELP_COMMAND = $102;
HELP_CONTENTS = $3;
@ -5274,7 +5275,7 @@
STATUS_SXS_EARLY_DEACTIVATION = $C015000F;
STATUS_SXS_INVALID_DEACTIVATION = $C0150010;
{$define EXCEPTION_CTRL_C}
PROCESSOR_ARCHITECTURE_INTEL = 0;
PROCESSOR_ARCHITECTURE_MIPS = 1;
@ -5398,7 +5399,7 @@
LOGON32_LOGON_NETWORK = $03;
LOGON32_LOGON_BATCH = $04;
LOGON32_LOGON_SERVICE = $05;
LOGON32_LOGON_UNLOCK = $07;
LOGON32_LOGON_UNLOCK = $07;
LOGON32_LOGON_NETWORK_CLEARTEXT=$08; // $0500+
LOGON32_LOGON_NEW_CREDENTIALS =$09; // $0500+
LOGON32_PROVIDER_DEFAULT = $00;

5
rtl/win32/system.pp
View File

@ -930,6 +930,7 @@ const
{ MultiByteToWideChar }
MB_PRECOMPOSED = 1;
CP_ACP = 0;
WC_NO_BEST_FIT_CHARS = $400;
function MultiByteToWideChar(CodePage:UINT; dwFlags:DWORD; lpMultiByteStr:PChar; cchMultiByte:longint; lpWideCharStr:PWideChar;cchWideChar:longint):longint;
stdcall; external 'kernel32' name 'MultiByteToWideChar';
@ -947,10 +948,10 @@ procedure Win32Wide2AnsiMove(source:pwidechar;var dest:ansistring;len:SizeInt);
begin
// retrieve length including trailing #0
// not anymore, because this must also be usable for single characters
destlen:=WideCharToMultiByte(CP_ACP, 0, source, len, nil, 0, nil, nil);
destlen:=WideCharToMultiByte(CP_ACP, WC_NO_BEST_FIT_CHARS, source, len, nil, 0, nil, nil);
// this will null-terminate
setlength(dest, destlen);
WideCharToMultiByte(CP_ACP, 0, source, len, @dest[1], destlen, nil, nil);
WideCharToMultiByte(CP_ACP, WC_NO_BEST_FIT_CHARS, source, len, @dest[1], destlen, nil, nil);
end;
procedure Win32Ansi2WideMove(source:pchar;var dest:widestring;len:SizeInt);

5
rtl/win64/system.pp
View File

@ -952,6 +952,7 @@ const
{ MultiByteToWideChar }
MB_PRECOMPOSED = 1;
CP_ACP = 0;
WC_NO_BEST_FIT_CHARS = $400;
function MultiByteToWideChar(CodePage:UINT; dwFlags:DWORD; lpMultiByteStr:PChar; cchMultiByte:longint; lpWideCharStr:PWideChar;cchWideChar:longint):longint;
stdcall; external 'kernel32' name 'MultiByteToWideChar';
@ -969,10 +970,10 @@ procedure Win32Wide2AnsiMove(source:pwidechar;var dest:ansistring;len:SizeInt);
begin
// retrieve length including trailing #0
// not anymore, because this must also be usable for single characters
destlen:=WideCharToMultiByte(CP_ACP, 0, source, len, nil, 0, nil, nil);
destlen:=WideCharToMultiByte(CP_ACP, WC_NO_BEST_FIT_CHARS, source, len, nil, 0, nil, nil);
// this will null-terminate
setlength(dest, destlen);
WideCharToMultiByte(CP_ACP, 0, source, len, @dest[1], destlen, nil, nil);
WideCharToMultiByte(CP_ACP, WC_NO_BEST_FIT_CHARS, source, len, @dest[1], destlen, nil, nil);
end;
procedure Win32Ansi2WideMove(source:pchar;var dest:widestring;len:SizeInt);

7
rtl/wince/system.pp
View File

@ -175,7 +175,7 @@ function ui64tod(i : qword) : double; compilerproc;
function i64tod(i : int64) : double; compilerproc;
cdecl;external 'coredll' name '__i64tod';
function utos(i : dword) : single; compilerproc;
cdecl;external 'coredll' name '__utos';
@ -310,6 +310,7 @@ const
MB_USEGLYPHCHARS = 4;
CP_ACP = 0;
CP_OEMCP = 1;
WC_NO_BEST_FIT_CHARS = $400;
function MultiByteToWideChar(CodePage:UINT; dwFlags:DWORD; lpMultiByteStr:PChar; cchMultiByte:longint; lpWideCharStr:PWideChar;cchWideChar:longint):longint;
cdecl; external 'coredll' name 'MultiByteToWideChar';
@ -336,7 +337,7 @@ end;
function WideToAnsiBuf(WideBuf: PWideChar; WideCharsLen: longint; AnsiBuf: PChar; AnsiBufLen: longint): longint;
begin
Result := WideCharToMultiByte(CP_ACP, 0, WideBuf, WideCharsLen, AnsiBuf, AnsiBufLen, nil, nil);
Result := WideCharToMultiByte(CP_ACP, WC_NO_BEST_FIT_CHARS, WideBuf, WideCharsLen, AnsiBuf, AnsiBufLen, nil, nil);
if ((WideCharsLen <> -1) or (Result = 0)) and (AnsiBuf <> nil) then
begin
if Result + 1 > AnsiBufLen then
@ -1789,7 +1790,7 @@ begin
end;
initialization
SysResetFPU;
SysResetFPU;
if not(IsLibrary) then
SysInitFPU;
StackLength := CheckInitialStkLen(InitialStkLen);

58
tests/test/twide6.pp
View File

@ -5,6 +5,12 @@ uses
{$endif}
sysutils;
procedure doerror(i : integer);
begin
writeln('Error: ',i);
halt(i);
end;
{ normal upper case testing }
procedure testupper;
@ -21,6 +27,9 @@ begin
writeln('original upper: ',w2);
{$endif print}
s:=w1;
{$ifdef print}
writeln('ansi: ',s);
{$endif print}
w3:=s;
w4:=AnsiUpperCase(s);
{ filter out unsupported characters }
@ -33,12 +42,13 @@ begin
w1:=wideuppercase(w1);
{$ifdef print}
writeln('wideupper: ',w1);
writeln('original upper: ',w2);
writeln('ansiupper: ',w4);
{$endif print}
if (w1 <> w2) then
halt(1);
doerror(1);
if (w4 <> w2) then
halt(2);
doerror(2);
w1:='aéèàł'#$d87e#$dc04;
w2:='AÉÈÀŁ'#$d87e#$dc04;
@ -58,9 +68,9 @@ begin
writeln('ansistrupper: ',w4);
{$endif print}
if (w1 <> w2) then
halt(1);
doerror(21);
if (w4 <> w2) then
halt(2);
doerror(22);
end;
@ -95,9 +105,9 @@ begin
writeln('ansilower: ',w4);
{$endif print}
if (w1 <> w2) then
halt(3);
doerror(3);
if (w4 <> w2) then
halt(4);
doerror(4);
w1:='AÉÈÀŁ'#$d87e#$dc04;
@ -118,9 +128,9 @@ begin
writeln('ansistrlower: ',w4);
{$endif print}
if (w1 <> w2) then
halt(3);
doerror(3);
if (w4 <> w2) then
halt(4);
doerror(4);
end;
@ -156,9 +166,9 @@ begin
writeln('ansiupper: ',w4);
{$endif print}
if (w1 <> w2) then
halt(5);
doerror(5);
if (w4 <> w2) then
halt(6);
doerror(6);
end;
@ -193,9 +203,9 @@ begin
writeln('ansilower: ',w4);
{$endif print}
if (w1 <> w2) then
halt(7);
doerror(7);
if (w4 <> w2) then
halt(8);
doerror(8);
end;
@ -231,9 +241,9 @@ begin
writeln('ansiupper: ',w4);
{$endif print}
if (w1 <> w2) then
halt(9);
doerror(9);
if (w4 <> w2) then
halt(10);
doerror(10);
end;
@ -268,9 +278,9 @@ begin
writeln('ansilower: ',w4);
{$endif print}
if (w1 <> w2) then
halt(11);
doerror(11);
if (w4 <> w2) then
halt(12);
doerror(12);
end;
@ -295,8 +305,8 @@ begin
{ adjust checking values for new length due to corruption }
if length(w3)<>length(w2) then
begin
setlength(w2,length(w3));
setlength(w1,length(w3));
setlength(w2,length(w3));
setlength(w1,length(w3));
end;
w4:=AnsiUpperCase(s);
{ filter out unsupported characters }
@ -312,9 +322,9 @@ begin
writeln('ansiupper: ',w4);
{$endif print}
if (w1 <> w2) then
halt(13);
doerror(13);
if (w4 <> w2) then
halt(14);
doerror(14);
end;
@ -339,8 +349,8 @@ begin
{ adjust checking values for new length due to corruption }
if length(w3)<>length(w2) then
begin
setlength(w2,length(w3));
setlength(w1,length(w3));
setlength(w2,length(w3));
setlength(w1,length(w3));
end;
w4:=AnsiLowerCase(s);
{ filter out unsupported characters }
@ -356,9 +366,9 @@ begin
writeln('ansilower: ',w4);
{$endif print}
if (w1 <> w2) then
halt(15);
doerror(15);
if (w4 <> w2) then
halt(16);
doerror(16);
end;