h_contr.pas

一个Delphi解释器的例子

End;
{--------------------}
function myTWINCONTROLREPAINT(slf:TObject;var APropName:String;var s:array of variant):variant;
begin
 TWINCONTROL(slf).REPAINT;
End;
{--------------------}
function myTWINCONTROLSCALEBY(slf:TObject;var APropName:String;var s:array of variant):variant;
begin
 TWINCONTROL(slf).SCALEBY(S[0],S[1]);
End;
{--------------------}
function myTWINCONTROLSCROLLBY(slf:TObject;var APropName:String;var s:array of variant):variant;
begin
 TWINCONTROL(slf).SCROLLBY(S[0],S[1]);
End;
{--------------------}
function myTWINCONTROLSETFOCUS(slf:TObject;var APropName:String;var s:array of variant):variant;
begin
 TWINCONTROL(slf).SETFOCUS;
End;
{--------------------}
(*Function TWINCONTROLget_BRUSH(slf:TObject;var APropName:String;var s:array of variant):variant;
Begin
  Result := TWINCONTROL(slf).BRUSH;
End;

Function TWINCONTROLset_BRUSH(slf:TObject;var APropName:String;var s:array of variant):variant;
Begin
TWINCONTROL(slf).BRUSH:=S[0];
End;
*){--------------------}
Function TWINCONTROLget_CONTROLCOUNT(slf:TObject;var APropName:String;var s:array of variant):variant;
Begin
  Result := TWINCONTROL(slf).CONTROLCOUNT;
End;

Function TWINCONTROLget_SHOWING(slf:TObject;var APropName:String;var s:array of variant):variant;
Begin
  Result := TWINCONTROL(slf).SHOWING;
End;
{--------------------}
Function TWINCONTROLget_TABSTOP(slf:TObject;var APropName:String;var s:array of variant):variant;
Begin
  Result := TWINCONTROL(slf).TABSTOP;
End;

Function TWINCONTROLset_TABSTOP(slf:TObject;var APropName:String;var s:array of variant):variant;
Begin
TWINCONTROL(slf).TABSTOP:=S[0];
End;
{--------------------}
Function TWINCONTROLget_HELPCONTEXT(slf:TObject;var APropName:String;var s:array of variant):variant;
Begin
  Result := TWINCONTROL(slf).HELPCONTEXT;
End;

Function TWINCONTROLset_HELPCONTEXT(slf:TObject;var APropName:String;var s:array of variant):variant;
Begin
TWINCONTROL(slf).HELPCONTEXT:=S[0];
End;

Function TConvertObjget_ALIGN(slf:TObject;var APropName:String;var s:array of variant):variant;
Begin
  Result := TConvertObj(slf).ALIGN;
End;

Function TConvertObjset_ALIGN(slf:TObject;var APropName:String;var s:array of variant):variant;
Begin
TConvertObj(slf).ALIGN:=S[0];
End;

{--------------------}

type
TMControl=class(TControl)
end;

Function TConvertObjget_CAPTION(slf:TObject;var APropName:String;var s:array of variant):variant;
Begin
  Result := TMControl(slf).CAPTION;
End;

Function TConvertObjset_CAPTION(slf:TObject;var APropName:String;var s:array of variant):variant;
Begin
  TMControl(slf).CAPTION:=S[0];
End;

{--------------------}
Function TConvertObjget_COLOR(slf:TObject;var APropName:String;var s:array of variant):variant;
Begin
  Result := TConvertObj(slf).COLOR;
End;

Function TConvertObjset_COLOR(slf:TObject;var APropName:String;var s:array of variant):variant;
Begin
TConvertObj(slf).COLOR:=S[0];
End;
{--------------------}
Function TConvertObjget_CTL3D(slf:TObject;var APropName:String;var s:array of variant):variant;
Begin
  Result := TConvertObj(slf).CTL3D;
End;

Function TConvertObjset_CTL3D(slf:TObject;var APropName:String;var s:array of variant):variant;
Begin
TConvertObj(slf).CTL3D:=S[0];
End;
{--------------------}
Function TConvertObjget_DRAGCURSOR(slf:TObject;var APropName:String;var s:array of variant):variant;
Begin
  Result := TConvertObj(slf).DRAGCURSOR;
