imp_javascript.pas

来自「Delphi脚本控件」· PAS 代码 · 共 2,672 行 · 第 1/5 页

      V := Params[0].AsVariant;

      if not IsNumericString(ToString(V)) then
      begin
        ClassRec := TPAXBaseScripter(Scripter).ClassList.ArrayClassRec;
        SO := TPAXJavaScriptArrayObject.Create(ClassRec);
        SO.Length := 1;
        SO[0] := 1;
        Self := SO;
        Exit;
      end;

      L := ToInt32(V);
    end
    else
      L := ParamCount;

    ClassRec := TPAXBaseScripter(Scripter).ClassList.ArrayClassRec;
    SO := TPAXJavaScriptArrayObject.Create(ClassRec);
    SO.Length := L;

    if ParamCount > 1 then
      for I:=0 to ParamCount - 1 do
        SO[I] := Params[I].AsVariant;

    Self := SO;
  end;
end;

procedure _Array_GetProperty(M: TPAXMethodBody);
var
  SO: TPAXJavaScriptArrayObject;
  I: Integer;
  V: Variant;
begin
  with M do
  begin
    SO := TPAXJavaScriptArrayObject(Self);
    if IsDigits(Name) then
    begin
      I := StrToInt(Name);
      V := SO[I];

      if IsObject(V) then
      begin
        PSelf := nil;
      end;

      result.AsVariant := V;

//      with TPAXBaseScripter(SO.Scripter).Code do
//        Prog[N].Op := OP_GET_ITEM_EX;
    end
    else if Name = 'length' then
      result.AsVariant := SO.Length
    else
      result.AsVariant := SO.GetProperty(CreateNameIndex(Name, Scripter));
  end;
end;

procedure _Array_PutProperty(M: TPAXMethodBody);
var
  SO: TPAXJavaScriptArrayObject;
  I: Integer;
begin
  with M do
  begin
    SO := TPAXJavaScriptArrayObject(Self);
    if IsDigits(Name) then
    begin
      I := StrToInt(Name);
      SO[I] := Params[0].AsVariant;

//      with TPAXBaseScripter(SO.Scripter).Code do
//        Prog[N].Op := OP_PUT_ITEM_EX;
    end
    else
    begin
      SO.SetProperty(CreateNameIndex(Name, Scripter), Params[0].AsVariant);
      if Name = 'length' then
        SO.Length := Params[0].AsVariant;
    end;
  end;
end;

procedure _Array_toString(M: TPAXMethodBody);
begin
  with M do
    result.AsVariant := TPAXJavaScriptArrayObject(Self).ToString;
end;

procedure _Array_concat(M: TPAXMethodBody);
var
  Source, Dest: TPAXJavaScriptArrayObject;
  I, J, K, L: Integer;
  V: Variant;
  PaxArray: TPaxArray;
begin
  with M do
  begin
    Source := TPAXJavaScriptArrayObject(Self);
    L := Source.Length;
    Dest := TPAXJavaScriptArrayObject.Create(Source.ClassRec);
    Dest.Length := L;
    for I:=0 to L - 1 do
      Dest[I] := Source[I];
    K := Dest.Length - 1;
    for I:=0 to ParamCount - 1 do
    begin
      V := Params[I].AsVariant;
      if IsJavaScriptArrayObject(V) then
      begin
        Source := TPAXJavaScriptArrayObject(VariantToScriptObject(V));
        for J:=0 to Source.Length - 1 do
        begin
          Dest[K] := Source[J];
          Inc(K);
        end;
      end
      else if IsPaxArray(V) then
      begin
        PaxArray := TPAXArray(VariantToScriptObject(V).Instance);
        for J:=0 to PaxArray.HighBound(1) - 1 do
        begin
          Dest[K] := PaxArray.Get([J]);
          Inc(K);
        end;
      end
      else
      begin
        Dest[K] := V;
        Inc(K);
      end;
    end;

    result.AsVariant := ScriptObjectToVariant(Dest);

    PSelf := nil;

  end;
end;

procedure _Array_join(M: TPAXMethodBody);
var
  R, S, Separator: String;
  Source: TPAXJavaScriptArrayObject;
  J, L: Integer;
begin
  with M do
  begin
    Separator := ',';
    if ParamCount > 0 then
      Separator := ToString(Params[0].AsVariant);

    Source := TPAXJavaScriptArrayObject(Self);
    L := Source.Length;

    R := '';

    for J:=0 to L - 1 do
    begin
      S := ToString(Source[J]);
      R := R + S;
      if J < L - 1 then
        R := R + Separator;
    end;
    result.AsVariant := R;
  end;
