|
unit Convert;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ComCtrls, jpeg, ExtCtrls, StrUtils, WinSock,
ShellAPI, OptionClass, Utilities, Frame11, Interfaces;
const
em = 3000;
Soft = 'Software';
endcolor='\cf0\f0 ';
indepth=4;
type
Destination = (D_JAVA, D_PL1);
Status = (s_working, s_linkage, s_procedure, s_assign,
s_while, s_expression, s_declaration, s_null);
procedure MakeJava(FN:String;SO:TTreeView;var TR:TRichEdit);
procedure SaveAsJava(FN:String;TR:TRichEdit);
procedure traverse(tn:TTreeNode);
procedure CompileLinkGo(Hand:THandle;SDir,SClass:String);
var
os:TMemoryStream;
indent:integer;
State:Status;
TVL:LongTexts;
Working, Linkage, Actuals, Values, Method:String;
Listcounter:integer;
implementation
//-------------------------------------
// stream out
//-------------------------------------
procedure app(S:String);
var i:integer;
begin
for i:=1 to Length(S) do
os.WriteBuffer(S[i], 1);
end;
//-------------------------------------
// stream out
//-------------------------------------
function colorof(H:Highlite):String;
var i:Highlite;R:String;
begin
R:='1';
for i:=low(Opt.r.Highlites) to High(Opt.r.Highlites) do
if i=H then
R:= inttostr(ord(i)+1);
R:='\cf'+R+' \f1 ';
colorof:=R
end;
//-------------------------------------
// stream out
//-------------------------------------
function endline():String;
var S:String;i:integer;
begin
S:='';
for i:=1 to indent do S:=S+' ';
endline:='\par '+S;
end;
//-------------------------------------
// express
//-------------------------------------
procedure rtfheader;
var
Header : String ;
h : Highlite; C:TColor;
rgb, r, g, b : integer; Fsk : String;
ThisFont:String;
begin
ThisFont:='Fixedsys';
//set rtf header
Header := '{\rtf1\ansi\deff0{\fonttbl{\f0\fnil\fcharset0 '+ThisFont+';}'+
'{\f1\fmodern\fprq1\fcharset0 '+ThisFont+';}';
Header := Header + '{\colortbl;';
for h:= low(Highlite) to high(Highlite) do begin
C := opt.r.Highlites[h];
rgb := ColorToRGB(C);
b := rgb mod 256;rgb := rgb div 256;
g := rgb mod 256;rgb := rgb div 256;
r := rgb;
Header := Header + '\red' + Inttostr(r);
Header := Header + '\green'+ IntToStr(g);
Header := Header + '\blue' + IntToStr(b);
Header := Header + ';';
end;
Header := Header + '}';
Fsk:='';
if fsbold in Opt.R.FontStyle then Fsk := Fsk + '\b ';
if fsunderline in Opt.R.FontStyle then Fsk := Fsk + '\u ';
if fsitalic in Opt.R.FontStyle then Fsk := Fsk + '\i ';
Header := Header +
'{\*\generator Msftedit 5.41.15.1507;}\viewkind4\uc1\pard\lang1031'+
Fsk+'\f0\fs'+
inttostr(Opt.r.fontsize*2)+'}';
app(Header)
end;
//-------------------------------------
// class header
//-------------------------------------
procedure fileheader(S:String);
var T:String;
begin
indent := 0;
T:=colorof(H_Keyword)+'import '+endcolor;
T:=T+colorof(H_Identifier)+'java.io.*'+endcolor;
T:=T+colorof(H_String)+';'+endcolor;
app(T+endline);
T:=colorof(H_Keyword)+'import '+endcolor;
T:=T+colorof(H_Identifier)+'com.ibm.math.*'+endcolor;
T:=T+colorof(H_String)+';'+endcolor;
app(T+endline+endline);
end;
//-------------------------------------
// class header
//-------------------------------------
procedure classheader(S:String);
var T:String;
begin
indent := 0;
T:=colorof(H_Keyword);
T:=T+'public class ';
T:=T+endcolor;
app(T);
app(colorof(H_Identifier)+Stripof(S)+endcolor);
app(colorof(H_String)+' \{'+endcolor);
indent := indent+indepth;
app(endline());
State:=s_null;
end;
//-------------------------------------
// method header
//-------------------------------------
procedure methodheader(S:String);
begin
app(colorof(H_Keyword)+'public static void '+endcolor);
app(S);
Method:=S;
indent := indent+indepth;
Working:='';
Linkage:='';
end;
//-------------------------------------
// method header
//-------------------------------------
procedure methodtrailer(S:String);
begin
app(colorof(H_String));app('\} ');app(endcolor);
app(colorof(H_Comment));app('//'+ S);app(endcolor);
app(endline());
end;
//-------------------------------------
// express
//-------------------------------------
procedure classtrailer(S:String);
begin
app(endline);
app(colorof(H_Keyword)+'public static void '+endcolor);
app(colorof(H_Identifier)+'main('+endcolor);
app(colorof(H_Keyword)+'String'+endcolor);
app(colorof(H_String)+'[] '+endcolor);
app(colorof(H_Identifier)+'args'+endcolor);
app(colorof(H_String)+') \{'+endcolor+endline);
app(colorof(H_Identifier)+Method+endcolor);
app(colorof(H_String)+'('+Actuals+');'+endcolor);
app(colorof(H_String)+'\}'+endcolor+endline);
indent := indent-indepth;
app(endline);
app(colorof(H_String)); app('\}');app(endcolor);
app(colorof(H_Comment)); app(' //'+ S);app(endcolor);
app('}');
indent := 0;
end;
//-------------------------------------
// parse
//-------------------------------------
function expression(tn:TTreeNode):String;
var S, R:String;tc:TTreeNode;
begin
expression:='';
if tn<>nil then begin
S := tn.Text;R:='';
if (S=':=') or (S='+') or (S='-') or (S='*') or (S='/')
or (S='<') or (S='<=') or (S='==') or (S='>=') or (S='>') or (S='<>')
or (S='**') or (S='rem') then begin
tc:=tn.getFirstChild;
if S=':=' then S:=' = ';
R:=expression(tc)+colorof(H_String)+' '+S+endcolor+' ';
while tc<>nil do begin
tc:=tc.getNextSibling;
R:=R+expression(tc)
end
end else if (S='Test') then begin
tc:=tn.getFirstChild;
R:=expression(tc)+' ';
while tc<>nil do begin
tc:=tc.getNextSibling;
R:=R+expression(tc)
end
end else
R := colorof(H_Identifier)+S+endcolor;
expression:=R
end
end;
//-------------------------------------
// append to list
//-------------------------------------
procedure append(var S:String;T:String);
begin
if S='' then S:=T
else begin
S:=S+','+T
end
end;
//-------------------------------------
// express
//-------------------------------------
function definitions(tn:TTreeNode;Sep:char;wrap:boolean):String;
var L, T, B, S, R, D:String;
begin
if tn<>nil then begin
if wrap then Listcounter := Listcounter+1;
L := Longeur(TVL,tn);
T := getpar(S_Typ,L);
B := getpar(S_Bas,L);
if B='decimalbase' then begin
R:=colorof(H_Keyword)+'long ' +endcolor+Functor(L);
append(Values,inttostr(Random(GetCurrentTime MOD 29)));
end else if B='binarybase' then begin
R:=colorof(H_Keyword)+'long ' +endcolor+Functor(L);
append(Values,inttostr(Random(GetCurrentTime MOD 29)));
end else if B='octetbase' then begin
R:=colorof(H_Keyword)+'String '+endcolor+Functor(L);
append(Values,inttostr(Random(GetCurrentTime MOD 29)));
end else begin
R:=colorof(H_Identifier)+S+endcolor
end;
if wrap and (Listcounter>=3) then begin R:=endline()+R;ListCounter:=0 end;
D:=definitions(tn.getNextSibling(),Sep,wrap);
if (D<>'') then definitions:=R+Sep+D
else if (Sep=';') then definitions:=R+Sep+D
else definitions:=R
end
else definitions:='';
end;
//-------------------------------------
// express
//-------------------------------------
procedure traverse(tn:TTreeNode);
var tc:TTreeNode;S :String;komma:boolean;
begin
if tn<>nil then begin
S := tn.Text;
if S='Data' then begin
tc:=tn.getFirstChild();
while tc<>nil do begin
traverse(tc);
tc:=tc.getNextSibling
end
end else if S='Working-Storage' then begin
Listcounter:=0;
Values:='';
Working:=definitions(tn.getFirstChild(),';',true);
end else if S='Linkage' then begin
Listcounter:=0;
Values:='';
Linkage:=definitions(tn.getFirstChild(),',',false);
Actuals:=Values;
end else if S='Procedure' then begin
if Linkage<>'' then begin
app('('+Linkage+')'+colorof(H_String)+' \{'+endcolor+endline());
end else
app(colorof(H_String)+'() \{'+endcolor+endline);
app(Working);
traverse(tn.getFirstChild());
indent:=indent-indepth;
end else if S='If' then begin
tc:=tn.getFirstChild();
app(expression(tc)+endline());
traverse(tc.getNextSibling)
end else if S=':=' then begin
S:=expression(tn);
app(endline+S+';');
tc:=tn.Parent.GetNextChild(tn);
traverse(tc);
end else if (S='interface') then begin
tc:=tn.getFirstChild;
S:=expression(tc);
if tc.Text='display' then
S:=StringReplace(S,'display','System.out.println',[rfReplaceAll]);
app(endline+S+'(');
tc:=tc.getNextSibling;
komma:=false;
while tc<>nil do begin
if komma then app(colorof(H_String)+'+'+endcolor);
komma:=true;
S:=expression(tc);
app(S);
tc:=tc.getNextSibling;
end;
app(colorof(H_String)+')'+endcolor+';')
end else if S='branch' then begin
end else if S='perform' then begin
app(endline+colorof(H_Keyword)+'while'+endcolor+colorof(H_String)+' (!('+endcolor);
indent:=indent+indepth;
tc:=tn.getFirstChild();
app(expression(tc));
app(colorof(H_String)+')) \{'+endcolor);
tc:=tc.getNextSibling();
traverse(tc);
indent:=indent-indepth;
app(colorof(H_String)+'\}'+endcolor);
tc:=tn.Parent.GetNextChild(tn);
traverse(tc);
end else begin
tc:=tn.getFirstChild();
while tc<>nil do begin
traverse(tc);
tc:=tc.getNextSibling
end
end
end
end;
//-------------------------------------
// JavaConvert
//-------------------------------------
procedure MakeJava(FN:String;SO:TTreeView;var TR:TRichEdit);
var
streamout:TMemoryStream;
Save_Cursor:TCursor;
begin
TR.Lines.Clear;
streamout := TMemoryStream.Create;
streamout.SetSize(SO.Items.Count*32);
streamout.Position := 0;
os:=streamout;
Save_Cursor := Screen.Cursor;
Screen.Cursor := crHourGlass;
// now output JAVA program
RtfHeader;
fileheader(LowerCase(Application.Title));
classheader(Fn);
methodheader(SO.TopItem.Text);
traverse(SO.TopItem);
methodtrailer(SO.TopItem.Text);
classtrailer(Fn);
// and load it to richedit
streamout.Position := 0;
TR.Lines.LoadFromStream(streamout);
Screen.Cursor := Save_Cursor;
streamout.Destroy
end;
{------------------------------------------------------------------}
{- execute JAVA artefact -}
{- -}
{------------------------------------------------------------------}
procedure CompileLinkGo(Hand:THandle;SDir,SClass:String);
var Fse: text;CmdFile, Umleitung:String;H:Cardinal;
begin
CmdFile:=SDir+SClass+'.cmd';
Umleitung := '>'+StripOf(SClass)+'.txt';
try
AssignFile (Fse,CmdFile);
Rewrite(fse);
writeln(fse,'javac '+SClass+' 2'+Umleitung);
writeln(fse,'java -cp . '+StripOf(SClass)+' 1'+Umleitung);
writeln(fse,'pause');
CloseFile(fse);
except
On E:Exception do error(em+53,'unable to create '+sdir+SMAcOut
+' Dir='+SDir+' Msg='+E.Message);
end;
H:=ShellExecuteA(Hand,'exec',PChar(CmdFile),nil,PChar(SDir), SW_HIDE);
TerminateProcess(H,0);
end;
//-------------------------------------
// MakeJava
//-------------------------------------
procedure SaveAsJava(FN:String;TR:TRichEdit);
begin
TR.PlainText:=true;
TR.Lines.SaveToFile(FN);
TR.PlainText:=false;
end;
{------------------------------------------------------------------}
{- -}
{- Ende dieser Quelle -}
{- -}
{------------------------------------------------------------------}
end.
¤ Dauer der Verarbeitung: 0.21 Sekunden
(vorverarbeitet)
¤
|
Haftungshinweis
Die Informationen auf dieser Webseite wurden
nach bestem Wissen sorgfältig zusammengestellt. Es wird jedoch weder Vollständigkeit, noch Richtigkeit,
noch Qualität der bereit gestellten Informationen zugesichert.
Bemerkung:
Die farbliche Syntaxdarstellung ist noch experimentell.
|
