jvqgnugettext.pas

East make Tray Icon in delphi

    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;



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 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 
    sl.Text := Utf8Encode(gettext('')); 
    for i := 0 to sl.Count - 1 do
    begin
      s := sl.Strings[i];
      if StartsWith(s, PropertyName, True) then
      begin 
        Result := Utf8Decode(TrimCopy(s, PropLen, MaxInt)); 
        {$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
  if not Enabled then
  begin
    Result := msgid; 
    Exit; 
  end; 
  if (moFile = nil) and (not OpenHasFailedBefore) then
    OpenMoFile; 
  if moFile = nil then 
  begin
    {$ifdef DXGETTEXTDEBUG}
    DebugLogger('.mo file is not open. Not translating "' + msgid + '"'); 
    {$endif}
    Result := msgid; 
  end 
  else 
  begin
    Result := moFile.gettext(msgid, found); 
    {$ifdef DXGETTEXTDEBUG}
    if found then
      DebugLogger('Found in .mo (' + Domain + '): "' + Utf8Encode(msgid) +
        '"->"' + Utf8Encode(Result) + '"')
    else
      DebugLogger('Translation not found in .mo file (' + Domain +
        ') : "' + Utf8Encode(msgid) + '"'); 
    {$endif}
  end; 
end; 

constructor TDomain.Create;
begin
  inherited Create;
  Enabled := True;
end;

{ TGnuGettextInstance }

procedure TGnuGettextInstance.bindtextdomain(const szDomain, szDirectory: string);
var
  dir: string;
begin
  dir := IncludeTrailingPathDelimiter(szDirectory);
  {$ifdef DXGETTEXTDEBUG}
  DebugWriteln('Text domain "' + szDomain + '" is now located at "' + dir + '"'); 
  {$endif}
  getdomain(szDomain, DefaultDomainDirectory, CurLang).Directory := dir; 
  WhenNewDomainDirectory(szDomain, szDirectory); 
end;

constructor TGnuGettextInstance.Create;
begin
  inherited Create; 
  CreatorThread := GetCurrentThreadId;
  { TODO : Do something about Thread handling if resourcestrings are enabled } 
  {$ifdef MSWINDOWS}
  DesignTimeCodePage := CP_ACP;
  {$endif}
  {$ifdef DXGETTEXTDEBUG}
  DebugLogCS := TMultiReadExclusiveWriteSynchronizer.Create;
  DebugLog := TMemoryStream.Create;