jvgnugettext.pas

East make Tray Icon in delphi

  if DefaultInstance <> nil then
    Result := DefaultInstance.LoadResString(ResStringRec)
  else
    Result := PChar(ResStringRec.Identifier);
end;
{$endif}

function GetTranslatorNameAndEmail: WideString;
begin
  Result := DefaultInstance.GetTranslatorNameAndEmail;
end;

procedure UseLanguage(const LanguageCode: string);
begin
  DefaultInstance.UseLanguage(LanguageCode);
end;

{$ifndef CLR}
type
  PStrData = ^TStrData;
  TStrData = record
    Ident: Integer;
    Str: AnsiString;
  end;

function SysUtilsEnumStringModules(Instance: Longint; Data: Pointer): Boolean;
{$ifdef MSWINDOWS}
var
  Buffer: array[0..1023] of AnsiChar;
begin
  with PStrData(Data)^ do
  begin
    SetString(Str, Buffer,
      LoadString(Instance, Ident, Buffer, SizeOf(Buffer)));
    Result := Str = '';
  end;
end;
{$endif}
{$ifdef LINUX}
var
  rs: TResStringRec;
  Module: HModule;
begin
  Module := Instance;
  rs.Module := @Module;
  with PStrData(Data)^ do
  begin
    rs.Identifier := Ident;
    Str := System.LoadResString(@rs);
    Result := Str = '';
  end;
end;
{$endif}

function SysUtilsFindStringResource(Ident: Integer): AnsiString; 
var
  StrData: TStrData;
begin
  StrData.Ident := Ident; 
  StrData.Str := ''; 
  EnumResourceModules(SysUtilsEnumStringModules, @StrData); 
  Result := StrData.Str; 
end; 

function SysUtilsLoadStr(Ident: Integer): AnsiString; 
begin
  {$ifdef DXGETTEXTDEBUG}
  DefaultInstance.DebugWriteln('SysUtils.LoadRes(' + IntToStr(ident) + ') called');
  {$endif}
  Result := ResourceStringGettext(SysUtilsFindStringResource(Ident)); 
end; 

function SysUtilsFmtLoadStr(Ident: Integer; const Args: array of const): AnsiString; 
begin
  {$ifdef DXGETTEXTDEBUG}
  DefaultInstance.DebugWriteln('SysUtils.FmtLoadRes(' + IntToStr(ident) + ', Args) called'); 
  {$endif}
  FmtStr(Result, SysUtilsFindStringResource(Ident), Args); 
  Result := ResourceStringGettext(Result); 
end; 

function LoadResString(ResStringRec: PResStringRec): WideString;
begin
  Result := DefaultInstance.LoadResString(ResStringRec);
end;

function LoadResStringW(ResStringRec: PResStringRec): WideString;
begin
  Result := DefaultInstance.LoadResString(ResStringRec);
end;
{$endif}


function GetCurrentLanguage: string; 
begin
  Result := DefaultInstance.GetCurrentLanguage;
end; 

{ TDomain }

procedure TDomain.CloseMoFile;
begin
  if moFile <> nil then 
    FileLocator.ReleaseMoFile(moFile);
  OpenHasFailedBefore := False;
end; 

destructor TDomain.Destroy; 
begin
  CloseMoFile; 
  inherited Destroy; 
end;

{$ifdef MSWINDOWS}
{not used}
{
function GetLastWinError: AnsiString;
var
  ErrCode: Cardinal;
begin
  SetLength(Result, 2000);
  ErrCode := GetLastError();
  Windows.FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM, nil, ErrCode,
    0, PChar(Result), 2000, nil);
  Result := StrPas(PChar(Result));
end;
} 
{$endif}

procedure TDomain.OpenMoFile;
const
  ErrorMsg = 'The translation for the language code %s (in %s) does not have ' +
    'charset=utf-8 in its Content-Type. Translations are turned off.';
var
  Filename: string;