end;

procedure _Array_pop(M: TPAXMethodBody);
var
  Source: TPAXJavaScriptArrayObject;
  L: Integer;
  V: Variant;
begin
  with M do
  begin
    Source := TPAXJavaScriptArrayObject(Self);
    L := Source.Length - 1;

    V := Source[L];
    result.AsVariant := V;
    Source.Length := L;

    if IsObject(V) then
      PSelf := nil;
  end;
end;

procedure _Array_push(M: TPAXMethodBody);
var
  Source: TPAXJavaScriptArrayObject;
  I, K: Integer;
begin
  with M do
  begin
    Source := TPAXJavaScriptArrayObject(Self);
    K := Source.Length;
    for I:=0 to ParamCount - 1 do
    begin
      Source[K] := Params[I].AsVariant;
      Inc(K);
    end;
  end;
end;

procedure _Array_reverse(M: TPAXMethodBody);
var
  Source: TPAXJavaScriptArrayObject;
  I, L: Integer;
  A: array of Variant;
begin
  with M do
  begin
    Source := TPAXJavaScriptArrayObject(Self);
    L := Source.Length;
    SetLength(A, L);
    for I:=0 to L - 1 do
      A[I] := Source[I];
    for I:=0 to L - 1 do
      Source[L - 1 - I] := A[I];
    result.AsVariant := ScriptObjectToVariant(Source);
  end;
end;

procedure _Array_shift(M: TPAXMethodBody);
var
  Source: TPAXJavaScriptArrayObject;
  I, L: Integer;
  A: array of Variant;
begin
  with M do
  begin
    Source := TPAXJavaScriptArrayObject(Self);
    L := Source.Length;
    if L = 0 then
      Exit;

    SetLength(A, L);
    for I:=0 to L - 1 do
      A[I] := Source[I];

    Dec(L);
    Source.Length := L;
    for I:=0 to L - 1 do
      Source[I] := A[I + 1];

    result.AsVariant := A[0];
  end;
end;

procedure _Array_slice(M: TPAXMethodBody);
var
  Source, Dest: TPAXJavaScriptArrayObject;
  I, IStart, IEnd, L, K: Integer;
begin
  with M do
  begin
    Source := TPAXJavaScriptArrayObject(Self);
    L := Source.Length;

    if ParamCount = 0 then
    begin
      IStart := 0;
      IEnd := L - 1;
    end
    else if ParamCount = 1 then
    begin
      IStart := ToInt32(Params[0].AsVariant);
      if IStart < 0 then
        IStart := IStart + L;
      IEnd := L - 1;
    end
    else
    begin
      IStart := ToInt32(Params[0].AsVariant);
      IEnd := ToInt32(Params[1].AsVariant);
      if IStart < 0 then
        IStart := IStart + L;
      if IEnd < 0 then
        IEnd := IEnd + L;
    end;

    L := IEnd - IStart + 1;
    if L > 0 then
    begin
      K := 0;
      Dest := TPAXJavaScriptArrayObject.Create(Source.ClassRec);
      Dest.Length := L;
      for I:=IStart to IEnd do
      begin
        Dest[K] := Source[I];
        Inc(K);
      end;
      result.AsVariant := ScriptObjectToVariant(Dest);
    end;
  end;
end;

procedure _Array_sort(M: TPAXMethodBody);
var
  Source: TPAXJavaScriptArrayObject;
  I, L: Integer;
  A: array of Variant;
begin
  with M do
  begin
    Source := TPAXJavaScriptArrayObject(Self);
    L := Source.Length;
    if L = 0 then
      Exit;

    SetLength(A, L);
    for I:=0 to L - 1 do
      A[I] := Source[I];

    SortVariants(A);

    for I:=0 to L - 1 do
      Source[I] := A[I];

    result.AsVariant := ScriptObjectToVariant(Source);
  end;
end;

procedure _Array_unshift(M: TPAXMethodBody);
var
  Source: TPAXJavaScriptArrayObject;
  I, K, L: Integer;
  A: array of Variant;
begin
  with M do
  begin
    Source := TPAXJavaScriptArrayObject(Self);
    L := Source.Length;
    if L = 0 then
      Exit;

    SetLength(A, L + ParamCount);
    K := -1;

    for I:=0 to ParamCount - 1 do
    begin
      Inc(K);
      A[K] := Params[I].AsVariant;
    end;

    for I:=0 to L - 1 do
    begin
      Inc(K);
      A[K] := Source[I];
    end;

    Source.Length := L + ParamCount;
    for I:=0 to Source.Length - 1 do
      Source[I] := A[I];

    result.AsVariant := ScriptObjectToVariant(Source);
  end;
