h_forms.pas

一个Delphi解释器的例子

begin
 TAPPLICATION(slf).HANDLEEXCEPTION(VarToObj(S[0]));
End;
{--------------------}
function myTAPPLICATIONHANDLEMESSAGE(slf:TObject;var APropName:String;var s:array of variant):variant;
begin
 TAPPLICATION(slf).HANDLEMESSAGE;
End;
{--------------------}
function myTAPPLICATIONHELPCOMMAND(slf:TObject;var APropName:String;var s:array of variant):variant;
begin
 Result := TAPPLICATION(slf).HELPCOMMAND(S[0],S[1]);
End;
{--------------------}
function myTAPPLICATIONHELPCONTEXT(slf:TObject;var APropName:String;var s:array of variant):variant;
begin
 Result := TAPPLICATION(slf).HELPCONTEXT(S[0]);
End;
{--------------------}
function myTAPPLICATIONHELPJUMP(slf:TObject;var APropName:String;var s:array of variant):variant;
begin
 Result := TAPPLICATION(slf).HELPJUMP(S[0]);
End;
{--------------------}
{function myTAPPLICATIONHIDEHINT(slf:TObject;var APropName:String;var s:array of variant):variant;
begin
 TAPPLICATION(slf).HIDEHINT;
End; }
{--------------------}
function myTAPPLICATIONPROCESSMESSAGES(slf:TObject;var APropName:String;var s:array of variant):variant;
begin
 TAPPLICATION(slf).PROCESSMESSAGES;
End;
{--------------------}
Function TAPPLICATIONget_ACTIVE(slf:TObject;var APropName:String;var s:array of variant):variant;
Begin
  Result := TAPPLICATION(slf).ACTIVE;
End;
{--------------------}
Function TAPPLICATIONget_EXENAME(slf:TObject;var APropName:String;var s:array of variant):variant;
Begin
  Result := TAPPLICATION(slf).EXENAME;
End;

{--------------------}
{Function TAPPLICATIONget_HANDLE(slf:TObject;var APropName:String;var s:array of variant):variant;
Begin
  Result := TAPPLICATION(slf).HANDLE;
End;

Function TAPPLICATIONset_HANDLE(slf:TObject;var APropName:String;var s:array of variant):variant;
Begin
TAPPLICATION(slf).HANDLE:=S[0];
End;}
{--------------------}
Function TAPPLICATIONget_HELPFILE(slf:TObject;var APropName:String;var s:array of variant):variant;
Begin
  Result := TAPPLICATION(slf).HELPFILE;
End;

Function TAPPLICATIONset_HELPFILE(slf:TObject;var APropName:String;var s:array of variant):variant;
Begin
TAPPLICATION(slf).HELPFILE:=S[0];
End;
{--------------------}
Function TAPPLICATIONget_HINT(slf:TObject;var APropName:String;var s:array of variant):variant;
Begin
  Result := TAPPLICATION(slf).HINT;
End;

Function TAPPLICATIONset_HINT(slf:TObject;var APropName:String;var s:array of variant):variant;
Begin
TAPPLICATION(slf).HINT:=S[0];
End;
{--------------------}
Function TAPPLICATIONget_HINTCOLOR(slf:TObject;var APropName:String;var s:array of variant):variant;
Begin
  Result := TAPPLICATION(slf).HINTCOLOR;
End;

Function TAPPLICATIONset_HINTCOLOR(slf:TObject;var APropName:String;var s:array of variant):variant;
Begin
TAPPLICATION(slf).HINTCOLOR:=S[0];
End;
{--------------------}
Function TAPPLICATIONget_HINTPAUSE(slf:TObject;var APropName:String;var s:array of variant):variant;
Begin
  Result := TAPPLICATION(slf).HINTPAUSE;
End;

Function TAPPLICATIONset_HINTPAUSE(slf:TObject;var APropName:String;var s:array of variant):variant;
Begin
TAPPLICATION(slf).HINTPAUSE:=S[0];
End;
{--------------------}
Function TAPPLICATIONget_HINTSHORTPAUSE(slf:TObject;var APropName:String;var s:array of variant):variant;
Begin
  Result := TAPPLICATION(slf).HINTSHORTPAUSE;
