[fpc-devel] patch: Wide2AnsiMoveProc and Ansi2WideMoveProc

[Vincent Snijders]

Hi,

Attached patch implements the Wide2AnsiMoveProc and Ansi2WideMoveProc 
for win32.

Vincent.
Index: rtl/win32/system.pp
===================================================================
--- rtl/win32/system.pp (revision 794)
+++ rtl/win32/system.pp (working copy)
@@ -927,10 +927,42 @@
                       OS dependend widestrings
 ****************************************************************************}
 
-function CharUpperBuff(lpsz:LPWSTR; cchLength:DWORD):DWORD; stdcall; external 
'user32' name 'CharUpperBuffW';
-function CharLowerBuff(lpsz:LPWSTR; cchLength:DWORD):DWORD; stdcall; external 
'user32' name 'CharLowerBuffW';
+const
+  { MultiByteToWideChar  }
+     MB_PRECOMPOSED = 1;
+     CP_ACP = 0;
 
+function MultiByteToWideChar(CodePage:UINT; dwFlags:DWORD; 
lpMultiByteStr:PChar; cchMultiByte:longint; 
lpWideCharStr:PWideChar;cchWideChar:longint):longint;
+    stdcall; external 'kernel32' name 'MultiByteToWideChar';
+function WideCharToMultiByte(CodePage:UINT; dwFlags:DWORD; 
lpWideCharStr:PWideChar; cchWideChar:longint; 
lpMultiByteStr:PChar;cchMultiByte:longint; lpDefaultChar:PChar; 
lpUsedDefaultChar:pointer):longint;
+    stdcall; external 'kernel32' name 'WideCharToMultiByte';
+function CharUpperBuff(lpsz:LPWSTR; cchLength:DWORD):DWORD;
+    stdcall; external 'user32' name 'CharUpperBuffW';
+function CharLowerBuff(lpsz:LPWSTR; cchLength:DWORD):DWORD;
+    stdcall; external 'user32' name 'CharLowerBuffW';
 
+
+procedure Win32Wide2AnsiMove(source:pwidechar;var dest:ansistring;len:SizeInt);
+  var
+    destlen: SizeInt;
+  begin
+    // retrieve length including trailing #0
+    destlen:=WideCharToMultiByte(CP_ACP, 0, source, len+1, nil, 0, nil, nil);
+    setlength(dest, destlen-1);
+    WideCharToMultiByte(CP_ACP, 0, source, len+1, @dest[1], destlen, nil, nil);
+  end;
+  
+procedure Win32Ansi2WideMove(source:pchar;var dest:widestring;len:SizeInt);
+  var
+    destlen: SizeInt;
+  begin
+    // retrieve length including trailing #0
+    destlen:=MultiByteToWideChar(CP_ACP, MB_PRECOMPOSED, source, len+1, nil, 
0);
+    setlength(dest, destlen-1);
+    MultiByteToWideChar(CP_ACP, MB_PRECOMPOSED, source, len+1, @dest[1], 
destlen);
+  end;
+  
+  
 function Win32WideUpper(const s : WideString) : WideString;
   begin
     result:=s;
@@ -953,6 +985,8 @@
   are only relevant for the sysutils units }
 procedure InitWin32Widestrings;
   begin
+    widestringmanager.Wide2AnsiMoveProc:[EMAIL PROTECTED];
+    widestringmanager.Ansi2WideMoveProc:[EMAIL PROTECTED];
     widestringmanager.UpperWideStringProc:[EMAIL PROTECTED];
     widestringmanager.LowerWideStringProc:[EMAIL PROTECTED];
   end;
_______________________________________________
fpc-devel maillist  -  fpc-devel@lists.freepascal.org
http://lists.freepascal.org/mailman/listinfo/fpc-devel