dxjs_extern.pas

Well known and usefull component for delphi 7

   result:=__joinArray (This,Parameters) ;
end;

function __popArray (var This:Variant;const Parameters:array of Variant) :Variant;
var
   SourceArray:TScriptObject;
   L:Integer;
begin
   SourceArray:=TArrayObject (VariantToScriptObject (This) ) ;
   L:=ToInt32 (SourceArray.GetProperty ('length') ) ;
   if L<>0 then Begin
      Dec (L) ;
      result:=SourceArray.GetProperty (IntegerToString (L) ) ;
      SourceArray.PutProperty ('length',L) ;
      This:=ScriptObjectToVariant (SourceArray) ;
   End;
end;

function __pushArray (var This:Variant;const Parameters:array of Variant) :Variant;
var
   SourceArray:TScriptObject;
   I:Integer;
begin
   SourceArray:=TArrayObject (VariantToScriptObject (This) ) ;
   result:=ToInt32 (SourceArray.GetProperty ('length') ) ;

   for I:=0 to Length (Parameters) -1 do begin
      SourceArray.PutProperty (IntegerToString (result) ,Parameters[I]) ;
      Inc (result) ;
   end;

   This:=ScriptObjectToVariant (SourceArray) ;
end;

function __reverseArray (var This:Variant;const Parameters:array of Variant) :Variant;
var
   SourceArray:TScriptObject;
   I,L:Integer;
   A:array of Variant;
begin
   SourceArray:=TArrayObject (VariantToScriptObject (This) ) ;
   L:=ToInt32 (SourceArray.GetProperty ('length') ) ;
   SetLength (A,L) ;
   for I:=0 to L-1 do A[I]:=SourceArray.GetProperty (IntegerToString (I) ) ;
   for I:=0 to L-1 do SourceArray.PutProperty (IntegerToString (L-1-I) ,A[I]) ;
   This:=ScriptObjectToVariant (SourceArray) ;
   result:=This;
end;

function __shiftArray (var This:Variant;const Parameters:array of Variant) :Variant;
var
   SourceArray:TScriptObject;
   L:Integer;
begin
   SourceArray:=TArrayObject (VariantToScriptObject (This) ) ;
   L:=ToInt32 (SourceArray.GetProperty ('length') ) ;
   if L>0 then begin
      result:=SourceArray.GetProperty (IntegerToString (0) ) ;
      Dec (L) ;
      SourceArray.PutProperty ('length',L) ;
      This:=ScriptObjectToVariant (SourceArray) ;
   end;
end;

function __sliceArray (var This:Variant;const Parameters:array of Variant) :Variant;
var
   SourceArray,DestArray:TScriptObject;
   I,K,L,IStart,IEnd:Integer;
   V:Variant;
begin
   SourceArray:=TArrayObject (VariantToScriptObject (This) ) ;
   DestArray:=TArrayObject.Create (VariantToScriptObject (This) .PScript) ;

   L:=ToInt32 (SourceArray.GetProperty ('length') ) ;

   IStart:=0;
   IEnd:=L-1;

   if Length (Parameters) >0 then begin
      IStart:=ToInt32 (Parameters[0]) ;
      if Length (Parameters) >1 then
         IEnd:=ToInt32 (Parameters[1]) ;
   end;
   if IStart<0 then IStart:=IStart+L;
   if IEnd<0 then IEnd:=IEnd+L;
   K:=0;
   for I:=IStart+1 to IEnd do begin
      V:=SourceArray.GetProperty (IntegerToString (I) ) ;
      DestArray.PutProperty (IntegerToString (K) ,V) ;
      Inc (K) ;
   end;

   result:=ScriptObjectToVariant (DestArray) ;
end;

procedure Sort (var A:array of Variant) ;
var
   I,J,N:Integer;
   X:Variant;
begin
   N:=Length (A) -1;
   for I:=1 to N do
      for J:=N downto I do
         if A[J-1]>A[J] then begin
            X:=A[J-1];
            A[J-1]:=A[J];
            A[J]:=X;
         end;
end;

function __sortArray (var This:Variant;const Parameters:array of Variant) :Variant;
var
   SourceArray:TScriptObject;
   I,L:Integer;
   A:array of Variant;