End;

Function TAPPLICATIONset_HINTSHORTPAUSE(slf:TObject;var APropName:String;var s:array of variant):variant;
Begin
TAPPLICATION(slf).HINTSHORTPAUSE:=S[0];
End;
{--------------------}
Function TAPPLICATIONget_HINTHIDEPAUSE(slf:TObject;var APropName:String;var s:array of variant):variant;
Begin
  Result := TAPPLICATION(slf).HINTHIDEPAUSE;
End;

Function TAPPLICATIONset_HINTHIDEPAUSE(slf:TObject;var APropName:String;var s:array of variant):variant;
Begin
TAPPLICATION(slf).HINTHIDEPAUSE:=S[0];
End;
{--------------------}
Function TAPPLICATIONget_MAINFORM(slf:TObject;var APropName:String;var s:array of variant):variant;
Begin
  Result := ObjToVar(TAPPLICATION(slf).MAINFORM);
End;

{--------------------}
Function TAPPLICATIONget_SHOWHINT(slf:TObject;var APropName:String;var s:array of variant):variant;
Begin
  Result := TAPPLICATION(slf).SHOWHINT;
End;

Function TAPPLICATIONset_SHOWHINT(slf:TObject;var APropName:String;var s:array of variant):variant;
Begin
TAPPLICATION(slf).SHOWHINT:=S[0];
End;
{--------------------}
Function TAPPLICATIONget_SHOWMAINFORM(slf:TObject;var APropName:String;var s:array of variant):variant;
Begin
  Result := TAPPLICATION(slf).SHOWMAINFORM;
End;

Function TAPPLICATIONset_SHOWMAINFORM(slf:TObject;var APropName:String;var s:array of variant):variant;
Begin
TAPPLICATION(slf).SHOWMAINFORM:=S[0];
End;
{--------------------}
Function TAPPLICATIONget_TERMINATED(slf:TObject;var APropName:String;var s:array of variant):variant;
Begin
  Result := TAPPLICATION(slf).TERMINATED;
End;

{--------------------}
Function TAPPLICATIONget_TITLE(slf:TObject;var APropName:String;var s:array of variant):variant;
Begin
  Result := TAPPLICATION(slf).TITLE;
End;

Function TAPPLICATIONset_TITLE(slf:TObject;var APropName:String;var s:array of variant):variant;
Begin
TAPPLICATION(slf).TITLE:=S[0];
End;
{--------------------}
Function TAPPLICATIONget_UPDATEFORMATSETTINGS(slf:TObject;var APropName:String;var s:array of variant):variant;
Begin
  Result := TAPPLICATION(slf).UPDATEFORMATSETTINGS;
End;

Function TAPPLICATIONset_UPDATEFORMATSETTINGS(slf:TObject;var APropName:String;var s:array of variant):variant;
Begin
TAPPLICATION(slf).UPDATEFORMATSETTINGS:=S[0];
End;
{--------------------}
Function TScreenget_Forms(slf:TObject;var APropName:String;var s:array of variant):variant;
Begin
  Result := ObjTOVar(TScreen(slf).Forms[S[0]]);
End;

{-----------------------------------------------}
procedure FormsHalInit;
begin
{   AddObjectType('TSCROLLBOX','TWINCONTROL');
   AddObjectType('TFORM','TSCROLLBOX');
   AddObjectType('TDATAMODULE','TCOMPONENT');
   AddObjectType('TSCREEN','TCOMPONENT');
   AddObjectType('TAPPLICATION','TCOMPONENT');}

   AddFun('TFORM.CREATE',myTFORMCREATE,[0]);
