imp_javascript.pas

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

PAS
2,672 行
字号
12345
      D := ToNumber(Params[0].AsVariant);
      if (D >= -1) and (D <= 1) then
        result.AsVariant := Math.ArcCos(D)
      else
        result.AsVariant := NaN;
     end;
end;

procedure _Math_asin(MethodBody: TPAXMethodBody);
var
  D: Double;
begin
  with MethodBody do
    if ParamCount > 0 then
    begin
      D := ToNumber(Params[0].AsVariant);
      if (D >= -1) and (D <= 1) then
        result.AsVariant := Math.ArcSin(D)
      else
        result.AsVariant := NaN;
     end;
end;

procedure _Math_atan(MethodBody: TPAXMethodBody);
var
  D: Double;
begin
  with MethodBody do
    if ParamCount > 0 then
    begin
      D := ToNumber(Params[0].AsVariant);
      if (D >= -1) and (D <= 1) then
        result.AsVariant := ArcTan(D)
      else
        result.AsVariant := NaN;
     end;
end;

procedure _Math_atan2(MethodBody: TPAXMethodBody);
var
  A, B: Double;
begin
  with MethodBody do
    if ParamCount > 0 then
    begin
      A := ToNumber(Params[0].AsVariant);
      B := ToNumber(Params[1].AsVariant);

      if (A = NaN) or (B = NaN) then
        result.AsVariant := NaN
      else
        result.AsVariant := Math.arctan2(A,B);
     end;
end;

procedure _Math_ceil(MethodBody: TPAXMethodBody);
var
  D: Double;
begin
  with MethodBody do
    if ParamCount > 0 then
    begin
      D := ToNumber(Params[0].AsVariant);
      if D = NaN then
        result.AsVariant := NaN
      else
        result.AsVariant := Ceil(D);
     end;
end;

procedure _Math_cos(MethodBody: TPAXMethodBody);
var
  D: Double;
begin
  with MethodBody do
    if ParamCount > 0 then
    begin
      D := ToNumber(Params[0].AsVariant);
      if D = NaN then
        result.AsVariant := NaN
      else
        result.AsVariant := Cos(D);
     end;
end;

procedure _Math_exp(MethodBody: TPAXMethodBody);
var
  D: Double;
begin
  with MethodBody do
    if ParamCount > 0 then
    begin
      D := ToNumber(Params[0].AsVariant);
      if D = NaN then
        result.AsVariant := NaN
      else
        result.AsVariant := Exp(D);
     end;
end;

procedure _Math_floor(MethodBody: TPAXMethodBody);
var
  D: Double;
begin
  with MethodBody do
    if ParamCount > 0 then
    begin
      D := ToNumber(Params[0].AsVariant);
      if D = NaN then
        result.AsVariant := NaN
      else
        result.AsVariant := Floor(D);
     end;
end;

procedure _Math_log(MethodBody: TPAXMethodBody);
var
  D: Double;
begin
  with MethodBody do
    if ParamCount > 0 then
    begin
      D := ToNumber(Params[0].AsVariant);
      if D = NaN then
        result.AsVariant := NaN
      else
        result.AsVariant := Ln(D);
     end;
end;

procedure _Math_max(MethodBody: TPAXMethodBody);
var
  D, M: Double;
  I: Integer;
begin
  with MethodBody do
  begin
    M := NEGATIVE_INFINITY;
    for I:=0 to ParamCount - 1 do
    begin
      D := ToNumber(Params[I].AsVariant);
      if D > M then
        M := D;
    end;
    result.AsVariant := M;
  end;
end;

procedure _Math_min(MethodBody: TPAXMethodBody);
var
  D, M: Double;
  I: Integer;
begin
  with MethodBody do
  begin
    M := POSITIVE_INFINITY;
    for I:=0 to ParamCount - 1 do
    begin
      D := ToNumber(Params[I].AsVariant);
      if D < M then
        M := D;
    end;
    result.AsVariant := M;
  end;
end;

procedure _Math_pow(MethodBody: TPAXMethodBody);
var
  A, B: Double;
begin
  with MethodBody do
    if ParamCount > 0 then
    begin
      A := ToNumber(Params[0].AsVariant);
      B := ToNumber(Params[1].AsVariant);

      if (A = NaN) or (B = NaN) then
        result.AsVariant := NaN
      else
        result.AsVariant := Math.power(A,B);
     end;
end;

procedure _Math_random(MethodBody: TPAXMethodBody);
begin
  with MethodBody do
    result.AsVariant := Random(10000)/10000;
end;

procedure _Math_round(MethodBody: TPAXMethodBody);
var
  D: Double;
  I: Integer;
begin
  with MethodBody do
    if ParamCount > 0 then
    begin
      D := ToNumber(Params[0].AsVariant);
      if D = NaN then
        result.AsVariant := NaN
      else
      begin
        I := round(D);
        D := I;
        result.AsVariant := D;
      end;
   end;