begin
  // Check if it is already open
  if moFile <> nil then
    Exit;

  // Check if it has been attempted to open the file before
  if OpenHasFailedBefore then
    Exit;

  if SpecificFilename <> '' then
    Filename := SpecificFilename
  else
  begin
    Filename := Directory + curlang + PathDelim + 'LC_MESSAGES' + PathDelim + domain + '.mo';
    if (not FileLocator.FileExists(Filename)) and (not FileExists(Filename)) then
      Filename := Directory + Copy(curlang, 1, 2) + PathDelim +
        'LC_MESSAGES' + PathDelim + domain + '.mo';
  end;
  if (not FileLocator.FileExists(Filename)) and (not FileExists(Filename)) then
  begin
    OpenHasFailedBefore := True;
    Exit;
  end;
  moFile := FileLocator.GetMoFile(Filename, DebugLogger);

  {$ifdef DXGETTEXTDEBUG}
  if moFile.isSwappedArchitecture then
    DebugLogger('.mo file is swapped (comes from another CPU architecture)');
  {$endif}

  // Check, that the contents of the file is utf-8
  if Pos('CHARSET=UTF-8', UpperCase(GetTranslationProperty('Content-Type'))) = 0 then
  begin
    CloseMoFile;
    {$ifdef DXGETTEXTDEBUG}
    DebugLogger(Format(ErrorMsg, [curlang, Filename]));
    {$endif}
    {$ifdef MSWINDOWS}
    MessageBox(0, PChar(Format(ErrorMsg, [curlang, Filename])),
      'Localization problem', MB_OK);
    {$endif}
    {$ifdef CLR}
    MessageBox.show(Format(ErrorMsg, [curlang, Filename]));
    {$endif}
    {$ifdef LINUX}
    WriteLn(stderr, Format(ErrorMsg, [curlang, Filename]));
    {$endif}
    Enabled := False;
  end;
end;

function TDomain.GetTranslationProperty(PropertyName: string): WideString;
var
  sl: TStringList;
  i, PropLen: Integer;
  s: string;
