📄 gnugettext.pas
字号:
begin
Result := '';
for i := 1 to length(s) do begin
c := s[i];
case c of
#32..#33, #35..#255: Result := Result + c;
#13: Result := Result + '\r';
#10: Result := Result + '\n"'#13#10'"';
#34: Result := Result + '\"';
else
Result := Result + '\0x' + IntToHex(ord(c), 2);
end;
end;
Result := '"' + Result + '"';
end;
function ResourceStringGettext(MsgId: widestring): widestring;
var
i:integer;
begin
if TPDomainListCS=nil then begin
// This only happens during very complicated program startups that fail
Result:=MsgId;
exit;
end;
TPDomainListCS.BeginRead;
try
for i:=0 to TPDomainList.Count-1 do begin
Result:=dgettext(TPDomainList.Strings[i], MsgId);
if Result<>MsgId then
break;
end;
finally
TPDomainListCS.EndRead;
end;
end;
function gettext(const szMsgId: widestring): widestring;
begin
Result:=DefaultInstance.gettext(szMsgId);
end;
function _(const szMsgId: widestring): widestring;
begin
Result:=DefaultInstance.gettext(szMsgId);
end;
function dgettext(const szDomain: string; const szMsgId: widestring): widestring;
begin
Result:=DefaultInstance.dgettext(szDomain, szMsgId);
end;
function dngettext(const szDomain: string; const singular,plural: widestring; Number:longint): widestring;
begin
Result:=DefaultInstance.dngettext(szDomain,singular,plural,Number);
end;
function ngettext(const singular,plural: widestring; Number:longint): widestring;
begin
Result:=DefaultInstance.ngettext(singular,plural,Number);
end;
procedure textdomain(const szDomain: string);
begin
DefaultInstance.textdomain(szDomain);
end;
procedure SetGettextEnabled (enabled:boolean);
begin
DefaultInstance.Enabled:=enabled;
end;
function getcurrenttextdomain: string;
begin
Result:=DefaultInstance.getcurrenttextdomain;
end;
procedure bindtextdomain(const szDomain: string; const szDirectory: string);
begin
DefaultInstance.bindtextdomain(szDomain, szDirectory);
end;
procedure TP_Ignore(AnObject:TObject; const name:string);
begin
DefaultInstance.TP_Ignore(AnObject, name);
end;
procedure TP_GlobalIgnoreClass (IgnClass:TClass);
begin
DefaultInstance.TP_GlobalIgnoreClass(IgnClass);
end;
procedure TP_GlobalIgnoreClassProperty (IgnClass:TClass;propertyname:string);
begin
DefaultInstance.TP_GlobalIgnoreClassProperty(IgnClass,propertyname);
end;
procedure TP_GlobalHandleClass (HClass:TClass;Handler:TTranslator);
begin
DefaultInstance.TP_GlobalHandleClass (HClass, Handler);
end;
procedure TranslateProperties(AnObject: TObject; TextDomain:string='');
begin
DefaultInstance.TranslateProperties(AnObject, TextDomain);
end;
procedure TranslateComponent(AnObject: TComponent; TextDomain:string='');
begin
DefaultInstance.TranslateComponent(AnObject, TextDomain);
end;
{$ifdef MSWINDOWS}
// These constants are only used in Windows 95
// Thanks to Frank Andreas de Groot for this table
const
IDAfrikaans = $0436; IDAlbanian = $041C;
IDArabicAlgeria = $1401; IDArabicBahrain = $3C01;
IDArabicEgypt = $0C01; IDArabicIraq = $0801;
IDArabicJordan = $2C01; IDArabicKuwait = $3401;
IDArabicLebanon = $3001; IDArabicLibya = $1001;
IDArabicMorocco = $1801; IDArabicOman = $2001;
IDArabicQatar = $4001; IDArabic = $0401;
IDArabicSyria = $2801; IDArabicTunisia = $1C01;
IDArabicUAE = $3801; IDArabicYemen = $2401;
IDArmenian = $042B; IDAssamese = $044D;
IDAzeriCyrillic = $082C; IDAzeriLatin = $042C;
IDBasque = $042D; IDByelorussian = $0423;
IDBengali = $0445; IDBulgarian = $0402;
IDBurmese = $0455; IDCatalan = $0403;
IDChineseHongKong = $0C04; IDChineseMacao = $1404;
IDSimplifiedChinese = $0804; IDChineseSingapore = $1004;
IDTraditionalChinese = $0404; IDCroatian = $041A;
IDCzech = $0405; IDDanish = $0406;
IDBelgianDutch = $0813; IDDutch = $0413;
IDEnglishAUS = $0C09; IDEnglishBelize = $2809;
IDEnglishCanadian = $1009; IDEnglishCaribbean = $2409;
IDEnglishIreland = $1809; IDEnglishJamaica = $2009;
IDEnglishNewZealand = $1409; IDEnglishPhilippines = $3409;
IDEnglishSouthAfrica = $1C09; IDEnglishTrinidad = $2C09;
IDEnglishUK = $0809; IDEnglishUS = $0409;
IDEnglishZimbabwe = $3009; IDEstonian = $0425;
IDFaeroese = $0438; IDFarsi = $0429;
IDFinnish = $040B; IDBelgianFrench = $080C;
IDFrenchCameroon = $2C0C; IDFrenchCanadian = $0C0C;
IDFrenchCotedIvoire = $300C; IDFrench = $040C;
IDFrenchLuxembourg = $140C; IDFrenchMali = $340C;
IDFrenchMonaco = $180C; IDFrenchReunion = $200C;
IDFrenchSenegal = $280C; IDSwissFrench = $100C;
IDFrenchWestIndies = $1C0C; IDFrenchZaire = $240C;
IDFrisianNetherlands = $0462; IDGaelicIreland = $083C;
IDGaelicScotland = $043C; IDGalician = $0456;
IDGeorgian = $0437; IDGermanAustria = $0C07;
IDGerman = $0407; IDGermanLiechtenstein = $1407;
IDGermanLuxembourg = $1007; IDSwissGerman = $0807;
IDGreek = $0408; IDGujarati = $0447;
IDHebrew = $040D; IDHindi = $0439;
IDHungarian = $040E; IDIcelandic = $040F;
IDIndonesian = $0421; IDItalian = $0410;
IDSwissItalian = $0810; IDJapanese = $0411;
IDKannada = $044B; IDKashmiri = $0460;
IDKazakh = $043F; IDKhmer = $0453;
IDKirghiz = $0440; IDKonkani = $0457;
IDKorean = $0412; IDLao = $0454;
IDLatvian = $0426; IDLithuanian = $0427;
IDMacedonian = $042F; IDMalaysian = $043E;
IDMalayBruneiDarussalam = $083E; IDMalayalam = $044C;
IDMaltese = $043A; IDManipuri = $0458;
IDMarathi = $044E; IDMongolian = $0450;
IDNepali = $0461; IDNorwegianBokmol = $0414;
IDNorwegianNynorsk = $0814; IDOriya = $0448;
IDPolish = $0415; IDBrazilianPortuguese = $0416;
IDPortuguese = $0816; IDPunjabi = $0446;
IDRhaetoRomanic = $0417; IDRomanianMoldova = $0818;
IDRomanian = $0418; IDRussianMoldova = $0819;
IDRussian = $0419; IDSamiLappish = $043B;
IDSanskrit = $044F; IDSerbianCyrillic = $0C1A;
IDSerbianLatin = $081A; IDSesotho = $0430;
IDSindhi = $0459; IDSlovak = $041B;
IDSlovenian = $0424; IDSorbian = $042E;
IDSpanishArgentina = $2C0A; IDSpanishBolivia = $400A;
IDSpanishChile = $340A; IDSpanishColombia = $240A;
IDSpanishCostaRica = $140A; IDSpanishDominicanRepublic = $1C0A;
IDSpanishEcuador = $300A; IDSpanishElSalvador = $440A;
IDSpanishGuatemala = $100A; IDSpanishHonduras = $480A;
IDMexicanSpanish = $080A; IDSpanishNicaragua = $4C0A;
IDSpanishPanama = $180A; IDSpanishParaguay = $3C0A;
IDSpanishPeru = $280A; IDSpanishPuertoRico = $500A;
IDSpanishModernSort = $0C0A; IDSpanish = $040A;
IDSpanishUruguay = $380A; IDSpanishVenezuela = $200A;
IDSutu = $0430; IDSwahili = $0441;
IDSwedishFinland = $081D; IDSwedish = $041D;
IDTajik = $0428; IDTamil = $0449;
IDTatar = $0444; IDTelugu = $044A;
IDThai = $041E; IDTibetan = $0451;
IDTsonga = $0431; IDTswana = $0432;
IDTurkish = $041F; IDTurkmen = $0442;
IDUkrainian = $0422; IDUrdu = $0420;
IDUzbekCyrillic = $0843; IDUzbekLatin = $0443;
IDVenda = $0433; IDVietnamese = $042A;
IDWelsh = $0452; IDXhosa = $0434;
IDZulu = $0435;
function GetWindowsLanguage: string;
var
langid: Cardinal;
langcode: string;
CountryName: array[0..4] of char;
LanguageName: array[0..4] of char;
works: boolean;
begin
// The return value of GetLocaleInfo is compared with 3 = 2 characters and a zero
works := 3 = GetLocaleInfo(LOCALE_USER_DEFAULT, LOCALE_SISO639LANGNAME, LanguageName, SizeOf(LanguageName));
works := works and (3 = GetLocaleInfo(LOCALE_USER_DEFAULT, LOCALE_SISO3166CTRYNAME, CountryName,
SizeOf(CountryName)));
if works then begin
// Windows 98, Me, NT4, 2000, XP and newer
LangCode := PChar(@LanguageName[0]) + '_' + PChar(@CountryName[0]);
end else begin
// This part should only happen on Windows 95.
langid := GetThreadLocale;
case langid of
IDBelgianDutch: langcode := 'nl_BE';
IDBelgianFrench: langcode := 'fr_BE';
IDBrazilianPortuguese: langcode := 'pt_BR';
IDDanish: langcode := 'da_DK';
IDDutch: langcode := 'nl_NL';
IDEnglishUK: langcode := 'en_UK';
IDEnglishUS: langcode := 'en_US';
IDFinnish: langcode := 'fi_FI';
IDFrench: langcode := 'fr_FR';
IDFrenchCanadian: langcode := 'fr_CA';
IDGerman: langcode := 'de_DE';
IDGermanLuxembourg: langcode := 'de_LU';
IDGreek: langcode := 'gr_GR';
IDIcelandic: langcode := 'is_IS';
IDItalian: langcode := 'it_IT';
IDKorean: langcode := 'ko_KO';
IDNorwegianBokmol: langcode := 'no_NO';
IDNorwegianNynorsk: langcode := 'nn_NO';
IDPolish: langcode := 'pl_PL';
IDPortuguese: langcode := 'pt_PT';
IDRussian: langcode := 'ru_RU';
IDSpanish, IDSpanishModernSort: langcode := 'es_ES';
IDSwedish: langcode := 'sv_SE';
IDSwedishFinland: langcode := 'fi_SE';
else
langcode := 'C';
end;
end;
Result := langcode;
end;
{$endif}
function LoadResStringA(ResStringRec: PResStringRec): string;
begin
Result:=LoadResString(ResStringRec);
end;
procedure gettext_putenv(const envstring: string);
begin
{$ifdef mswindows}
if DLLisLoaded and Assigned(pgettext_putenv) then
pgettext_putenv(PChar(envstring));
{$endif}
end;
function GetTranslatorNameAndEmail:widestring;
begin
Result:=DefaultInstance.GetTranslatorNameAndEmail;
end;
procedure UseLanguage(LanguageCode: string);
begin
DefaultInstance.UseLanguage(LanguageCode);
end;
function LoadResString(ResStringRec: PResStringRec): widestring;
{$ifdef MSWINDOWS}
var
Len: Integer;
Buffer: array [0..1023] of char;
{$endif}
begin
if (ResStringRec = nil) then
exit;
if ResStringRec.Identifier >= 64*1024 then
Result:=PChar(ResStringRec.Identifier)
else
{$ifdef LINUX}
// This works with Unicode if the Linux has utf-8 character set
Result:=System.LoadResString(ResStringRec);
{$endif}
{$ifdef MSWINDOWS}
if not Win32PlatformIsUnicode then begin
SetString(Result, Buffer,
LoadString(FindResourceHInstance(ResStringRec.Module^),
ResStringRec.Identifier, Buffer, SizeOf(Buffer)))
end else begin
Result := '';
Len := 0;
While Len = Length(Result) do begin
if Length(Result) = 0 then
SetLength(Result, 1024)
else
SetLength(Result, Length(Result) * 2);
Len := LoadStringW(FindResourceHInstance(ResStringRec.Module^),
ResStringRec.Identifier, PWideChar(Result), Length(Result));
end;
SetLength(Result, Len);
end;
{$endif}
Result:=ResourceStringGettext(Result);
end;
function LoadResStringW(ResStringRec: PResStringRec): widestring;
begin
Result:=LoadResString(ResStringRec);
end;
function GetCurrentLanguage:string;
begin
Result:=DefaultInstance.GetCurrentLanguage;
end;
function getdomain(list:TStringList; domain, DefaultDomainDirectory, CurLang: string): TDomain;
// Retrieves the TDomain object for the specified domain.
// Creates one, if none there, yet.
var
idx: integer;
begin
idx := list.IndexOf(Domain);
if idx = -1 then begin
Result := TDomain.Create;
Result.Domain := Domain;
Result.Directory := DefaultDomainDirectory;
Result.SetLanguageCode(curlang);
list.AddObject(Domain, Result);
end else begin
Result := list.Objects[idx] as TDomain;
end;
end;
{ TDomain }
function TDomain.CardinalInMem (baseptr:PChar; Offset:Cardinal):Cardinal;
var pc:^Cardinal;
begin
inc (baseptr,offset);
pc:=Pointer(baseptr);
Result:=pc^;
if doswap then
autoswap32(Result);
end;
function TDomain.autoswap32(i: cardinal): cardinal;
var
cnv1, cnv2:
record
case integer of
0: (arr: array[0..3] of byte);
1: (int: cardinal);
end;
begin
if doswap then begin
cnv1.int := i;
cnv2.arr[0] := cnv1.arr[3];
cnv2.arr[1] := cnv1.arr[2];
cnv2.arr[2] := cnv1.arr[1];
cnv2.arr[3] := cnv1.arr[0];
Result := cnv2.int;
end else
Result := i;
end;
procedure TDomain.CloseMoFile;
begin
moCS.BeginWrite;
try
if isopen then begin
{$ifdef mswindows}
UnMapViewOfFile (momemoryHandle);
CloseHandle (momapping);
CloseHandle (mo);
{$endif}
{$ifdef linux}
FreeMem (momemoryHandle);
{$endif}
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -