expertcad/POWERCAD30/UNITS/h_class.pas

Unit h_class;

Interface

Uses Delphin, CLASSES;

Implementation

function myTSTRINGListCreate(slf:TObject;var APropName:String;var s:array of variant):variant;
var SL : TStringList;
begin
 SL :=TStringList.Create;
 Result := ObjToVar(SL);
End;

(*{--------------------}
function myTLISTADD(slf:TObject;var APropName:String;var s:array of variant):variant;
begin
 Result := TLIST(slf).ADD(S[0]);
End;
{--------------------}
function myTLISTCLEAR(slf:TObject;var APropName:String;var s:array of variant):variant;
begin
 TLIST(slf).CLEAR;
End;
{--------------------}
function myTLISTDELETE(slf:TObject;var APropName:String;var s:array of variant):variant;
begin
 TLIST(slf).DELETE(S[0]);
End;
{--------------------}
function myTLISTEXCHANGE(slf:TObject;var APropName:String;var s:array of variant):variant;
begin
 TLIST(slf).EXCHANGE(S[0],S[1]);
End;
{--------------------}
function myTLISTEXPAND(slf:TObject;var APropName:String;var s:array of variant):variant;
begin
 Result := TLIST(slf).EXPAND;
End;
{--------------------}
function myTLISTFIRST(slf:TObject;var APropName:String;var s:array of variant):variant;
begin
 Result := TLIST(slf).FIRST;
End;
{--------------------}
function myTLISTINDEXOF(slf:TObject;var APropName:String;var s:array of variant):variant;
begin
 Result := TLIST(slf).INDEXOF(S[0]);
End;
{--------------------}
function myTLISTINSERT(slf:TObject;var APropName:String;var s:array of variant):variant;
begin
 TLIST(slf).INSERT(S[0],S[1]);
End;
{--------------------}
function myTLISTLAST(slf:TObject;var APropName:String;var s:array of variant):variant;
begin
 Result := TLIST(slf).LAST;
End;
{--------------------}
function myTLISTMOVE(slf:TObject;var APropName:String;var s:array of variant):variant;
begin
 TLIST(slf).MOVE(S[0],S[1]);
End;
{--------------------}
function myTLISTREMOVE(slf:TObject;var APropName:String;var s:array of variant):variant;
begin
 Result := TLIST(slf).REMOVE(S[0]);
End;
{--------------------}
function myTLISTPACK(slf:TObject;var APropName:String;var s:array of variant):variant;
begin
 TLIST(slf).PACK;
End;
{--------------------}
function myTLISTSORT(slf:TObject;var APropName:String;var s:array of variant):variant;
begin
 TLIST(slf).SORT(S[0]);
End;
{--------------------}
Function TLISTget_CAPACITY(slf:TObject;var APropName:String;var s:array of variant):variant;
Begin
  Result := TLIST(slf).CAPACITY;
End;

Function TLISTset_CAPACITY(slf:TObject;var APropName:String;var s:array of variant):variant;
Begin
TLIST(slf).CAPACITY:=S[0];
End;
{--------------------}
Function TLISTget_COUNT(slf:TObject;var APropName:String;var s:array of variant):variant;
Begin
  Result := TLIST(slf).COUNT;
End;

Function TLISTset_COUNT(slf:TObject;var APropName:String;var s:array of variant):variant;
Begin
TLIST(slf).COUNT:=S[0];
End;
{--------------------}
Function TLISTget_LIST(slf:TObject;var APropName:String;var s:array of variant):variant;
Begin
  Result := TLIST(slf).LIST;
End;

Function TLISTset_LIST(slf:TObject;var APropName:String;var s:array of variant):variant;
Begin
TLIST(slf).LIST:=S[0];
End;
*)


(*{--------------------}
function myTBITSDESTROY(slf:TObject;var APropName:String;var s:array of variant):variant;
begin
 TBITS(slf).DESTROY;
End;
{--------------------}
function myTBITSOPENBIT(slf:TObject;var APropName:String;var s:array of variant):variant;
begin
 Result := TBITS(slf).OPENBIT;
End;
{--------------------}
Function TBITSget_SIZE(slf:TObject;var APropName:String;var s:array of variant):variant;
Begin
  Result := TBITS(slf).SIZE;
End;

Function TBITSset_SIZE(slf:TObject;var APropName:String;var s:array of variant):variant;
Begin
TBITS(slf).SIZE:=S[0];
End;
*)

{--------------------}
function myTPERSISTENTASSIGN(slf:TObject;var APropName:String;var s:array of variant):variant;
var O : TPersistent;
begin
 O := TPersistent(VarToObj(S[0]));
 TPERSISTENT(slf).ASSIGN(O);