begin
  PropertyName := PropertyName + ': ';
  PropLen := Length(PropertyName) + 1;
  sl := TStringList.Create;
  try
    {$ifdef CLR}
    s := gettext('');
    if Pos(sLineBreak, s) = 0 then
      sl.LineBreak := #10
    else
      sl.LineBreak := sLineBreak;
    sl.Text := s;
    {$else}
    sl.Text := Utf8Encode(gettext(''));
    {$endif}
    for i := 0 to sl.Count - 1 do
    begin
      s := sl.Strings[i];
      if StartsWith(s, PropertyName, True) then
      begin
        {$ifdef CLR}
        Result := TrimCopy(s, PropLen, MaxInt);
        {$else}
        Result := Utf8Decode(TrimCopy(s, PropLen, MaxInt));
        {$endif}
        {$ifdef DXGETTEXTDEBUG}
        DebugLogger('GetTranslationProperty(' + PropertyName + ') returns ''' + Result + '''.');
        {$endif}
        Exit;
      end;
    end;
  finally
    sl.Free;
  end; 
  Result := ''; 
  {$ifdef DXGETTEXTDEBUG}
  DebugLogger('GetTranslationProperty(' + PropertyName +
    ') did not find any value. An empty string is returned.'); 
  {$endif}
end; 

procedure TDomain.SetDirectory(const Value: string);
begin
  vDirectory := IncludeTrailingPathDelimiter(Value);
  SpecificFilename := ''; 
  CloseMoFile; 
end; 

procedure AddDomainForResourceString(const domain: string);
begin
  {$ifdef DXGETTEXTDEBUG}
  DefaultInstance.DebugWriteln('Extra domain for resourcestring: ' + domain); 
  {$endif}
  ResourceStringDomainListCS.BeginWrite; 
  try
    if ResourceStringDomainList.IndexOf(domain) = -1 then
      ResourceStringDomainList.Add(domain);
  finally
    ResourceStringDomainListCS.EndWrite;
  end;
end;

procedure RemoveDomainForResourceString(const domain: string);
var
  i: Integer;
begin
  {$ifdef DXGETTEXTDEBUG}
  DefaultInstance.DebugWriteln('Remove domain for resourcestring: ' + domain);
  {$endif}
  ResourceStringDomainListCS.BeginWrite;
  try
    i := ResourceStringDomainList.IndexOf(domain);
    if i <> -1 then
      ResourceStringDomainList.Delete(i);
  finally
    ResourceStringDomainListCS.EndWrite;
  end;
end;

procedure TDomain.SetLanguageCode(const LangCode: string);
begin
  CloseMoFile;
  curlang := LangCode;
end; 

function GetPluralForm2EN(Number: Integer): Integer; 
begin
  Number := abs(Number); 
  if Number = 1 then Result := 0 
  else 
    Result := 1; 
end; 

function GetPluralForm1(Number: Integer): Integer; 
begin
  Result := 0; 
end; 

function GetPluralForm2FR(Number: Integer): Integer; 
begin
  Number := abs(Number); 
  if (Number = 1) or (Number = 0) then Result := 0 
  else 
    Result := 1; 
end; 

function GetPluralForm3LV(Number: Integer): Integer; 
begin
  Number := abs(Number); 
  if (Number mod 10 = 1) and (Number mod 100 <> 11) then
    Result := 0
  else if Number <> 0 then Result := 1
  else 
    Result := 2; 
end; 

function GetPluralForm3GA(Number: Integer): Integer; 
begin
  Number := abs(Number); 
  if Number = 1 then Result := 0
  else if Number = 2 then Result := 1
  else 
    Result := 2; 
end; 

function GetPluralForm3LT(Number: Integer): Integer; 
var
  n1, n2: Byte; 
begin
  Number := abs(Number); 
  n1 := Number mod 10; 
  n2 := Number mod 100; 
  if (n1 = 1) and (n2 <> 11) then
    Result := 0
  else if (n1 >= 2) and ((n2 < 10) or (n2 >= 20)) then Result := 1
  else 
    Result := 2; 
end; 

function GetPluralForm3PL(Number: Integer): Integer; 
var
  n1, n2: Byte; 
begin
  Number := abs(Number); 
  n1 := Number mod 10; 
  n2 := Number mod 100; 
  if n1 = 1 then Result := 0
  else if (n1 >= 2) and (n1 <= 4) and ((n2 < 10) or (n2 >= 20)) then Result := 1
  else 
    Result := 2; 
end; 

function GetPluralForm3RU(Number: Integer): Integer; 
var
  n1, n2: Byte; 
begin
  Number := abs(Number);
  n1 := Number mod 10; 
  n2 := Number mod 100; 
  if (n1 = 1) and (n2 <> 11) then
    Result := 0
  else if (n1 >= 2) and (n1 <= 4) and ((n2 < 10) or (n2 >= 20)) then Result := 1
  else 
    Result := 2; 
end; 

function GetPluralForm4SL(Number: Integer): Integer; 
var
  n2: Byte; 
begin
  Number := abs(Number);
  n2 := Number mod 100;
  if n2 = 1 then Result := 0
  else if n2 = 2 then Result := 1
  else if (n2 = 3) or (n2 = 4) then Result := 2
  else
    Result := 3;
end;

procedure TDomain.GetListOfLanguages(List: TStrings);
var
  sr: TSearchRec;
  more: Boolean;
  Filename, Path, LangCode: AnsiString;
  i, j: Integer;
begin
  List.Clear;

  // Iterate through filesystem
  more := FindFirst(Directory + '*', faAnyFile, sr) = 0;
  try
    while more do
    begin
      if (sr.Attr and faDirectory <> 0) and (sr.Name <> '.') and (sr.Name <> '..') then
      begin
        Filename := Directory + sr.Name + PathDelim + 'LC_MESSAGES' +
          PathDelim + domain + '.mo';
        if FileExists(Filename) then
        begin
          LangCode := LowerCase(sr.Name);
          if List.IndexOf(LangCode) = -1 then
            List.Add(LangCode);
        end;
      end;
      more := FindNext(sr) = 0;
    end;
  finally
    FindClose(sr);
  end;

  // Iterate through embedded files
  for i := 0 to FileLocator.FileList.Count - 1 do
  begin
    Filename := FileLocator.BaseDirectory + FileLocator.FileList.Strings[i];
    if IsInDirStrOf(Filename, Directory) then
    begin
      j := Length(Directory);
      Path := PathDelim + 'LC_MESSAGES' + PathDelim + domain + '.mo';
      if EndsWithFilename(Filename, Path) then
      begin
        LangCode := LowerCase(Copy(Filename, j + 1, Length(Filename) - Length(Path) - j));
        if List.IndexOf(LangCode) = -1 then
          List.Add(LangCode);
      end;
    end;
  end;
end;

procedure TDomain.SetFilename(const Filename: string);
begin
  CloseMoFile;
  vDirectory := '';
  SpecificFilename := Filename;
end;

function TDomain.gettext(const msgid: AnsiString): AnsiString;
var
  found: Boolean;
begin