Browse Source

* Add UnicodeFromLocaleChars for Delphi compatibility

Michaël Van Canneyt 1 year ago
parent
commit
31b978f3b7
2 changed files with 72 additions and 0 deletions
  1. 17 0
      rtl/inc/ustringh.inc
  2. 55 0
      rtl/inc/ustrings.inc

+ 17 - 0
rtl/inc/ustringh.inc

@@ -50,6 +50,14 @@ procedure UnicodeCharLenToStrVar(Src : PUnicodeChar;Len : SizeInt;out Dest : Uni
 procedure UnicodeCharLenToStrVar(Src : PUnicodeChar;Len : SizeInt;out Dest : AnsiString);
 procedure UnicodeCharToStrVar(S : PUnicodeChar;out Dest : AnsiString);
 
+function UnicodeFromLocaleChars(CodePage, Flags: Cardinal; LocaleStr: PAnsiChar;
+  LocaleStrLen: Integer; UnicodeStr: PWideChar; UnicodeStrLen: Integer): Integer; overload;
+
+function UnicodeFromLocaleChars(const LocaleName: AnsiString; Flags: Cardinal;
+  LocaleStr: PAnsiChar; LocaleStrLen: Integer; UnicodeStr: PWideChar;
+  UnicodeStrLen: Integer): Integer; overload;
+
+
 procedure DefaultUnicode2AnsiMove(source:punicodechar;var dest:RawByteString;cp : TSystemCodePage;len:SizeInt);
 procedure DefaultAnsi2UnicodeMove(source:pansichar;cp : TSystemCodePage;var dest:unicodestring;len:SizeInt);
 
@@ -177,3 +185,12 @@ function StringCodePage(const S : UnicodeString): TSystemCodePage; overload;
 Function ToSingleByteFileSystemEncodedFileName(const Str: UnicodeString): RawByteString;
 Function ToSingleByteFileSystemEncodedFileName(const arr: array of widechar): RawByteString;
 Function ToSingleByteFileSystemEncodedFileName(const Str: RawByteString): RawByteString;
+
+Type
+  TLocaleNameToCodePageCallBack = Procedure (const localename : shortstring; out codepage : TSystemCodePage; aHandled : Boolean);
+  
+
+Var
+  LocaleNameToCodePageCallBack : TLocaleNameToCodePageCallBack;
+  
+Function LocaleNameToCodePage(const localename : shortstring; out codepage : TSystemCodePage) : Boolean;

+ 55 - 0
rtl/inc/ustrings.inc

@@ -1047,6 +1047,40 @@ function StringToWideChar(const Src : RawByteString;Dest : PWideChar;DestSize :
   end;
 {$endif FPC_HAS_STRING_LEN_TO_WIDECHAR}
 
+function UnicodeFromLocaleChars(CodePage, Flags: Cardinal; LocaleStr: PAnsiChar;
+  LocaleStrLen: Integer; UnicodeStr: PWideChar; UnicodeStrLen: Integer): Integer; overload;
+
+var
+  temp: widestring;
+  Len: SizeInt;
+begin
+  widestringmanager.Ansi2WideMoveProc(LocaleStr,CodePage,temp,LocaleStrLen);
+  Len:=Length(temp);
+  // Only move when we have room.
+  if (UnicodeStrLen>0) then
+    begin  
+    if UnicodeStrLen<=Len then
+      Len:=UnicodeStrLen-1;
+    move(temp[1],UnicodeStr^,Len*SizeOf(WideChar));
+    UnicodeStr[Len]:=#0;
+    end;
+  // Return length  
+  result:=len;
+end;
+
+function UnicodeFromLocaleChars(const LocaleName: AnsiString; Flags: Cardinal;
+  LocaleStr: PAnsiChar; LocaleStrLen: Integer; UnicodeStr: PWideChar;
+  UnicodeStrLen: Integer): Integer; overload;
+
+var
+  CP : TSystemCodePage;
+
+begin
+  if not LocaleNameToCodePage(LocaleName,CP) then
+    Result:=0
+  else
+    Result:=UnicodeFromLocaleChars(CP,Flags,LocaleStr,LocaleStrLen,UnicodeStr,UnicodeStrLen);
+end;
 
 {$ifndef FPC_HAS_UNICODECHAR_LEN_TO_STRING}
 {$define FPC_HAS_UNICODECHAR_LEN_TO_STRING}
@@ -2416,3 +2450,24 @@ begin
   Result := UTF8ToString(rs);
 end;
 {$endif not CPUJVM}
+
+
+Function LocaleNameToCodePage(const localename : shortstring; out codepage : TSystemCodePage) : Boolean;
+
+begin
+  Result:=(localename='UTF-8') or (localename='UTF8');
+  if Result then
+    CodePage:=CP_UTF8
+  else 
+    begin
+    Result:=(localename='UTF-7') or (localename='UTF7');
+    if Result then  
+      CodePage:=CP_UTF7
+    else 
+      begin
+      Result:=Assigned(LocaleNameToCodePageCallBack);
+      If Result then
+        LocaleNameToCodePageCallBack(LocaleName,CodePage,Result);
+      end;
+    end;  
+end;