end;

procedure _alert(MethodBody: TPAXMethodBody);
var
  I: Integer;
begin
  with MethodBody do
    for I:=0 to ParamCount - 1 do
      ErrMessageBox(toString(Params[I].AsVariant));
end;

procedure _isJavaScriptArray(MethodBody: TPAXMethodBody);
var
  SO: TPaxScriptObject;
begin
  with MethodBody do
    if IsObject(Params[0].PValue^) then
    begin
      SO := VariantToScriptObject(Params[0].PValue^);
      result.AsVariant := SO.InheritsFrom(TPaxJavaScriptArrayObject);
    end
    else
      result.AsVariant := false;
end;


var
  C, N: TPaxClassDefinition;
initialization
  BooleanClass := TPAXJavaScriptBooleanObject;
  NumberClass := TPAXJavaScriptNumberObject;
  StringClass := TPAXJavaScriptStringObject;
  DateClass := TPAXJavaScriptDateObject;
  FunctionClass := TPAXJavaScriptFunctionObject;

  with DefinitionList do
  begin
    N := AddNamespace(paxJavaScriptNamespace, nil);

/////////////// GLOBAL //////////////////////////////////
    AddMethod3('alert', _alert, 1, N, true);

    AddMethod3('eval', _eval, 1, N, true);
    AddMethod3('parseInt', _parseInt, -1, N, true);
    AddMethod3('parseFloat', _parseFloat, -1, N, true);
    AddMethod3('isNaN', _isNaN, -1, N, true);
    AddConstant('NaN', NaN, N);
    AddMethod3('memberCount', _memberCount, 1, N, true);

/////////////// OBJECT //////////////////////////////////

    C := AddClass1('Object', N, nil, _Object_GetProperty,
                                     _Object_PutProperty);
    AddMethod3('Object', _Object_New, -1, C);
    AddMethod3('Create', _Object_New, -1, C);
    AddMethod3('New', _Object_New, -1, C);

    AddMethod3('toString', _Object_toString, -1, C);
    AddMethod3('valueOf', _Object_valueOf, -1, C);

/////////////// BOOLEAN //////////////////////////////////

    C := AddClass1('Boolean', N, nil, _Object_GetProperty,
                                      _Object_PutProperty);
    AddMethod3('Boolean', _Boolean_New, -1, C);
    AddMethod3('Create', _Boolean_New, -1, C);
    AddMethod3('New', _Boolean_New, -1, C);

    AddMethod3('toString', _Object_toString, -1, C);
    AddMethod3('valueOf', _Object_valueOf, -1, C);

/////////////// DATE ////////////////////////////////////

    C := AddClass1('Date', N, nil, _Object_GetProperty,
                                   _Object_PutProperty);
    AddMethod3('Date', _Date_New, -1, C);
    AddMethod3('Create', _Date_New, -1, C);
    AddMethod3('New', _Date_New, -1, C);

    AddMethod3('valueOf', _Object_valueOf, -1, C);
    AddMethod3('getTime', _Date_getTime, -1, C);
    AddMethod3('getYear', _Date_getFullYear, -1, C);
    AddMethod3('getFullYear', _Date_getFullYear, -1, C);
    AddMethod3('getUTCFullYear', _Date_getUTCFullYear, -1, C);
    AddMethod3('getMonth', _Date_getMonth, -1, C);
    AddMethod3('getUTCMonth', _Date_getUTCMonth, -1, C);
    AddMethod3('getDate', _Date_getDate, -1, C);
    AddMethod3('getUTCDate', _Date_getUTCDate, -1, C);
