[Lazarus] German localization in Lazarus app

Sven Barth pascaldragon at googlemail.com
Tue Dec 20 10:17:00 CET 2011


Am 19.12.2011 14:45, schrieb Michael Fuchs:
> Am 19.12.2011 09:38, schrieb fred f:
>> Hi guyz,
>>
>> I have compiled and use Lazarus with German language, but e.g. the
>> buttons in message dialogs are still Yes, No, Cancel instead of German
>> Ja, Nein, Abbrechen, ...
>>
>> What should I set up to get everything in German even exceptions, ...
>
>
> For the dialogs under windows, I have a little (and very ugly) hack:
>
> --------->8--------->8--------->8--------->8--------->8--------->8--
> {$IFDEF WINDOWS}
> {$R ekgnet.rc}
> // HACK: For using german descriptions in Messagebox
> procedure HookResourceString(rs: PResStringRec; newStr: PChar);
> var
> oldprotect: DWORD;
> begin
> VirtualProtect(rs, SizeOf(rs^), PAGE_EXECUTE_READWRITE, @oldProtect);
> rs^ := newStr;
> VirtualProtect(rs, SizeOf(rs^), oldProtect, @oldProtect);
> end;
> {$ENDIF}
>
>
> begin
> Application.Title := 'project1';
> Application.Initialize;
> Application.CreateForm(TForm1, Form1);
> {$IFDEF WINDOWS}
> HookResourceString(@rsMbYes, 'Ja');
> HookResourceString(@rsMbNo, 'Nein');
> {$ENDIF}
> Application.Run;
> end.

One can do that less "ugly" (and portable):

=== source begin ===

// aName is in format "unit.identifier"
function TranslateLCLStrConsts(aName, aValue: AnsiString; aHash: Longint;
   aArg: Pointer): AnsiString;
var
   name: String;
begin
   name := LowerCase(aName);
   // if you have a dotted unit name you will need to adjust this
   Delete(name, 1, Length('lclstrconsts') + 1);
   if name = 'rsmbyes' then
     Result := '&Ja'
   else
   if name = 'rsmbno' then
     Result := '&Nein'
   else
   if name = 'rsmbok' then
     Result := '&OK'
   else
   if name = 'rsmbcancel' then
     Result := 'Abbrechen'
   else
   if name = 'rsmbabort' then
     Result := 'Abbrechen'
   else
   if name = 'rsmbretry' then
     Result := '&Wiederholen'
   else
   if name = 'rsmbignore' then
     Result := '&Ignorieren'
   else
   if name = 'rsmball' then
     Result := '&Alle'
   else
   if name = 'rsmbnotoall' then
     Result := 'Nein für Alle'
   else
   if name = 'rsmbyestoall' then
     Result := 'Ja für Alle'
   else
   if name = 'rsmbhelp' then
     Result := '&Hilfe'
   else
   if name = 'rsmbclose' then
     Result := '&Schließen'
   else
   if name = 'rsmbopen' then
     Result := '&Öffnen'
   else
   if name = 'rsmbsave' then
     Result := 'Speichern'
   else
   if name = 'rsmbunlock' then
     Result := 'Entriegeln'
   else
   if name = 'rsmtwarning' then
     Result := 'Warnung'
   else
   if name = 'rsmterror' then
     Result := 'Fehler'
   else
   if name = 'rsmtinformation' then
     Result := 'Information'
   else
   if name = 'rsmtconfirmation' then
     Result := 'Bestätigung'
   else
   if name = 'rsmtauthentication' then
     Result := 'Authentifizierung'
   else
   if name = 'rsmtcustom' then
     Result := 'Benutzerdefiniert'
   else
     Result := aValue;
end;

// somewhere (e.g. main program file):
SetUnitResourceStrings('LCLStrConsts', @TranslateLCLStrConsts, Nil);

=== source end ===

See also: 
http://www.freepascal.org/docs-html/rtl/objpas/setunitresourcestrings.html

Regards,
Sven




More information about the Lazarus mailing list