h_class.pas

一个Delphi解释器的例子

End;

Function TSTRINGSget_TEXT(slf:TObject;var APropName:String;var s:array of variant):variant;
Begin
  Result := TSTRINGS(slf).TEXT;
End;

Function TSTRINGSset_TEXT(slf:TObject;var APropName:String;var s:array of variant):variant;
Begin
TSTRINGS(slf).TEXT:=S[0];
End;

function myTSTRINGLISTFIND(slf:TObject;var APropName:String;var s:array of variant):variant;
var I : Integer;
begin
 I := S[1];
 Result := TSTRINGLIST(slf).FIND(S[0],I);
 S[1]:=I;
End;
{--------------------}
function myTSTRINGLISTSORT(slf:TObject;var APropName:String;var s:array of variant):variant;
begin
 TSTRINGLIST(slf).SORT;
End;
{--------------------}
Function TSTRINGLISTget_DUPLICATES(slf:TObject;var APropName:String;var s:array of variant):variant;
Begin
  Result := TSTRINGLIST(slf).DUPLICATES;
End;

Function TSTRINGLISTset_DUPLICATES(slf:TObject;var APropName:String;var s:array of variant):variant;
Begin
TSTRINGLIST(slf).DUPLICATES:=S[0];
End;
{--------------------}
Function TSTRINGLISTget_SORTED(slf:TObject;var APropName:String;var s:array of variant):variant;
Begin
  Result := TSTRINGLIST(slf).SORTED;
End;

Function TSTRINGLISTset_SORTED(slf:TObject;var APropName:String;var s:array of variant):variant;
Begin
TSTRINGLIST(slf).SORTED:=S[0];
End;

{--------------------}
function myTCOMPONENTCREATE(slf:TObject;var APropName:String;var s:array of variant):variant;
begin
 Result:=ObjToVar(TCOMPONENT(slf).CREATE(TComponent(VarToObj(S[0]))));
End;
{--------------------}
function myTCOMPONENTDESTROYING(slf:TObject;var APropName:String;var s:array of variant):variant;
begin
 TCOMPONENT(slf).DESTROYING;
End;
{--------------------}
function myTCOMPONENTFINDCOMPONENT(slf:TObject;var APropName:String;var s:array of variant):variant;
begin
 Result := ObjToVar(TCOMPONENT(slf).FINDCOMPONENT(S[0]));
End;
{--------------------}
function myTCOMPONENTGETPARENTCOMPONENT(slf:TObject;var APropName:String;var s:array of variant):variant;
begin
 Result := ObjToVar(TCOMPONENT(slf).GETPARENTCOMPONENT);
End;
{--------------------}
function myTCOMPONENTHASPARENT(slf:TObject;var APropName:String;var s:array of variant):variant;
begin
 Result := TCOMPONENT(slf).HASPARENT;
End;
{--------------------}
function myTCOMPONENTFREENOTIFICATION(slf:TObject;var APropName:String;var s:array of variant):variant;
begin
 TCOMPONENT(slf).FREENOTIFICATION(TCOMPONENT(VarToObj(S[0])));
End;
{--------------------}
function myTCOMPONENTINSERTCOMPONENT(slf:TObject;var APropName:String;var s:array of variant):variant;
begin
 TCOMPONENT(slf).INSERTCOMPONENT(TCOMPONENT(VarToObj(S[0])));
End;
{--------------------}
function myTCOMPONENTREMOVECOMPONENT(slf:TObject;var APropName:String;var s:array of variant):variant;
begin
 TCOMPONENT(slf).REMOVECOMPONENT(TCOMPONENT(VarToObj(S[0])));
End;
{--------------------}
Function TCOMPONENTget_COMPONENTCOUNT(slf:TObject;var APropName:String;var s:array of variant):variant;
Begin
  Result := TCOMPONENT(slf).COMPONENTCOUNT;
End;
{--------------------}
Function TCOMPONENTget_COMPONENTINDEX(slf:TObject;var APropName:String;var s:array of variant):variant;
Begin
  Result := TCOMPONENT(slf).COMPONENTINDEX;
End;

Function TCOMPONENTset_COMPONENTINDEX(slf:TObject;var APropName:String;var s:array of variant):variant;
Begin
TCOMPONENT(slf).COMPONENTINDEX:=S[0];
End;
{--------------------}
Function TCOMPONENTget_OWNER(slf:TObject;var APropName:String;var s:array of variant):variant;
Begin
  Result := ObjToVar(TCOMPONENT(slf).OWNER);
End;