End;

Function TConvertObjset_DRAGCURSOR(slf:TObject;var APropName:String;var s:array of variant):variant;
Begin
TConvertObj(slf).DRAGCURSOR:=S[0];
End;
{--------------------}
Function TConvertObjget_DRAGMODE(slf:TObject;var APropName:String;var s:array of variant):variant;
Begin
  Result := TConvertObj(slf).DRAGMODE;
End;

Function TConvertObjset_DRAGMODE(slf:TObject;var APropName:String;var s:array of variant):variant;
Begin
TConvertObj(slf).DRAGMODE:=S[0];
End;
{--------------------}
Function TConvertObjget_ENABLED(slf:TObject;var APropName:String;var s:array of variant):variant;
Begin
  Result := TConvertObj(slf).ENABLED;
End;

Function TConvertObjset_ENABLED(slf:TObject;var APropName:String;var s:array of variant):variant;
Begin
TConvertObj(slf).ENABLED:=S[0];
End;
{--------------------}
Function TConvertObjget_FONT(slf:TObject;var APropName:String;var s:array of variant):variant;
Begin
  Result := ObjToVar(TConvertObj(slf).FONT);
End;

Function TConvertObjset_FONT(slf:TObject;var APropName:String;var s:array of variant):variant;
Begin
TConvertObj(slf).FONT:=TFont(VarToObj(S[0]));
End;
{--------------------}
Function TConvertObjget_PARENTCOLOR(slf:TObject;var APropName:String;var s:array of variant):variant;
Begin
  Result := TConvertObj(slf).PARENTCOLOR;
End;

Function TConvertObjset_PARENTCOLOR(slf:TObject;var APropName:String;var s:array of variant):variant;
Begin
TConvertObj(slf).PARENTCOLOR:=S[0];
End;
{--------------------}
Function TConvertObjget_PARENTCTL3D(slf:TObject;var APropName:String;var s:array of variant):variant;
Begin
  Result := TConvertObj(slf).PARENTCTL3D;
End;

Function TConvertObjset_PARENTCTL3D(slf:TObject;var APropName:String;var s:array of variant):variant;
Begin
TConvertObj(slf).PARENTCTL3D:=S[0];
End;
{--------------------}
Function TConvertObjget_PARENTFONT(slf:TObject;var APropName:String;var s:array of variant):variant;
Begin
  Result := TConvertObj(slf).PARENTFONT;
End;

Function TConvertObjset_PARENTFONT(slf:TObject;var APropName:String;var s:array of variant):variant;
Begin
TConvertObj(slf).PARENTFONT:=S[0];
End;
{--------------------}
Function TConvertObjget_PARENTSHOWHINT(slf:TObject;var APropName:String;var s:array of variant):variant;
Begin
  Result := TConvertObj(slf).PARENTSHOWHINT;
End;

Function TConvertObjset_PARENTSHOWHINT(slf:TObject;var APropName:String;var s:array of variant):variant;
Begin
TConvertObj(slf).PARENTSHOWHINT:=S[0];
End;
{--------------------}
Function TConvertObjget_POPUPMENU(slf:TObject;var APropName:String;var s:array of variant):variant;
Begin
  Result := ObjTOVar(TConvertObj(slf).POPUPMENU);
End;

Function TConvertObjset_POPUPMENU(slf:TObject;var APropName:String;var s:array of variant):variant;
Begin
TConvertObj(slf).POPUPMENU:=TPopupMenu(VarToObj(S[0]));
End;
{--------------------}
Function TConvertObjget_SHOWHINT(slf:TObject;var APropName:String;var s:array of variant):variant;
Begin
  Result := TConvertObj(slf).SHOWHINT;
End;

Function TConvertObjset_SHOWHINT(slf:TObject;var APropName:String;var s:array of variant):variant;
Begin
TConvertObj(slf).SHOWHINT:=S[0];
End;
{--------------------}
Function TConvertObjget_TABORDER(slf:TObject;var APropName:String;var s:array of variant):variant;
Begin
  Result := TConvertObj(slf).TABORDER;