end;

procedure _Math_sin(MethodBody: TPAXMethodBody);
var
  D: Double;
begin
  with MethodBody do
    if ParamCount > 0 then
    begin
      D := ToNumber(Params[0].AsVariant);
      if D = NaN then
        result.AsVariant := NaN
      else
        result.AsVariant := Sin(D);
     end;
end;

procedure _Math_sqrt(MethodBody: TPAXMethodBody);
var
  D: Double;
begin
  with MethodBody do
    if ParamCount > 0 then
    begin
      D := ToNumber(Params[0].AsVariant);
      if D = NaN then
        result.AsVariant := NaN
      else
        result.AsVariant := Sqrt(D);
     end;
end;

procedure _Math_tan(MethodBody: TPAXMethodBody);
var
  D: Double;
begin
  with MethodBody do
    if ParamCount > 0 then
    begin
      D := ToNumber(Params[0].AsVariant);
      if D = NaN then
        result.AsVariant := NaN
      else
        result.AsVariant := Tan(D);
     end;
end;

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

procedure _Function_New(MethodBody: TPAXMethodBody);
var
  SO: TPAXJavaScriptObject;
  ClassRec: TPAXClassRec;
  FormalParameters, FunctionBody, FunctionDecl: String;
  I: Integer;
  P: TPAXParser;
  V: Variant;
begin
  with MethodBody do
  begin
    if ParamCount >= 2 then
    begin
      FunctionBody := ToString(Params[ParamCount - 1].AsVariant);
      FormalParameters := '';
      for I:=0 to ParamCount - 2 do
        FormalParameters := FormalParameters + ToString(Params[I].AsVariant);

      FunctionDecl := 'function _Function(' + FormalParameters + ') {'
      + FunctionBody + '}';

      P := TPAXBaseScripter(Scripter).ParserList.FindParser('paxJavaScript');

      if P = nil then
        Exit;

       V := Eval(FunctionDecl, Scripter, P);
       Self := VariantToScriptObject(V);
    end
    else
    begin
      ClassRec := TPAXBaseScripter(Scripter).ClassList.FunctionClassRec;
      SO := TPAXJavaScriptFunctionObject.Create(ClassRec);
      Self := SO;
    end;
  end;
end;

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

function TPAXJavaScriptStringObject.Match(R: RegExp): TPaxJavaScriptArrayObject;
var
  S: String;
  PaxArray: TPaxArray;
  I, L: Integer;
begin
  S := ToStr(Scripter, DefaultValue);
  PaxArray := R.Exec(S);

  if PaxArray <> nil then
  begin
    L := PaxArray.HighBound(1);

    result := TPAXJavaScriptArrayObject.Create(ClassRec.GetClassList.ArrayClassRec);
    result.Length := L - 1;

    for I:=0 to L - 1 do
      result[I] := PaxArray.Get([I]);
    PaxArray.Free;

    result.SetProperty(CreateNameIndex('index', Scripter), R.RegExpr.MatchPos[0]);
  end
  else
    result := TPAXJavaScriptArrayObject.Create(ClassRec.GetClassList.ArrayClassRec);
end;

function TPAXJavaScriptStringObject.Replace(R: RegExp; const ReplaceStr: String): String;
var
  S: String;
begin
  S := ToStr(Scripter, DefaultValue);
  result := R.Replace(S, ReplaceStr);
end;

procedure _String_GetProperty(M: TPAXMethodBody);
var
  SO: TPAXJavaScriptObject;
begin
  with M do
  begin
    SO := TPAXJavaScriptObject(Self);

    if Name = 'length' then
      result.AsInteger := Length(ToString(SO.DefaultValue))
    else
      result.AsVariant := SO.GetProperty(CreateNameIndex(Name, Scripter));
  end;
end;

procedure _String_PutProperty(M: TPAXMethodBody);
var
  SO: TPAXJavaScriptObject;
begin
  with M do
  begin
    SO := TPAXJavaScriptObject(Self);
    SO.SetProperty(CreateNameIndex(Name, Scripter), Params[0].AsVariant);
  end;
end;

procedure _String_New(MethodBody: TPAXMethodBody);
var
  SO: TPAXJavaScriptStringObject;
  ClassRec: TPAXClassRec;
  R: Variant;
begin
  with MethodBody do
  begin
    ClassRec := TPAXBaseScripter(Scripter).ClassList.StringClassRec;
    SO := TPAXJavaScriptStringObject.Create(ClassRec);

    case ParamCount of
      1: R := ToString(Params[0].AsVariant);
      else
        R := '';
    end;
    SO.fDefaultValue := R;
    Self := SO;
    Result.AsVariant := R;
  end;
end;