{--------------------}
Function TCOMPONENTget_NAME(slf:TObject;var APropName:String;var s:array of variant):variant;
Begin
  Result := TCOMPONENT(slf).NAME;
End;

Function TCOMPONENTset_NAME(slf:TObject;var APropName:String;var s:array of variant):variant;
Begin
TCOMPONENT(slf).NAME:=S[0];
End;
{--------------------}
Function TCOMPONENTget_TAG(slf:TObject;var APropName:String;var s:array of variant):variant;
Begin
  Result := TCOMPONENT(slf).TAG;
End;

Function TCOMPONENTset_TAG(slf:TObject;var APropName:String;var s:array of variant):variant;
Begin
TCOMPONENT(slf).TAG:=S[0];
End;

Function TStringsget_names(slf:TObject;var APropName:String;var s:array of variant):variant;
Begin
  Result := TSTRINGS(slf).Names[S[0]];
End;

Function TStringsget_objects(slf:TObject;var APropName:String;var s:array of variant):variant;
Begin
  Result := ObjToVar(TSTRINGS(slf).Objects[S[0]]);
End;

Function TStringsset_Objects(slf:TObject;var APropName:String;var s:array of variant):variant;
Begin
  TStrings(slf).Objects[S[0]]:=VarToObj(S[1]);
End;

Function TStringsget_Values(slf:TObject;var APropName:String;var s:array of variant):variant;
Begin
  Result := TSTRINGS(slf).Values[S[0]];
End;

Function TStringsset_Values(slf:TObject;var APropName:String;var s:array of variant):variant;
Begin
  TStrings(slf).Values[S[0]]:=S[1];
End;


Function TStringsget_Strings(slf:TObject;var APropName:String;var s:array of variant):variant;
Begin
  Result := TSTRINGS(slf).Strings[S[0]];
End;

Function TStringsset_Strings(slf:TObject;var APropName:String;var s:array of variant):variant;
Begin
  TStrings(slf).Strings[S[0]]:=S[1];
End;


Function TComponentget_components(slf:TObject;var APropName:String;var s:array of variant):variant;
Begin
  Result:=ObjTOVar(TComponent(slf).Components[S[0]]);
End;

{----------------------------}
procedure ClassesHalInit;
begin

//   AddObjectType('TLIST','TOBJECT');
{  AddObjectType('TPERSISTENT','TOBJECT');
  AddObjectType('TSTRINGS','TPERSISTENT');
  AddObjectType('TSTRINGLIST','TSTRINGS');
  AddObjectType('TCOMPONENT','TPERSISTENT');}

(*
  AddFun ('TLIST.ADD',myTLISTADD,[0]);
  AddProc('TLIST.CLEAR',myTLISTCLEAR,[2]);
  AddProc('TLIST.DELETE',myTLISTDELETE,[0]);
  AddProc('TLIST.EXCHANGE',myTLISTEXCHANGE,[0,0]);
  AddFun ('TLIST.EXPAND',myTLISTEXPAND,[2]);
  AddFun ('TLIST.FIRST',myTLISTFIRST,[2]);
  AddFun ('TLIST.INDEXOF',myTLISTINDEXOF,[0]);
  AddProc('TLIST.INSERT',myTLISTINSERT,[0,0]);
  AddFun ('TLIST.LAST',myTLISTLAST,[2]);
  AddProc('TLIST.MOVE',myTLISTMOVE,[0,0]);
  AddFun ('TLIST.REMOVE',myTLISTREMOVE,[0]);
  AddProc('TLIST.PACK',myTLISTPACK,[2]);
  AddProc('TLIST.SORT',myTLISTSORT,[0]);
  AddProp('TLIST.CAPACITY',TLISTget_CAPACITY,TLISTset_CAPACITY);
  AddProp('TLIST.COUNT',TLISTget_COUNT,TLISTset_COUNT);
  AddProp('TLIST.LIST',TLISTget_LIST,TLISTset_LIST);
*)
  AddProc('TPERSISTENT.ASSIGN',myTPERSISTENTASSIGN,[0]);


  AddArrayProp('TSTRINGS.STRINGS',1,TSTRINGSget_Strings,TSTRINGSset_Strings);
  AddArrayProp('TSTRINGS.Names',1,TSTRINGSget_names,nil);
  AddArrayProp('TSTRINGS.Objects',1,TSTRINGSget_objects,TSTRINGSset_objects);
  AddArrayProp('TSTRINGS.Values',1,TSTRINGSget_Values,TSTRINGSset_Values);
  AddFun ('TSTRINGS.ADD',myTSTRINGSADD,[0]);
  AddFun ('TSTRINGS.ADDOBJECT',myTSTRINGSADDOBJECT,[0,0]);
  AddProc('TSTRINGS.APPEND',myTSTRINGSAPPEND,[0]);
  AddProc('TSTRINGS.ADDSTRINGS',myTSTRINGSADDSTRINGS,[0]);
  AddProc('TSTRINGS.BEGINUPDATE',myTSTRINGSBEGINUPDATE,[2]);
  AddProc('TSTRINGS.CLEAR',myTSTRINGSCLEAR,[2]);
  AddProc('TSTRINGS.DELETE',myTSTRINGSDELETE,[0]);
  AddProc('TSTRINGS.ENDUPDATE',myTSTRINGSENDUPDATE,[2]);
  AddFun ('TSTRINGS.EQUALS',myTSTRINGSEQUALS,[0]);
  AddProc('TSTRINGS.EXCHANGE',myTSTRINGSEXCHANGE,[0,0]);
  AddFun ('TSTRINGS.INDEXOF',myTSTRINGSINDEXOF,[0]);
  AddFun ('TSTRINGS.INDEXOFNAME',myTSTRINGSINDEXOFNAME,[0]);
  AddFun ('TSTRINGS.INDEXOFOBJECT',myTSTRINGSINDEXOFOBJECT,[0]);
  AddProc('TSTRINGS.INSERT',myTSTRINGSINSERT,[0,0]);