End;

Function TConvertObjset_TABORDER(slf:TObject;var APropName:String;var s:array of variant):variant;
Begin
TConvertObj(slf).TABORDER:=S[0];
End;
{--------------------}
Function TConvertObjget_TABSTOP(slf:TObject;var APropName:String;var s:array of variant):variant;
Begin
  Result := TConvertObj(slf).TABSTOP;
End;

Function TConvertObjset_TABSTOP(slf:TObject;var APropName:String;var s:array of variant):variant;
Begin
TConvertObj(slf).TABSTOP:=S[0];
End;
{--------------------}
Function TConvertObjget_VISIBLE(slf:TObject;var APropName:String;var s:array of variant):variant;
Begin
  Result := TConvertObj(slf).VISIBLE;
End;

Function TConvertObjset_VISIBLE(slf:TObject;var APropName:String;var s:array of variant):variant;
Begin
TConvertObj(slf).VISIBLE:=S[0];
End;


Procedure ControlsHalInit;
begin

{   AddObjectType('TCONTROL','TCOMPONENT');
   AddObjectType('TWINCONTROL','TCONTROL');
   AddObjectType('TCUSTOMCONTROL','TWINCONTROL');}

   AddProc('TCONTROL.BRINGTOFRONT',myTCONTROLBRINGTOFRONT,[2]);
   AddProc('TCONTROL.HIDE',myTCONTROLHIDE,[2]);
   AddProc('TCONTROL.INVALIDATE',myTCONTROLINVALIDATE,[2]);
   AddFun ('TCONTROL.PERFORM',myTCONTROLPERFORM,[0,0,0]);
   AddProc('TCONTROL.REFRESH',myTCONTROLREFRESH,[2]);
   AddProc('TCONTROL.REPAINT',myTCONTROLREPAINT,[2]);
   AddProc('TCONTROL.SENDTOBACK',myTCONTROLSENDTOBACK,[2]);
   AddProc('TCONTROL.SETBOUNDS',myTCONTROLSETBOUNDS,[0,0,0,0]);
   AddProc('TCONTROL.SHOW',myTCONTROLSHOW,[2]);
   AddProc('TCONTROL.UPDATE',myTCONTROLUPDATE,[2]);
   AddProp('TCONTROL.ALIGN',TCONTROLget_ALIGN,TCONTROLset_ALIGN);
   AddProp('TCONTROL.CLIENTHEIGHT',TCONTROLget_CLIENTHEIGHT,TCONTROLset_CLIENTHEIGHT);
   AddProp('TCONTROL.CLIENTWIDTH',TCONTROLget_CLIENTWIDTH,TCONTROLset_CLIENTWIDTH);
   AddProp('TCONTROL.PARENT',TCONTROLget_PARENT,TCONTROLset_PARENT);
   AddProp('TCONTROL.SHOWHINT',TCONTROLget_SHOWHINT,TCONTROLset_SHOWHINT);
   AddProp('TCONTROL.VISIBLE',TCONTROLget_VISIBLE,TCONTROLset_VISIBLE);
   AddProp('TCONTROL.ENABLED',TCONTROLget_ENABLED,TCONTROLset_ENABLED);
   AddProp('TCONTROL.LEFT',TCONTROLget_LEFT,TCONTROLset_LEFT);
   AddProp('TCONTROL.TOP',TCONTROLget_TOP,TCONTROLset_TOP);
   AddProp('TCONTROL.WIDTH',TCONTROLget_WIDTH,TCONTROLset_WIDTH);
   AddProp('TCONTROL.HEIGHT',TCONTROLget_HEIGHT,TCONTROLset_HEIGHT);
   AddProp('TCONTROL.CURSOR',TCONTROLget_CURSOR,TCONTROLset_CURSOR);
   AddProp('TCONTROL.HINT',TCONTROLget_HINT,TCONTROLset_HINT);
   AddFun ('TWINCONTROL.CANFOCUS',myTWINCONTROLCANFOCUS,[2]);
   AddFun ('TWINCONTROL.CONTAINSCONTROL',myTWINCONTROLCONTAINSCONTROL,[0]);
   AddFun ('TWINCONTROL.FOCUSED',myTWINCONTROLFOCUSED,[2]);
   AddProc('TWINCONTROL.INSERTCONTROL',myTWINCONTROLINSERTCONTROL,[0]);
   AddProc('TWINCONTROL.REMOVECONTROL',myTWINCONTROLREMOVECONTROL,[0]);
   AddProc('TWINCONTROL.SCALEBY',myTWINCONTROLSCALEBY,[0,0]);
   AddProc('TWINCONTROL.SCROLLBY',myTWINCONTROLSCROLLBY,[0,0]);
   AddProc('TWINCONTROL.SETFOCUS',myTWINCONTROLSETFOCUS,[2]);
   AddProp('TWINCONTROL.CONTROLCOUNT',TWINCONTROLget_CONTROLCOUNT,nil);
   AddProp('TWINCONTROL.SHOWING',TWINCONTROLget_SHOWING,nil);
   AddProp('TWINCONTROL.HELPCONTEXT',TWINCONTROLget_HELPCONTEXT,TWINCONTROLset_HELPCONTEXT);
   AddProp('TWINControl.ALIGN',TConvertObjget_ALIGN,TConvertObjset_ALIGN);
   AddProp('TControl.CAPTION',TConvertObjget_CAPTION,TConvertObjset_CAPTION);
   AddProp('TWINControl.TEXT',TConvertObjget_CAPTION,TConvertObjset_CAPTION);
   AddProp('TWINControl.COLOR',TConvertObjget_COLOR,TConvertObjset_COLOR);
   AddProp('TWINControl.CTL3D',TConvertObjget_CTL3D,TConvertObjset_CTL3D);
   AddProp('TWINControl.DRAGCURSOR',TConvertObjget_DRAGCURSOR,TConvertObjset_DRAGCURSOR);
   AddProp('TWINControl.DRAGMODE',TConvertObjget_DRAGMODE,TConvertObjset_DRAGMODE);
   AddProp('TWINControl.ENABLED',TConvertObjget_ENABLED,TConvertObjset_ENABLED);
   AddProp('TWINControl.FONT',TConvertObjget_FONT,TConvertObjset_FONT);
   AddProp('TWINControl.PARENTCOLOR',TConvertObjget_PARENTCOLOR,TConvertObjset_PARENTCOLOR);
   AddProp('TWINControl.PARENTCTL3D',TConvertObjget_PARENTCTL3D,TConvertObjset_PARENTCTL3D);
   AddProp('TWINControl.PARENTFONT',TConvertObjget_PARENTFONT,TConvertObjset_PARENTFONT);
   AddProp('TWINControl.PARENTSHOWHINT',TConvertObjget_PARENTSHOWHINT,TConvertObjset_PARENTSHOWHINT);
   AddProp('TWINControl.POPUPMENU',TConvertObjget_POPUPMENU,TConvertObjset_POPUPMENU);
   AddProp('TWINControl.SHOWHINT',TConvertObjget_SHOWHINT,TConvertObjset_SHOWHINT);
   AddProp('TWINControl.TABORDER',TConvertObjget_TABORDER,TConvertObjset_TABORDER);
   AddProp('TWINControl.TABSTOP',TConvertObjget_TABSTOP,TConvertObjset_TABSTOP);
   AddProp('TWINControl.VISIBLE',TConvertObjget_VISIBLE,TConvertObjset_VISIBLE);

   AddConst('clNavy',clNavy);
   AddConst('crDefault',crDefault);
   AddConst('crArrow',crArrow);
   AddConst('crCross',crCross);
   AddConst('crSize',crSize);
   AddConst('crIBeam',crIBeam);
   AddConst('crHourglass',crHourglass);
   AddConst('crDrag',crDrag);
   AddConst('alNone',alNone);
   AddConst('alTop',alTop);
   Addconst('alBottom',alBottom);
   AddConst('alLeft',alLeft);
   AddConst('alRight',alRight);
   AddConst('alClient',alClient);
   AddConst('dmAutomatic',dmAutomatic);
   AddConst('dmManual',dmManual);

end;

Initialization
    ControlsHalInit;
End.