paweld/pas2js
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/pas2js.git synced 2025-08-28 03:00:20 +02:00
Code Issues Packages Projects Releases Wiki Activity

* Remove duplicate committed by accident

Browse Source
This commit is contained in:
michael 2019-07-16 07:07:23 +00:00
parent 021964c4d0
commit 02aa1a44e6
1 changed files with 0 additions and 259 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

259
demo/translate/rstranslate.pp
View File

@ -1,259 +0,0 @@
{
This file is part of the Pas2JS run time library.
Copyright (c) 2019 by Michael Van Canneyt
See the file COPYING.FPC, included in this distribution,
for details about the copyright.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
**********************************************************************}
unit rstranslate;
{$mode objfpc}
interface
uses
SysUtils, JS, web;
Type
{ TResourceTranslator }
TLoadFailEvent = Reference to Procedure (Sender : TObject; aCode : Integer; aError : String);
TOnTranslatedEvent = Reference to Procedure (Sender : TObject; aURL : String);
TResourceTranslator = Class
Private
FOnLoadFail: TLoadFailEvent;
FOnURLTranslated: TOnTranslatedEvent;
class var FInstance : TResourceTranslator;
function GetUnitResources(const aUnit: string): TJSOBject;
Protected
procedure ResetTranslation(aUnitResources: TJSObject; AString: String); virtual;
procedure Translate(aUnitResources: TJSObject; AString, aTranslation: String); virtual;
Public
Class Function Instance : TResourceTranslator;
Procedure Translate(Const aUnit,aString,aTranslation : String); overload;
Procedure Translate(Const aTranslations : TJSOBject); overload;
Procedure ResetTranslation(Const aUnit : String; const aString : String = ''); overload;
procedure Translate(const aURL: string; aOnTranslated : TOnTranslatedEvent = Nil); overload;
Property OnLoadFail : TLoadFailEvent Read FOnLoadFail Write FOnLoadFail;
Property OnURLTranslated : TOnTranslatedEvent Read FOnURLTranslated Write FOnURLTranslated;
end;
Function ResourceTranslator : TResourceTranslator;
Procedure Translate(Const aURL : String; aOnTranslated : TOnTranslatedEvent = Nil);
Procedure Translate(Const aUnit,aString,aTranslation : String);
Procedure Translate(Const aTranslations : TJSOBject);
Procedure ResetTranslation(Const aUnit : String; Const aString : String = '');
implementation
Const
SCurrent = 'current';
var
Pas : TJSObject; external name 'pas';
{ TResourceTranslator }
procedure TResourceTranslator.Translate(aUnitResources: TJSObject; AString, aTranslation: String);
Var
res: JSValue;
begin
res:=aUnitResources[aString];
if Assigned(Res) then
TJSOBject(Res)[SCurrent]:=aTranslation;
end;
procedure TResourceTranslator.ResetTranslation(aUnitResources: TJSObject; AString: String);
Var
res: JSValue;
begin
res:=aUnitResources[aString];
if Assigned(Res) then
TJSOBject(Res)[SCurrent]:=undefined;
end;
function TResourceTranslator.GetUnitResources(const aUnit: string): TJSOBject;
var
jsMod,res : JSValue;
begin
Result:=Nil;
jsMod:=Pas[aUnit];
if assigned(jsMod) then
begin
res:=(TJSObject(jsMod)['$resourcestrings']);
if Assigned(res) then
Result:=TJSObject(res);
end;
end;
procedure TResourceTranslator.Translate(const aTranslations: TJSOBject);
var
aUnitName,aStringName : String;
aUnit,Res : TJSObject;
V : JSValue;
begin
for aUnitName in TJSObject.getOwnPropertyNames(aTranslations) do
if IsValidIdent(aUnitName,True) and isObject(aTranslations[aUnitName]) then
begin
aUnit:=TJSObject(aTranslations[aUnitName]);
Res:=GetUnitResources(aUnitName);
if Assigned(Res) then
For aStringName in TJSObject.getOwnPropertyNames(aUnit) do
begin
V:=aUnit[aStringName];
if IsString(V) then
Translate(Res,aStringName,String(V));
end;
end;
end;
procedure TResourceTranslator.Translate(const aUnit, aString, aTranslation: String);
Var
jsmod : TJSObject;
begin
jsMod:=GetUnitResources(aUnit);
if Assigned(jsMod) then
Translate(jsMod, aString,aTranslation);
end;
procedure TResourceTranslator.ResetTranslation(const aUnit: String; const aString: String);
Var
jsmod : TJSObject;
S : String;
begin
jsMod:=GetUnitResources(aUnit);
if Assigned(jsMod) then
if (aString<>'') then
ResetTranslation(jsMod, aString)
else
for S in TJSOBject.getOwnPropertyNames(TJSObject(jsMod)) do
ResetTranslation(jsMod, S);
end;
Type
{ TURLTranslator }
TURLTranslator = Class
Private
FTranslator : TResourceTranslator;
FURL : String;
FXHR : TJSXMLHttpRequest;
FOnTranslated : TOnTranslatedEvent;
procedure DoStateChange;
Public
Constructor Create(aUrl : String; ATranslator : TResourceTranslator;aOnTranslated : TOnTranslatedEvent);
Procedure Translate;
end;
{ TURLTranslator }
procedure TURLTranslator.DoStateChange;
Var
O : TJSObject;
begin
if (FXHR.ReadyState=TJSXMLHttpRequest.DONE) then
if ((FXHR.Status div 100)=2) then
begin
try
O:=TJSJSON.parseObject(FXHR.responseText);
FTranslator.Translate(O);
if Assigned(FOnTranslated) then
FOnTranslated(FTranslator,FURL);
if Assigned(FTranslator.OnURLTranslated) then
FTranslator.OnURLTranslated(FTranslator,FURL);
except
if Assigned(FTranslator.OnLoadFail) then
FTranslator.OnLoadFail(FTranslator,0,'Invalid JSON')
end
end
else
if Assigned(FTranslator.OnLoadFail) then
FTranslator.OnLoadFail(FTranslator,FXHR.Status,FXHR.StatusText);
end;
constructor TURLTranslator.Create(aUrl: String; ATranslator: TResourceTranslator;aOnTranslated : TOnTranslatedEvent);
begin
FURL:=aURL;
FTranslator:=ATranslator;
FOnTranslated:=aOnTranslated;
end;
procedure TURLTranslator.Translate;
begin
FXHR:=TJSXMLHttpRequest.new;
FXHR.open('GET',fURL);
FXHR.onreadystatechange:=@DoStateChange;
FXHR.responseType:='text';
FXHR.send;
end;
procedure TResourceTranslator.Translate(const aURL : string;aOnTranslated : TOnTranslatedEvent = Nil);
begin
With TURLTranslator.Create(aURL,Self,aOnTranslated) do
Translate;
end;
class function TResourceTranslator.Instance: TResourceTranslator;
begin
if FInstance=Nil then
FInstance:=TResourceTranslator.Create;
Result:=FInstance;
end;
{ ---------------------------------------------------------------------
Procedural access
---------------------------------------------------------------------}
Procedure Translate(Const aURL : String; aOnTranslated : TOnTranslatedEvent = Nil);
begin
TResourceTranslator.Instance.Translate(aURL,aOnTranslated);
end;
Procedure Translate(Const aTranslations : TJSOBject);
begin
TResourceTranslator.Instance.Translate(aTranslations);
end;
procedure Translate(const aUnit, aString, aTranslation: String);
begin
TResourceTranslator.Instance.Translate(aUnit,aString,aTranslation);
end;
Procedure ResetTranslation(Const aUnit : String; Const aString : String = '');
begin
TResourceTranslator.Instance.ResetTranslation(aUnit,Astring);
end;
Function ResourceTranslator : TResourceTranslator;
begin
Result:=TResourceTranslator.Instance;
end;
end.