begin
   SourceArray:=TArrayObject (VariantToScriptObject (This) ) ;
   L:=ToInt32 (SourceArray.GetProperty ('length') ) ;
   SetLength (A,L) ;
   for I:=0 to L-1 do A[I]:=SourceArray.GetProperty (IntegerToString (I) ) ;
   Sort (A) ;
   for I:=0 to L-1 do SourceArray.PutProperty (IntegerToString (I) ,A[I]) ;
   This:=ScriptObjectToVariant (SourceArray) ;
   result:=This;
end;

function __spliceArray (var This:Variant;const Parameters:array of Variant) :Variant;
var
   SourceArray,DestArray:TScriptObject;
   I,K,L,IStart,IDelCount:Integer;
   A,B,C:array of Variant;
begin
   SourceArray:=TArrayObject (VariantToScriptObject (This) ) ;
   DestArray:=TArrayObject.Create (VariantToScriptObject (This) .PScript) ;

   L:=ToInt32 (SourceArray.GetProperty ('length') ) ;

   IStart:=0;
   IDelCount:=0;

   if Length (Parameters) >0 then begin
      IStart:=ToInt32 (Parameters[0]) ;
      if Length (Parameters) >1 then
         IDelCount:=ToInt32 (Parameters[1]) ;
   end;

   if IStart<0 then
      IStart:=IStart+L;

   if IDelCount<0 then
      IDelCount:=IDelCount+L;

   if IDelCount>L then
      IDelCount:=L;

   SetLength (A,IStart) ;
   SetLength (B,IDelCount) ;
   SetLength (C,L-Length (A) -Length (B) ) ;

   for I:=0 to IStart-1 do
      A[I]:=SourceArray.GetProperty (IntegerToString (I) ) ;

   K:=-1;
   for I:=IStart to IStart+IDelCount-1 do begin
      Inc (K) ;
      B[K]:=SourceArray.GetProperty (IntegerToString (I) ) ;
      DestArray.PutProperty (IntegerToString (K) ,B[K]) ;
   end;

   K:=-1;
   for I:=IStart+IDelCount to L-1 do begin
      Inc (K) ;
      C[K]:=SourceArray.GetProperty (IntegerToString (I) ) ;
   end;

   SourceArray.PutProperty ('length',IStart) ;
   K:=IStart-1;
   for I:=2 to Length (Parameters) -1 do begin
      Inc (K) ;
      SourceArray.PutProperty (IntegerToString (K) ,Parameters[I]) ;
   end;

   for I:=0 to Length (C) -1 do begin
      Inc (K) ;
      SourceArray.PutProperty (IntegerToString (K) ,C[I]) ;
   end;

   This:=ScriptObjectToVariant (SourceArray) ;
   result:=ScriptObjectToVariant (DestArray) ;
end;

function __unshiftArray (var This:Variant;const Parameters:array of Variant) :Variant;
var
   SourceArray:TScriptObject;
   A:array of Variant;
   I,K,AL,PL,SL:Integer;
begin
   SourceArray:=TArrayObject (VariantToScriptObject (This) ) ;
   SL:=ToInt32 (SourceArray.GetProperty ('length') ) ;
   PL:=Length (Parameters) ;
   AL:=PL+SL;
   SetLength (A,AL) ;
   K:=-1;
   for I:=0 to PL-1 do begin
      Inc (K) ;
      A[K]:=Parameters[I];
   end;
   for I:=0 to SL-1 do begin
      Inc (K) ;
      A[K]:=SourceArray.GetProperty (IntegerToString (I) ) ;
   end;
   for I:=0 to Length (A) -1 do
      SourceArray.PutProperty (IntegerToString (I) ,A[I]) ;
   This:=ScriptObjectToVariant (SourceArray) ;
   result:=This;
end;

function __dimensionsArray (var This:Variant;const Parameters:array of Variant) :Variant;
var
   SL:Integer;

begin
   SL:=ToInt32 (TArrayObject (VariantToScriptObject (This) ).GetProperty ('length') ) ;
   result:=SL;
end;

constructor THostVariableList.Create;
begin
   inherited Create;
   Sorted:=true;
   Duplicates:=DupIgnore;
end;

procedure THostVariableList.Print (const Name:string) ;
var
   T:TextFile;
   I:Integer;
   V:Variant;
