tps_demo_codeexpl.htm
来自「Delphi脚本控件」· HTM 代码 · 共 263 行
HTM
263 行
<html>
<head>
<link rel=stylesheet type="text/css" href="styles.css">
</head>
<body>
<font face="Arial, Helvetica">
<h3>
TpaxScripter Demo. Code Explorer.
</h3>
<hr>
<PRE>
<B>unit</B> CodeExplorer;
<P></P>
<B>interface</B>
<P></P>
<B>uses</B>
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ComCtrls, ExtCtrls,
<P></P>
contnrs,
PaxScripter, PaxPascal;
<B>type</B>
TForm1 = <B>class</B>(TForm)
Panel1: TPanel;
Memo1: TMemo;
TreeView1: TTreeView;
Button1: TButton;
Button2: TButton;
OpenDialog1: TOpenDialog;
PaxScripter1: TPaxScripter;
PaxPascal1: TPaxPascal;
<B>procedure</B> Button1Click(Sender: TObject);
<B>procedure</B> FormCreate(Sender: TObject);
<B>procedure</B> TreeView1DblClick(Sender: TObject);
<B>procedure</B> FormDestroy(Sender: TObject);
<B>procedure</B> Button2Click(Sender: TObject);
<B>procedure</B> TreeView1Click(Sender: TObject);
<B>private</B>
{ <B>private</B> declarations }
Module: Integer;
PosList: TObjectList;
<B>procedure</B> EnumProc(<B>const</B> Name: <B>string</B>;
ID: Integer;
Kind: TPAXMemberKind;
ml: TPAXModifierList;
Data: Pointer);
<B>procedure</B> SetupClassNode(N: TTreeNode; ID: Integer);
<B>procedure</B> SetupFuncNode(N: TTreeNode; ID: Integer);
<B>public</B>
{ <B>public</B> declarations }
<B>end</B>;
<P></P>
<B>var</B>
Form1: TForm1;
<P></P>
<B>implementation</B>
<P></P>
{$R *.DFM}
<P></P>
<B>type</B>
PNodeRec = ^TNodeRec;
TNodeRec = <B>record</B>
NParams, NFields, NConsts, NMethods, NProperties, NClasses: TTreeNode;
<B>end</B>;
<P></P>
TPosObject = <B>class</B>
Module, Position, Length: Integer;
<B>constructor</B> Create(Module, Position, Length: Integer);
<B>end</B>;
<P></P>
<B>constructor</B> TPosObject.Create(Module, Position, Length: Integer);
<B>begin</B>
Self.Module := Module;
Self.Position := Position;
Self.Length := Length;
<B>end</B>;
<P></P>
<B>procedure</B> TForm1.SetupClassNode(N: TTreeNode; ID: Integer);
<B>var</B>
R: TNodeRec;
<B>begin</B>
<B>with</B> TreeView1.Items <B>do</B>
<B>begin</B>
<B>with</B> R <B>do</B>
<B>begin</B>
NConsts := AddChild(N, <font color="red">'Constants'</font>);
NFields := AddChild(N, <font color="red">'Fields'</font>);
NMethods := AddChild(N, <font color="red">'Methods'</font>);
NProperties := AddChild(N, <font color="red">'Properties'</font>);
NClasses := AddChild(N, <font color="red">'Nested classes'</font>);
<B>end</B>;
<P></P>
PaxScripter1.EnumMembers(ID, Module, EnumProc, @R);
<P></P>
<B>with</B> R <B>do</B>
<B>begin</B>
<B>if</B> NConsts.Count = 0 <B>then</B>
NConsts.Delete;
<B>if</B> NFields.Count = 0 <B>then</B>
NFields.Delete;
<B>if</B> NMethods.Count = 0 <B>then</B>
NMethods.Delete;
<B>if</B> NProperties.Count = 0 <B>then</B>
NProperties.Delete;
<B>if</B> NClasses.Count = 0 <B>then</B>
NClasses.Delete;
<B>end</B>;
<B>end</B>;
<B>end</B>;
<P></P>
<B>procedure</B> TForm1.SetupFuncNode(N: TTreeNode; ID: Integer);
<B>var</B>
R: TNodeRec;
<B>begin</B>
<B>with</B> TreeView1.Items <B>do</B>
<B>begin</B>
<B>with</B> R <B>do</B>
<B>begin</B>
NParams := AddChild(N, <font color="red">'Parameters'</font>);
NConsts := AddChild(N, <font color="red">'Constants'</font>);
NFields := AddChild(N, <font color="red">'Local variables'</font>);
NMethods := AddChild(N, <font color="red">'Nested routines'</font>);
NClasses := AddChild(N, <font color="red">'Nested classes'</font>);
<B>end</B>;
<P></P>
PaxScripter1.EnumMembers(ID, Module, EnumProc, @R);
<P></P>
<B>with</B> R <B>do</B>
<B>begin</B>
<B>if</B> NParams.Count = 0 <B>then</B>
NParams.Delete;
<B>if</B> NConsts.Count = 0 <B>then</B>
NConsts.Delete;
<B>if</B> NFields.Count = 0 <B>then</B>
NFields.Delete;
<B>if</B> NMethods.Count = 0 <B>then</B>
NMethods.Delete;
<B>if</B> NClasses.Count = 0 <B>then</B>
NClasses.Delete;
<B>end</B>;
<B>end</B>;
<B>end</B>;
<P></P>
<B>procedure</B> TForm1.EnumProc(<B>const</B> Name: <B>string</B>;
ID: Integer;
Kind: TPAXMemberKind;
ml: TPAXModifierList;
Data: Pointer);
<B>var</B>
P: PNodeRec;
TypeName: <B>string</B>;
PosObject: TPosObject;
<B>begin</B>
<B>with</B> PaxScripter1 <B>do</B>
PosObject := TPosObject.Create(GetModule(ID),
GetPosition(ID),
Length(GetName(ID)));
PosList.Add(PosObject);
<P></P>
P := PNodeRec(Data);
<P></P>
<B>with</B> PaxScripter1 <B>do</B>
TypeName := GetName(GetTypeID(ID));
<P></P>
<B>with</B> TreeView1.Items <B>do</B>
case Kind of
mkParam: AddChildObject(P^.NParams, Name + <font color="red">': '</font> + TypeName, PosObject);
mkField: AddChildObject(P^.NFields, Name + <font color="red">': '</font> + TypeName, PosObject);
mkMethod: SetupFuncNode(AddChildObject(P^.NMethods, Name, PosObject), ID);
mkConst: AddChildObject(P^.NConsts, Name + <font color="red">': '</font> + TypeName, PosObject);
mkClass: SetupClassNode(AddChildObject(P^.NClasses, Name, PosObject), ID);
mkProp: AddChildObject(P^.NProperties, Name + <font color="red">': '</font> + TypeName, PosObject);
<B>end</B>;
<B>end</B>;
<P></P>
<B>procedure</B> TForm1.Button1Click(Sender: TObject);
<B>begin</B>
<B>with</B> OpenDialog1 <B>do</B>
<B>begin</B>
Filter := <font color="red">'paxPascal (*'</font> + <font color="red">'.pp'</font> + <font color="red">'|*'</font> + <font color="red">'.pp'</font>;
<B>if</B> Execute <B>then</B>
<B>begin</B>
<B>if</B> Pos(<font color="red">'.'</font>, FileName) = 0 <B>then</B>
FileName := FileName + <font color="red">'.pp'</font>;
Memo1.Lines.LoadFromFile(FileName);
<B>end</B>;
<B>end</B>;
<B>end</B>;
<P></P>
<B>procedure</B> TForm1.Button2Click(Sender: TObject);
<B>begin</B>
PaxScripter1.ResetScripter;
Module := PaxScripter1.AddModule(<font color="red">'Main'</font>, <font color="red">'paxPascal'</font>);
PaxScripter1.AddCode(<font color="red">'Main'</font>, Memo1.Lines.Text);
PaxScripter1.Compile;
<B>with</B> TreeView1.Items <B>do</B>
<B>begin</B>
Clear;
SetupClassNode(Add(nil, <font color="red">'Noname namespace'</font>), PaxScripter1.GetRootID);
<B>end</B>;
<B>end</B>;
<P></P>
<B>procedure</B> TForm1.FormCreate(Sender: TObject);
<B>var</B>
S: <B>string</B>;
<B>begin</B>
S := ExtractFileDir(Application.ExeName);
SetCurrentDir(S);
OpenDialog1.InitialDir := S;
<P></P>
PosList := TObjectList.Create;
<B>end</B>;
<P></P>
<B>procedure</B> TForm1.FormDestroy(Sender: TObject);
<B>begin</B>
PosList.Free;
<B>end</B>;
<P></P>
<B>procedure</B> TForm1.TreeView1DblClick(Sender: TObject);
<B>var</B>
N: TTreeNode;
PosObject: TPosObject;
<B>begin</B>
N := TTreeView(Sender).Selected;
<P></P>
<B>if</B> N = nil <B>then</B>
Exit;
<P></P>
PosObject := TPosObject(N.Data);
<P></P>
<B>if</B> PosObject <> nil <B>then</B>
<B>if</B> PosObject.Module = Module <B>then</B>
<B>if</B> PosObject.Position >= 0 <B>then</B>
<B>with</B> Memo1 <B>do</B>
<B>begin</B>
SetFocus;
SelStart := PosObject.Position;
SelLength := PosObject.Length;
<B>end</B>;
<B>end</B>;
<P></P>
<B>procedure</B> TForm1.TreeView1Click(Sender: TObject);
<B>begin</B>
TreeView1DblClick(Sender);
<B>end</B>;
<P></P>
<B>end</B>.
</PRE>
<p>
<HR>
<font size = 1 color ="gray">
Copyright © 1999-2005
VIRT Laboratory. All rights reserved.
</font>
</body>
</html>
⌨️ 快捷键说明
复制代码Ctrl + C
搜索代码Ctrl + F
全屏模式F11
增大字号Ctrl + =
减小字号Ctrl + -
显示快捷键?