mirror of
https://gitlab.com/freepascal.org/fpc/pas2js.git
synced 2025-04-08 05:48:05 +02:00
* Improved demo for classtopas
This commit is contained in:
michael
parent
e8804d29c2
commit
396bda65af
@ -1,13 +1,76 @@
|
||||
<!DOCTYPE html>
|
||||
<html>
|
||||
<head>
|
||||
<head id="head">
|
||||
<meta charset="utf-8"/>
|
||||
<title>Generate class from Javascript object</title>
|
||||
<link href="https://stackpath.bootstrapcdn.com/bootstrap/4.3.1/css/bootstrap.min.css" rel="stylesheet"/>
|
||||
<script src="https://code.jquery.com/jquery-3.3.1.js" type="text/javascript"></script>
|
||||
<script src="https://cdnjs.cloudflare.com/ajax/libs/popper.js/1.14.7/umd/popper.min.js" crossorigin="anonymous"></script>
|
||||
<script src="https://stackpath.bootstrapcdn.com/bootstrap/4.3.1/js/bootstrap.min.js" type="text/javascript"></script>
|
||||
<!--
|
||||
<script type="application/javascript" src="theme.js"></script>
|
||||
-->
|
||||
<script type="application/javascript" src="democlasstopas.js"></script>
|
||||
</head>
|
||||
<body>
|
||||
<script type="application/javascript">
|
||||
<div class="container-fluid">
|
||||
<div class="row">
|
||||
<div class="col-md-3">
|
||||
<div class="form-group">
|
||||
<label for="edtJSObject">Object instance path</label>
|
||||
<input type="text" class="form-control" id="edtJSObject" aria-describedby="lblJSObject" placeholder="Object instance path" value="">
|
||||
<small id="lblJSObject" class="form-text text-muted">Path to instance of javascript object, relative to global scope</small>
|
||||
</div>
|
||||
</div>
|
||||
<div class="col-md-3">
|
||||
<div class="form-group">
|
||||
<label for="edtExternalName">Pascal Class external name</label>
|
||||
<input type="text" class="form-control" id="edtExternalName" aria-describedby="lblExternalName" placeholder="Class external name" value="">
|
||||
<small id="lblExternalName" class="form-text text-muted">The Object Pascal definition class external (JS) name.</small>
|
||||
</div>
|
||||
</div>
|
||||
<div class="col-md-3">
|
||||
<div class="form-group">
|
||||
<label for="edtPascalClass">Pascal Class name</label>
|
||||
<input type="text" class="form-control" id="edtPascalClass" aria-describedby="lblPascalClass" placeholder="Class name" value="">
|
||||
<small id="lblPascalClass" class="form-text text-muted">The Object Pascal definition class name.</small>
|
||||
</div>
|
||||
</div>
|
||||
<div class="col-md-3">
|
||||
<div class="form-group">
|
||||
<label for="edtPascalClassAncestor">Pascal Class ancestor name</label>
|
||||
<input type="text" class="form-control" id="edtPascalClassAncestor" aria-describedby="lblPascalClassAncestor" placeholder="Class ancestor name" value="TJSObject">
|
||||
<small id="lblPascalClassAncestor" class="form-text text-muted">The Object Pascal class ancestor class name.</small>
|
||||
</div>
|
||||
</div>
|
||||
</div>
|
||||
<div class="row">
|
||||
<div class="col-md-10">
|
||||
<div class="form-group">
|
||||
<label for="edtScript">Load javascript</label>
|
||||
<input type="text" class="form-control" id="edtScript" aria-describedby="lblScript" placeholder="URL to javascript file" value="">
|
||||
<small id="lblScript" class="form-text text-muted">A javascript file to load using a script tag. (jquery, popper and bootstrap are already loaded)</small>
|
||||
</div>
|
||||
</div>
|
||||
<div class="col-md-2" style="display: flex; align-items: center;">
|
||||
<button id="load" class="btn btn-secondary">Load script</button>
|
||||
</div>
|
||||
</div>
|
||||
<div class="row">
|
||||
<div class="col-md-1">
|
||||
<button id="go" class="btn btn-primary">Create class</button>
|
||||
</div>
|
||||
<div class="col-md-11">
|
||||
<div class="form-group">
|
||||
<label for="edtClassDefinition">Generated Pascal Class:</label>
|
||||
<textarea class="form-control" rows=25 id="edtClassDefinition" aria-describedby="edtClassDefinition" placeholder="Generated code comes here" value=""></textarea>
|
||||
<small id="lblClassDefinition" class="form-text text-muted">The Object Pascal class.</small>
|
||||
</div>
|
||||
</div>
|
||||
<div>
|
||||
</div>
|
||||
<script type="application/javascript">
|
||||
rtl.run();
|
||||
</script>
|
||||
</body>
|
||||
</html>
|
||||
|
||||
|
||||
@ -1,6 +1,6 @@
|
||||
<?xml version="1.0" encoding="UTF-8"?>
|
||||
<CONFIG>
|
||||
<ProjectOptions BuildModesCount="1">
|
||||
<ProjectOptions>
|
||||
<Version Value="12"/>
|
||||
<General>
|
||||
<Flags>
|
||||
@ -9,12 +9,11 @@
|
||||
<CompatibilityMode Value="True"/>
|
||||
</Flags>
|
||||
<SessionStorage Value="InProjectDir"/>
|
||||
<MainUnit Value="0"/>
|
||||
<Title Value="democlasstopas"/>
|
||||
<UseAppBundle Value="False"/>
|
||||
<ResourceType Value="res"/>
|
||||
</General>
|
||||
<BuildModes>
|
||||
<BuildModes Count="1">
|
||||
<Item1 Name="default" Default="True"/>
|
||||
</BuildModes>
|
||||
<PublishOptions>
|
||||
|
||||
@ -1,32 +1,130 @@
|
||||
program democlasstopas;
|
||||
|
||||
uses Web, Classes, JS, browserconsole, class2pas;
|
||||
uses Sysutils, Types, Web, Classes, JS, browserconsole, class2pas;
|
||||
|
||||
Type
|
||||
|
||||
{ TGenCodeApp }
|
||||
|
||||
TGenCodeApp = Class
|
||||
elHead : TJSHTMLElement;
|
||||
btnGo : TJSHTMLElement;
|
||||
btnLoad : TJSHTMLElement;
|
||||
edtJSObject : TJSHTMLInputElement;
|
||||
edtScript : TJSHTMLInputElement;
|
||||
edtPascalClass : TJSHTMLInputElement;
|
||||
edtPascalParentClass : TJSHTMLInputElement;
|
||||
edtExternalName : TJSHTMLInputElement;
|
||||
edtClassDefinition : TJSHTMLTextAreaElement;
|
||||
Procedure Execute;
|
||||
procedure ShowRTLProps(aClassName,aParentClassName,aJSClassName : String; O : TJSObject);
|
||||
private
|
||||
function DoGenCode(aEvent: TJSMouseEvent): boolean;
|
||||
function DoLoad(aEvent: TJSMouseEvent): boolean;
|
||||
function FindObject(aPath: String): TJSObject;
|
||||
end;
|
||||
|
||||
procedure TGenCodeApp.ShowRTLProps(aClassName,aParentClassName,aJSClassName : String; O : TJSObject);
|
||||
|
||||
procedure ShowRTLProps(aClassName,aJSClassName : String; O : TJSObject);
|
||||
Var
|
||||
S : TStrings;
|
||||
I : Integer;
|
||||
|
||||
begin
|
||||
S:=TStringList.Create;
|
||||
try
|
||||
ClassToPas(aClassName,aJSClassName,'',O,S,True);
|
||||
For I:=0 to S.Count-1 do
|
||||
Writeln(S[i]);
|
||||
ClassToPas(aJSClassName,aClassName,aParentClassName,O,S,True);
|
||||
edtClassDefinition.value:=S.Text;
|
||||
finally
|
||||
S.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TGenCodeApp.FindObject(aPath : String): TJSObject;
|
||||
|
||||
Var
|
||||
o : TJSObject;
|
||||
p : JSValue;
|
||||
O : TJSObject;
|
||||
Path : TStringDynArray;
|
||||
Done,S : String;
|
||||
|
||||
begin
|
||||
// get the new JavaScript object:
|
||||
asm
|
||||
$mod.o = window.localStorage;
|
||||
end;
|
||||
MaxConsoleLines:=5000;
|
||||
ShowRTLProps('localStorage','TJSLocalStorage',o);
|
||||
Path:=aPath.Split('.');
|
||||
Result:=nil;
|
||||
O:=Window;
|
||||
Done:='';
|
||||
for S in Path do
|
||||
begin
|
||||
if Done<>'' then
|
||||
Done:=Done+'.';
|
||||
Done:=Done+S;
|
||||
p:=O.Properties[S];
|
||||
if Not Assigned(P) then
|
||||
begin
|
||||
Window.Alert('No object found at : '+Done);
|
||||
exit;
|
||||
end;
|
||||
if Not isObject(P) then
|
||||
begin
|
||||
Window.Alert('Value at : '+Done+' is not an object');
|
||||
exit;
|
||||
end;
|
||||
O:=TJSObject(P);
|
||||
end;
|
||||
Result:=O;
|
||||
end;
|
||||
|
||||
function TGenCodeApp.DoGenCode(aEvent: TJSMouseEvent): boolean;
|
||||
|
||||
var
|
||||
O : TJSObject;
|
||||
|
||||
begin
|
||||
Result:=False;
|
||||
if (edtPascalClass.value='') or (edtJSObject.Value='') or (edtExternalName.Value='') then
|
||||
begin
|
||||
Window.Alert('Please fill in all fields');
|
||||
exit;
|
||||
end;
|
||||
O:=FindObject(edtJSObject.Value);
|
||||
if Assigned(O) then
|
||||
ShowRTLProps(edtPascalClass.value,edtPascalParentClass.Value,edtExternalName.Value,O);
|
||||
end;
|
||||
|
||||
function TGenCodeApp.DoLoad(aEvent: TJSMouseEvent): boolean;
|
||||
|
||||
Var
|
||||
El : TJSElement;
|
||||
|
||||
begin
|
||||
if (edtScript.Value='') then
|
||||
begin
|
||||
Window.Alert('Please fill in URL');
|
||||
exit;
|
||||
end;
|
||||
El:=Document.createElement('script');
|
||||
EL.Properties['src']:=edtScript.Value;
|
||||
elHead.appendChild(El);
|
||||
end;
|
||||
|
||||
Procedure TGEncodeApp.Execute;
|
||||
|
||||
begin
|
||||
elHead:=TJSHTMLElement(Document.GetElementByID('head'));
|
||||
btnGo:=TJSHTMLButtonElement(Document.GetElementByID('go'));
|
||||
btnLoad:=TJSHTMLButtonElement(Document.GetElementByID('load'));
|
||||
edtJSObject:=TJSHTMLInputElement(Document.GetElementByID('edtJSObject'));
|
||||
edtScript:=TJSHTMLInputElement(Document.GetElementByID('edtScript'));
|
||||
edtPascalClass:=TJSHTMLInputElement(Document.GetElementByID('edtPascalClass'));
|
||||
edtPascalParentClass:=TJSHTMLInputElement(Document.GetElementByID('edtPascalClassAncestor'));
|
||||
edtExternalName:=TJSHTMLInputElement(Document.GetElementByID('edtExternalName'));
|
||||
edtClassDefinition:=TJSHTMLTextAreaElement(Document.GetElementByID('edtClassDefinition'));
|
||||
btnGo.onclick:=@DoGenCode;
|
||||
btnLoad.onclick:=@DoLoad;
|
||||
end;
|
||||
|
||||
|
||||
begin
|
||||
With TGenCodeApp.Create do
|
||||
Execute;
|
||||
end.
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user