begin
   AssignFile (T,Name) ;
   Rewrite (T) ;
   try
      for I:=0 to Count-1 do begin
         V:=Variant (Pointer (Objects[I]) ^) ;
         writeln (T,I:5,' ',Norm (Strings[I],20) ,' ',ToString (V) ) ;
      end;
   finally
      Close (T) ;
   end;
end;

constructor TConstantList.Create;
begin
   inherited Create;
   Sorted:=true;
   Duplicates:=DupIgnore;
end;

destructor TConstantList.Destroy;
var
   I:Integer;
begin
   for I:=0 to Count-1 do
      FreeMem (Pointer (Objects[I]) ,SizeOf (Variant) ) ;
   inherited Destroy;
end;

procedure TConstantList.AddConstant (const Name:string;const Value:Variant) ;
var
   P:Pointer;
   VType:Integer;
begin
   GetMem (P,SizeOf (Variant) ) ;
   FillChar2 (P^,SizeOf (Variant) ,#0) ; // can not remove - if you do you break the typecasting below!!!! (Sept 27 2003)
   VType:=VarType (Value) ;
   case VType of
      varByte,
      varSmallInt:Variant (P^) :=Integer (Value) ;
   else
      Variant (P^) :=Value;
   end;
//   VType:=VarType (Variant (P^) ) ; {removed July 24}
   AddObject (Name,P) ;
end;

procedure TConstantList.Print (const Name:string) ;
var
   T:TextFile;
   I:Integer;
   V:Variant;
begin
   AssignFile (T,Name) ;
   Rewrite (T) ;
   try
      for I:=0 to Count-1 do begin
         V:=Variant (Pointer (Objects[I]) ^) ;
         writeln (T,I:5,' ',Norm (Strings[I],20) ,' ',ToString (V) ) ;
      end;
   finally
      Close (T) ;
   end;
end;

procedure TDefinitionList.AddStandardRoutines;
begin
   RegisterRoutine ('__Object',0,@_Object) ;
   RegisterRoutine ('__Boolean',0,@__Boolean) ;
   RegisterRoutine ('__Date',0,@__Date) ;
   RegisterRoutine ('__Number',0,@__Number) ;
   RegisterRoutine ('__String',0,@__String) ;
   RegisterRoutine ('__Array',0,@__Array) ;
   RegisterRoutine ('__Math',0,@__Math) ;
   RegisterRoutine ('__RegExp',0,@__RegExp) ;
   RegisterRoutine ('__Function',0,@__Function) ;
   RegisterRoutine ('__Error',0,@__Error) ;
   RegisterRoutine ('__DelphiObject',0,@__DelphiObject) ;
   RegisterRoutine ('__ActiveXObject',0,@__ActiveXObject) ;
// Mar 2004
   RegisterRoutine ('__Enumerator',0,@__EnumeratorObject) ;

   RegisterRoutine ('eval',1,@_eval) ;
   RegisterRoutine ('parseInt',1,@_parseInt) ;
   RegisterRoutine ('parseFloat',1,@_parseFloat) ;
   RegisterRoutine ('isNaN',1,@_isNaN) ;
   RegisterRoutine ('isFinite',1,@_isFinite) ;
   RegisterRoutine ('escape',1,@_escape) ;
   RegisterRoutine ('unescape',1,@_unescape) ;

// String
   RegisterRoutine ('anchor',1,@__anchor,String_ID) ;
   RegisterRoutine ('big',0,@__big,String_ID) ;
   RegisterRoutine ('blink',0,@__blink,String_ID) ;
   RegisterRoutine ('bold',0,@__bold,String_ID) ;
   RegisterRoutine ('charAt',1,@__charAt,String_ID) ;
   RegisterRoutine ('charCodeAt',1,@__charCodeAt,String_ID) ;
   RegisterRoutine ('concat',1,@__concat,String_ID) ;
   RegisterRoutine ('fixed',1,@__fixed,String_ID) ;
   RegisterRoutine ('fontcolor',1,@__fontcolor,String_ID) ;
   RegisterRoutine ('fontsize',1,@__fontsize,String_ID) ;
   RegisterRoutine ('fromCharCode',1,@__fromCharCode,String_ID) ;
   RegisterRoutine ('indexOf',1,@__indexOf,String_ID) ;
   RegisterRoutine ('italics',0,@__italics,String_ID) ;
   RegisterRoutine ('lastIndexOf',1,@__lastIndexOf,String_ID) ;
   RegisterRoutine ('link',1,@__link,String_ID) ;
   RegisterRoutine ('match',1,@__match,String_ID) ;
   RegisterRoutine ('replace',2,@__replace,String_ID) ;
   RegisterRoutine ('search',1,@__search,String_ID) ;
   RegisterRoutine ('slice',2,@__slice,String_ID) ;
   RegisterRoutine ('small',1,@__small,String_ID) ;
   RegisterRoutine ('split',2,@__split,String_ID) ;
   RegisterRoutine ('strike',1,@__strike,String_ID) ;
   RegisterRoutine ('sub',3,@__sub,String_ID) ;
   RegisterRoutine ('substr',3,@__substr,String_ID) ;
   RegisterRoutine ('substring',3,@__substring,String_ID) ;
   RegisterRoutine ('sup',1,@__sup,String_ID) ;
   RegisterRoutine ('toLowerCase',0,@__toLowerCase,String_ID) ;
   RegisterRoutine ('toUpperCase',0,@__toUpperCase,String_ID) ;
   RegisterRoutine ('toString',0,@__toString,String_ID) ;
   RegisterRoutine ('valueOf',0,@__valueOfString,String_ID) ;
   RegisterRoutine ('trim',0,@__trim,String_ID) ;
// Number
   RegisterRoutine ('toString',0,@__toString,Number_ID) ;
  // toExponential
  // toFixed
// Boolean
   RegisterRoutine ('toString',0,@__toString,Boolean_ID) ;
// Date
   RegisterRoutine ('valueOf',0,@__valueOfDate,Date_ID) ;
   RegisterRoutine ('getTime',0,@__getTime,Date_ID) ;
   RegisterRoutine ('getYear',0,@__getFullYear,Date_ID) ; // August 1
   RegisterRoutine ('getFullYear',0,@__getFullYear,Date_ID) ;
   RegisterRoutine ('getUTCFullYear',0,@__getFullYear,Date_ID) ;
   RegisterRoutine ('getMonth',0,@__getMonth,Date_ID) ;
   RegisterRoutine ('getUTCMonth',0,@__getMonth,Date_ID) ;
   RegisterRoutine ('getDate',0,@__getDate,Date_ID) ;
   RegisterRoutine ('getUTCDate',0,@__getDate,Date_ID) ;
   RegisterRoutine ('toGMTString',0,@__toGMTString,Date_ID) ;
   RegisterRoutine ('getDay',0,@__getDay,Date_ID) ;
   RegisterRoutine ('getUTCDay',0,@__getDay,Date_ID) ;
   RegisterRoutine ('getHours',0,@__getHours,Date_ID) ;
   RegisterRoutine ('getUTCHours',0,@__getHours,Date_ID) ;
   RegisterRoutine ('getMinutes',0,@__getMinutes,Date_ID) ;
   RegisterRoutine ('getUTCMinutes',0,@__getMinutes,Date_ID) ;
   RegisterRoutine ('getSeconds',0,@__getSeconds,Date_ID) ;
   RegisterRoutine ('getUTCSeconds',0,@__getSeconds,Date_ID) ;
   RegisterRoutine ('getMilliseconds',0,@__getMilliseconds,Date_ID) ;
   RegisterRoutine ('getUTCMilliseconds',0,@__getMilliseconds,Date_ID) ;
  //getTimezoneOffset ( )
   RegisterRoutine ('setTime',1,@__setTime,Date_ID) ;
   RegisterRoutine ('setMilliseconds',1,@__setMilliseconds,Date_ID) ;
   RegisterRoutine ('setUTCMilliseconds',1,@__setMilliseconds,Date_ID) ;
   RegisterRoutine ('setSeconds',1,@__setSeconds,Date_ID) ;
   RegisterRoutine ('setUTCSeconds',1,@__setSeconds,Date_ID) ;
   RegisterRoutine ('setMinutes',1,@__setMinutes,Date_ID) ;
   RegisterRoutine ('setUTCMinutes',1,@__setMinutes,Date_ID) ;
   RegisterRoutine ('setHours',1,@__setHours,Date_ID) ;
   RegisterRoutine ('setUTCHours',1,@__setHours,Date_ID) ;
   RegisterRoutine ('setDate',1,@__setDate,Date_ID) ;
   RegisterRoutine ('setUTCDate',1,@__setDate,Date_ID) ;
   RegisterRoutine ('setMonth',1,@__setMonth,Date_ID) ;
   RegisterRoutine ('setUTCMonth',1,@__setMonth,Date_ID) ;
   RegisterRoutine ('setFullYear',1,@__setFullYear,Date_ID) ;
   RegisterRoutine ('setUTCFullYear',1,@__setFullYear,Date_ID) ;
// 2.0 fixes:
   RegisterRoutine ('UTC',6,@__getUTC,Date_ID) ;
   RegisterRoutine ('toString',0,@__toStringDate,Date_ID) ;
   RegisterRoutine ('toDateString',0,@__toDateString,Date_ID) ;
   RegisterRoutine ('toTimeString',0,@__toTimeString,Date_ID) ;
   RegisterRoutine ('toLocaleString',0,@__toLocaleStringDate,Date_ID) ;
   RegisterRoutine ('toLocaleDateString',0,@__toLocaleDateString,Date_ID) ;
   RegisterRoutine ('toLocaleTimeString',0,@__toLocaleTimeString,Date_ID) ;
   RegisterRoutine ('getTimezoneOffset',0,@__getTimezoneOffset,Date_ID) ;
   RegisterRoutine ('toUTCString',0,@__toUTCString,Date_ID) ;
// Mar 2004 (to be implemented)
//   RegisterRoutine ('parse',6,@__getparse,Date_ID) ;
// Math
   RegisterRoutine ('abs',1,@__abs,Math_ID) ;
   RegisterRoutine ('acos',1,@__acos,Math_ID) ;
   RegisterRoutine ('asin',1,@__asin,Math_ID) ;
   RegisterRoutine ('atan',1,@__atan,Math_ID) ;
   RegisterRoutine ('atan2',1,@__atan2,Math_ID) ;
   RegisterRoutine ('ceil',1,@__ceil,Math_ID) ;
   RegisterRoutine ('cos',1,@__cos,Math_ID) ;
   RegisterRoutine ('exp',1,@__exp,Math_ID) ;
   RegisterRoutine ('floor',1,@__floor,Math_ID) ;
   RegisterRoutine ('log',1,@__log,Math_ID) ;
   RegisterRoutine ('max',1,@__max,Math_ID) ;
   RegisterRoutine ('min',1,@__min,Math_ID) ;
   RegisterRoutine ('pow',1,@__pow,Math_ID) ;
   RegisterRoutine ('random',1,@__random,Math_ID) ;
   RegisterRoutine ('round',1,@__round,Math_ID) ;
   RegisterRoutine ('sin',1,@__sin,Math_ID) ;
   RegisterRoutine ('sqrt',1,@__sqrt,Math_ID) ;
   RegisterRoutine ('tan',1,@__tan,Math_ID) ;
// CONSTANTS (E, LN10, etc. are defined in DXJS_OBEJCT)
// Array
   RegisterRoutine ('toString',0,@__toStringArray,Array_ID) ;
   RegisterRoutine ('concat',1,@__concatArray,Array_ID) ;
   RegisterRoutine ('join',1,@__joinArray,Array_ID) ;
   RegisterRoutine ('pop',0,@__popArray,Array_ID) ;
   RegisterRoutine ('push',1,@__pushArray,Array_ID) ;
   RegisterRoutine ('reverse',0,@__reverseArray,Array_ID) ;
   RegisterRoutine ('shift',0,@__shiftArray,Array_ID) ;
   RegisterRoutine ('slice',0,@__sliceArray,Array_ID) ;
   RegisterRoutine ('sort',0,@__sortArray,Array_ID) ;
   RegisterRoutine ('splice',0,@__spliceArray,Array_ID) ;
   RegisterRoutine ('unshift',0,@__unshiftArray,Array_ID) ;
// Ozz
   RegisterRoutine ('dimensions',0,@__dimensionsArray,Array_ID) ;