This patch makes GetText/TranslateResourceStrings(FileName) work in
win32. (it didn't detect the right language under win32 before it worked
only in POSIX enviroments)
GetLanguageIDs is used with permission from Vincent(it's his code in
lazarus)
Ales
Index: fcl/inc/gettext.pp
===================================================================
--- fcl/inc/gettext.pp (revision 285)
+++ fcl/inc/gettext.pp (working copy)
@@ -1,5 +1,4 @@
{
- $Id: gettext.pp,v 1.9 2005/03/15 16:27:04 peter Exp $
This file is part of the Free Pascal run time library.
Copyright (c) 1999-2001 by the Free Pascal development team
@@ -77,7 +76,7 @@
implementation
-uses dos;
+uses {$ifdef win32} windows, {$endif}dos;
var
GettextUsed: Boolean;
@@ -261,10 +260,39 @@
{$endif}
procedure TranslateResourceStrings(const AFilename: String);
+
+{$ifdef win32}
+procedure GetLanguageIDs(var Lang, FallbackLang: string);
var
+ Buffer: array[1..4] of char;
+ Country: string;
+ UserLCID: LCID;
+begin
+ //defaults
+ Lang := '';
+ FallbackLang:='';
+ UserLCID := GetUserDefaultLCID;
+ if GetLocaleInfo(UserLCID, LOCALE_SABBREVLANGNAME, @Buffer, 4)<>0 then
+ FallbackLang := lowercase(copy(Buffer,1,2));
+ if GetLocaleInfo(UserLCID, LOCALE_SABBREVCTRYNAME, @Buffer, 4)<>0 then begin
+ Country := copy(Buffer,1,2);
+
+ // some 2 letter codes are not the first two letters of the 3 letter code
+ // there are probably more, but first let us see if there are translations
+ if (Buffer='PRT') then Country:='PT';
+
+ Lang := FallbackLang+'_'+Country;
+ end;
+end;
+{$endif}
+
+var
mo: TMOFile;
lang, FallbackLanguage: String;
begin
+ {$ifdef win32}
+ GetLanguageIDs(Lang, FallbackLanguage);
+ {$else}
lang := GetEnv('LC_ALL');
if Length(lang) = 0 then
begin
@@ -276,8 +304,8 @@
exit; // no language defined via environment variables
end;
end;
-
FallbackLanguage := Copy(lang, 1, 2);
+ {$endif}
try
mo := TMOFile.Create(Format(AFilename, [FallbackLanguage]));
try
@@ -306,14 +334,3 @@
if GettextUsed then
ResetResourceTables;
end.
-
-
-{
- $Log: gettext.pp,v $
- Revision 1.9 2005/03/15 16:27:04 peter
- * use dispose instead of freemem to also release the initialize types
-
- Revision 1.8 2005/02/14 17:13:15 peter
- * truncate log
-
-}
_______________________________________________
fpc-devel maillist - [email protected]
http://lists.freepascal.org/mailman/listinfo/fpc-devel