//   AddFun('TFORM.CREATENEW',myTFORMCREATENEW,[0]);
   AddProc('TFORM.ARRANGEICONS',myTFORMARRANGEICONS,[2]);
   AddProc('TFORM.CASCADE',myTFORMCASCADE,[2]);
   AddProc('TFORM.CLOSE',myTFORMCLOSE,[2]);
   AddFun ('TFORM.CLOSEQUERY',myTFORMCLOSEQUERY,[2]);
   AddProc('TFORM.FOCUSCONTROL',myTFORMFOCUSCONTROL,[0]);
   AddProc('TFORM.HIDE',myTFORMHIDE,[2]);
   AddProc('TFORM.NEXT',myTFORMNEXT,[2]);
   AddProc('TFORM.PREVIOUS',myTFORMPREVIOUS,[2]);
   AddProc('TFORM.PRINT',myTFORMPRINT,[2]);
   AddProc('TFORM.RELEASE',myTFORMRELEASE,[2]);
   AddProc('TFORM.SHOW',myTFORMSHOW,[2]);
   AddFun ('TFORM.SHOWMODAL',myTFORMSHOWMODAL,[2]);
   AddProc('TFORM.TILE',myTFORMTILE,[2]);
   AddProp('TFORM.ACTIVE',TFORMget_ACTIVE,nil);
   AddProp('TFORM.ACTIVEMDICHILD',TFORMget_ACTIVEMDICHILD,nil);
   AddProp('TFORM.MODALRESULT',TFORMget_MODALRESULT,TFORMset_MODALRESULT);
   AddProp('TFORM.MDICHILDCOUNT',TFORMget_MDICHILDCOUNT,nil);
   AddProp('TFORM.ACTIVECONTROL',TFORMget_ACTIVECONTROL,TFORMset_ACTIVECONTROL);
   AddProp('TFORM.CAPTION',TFORMget_CAPTION,TFORMset_CAPTION);
   AddProp('TFORM.CLIENTHEIGHT',TFORMget_CLIENTHEIGHT,TFORMset_CLIENTHEIGHT);
   AddProp('TFORM.CLIENTWIDTH',TFORMget_CLIENTWIDTH,TFORMset_CLIENTWIDTH);
   AddProp('TFORM.CTL3D',TFORMget_CTL3D,TFORMset_CTL3D);
   AddProp('TFORM.COLOR',TFORMget_COLOR,TFORMset_COLOR);
   AddProp('TFORM.ENABLED',TFORMget_ENABLED,TFORMset_ENABLED);
   AddProp('TFORM.FORMSTYLE',TFORMget_FORMSTYLE,TFORMset_FORMSTYLE);
   AddProp('TFORM.KEYPREVIEW',TFORMget_KEYPREVIEW,TFORMset_KEYPREVIEW);
   AddProp('TFORM.MENU',TFORMget_MENU,TFORMset_MENU);
   AddProp('TFORM.PIXELSPERINCH',TFORMget_PIXELSPERINCH,TFORMset_PIXELSPERINCH);

   AddFun('TDATAMODULE.CREATE',myTDATAMODULECREATE,[0]);