//  AddProc('TSTRINGS.INSERTOBJECT',myTSTRINGSINSERTOBJECT,[0,0,0]);
  AddProc('TSTRINGS.LOADFROMFILE',myTSTRINGSLOADFROMFILE,[0]);
  AddProc('TSTRINGS.MOVE',myTSTRINGSMOVE,[0,0]);
  AddProc('TSTRINGS.SAVETOFILE',myTSTRINGSSAVETOFILE,[0]);
  AddProp('TSTRINGS.COMMATEXT',TSTRINGSget_COMMATEXT,TSTRINGSset_COMMATEXT);
  AddProp('TSTRINGS.COUNT',TSTRINGSget_COUNT,nil);
  AddProp('TSTRINGS.TEXT',TSTRINGSget_TEXT,TSTRINGSset_TEXT);

  AddFun ('TSTRINGLIST.Create',myTSTRINGListCreate,[2]);
  AddFun ('TSTRINGLIST.FIND',myTSTRINGLISTFIND,[0,1]);
  AddProc('TSTRINGLIST.SORT',myTSTRINGLISTSORT,[2]);
  AddProp('TSTRINGLIST.DUPLICATES',TSTRINGLISTget_DUPLICATES,TSTRINGLISTset_DUPLICATES);
  AddProp('TSTRINGLIST.SORTED',TSTRINGLISTget_SORTED,TSTRINGLISTset_SORTED);

  AddFun ('TCOMPONENT.FINDCOMPONENT',myTCOMPONENTFINDCOMPONENT,[0]);
  AddFun ('TCOMPONENT.GETPARENTCOMPONENT',myTCOMPONENTGETPARENTCOMPONENT,[2]);
  AddFun ('TCOMPONENT.HASPARENT',myTCOMPONENTHASPARENT,[2]);
//  AddProc('TCOMPONENT.FREENOTIFICATION',myTCOMPONENTFREENOTIFICATION,[0]);
  AddProc('TCOMPONENT.INSERTCOMPONENT',myTCOMPONENTINSERTCOMPONENT,[0]);
  AddProc('TCOMPONENT.REMOVECOMPONENT',myTCOMPONENTREMOVECOMPONENT,[0]);
  AddProp('TCOMPONENT.COMPONENTCOUNT',TCOMPONENTget_COMPONENTCOUNT,nil);
  AddProp('TCOMPONENT.COMPONENTINDEX',TCOMPONENTget_COMPONENTINDEX,TCOMPONENTset_COMPONENTINDEX);
  AddProp('TCOMPONENT.OWNER',TCOMPONENTget_OWNER,nil);
  AddProp('TCOMPONENT.NAME',TCOMPONENTget_NAME,TCOMPONENTset_NAME);
  AddProp('TCOMPONENT.TAG',TCOMPONENTget_TAG,TCOMPONENTset_TAG);
  AddArrayProp('TCOMPONENT.COMPONENTS',1,TCOMPONENTget_COMPONENTS,nil);

  AddConst('dupIgnore',dupIgnore);
  AddConst('dupAccept',dupAccept);
  AddConst('dupError',dupError);
end;

Initialization ClassesHalInit;
               RegisterClasses([TComponent,TStrings,TStringList,TPersistent]);
End.