//  AddMethod3('toGMTString', _Date_toGMTString, -1, C);
    AddMethod3('getDay', _Date_getDay, -1, C);
    AddMethod3('getUTCDay', _Date_getUTCDay, -1, C);
    AddMethod3('getHours', _Date_getHours, -1, C);
    AddMethod3('getUTCHours', _Date_getUTCHours, -1, C);
    AddMethod3('getMinutes', _Date_getMinutes, -1, C);
    AddMethod3('getUTCMinutes', _Date_getUTCMinutes, -1, C);
    AddMethod3('getSeconds', _Date_getSeconds, -1, C);
    AddMethod3('getUTCSeconds', _Date_getUTCSeconds, -1, C);
    AddMethod3('getMilliseconds', _Date_getMilliseconds, -1, C);
    AddMethod3('getUTCMilliseconds', _Date_getUTCMilliseconds, -1, C);

    AddMethod3('setTime', _Date_setTime, -1, C);
    AddMethod3('setMilliseconds', _Date_setMilliseconds, -1, C);
    AddMethod3('setUTCMilliseconds', _Date_setUTCMilliseconds, -1, C);
    AddMethod3('setSeconds', _Date_setSeconds, -1, C);
    AddMethod3('setUTCSeconds', _Date_setUTCSeconds, -1, C);
    AddMethod3('setMinutes', _Date_setMinutes, -1, C);
    AddMethod3('setUTCMinutes', _Date_setUTCMinutes, -1, C);
    AddMethod3('setHours', _Date_setHours, -1, C);
    AddMethod3('setUTCHours', _Date_setUTCHours, -1, C);
    AddMethod3('setDate', _Date_setDate, -1, C);
    AddMethod3('setUTCDate', _Date_setUTCDate, -1, C);
    AddMethod3('setMonth', _Date_setMonth, -1, C);
    AddMethod3('setUTCMonth', _Date_setUTCMonth, -1, C);
    AddMethod3('setFullYear', _Date_setFullYear, -1, C);
    AddMethod3('setUTCFullYear', _Date_setUTCFullYear, -1, C);

    AddMethod3('toString', _Date_toString, -1, C);
    AddMethod3('toGMTString', _Date_toGMTString, -1, C);
    AddMethod3('getTimezoneOffset', _Date_getTimezoneOffset, -1, C);
    AddMethod3('valueOf', _Object_valueOf, -1, C);

/////////////// MATH ////////////////////////////////////

    C := AddClass1('Math', N, nil, _Object_GetProperty,
                                   _Object_PutProperty);
    AddMethod3('abs', _Math_abs, -1, C, true);
    AddMethod3('acos', _Math_acos, -1, C, true);
    AddMethod3('asin', _Math_asin, -1, C, true);
    AddMethod3('atan', _Math_atan, -1, C, true);
    AddMethod3('atan2', _Math_atan2, -1, C, true);
    AddMethod3('ceil', _Math_ceil, -1, C, true);
    AddMethod3('cos', _Math_cos, -1, C, true);
    AddMethod3('exp', _Math_exp, -1, C, true);
    AddMethod3('floor', _Math_floor, -1, C, true);
    AddMethod3('log', _Math_log, -1, C, true);
    AddMethod3('max', _Math_max, -1, C, true);
    AddMethod3('min', _Math_min, -1, C, true);
    AddMethod3('pow', _Math_pow, -1, C, true);
    AddMethod3('random', _Math_random, -1, C, true);
    AddMethod3('round', _Math_round, -1, C, true);
    AddMethod3('sin', _Math_sin, -1, C, true);
    AddMethod3('sqrt', _Math_sqrt, -1, C, true);
    AddMethod3('tan', _Math_tan, -1, C, true);
    AddConstant('PI', PI, C, true); 
    AddConstant('E', 2.7182818284590452354, C, true);
    AddConstant('LN10', 2.302585092994046, C, true);
    AddConstant('LN2', 0.6931471805599453, C, true);
    AddConstant('LOG2E', 1.4426950408889634, C, true);
    AddConstant('LOG10E', 0.434294819032518, C, true);
    AddConstant('SQRT1_2', 0.7071067811865476, C, true);
    AddConstant('SQRT2', 1.4142135623730951, C, true);

/////////////// FUNCTION //////////////////////////////////

    C := AddClass1('Function', N, nil, _Object_GetProperty,
                                       _Object_PutProperty);
    AddMethod3('Function', _Function_New, -1, C);
    AddMethod3('Create', _Function_New, -1, C);
    AddMethod3('New', _Function_New, -1, C);
    AddMethod3('valueOf', _Object_valueOf, -1, C);

/////////////// STRING //////////////////////////////////

    C := AddClass1('String', N, nil, _String_GetProperty,
                                     _String_PutProperty);
    AddMethod3('String', _String_New, -1, C);
    AddMethod3('Create', _String_New, -1, C);
    AddMethod3('New', _String_New, -1, C);

    AddMethod3('anchor', _String_anchor, -1, C);
    AddMethod3('big', _String_big, -1, C);
    AddMethod3('bli