//   AddFun('TDATAMODULE.CREATENEW',myTDATAMODULECREATENEW,[0]);

   AddProp('TSCREEN.ACTIVECONTROL',TSCREENget_ACTIVECONTROL,nil);
   AddProp('TSCREEN.ACTIVEFORM',TSCREENget_ACTIVEFORM,nil);
   AddProp('TSCREEN.CURSOR',TSCREENget_CURSOR,TSCREENset_CURSOR);
   AddProp('TSCREEN.DATAMODULECOUNT',TSCREENget_DATAMODULECOUNT,nil);
   AddProp('TSCREEN.FONTS',TSCREENget_FONTS,nil);
   AddProp('TSCREEN.HEIGHT',TSCREENget_HEIGHT,nil);
   AddProp('TSCREEN.PIXELSPERINCH',TSCREENget_PIXELSPERINCH,nil);
   AddProp('TSCREEN.WIDTH',TSCREENget_WIDTH,nil);
   AddProp('TSCREEN.FORMCOUNT',TSCREENget_FORMCOUNT,nil);
   AddArrayProp('TSCREEN.FORMS',1,TSCREENget_FORMS,nil);

   AddProc('TAPPLICATION.BRINGTOFRONT',myTAPPLICATIONBRINGTOFRONT,[2]);
  // AddProc('TAPPLICATION.CANCELHINT',myTAPPLICATIONCANCELHINT,[2]);
   AddProc('TAPPLICATION.HANDLEEXCEPTION',myTAPPLICATIONHANDLEEXCEPTION,[0]);
   AddProc('TAPPLICATION.HANDLEMESSAGE',myTAPPLICATIONHANDLEMESSAGE,[2]);
   AddFun ('TAPPLICATION.HELPCOMMAND',myTAPPLICATIONHELPCOMMAND,[0,0]);
   AddFun ('TAPPLICATION.HELPCONTEXT',myTAPPLICATIONHELPCONTEXT,[0]);
   AddFun ('TAPPLICATION.HELPJUMP',myTAPPLICATIONHELPJUMP,[0]);
  // AddProc('TAPPLICATION.HIDEHINT',myTAPPLICATIONHIDEHINT,[2]);
   AddProc('TAPPLICATION.PROCESSMESSAGES',myTAPPLICATIONPROCESSMESSAGES,[2]);
   AddProp('TAPPLICATION.ACTIVE',TAPPLICATIONget_ACTIVE,nil);
   AddProp('TAPPLICATION.EXENAME',TAPPLICATIONget_EXENAME,nil);
  // AddProp('TAPPLICATION.HANDLE',TAPPLICATIONget_HANDLE,TAPPLICATIONset_HANDLE);
   AddProp('TAPPLICATION.HELPFILE',TAPPLICATIONget_HELPFILE,TAPPLICATIONset_HELPFILE);
   AddProp('TAPPLICATION.HINT',TAPPLICATIONget_HINT,TAPPLICATIONset_HINT);
   AddProp('TAPPLICATION.HINTCOLOR',TAPPLICATIONget_HINTCOLOR,TAPPLICATIONset_HINTCOLOR);
   AddProp('TAPPLICATION.HINTPAUSE',TAPPLICATIONget_HINTPAUSE,TAPPLICATIONset_HINTPAUSE);
   AddProp('TAPPLICATION.HINTSHORTPAUSE',TAPPLICATIONget_HINTSHORTPAUSE,TAPPLICATIONset_HINTSHORTPAUSE);
   AddProp('TAPPLICATION.HINTHIDEPAUSE',TAPPLICATIONget_HINTHIDEPAUSE,TAPPLICATIONset_HINTHIDEPAUSE);
   AddProp('TAPPLICATION.MAINFORM',TAPPLICATIONget_MAINFORM,nil);
   AddProp('TAPPLICATION.SHOWHINT',TAPPLICATIONget_SHOWHINT,TAPPLICATIONset_SHOWHINT);
   AddProp('TAPPLICATION.SHOWMAINFORM',TAPPLICATIONget_SHOWMAINFORM,TAPPLICATIONset_SHOWMAINFORM);
   AddProp('TAPPLICATION.TITLE',TAPPLICATIONget_TITLE,TAPPLICATIONset_TITLE);
   AddProp('TAPPLICATION.UPDATEFORMATSETTINGS',TAPPLICATIONget_UPDATEFORMATSETTINGS,TAPPLICATIONset_UPDATEFORMATSETTINGS);

 AddConst('caNone',caNone);
 AddConst('caHide',caHide);
 AddConst('caFree',caFree);
 AddConst('caMinimize',caMinimize);
 AddConst('fsNormal',fsNormal);
 AddConst('fsMDIChild',fsMDIChild);
 AddConst('fsMDIForm',fsMDIForm);
 AddConst('fsStayOnTop',fsStayOnTop);
 AddConst('mrCancel',mrCancel);
 AddConst('mrNone',mrNone);
 AddConst('mrOk',mrOk);
 AddConst('mrAbort',mrAbort);
 AddConst('mrRetry',mrRetry);
 AddConst('mrIgnore',mrIgnore);
 AddConst('mrYes',mrYes);
 AddConst('mrNo',mrNo);
 AddConst('mrAll',mrAll);
 AddConst('bsDialog',bsDialog);
 AddConst('bsSingle',bsSingle);
 AddConst('bsNone',bsNone);
 Addconst('bsSizeable',bsSizeable);
 AddConst('bsToolWindow',bsToolWindow);
 AddConst('bsSizeToolWin',bsSizeToolWin);
 AddConst('sbHorizontal',sbHorizontal);
 AddConst('sbVertical',sbVertical);
end;

Initialization FormsHalInit;
               RegisterClasses([TForm,TApplication,TScreen,TScrollBox]);
End.