End;


{--------------------}
function myTSTRINGSADD(slf:TObject;var APropName:String;var s:array of variant):variant;
begin
 Result := TSTRINGS(slf).ADD(S[0]);
End;
{--------------------}
function myTSTRINGSADDOBJECT(slf:TObject;var APropName:String;var s:array of variant):variant;
begin
 Result := TSTRINGS(slf).ADDOBJECT(S[0],VarToObj(S[1]));
End;
{--------------------}
function myTSTRINGSAPPEND(slf:TObject;var APropName:String;var s:array of variant):variant;
begin
  TSTRINGS(slf).APPEND(S[0]);
End;
{--------------------}
function myTSTRINGSADDSTRINGS(slf:TObject;var APropName:String;var s:array of variant):variant;
begin
 TSTRINGS(slf).ADDSTRINGS(TStrings(VarToObj(S[0])));
End;
{--------------------}
function myTSTRINGSBEGINUPDATE(slf:TObject;var APropName:String;var s:array of variant):variant;
begin
 TSTRINGS(slf).BEGINUPDATE;
End;
{--------------------}
function myTSTRINGSCLEAR(slf:TObject;var APropName:String;var s:array of variant):variant;
begin
 TSTRINGS(slf).CLEAR;
End;
{--------------------}
function myTSTRINGSDELETE(slf:TObject;var APropName:String;var s:array of variant):variant;
begin
 TSTRINGS(slf).DELETE(S[0]);
End;
{--------------------}
function myTSTRINGSENDUPDATE(slf:TObject;var APropName:String;var s:array of variant):variant;
begin
 TSTRINGS(slf).ENDUPDATE;
End;
{--------------------}
function myTSTRINGSEQUALS(slf:TObject;var APropName:String;var s:array of variant):variant;
begin
 Result := TSTRINGS(slf).EQUALS(TStrings(VarToObj(S[0])));
End;
{--------------------}
function myTSTRINGSEXCHANGE(slf:TObject;var APropName:String;var s:array of variant):variant;
begin
 TSTRINGS(slf).EXCHANGE(S[0],S[1]);
End;
{--------------------}
{function myTSTRINGSGETTEXT(slf:TObject;var APropName:String;var s:array of variant):variant;
begin
 Result := String(TSTRINGS(slf).GETTEXT);
End;}
{--------------------}
function myTSTRINGSINDEXOF(slf:TObject;var APropName:String;var s:array of variant):variant;
begin
 Result := TSTRINGS(slf).INDEXOF(S[0]);
End;
{--------------------}
function myTSTRINGSINDEXOFNAME(slf:TObject;var APropName:String;var s:array of variant):variant;
begin
 Result := TSTRINGS(slf).INDEXOFNAME(S[0]);
End;
{--------------------}
function myTSTRINGSINDEXOFOBJECT(slf:TObject;var APropName:String;var s:array of variant):variant;
begin
 Result := TSTRINGS(slf).INDEXOFOBJECT(VarToObj(S[0]));
End;
{--------------------}
function myTSTRINGSINSERT(slf:TObject;var APropName:String;var s:array of variant):variant;
begin
 TSTRINGS(slf).INSERT(S[0],S[1]);
End;
{--------------------}
function myTSTRINGSLOADFROMFILE(slf:TObject;var APropName:String;var s:array of variant):variant;
begin
 TSTRINGS(slf).LOADFROMFILE(S[0]);
End;
{--------------------}
(*function myTSTRINGSLOADFROMSTREAM(slf:TObject;var APropName:String;var s:array of variant):variant;
begin
 TSTRINGS(slf).LOADFROMSTREAM(S[0]);
End;
*)
{--------------------}
function myTSTRINGSMOVE(slf:TObject;var APropName:String;var s:array of variant):variant;
begin
 TSTRINGS(slf).MOVE(S[0],S[1]);
End;
{--------------------}
function myTSTRINGSSAVETOFILE(slf:TObject;var APropName:String;var s:array of variant):variant;
begin
 TSTRINGS(slf).SAVETOFILE(S[0]);
End;

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

Function TSTRINGSset_COMMATEXT(slf:TObject;var APropName:String;var s:array of variant):variant;
Begin
TSTRINGS(slf).COMMATEXT:=S[0];
End;
{--------------------}
Function TSTRINGSget_COUNT(slf:TObject;var APropName:String;var s:array of variant):variant;
Begin
  Result := TSTRINGS(slf).COUNT;
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.