procedure _String_anchor(MethodBody: TPAXMethodBody);
begin
  with MethodBody do
  begin
    if ParamCount > 0 then
      Name := ToString(Params[0].AsVariant)
    else
      Name := 'undefined';
    result.AsVariant := '<A NAME="' + Name + '">' + ToString(DefaultValue) + '</A>';
  end;
end;

procedure _String_big(MethodBody: TPAXMethodBody);
begin
  with MethodBody do
    result.AsVariant := '<BIG>' + ToString(DefaultValue) + '</BIG>';
end;

procedure _String_blink(MethodBody: TPAXMethodBody);
begin
  with MethodBody do
    result.AsVariant := '<BLINK>' + ToString(DefaultValue) + '</BLINK>';
end;

procedure _String_bold(MethodBody: TPAXMethodBody);
begin
  with MethodBody do
    result.AsVariant := '<B>' + ToString(DefaultValue) + '</B>';
end;

procedure _String_charAt(MethodBody: TPAXMethodBody);
var
  S: String;
  I: Integer;
begin
  with MethodBody do
  begin
    S := ToString(DefaultValue);
    if ParamCount > 0 then
      I := ToInt32(Params[0].AsVariant)
    else
    begin
      result.AsVariant := '';
      Exit;
    end;
    if (I >= 0) and (I <= Length(S) - 1) then
      result.AsVariant := S[I + 1]
    else
      result.AsVariant := '';
  end;
end;

procedure _String_charCodeAt(MethodBody: TPAXMethodBody);
var
  S: String;
  I: Integer;
begin
  with MethodBody do
  begin
    S := ToString(DefaultValue);
    if ParamCount > 0 then
      I := ToInt32(Params[0].AsVariant)
    else
    begin
      result.AsVariant := -1;
      Exit;
    end;
    if (I >= 0) and (I <= Length(S) - 1) then
      result.AsVariant := ord(S[I + 1])
    else
      result.AsVariant := -1;
  end;
end;

procedure _String_concat(MethodBody: TPAXMethodBody);
var
  S: String;
  I: Integer;
begin
  with MethodBody do
  begin
    S := ToString(DefaultValue);
    for I:=0 to ParamCount - 1 do
      S := S + ToString(Params[I].AsVariant);
     result.AsVariant := S;
  end;
end;

procedure _String_fixed(MethodBody: TPAXMethodBody);
begin
  with MethodBody do
    result.AsVariant := '<TT>' + ToString(DefaultValue) + '</TT>';
end;

procedure _String_fontcolor(MethodBody: TPAXMethodBody);
begin
  with MethodBody do
  begin
    if ParamCount > 0 then
      Name := ToString(Params[0].AsVariant)
    else
      Name := 'undefined';
    result.AsVariant := '<FONT COLOR="' + Name + '">' + ToString(DefaultValue) + '</FONT>';
  end;
end;

procedure _String_fontsize(MethodBody: TPAXMethodBody);
begin
  with MethodBody do
  begin
    if ParamCount > 0 then
      Name := ToString(Params[0].AsVariant)
    else
      Name := 'undefined';
    result.AsVariant := '<FONT SIZE="' + Name + '">' + ToString(DefaultValue) + '</FONT>';
  end;
end;

procedure _String_fromCharCode(MethodBody: TPAXMethodBody);
var
  S: String;
  I: Integer;
  B: Byte;
begin
  with MethodBody do
  begin
    S := '';
    for I:=0 to ParamCount - 1 do
    begin
      B := ToInt32(Params[I].AsVariant);
      S := S + Chr(B);
    end;
    result.AsVariant := S;
  end;
end;

procedure _String_indexOf(MethodBody: TPAXMethodBody);
var
  S, P: String;
  I, J, L: Integer;
begin
  with MethodBody do
  begin
    result.AsVariant := Integer(-1);
    L := ParamCount;
    if L = 0 then
      Exit;
     S := ToString(DefaultValue);
     P := ToString(Params[0].AsVariant);
     if L > 1 then
       J := ToInt32(Params[1].AsVariant)
     else
       J := 1;
     if J <= 0 then
       J := 1;
     L := Length(P);
     for I:=J to Length(S) - L + 1 do
12345

imp_javascript.pas - 源码说明

本页面展示了「Delphi脚本控件」中的 imp_javascript.pas 源码文件，采用 PAS 编程语言编写，共 2,672 行代码。您可以在线阅读完整代码内容，也可以返回资源详情页下载完整源码包进行本地学习和开发。

虫虫下载站收录了大量与Delphi相关的技术资源，包括源代码、技术文档、电路图等，是电子工程师和嵌入式开发者的专业学习平台。

⌨️ 快捷键说明

复制代码Ctrl + C
搜索代码Ctrl + F
全屏模式F11
增大字号Ctrl + =
减小字号Ctrl + -
显示快捷键?