imp_basic.pas

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

  end;
end;

procedure _Exp(MethodBody: TPAXMethodBody);
begin
  with MethodBody do
    result.AsVariant := Exp(ToNumber(Params[0].AsVariant));
end;

procedure _Array(MethodBody: TPAXMethodBody);
var
  Values: array of Variant;
  I: Integer;
  PA: TPaxArray;
  SO: TPaxScriptObject;
begin
  with MethodBody do
  begin
    if TPaxBaseScripter(Scripter).Code.SignVBARRAYS then
    begin
      SetLength(Values, ParamCount);
      for I:=0 to ParamCount - 1 do
        Values[I] := Params[I].AsVariant;
      result.AsVariant := VarArrayOf(Values);
    end
    else
    begin
      PA := TPaxArray.Create([ParamCount - 1]);
      PA.Scripter := Scripter;
      for I:=0 to ParamCount - 1 do
        PA.Put([I], Params[I].AsVariant);

      SO := TPAXBaseScripter(Scripter).ArrayClassRec.CreateScriptObject;
      SO.RefCount := 1;
      SO.Instance := PA;
      result.AsVariant := ScriptObjectToVariant(SO);
    end;
  end;
end;

procedure _Filter(MethodBody: TPAXMethodBody);
var
  L: TStringList;
  V: Variant;
  S: String;
  Bounds: array of integer;
  I: Integer;
  InputStrings, Value: Variant;
  Include: Boolean;
  PA: TPaxArray;
  SO: TPaxScriptObject;
begin
  Include := false;
  with MethodBody do
  begin
    L := TStringList.Create;

    Value := ToString(Params[1].AsVariant);

    case ParamCount of
      2:
      begin
        Include := true;
      end;
      3:
      begin
        Include := ToBoolean(Params[2].AsVariant);
      end;
      4:
      begin
        Include := ToBoolean(Params[2].AsVariant);
      end;
    end;

    InputStrings := Params[0].AsVariant;
    if IsVBArray(InputStrings) then
    begin
      for I:=0 to VarArrayHighBound(V, 1) do
      begin
        S := ToString(InputStrings[I]);
        if Pos(String(Value), S) > 0 then
          if Include then
             L.Add(S);
      end;

      SetLength(Bounds, 2);
      Bounds[0] := 0;
      Bounds[1] := L.Count - 1;

      V := VarArrayCreate(Bounds, varVariant);
      for I:=0 to L.Count - 1 do
        V[I] := L[I];

      result.AsVariant := V;
    end
    else if IsPaxArray(InputStrings) then
    begin
      PA := VariantToScriptObject(InputStrings).Instance as TPaxArray;
      for I:=0 to PA.Length - 1 do
      begin
        S := ToString(PA.Get([I]));
        if Pos(String(Value), S) > 0 then
          if Include then
             L.Add(S);
      end;

      PA := TPaxArray.Create([L.Count - 1]);
      PA.Scripter := Scripter;
      for I:=0 to L.Count - 1 do
        PA.Put([I], L[I]);

      SO := TPAXBaseScripter(Scripter).ArrayClassRec.CreateScriptObject;
      SO.RefCount := 1;
      SO.Instance := PA;
      result.AsVariant := ScriptObjectToVariant(SO);
    end;
    L.Free;
  end;
end;

procedure _Join(MethodBody: TPAXMethodBody);
var
  V: Variant;
  S, Delim: String;
  I, K: Integer;
  PA: TPaxArray;
begin
  with MethodBody do
  begin
    V := Params[0].AsVariant;
    S := '';
    Delim := ' ';
    if ParamCount = 2 then
      Delim := Params[1].AsString;

    if IsVBArray(V) then
    begin
      K := VarArrayHighBound(V, 1);
      for I:=0 to K do
      begin
        S := S + ToString(V[I]);
        if I < K then
          S := S + Delim;
      end;
    end
    else if IsPaxArray(V) then
    begin
      PA := VariantToScriptObject(V).Instance as TPaxArray;
      K := PA.Length - 1;
      for I:=0 to K do
      begin
        S := S + ToString(PA.Get([I]));
        if I < K then
          S := S + Delim;
      end;
    end;

    result.AsVariant := S;
  end;
end;

procedure _Split(MethodBody: TPAXMethodBody);
var
  V: Variant;
  S, R: String;
  Delim: Char;
  I: Integer;
  L: TStringList;
  PA: TPaxArray;
  SO: TPaxScriptObject;
begin
  with MethodBody do
  begin
    S := Params[0].AsString;
    Delim := ' ';
    if ParamCount >= 2 then
      Delim := Params[1].AsString[1];

    L := TStringList.Create;
    try
      R := '';
      I := 1;
      repeat
        if I > Length(S) then
        begin
          L.Add(S);
          break;
        end;
        if S[I] = Delim then
        begin
          R := Copy(S, 1, I - 1);
          L.Add(R);
          Delete(S, 1, I);
          R := '';
          I := 1;
          if S = '' then
            Break;
        end
        else
          Inc(I);
      until false;

      if TPaxBaseScripter(Scripter).Code.SignVBARRAYS then
      begin
        V := VarArrayCreate([0, L.Count - 1], varVariant);
        for I := 0 to L.Count - 1 do
          V[I] := L[I];
      end
      else
      begin
        PA := TPaxArray.Create([L.Count - 1]);
        PA.Scripter := Scripter;
        for I:=0 to L.Count - 1 do
          PA.Put([I], L[I]);

        SO := TPAXBaseScripter(Scripter).ArrayClassRec.CreateScriptObject;
        SO.RefCount := 1;
        SO.Instance := PA;
        V := ScriptObjectToVariant(SO);
      end;

    finally
      L.Free;
      result.AsVariant := V;
    end;
  end;
end;

procedure _LBound(MethodBody: TPAXMethodBody);
begin
  with MethodBody do
    result.AsVariant := 0;
end;

procedure _UBound(MethodBody: TPAXMethodBody);
var
  V: Variant;
  D: Integer;
begin
  with MethodBody do
  begin
    V := Params[0].AsVariant;
    D := Params[1].AsInteger;
    if IsVBArray(V) then
      result.AsInteger := VarArrayHighBound(V, D)
    else if IsPaxArray(V) then
      result.AsInteger := (VariantToScriptObject(V).Instance as TPaxArray).Length - 1;
  end;
end;

procedure _LCase(MethodBody: TPAXMethodBody);
begin
  with MethodBody do
    result.AsVariant := LowerCase(Params[0].AsString);
end;

procedure _UCase(MethodBody: TPAXMethodBody);
begin
  with MethodBody do
    result.AsVariant := UpperCase(Params[0].AsString);
end;

procedure _Left(MethodBody: TPAXMethodBody);
begin
  with MethodBody do
    result.AsVariant := Copy(Params[0].AsString, 1, Params[1].AsInteger);
end;

procedure _Right(MethodBody: TPAXMethodBody);
var
  R, S: String;
  I, L: Integer;
begin
  with MethodBody do
  begin
    S := Params[0].AsString;
    L := Params[1].AsInteger;

    if L > Length(S) then
      L := Length(S);

    R := '';
    for I:=Length(S) downto Length(S) - L + 1 do
      R := S[I] + R;

    result.AsVariant := R;
  end;
end;

procedure _RND(MethodBody: TPAXMethodBody);
begin
  with MethodBody do
  begin
    if ParamCount = 2 then
      result.AsVariant := Random(Params[1].AsInteger - Params[0].AsInteger) + Params[0].AsInteger
    else
      result.AsVariant := Random(Params[0].AsInteger);
  end;
end;

procedure _Sgn(MethodBody: TPAXMethodBody);
var
  V: Variant;
begin
  with MethodBody do
  begin
    V := Params[0].AsInteger;
    if V > 0 then
      result.AsInteger := 1
    else if V < 0 then
      result.AsInteger := -1
    else
      result.AsInteger := 0;
  end;
end;

procedure _Round(MethodBody: TPAXMethodBody);
var
  D: Double;
  L, P: Integer;
  S: String;

begin
  with MethodBody do
  begin
    if ParamCount = 1 then
      result.AsInteger := Round(Params[0].AsDouble)
    else
    begin
      L := Params[1].AsInteger;
      D := Params[0].AsDouble;
      S := FloatToStr(D);
      P := Pos(DecimalSeparator, S);
      if P > 0 then
      begin
        S := Copy(S, 1, P + L);
        D := StrToFloat(S);
        result.AsDouble := D;
      end
      else
      begin
        result.AsInteger := Round(Params[0].AsDouble);
      end;
    end;
  end;
end;

procedure _Len(MethodBody: TPAXMethodBody);
begin
  with MethodBody do
    result.AsVariant := Length(Params[0].AsString);
end;

procedure _Log(MethodBody: TPAXMethodBody);
begin
  with MethodBody do
    result.AsVariant := Ln(Params[0].AsVariant);
end;

procedure _LTrim(MethodBody: TPAXMethodBody);
begin
  with MethodBody do
    result.AsVariant := TrimLeft(Params[0].AsString);
end;

procedure _RTrim(MethodBody: TPAXMethodBody);
begin
  with MethodBody do
    result.AsVariant := TrimRight(Params[0].AsString);
end;

procedure _Trim(MethodBody: TPAXMethodBody);
begin
  with MethodBody do
    result.AsVariant := Trim(Params[0].AsString);
end;

procedure _Space(MethodBody: TPAXMethodBody);
var
  I: Integer;
  S: String;
begin
  with MethodBody do
  begin
    S := '';
    for I:=1 to Params[0].AsInteger do
      S := S + ' ';
    result.AsString := S;
  end;
end;

procedure _Replace(MethodBody: TPAXMethodBody);
begin
  with MethodBody do
    result.AsVariant := StringReplace(Params[0].AsString,
                                      Params[1].AsString,
                                      Params[2].AsString,
                                      [rfReplaceAll, rfIgnoreCase]);
end;

procedure _RGB(MethodBody: TPAXMethodBody);
var
  red, green, blue: INteger;
begin
  with MethodBody do
  begin
    red := Params[0].AsInteger;
    green := Params[1].AsInteger;
    blue := Params[2].AsInteger;
    result.AsVariant := red + (green * 256) + (blue * 65536);
  end;
end;

procedure _Mid(MethodBody: TPAXMethodBody);
var
  L: Integer;
begin
  with MethodBody do
  begin
    if ParamCount = 3 then
      L := Params[2].AsInteger
    else
      L := Length(Params[0].AsString);
    result.AsVariant := Copy(Params[0].AsString, Params[1].AsInteger, L);
  end;
end;

procedure _FormatCurrency(MethodBody: TPAXMethodBody);
var
  V: Currency;
begin
  with MethodBody do
  begin
    V := ToNumber(Params[0].AsVariant);
    result.AsVariant := CurrToStr(V);
  end;
end;

procedure _FormatDateTime(MethodBody: TPAXMethodBody);
begin
  with MethodBody do
  begin
    result.AsVariant := DateTimeToStr(Params[0].AsVariant);
  end;
end;

procedure _FormatNumber(MethodBody: TPAXMethodBody);
var
  D: Double;
  Fmt: String;
  NumDigitsAfterDecimal: Integer;
begin
  with MethodBody do
  begin
    case ParamCount of
      1: result.AsVariant := ToString(Params[0].AsVariant);
      2, 3:
      begin
        D := ToNumber(Params[0].AsVariant);
        NumDigitsAfterDecimal := ToInt32(Params[1].AsVariant);
        Fmt := '%*.' + IntToStr(NumDigitsAfterDecimal) + 'f';
        result.AsVariant := Format(Fmt, [D]);
      end;
    end;
  end;
end;

procedure _FormatPercent(MethodBody: TPAXMethodBody);
var
  D: Double;
  Fmt: String;
  NumDigitsAfterDecimal: Integer;
begin
  with MethodBody do
  begin
    case ParamCount of
      1: result.AsVariant := ToString(Params[0].AsVariant * 100.0) + '%';
      2, 3:
      begin
        D := ToNumber(Params[0].AsVariant * 100.0);
        NumDigitsAfterDecimal := ToInt32(Params[1].AsVariant);
        Fmt := '%*.' + IntToStr(NumDigitsAfterDecimal) + 'f';
        result.AsVariant := Format(Fmt, [D]) + '%';
      end;
    end;
  end;
end;

procedure _GetLocale(MethodBody: TPAXMethodBody);
begin
  with MethodBody do
    result.AsString := '';
end;

procedure _Hex(MethodBody: TPAXMethodBody);
var
  I: Integer;
begin
  with MethodBody do
  begin
    I := ToInt32(Params[0].AsVariant);
    result.AsString := Format('%x', [I]);
  end;
end;

procedure _InputBox(MethodBody: TPAXMethodBody);
var
  Caption, Prompt: String;
begin
  with MethodBody do
  begin
    Caption := '';
    Prompt := '';

    if ParamCount = 1 then
      Caption := ToString(Params[0].AsVariant)
    else if ParamCount >= 2 then
    begin
      Caption := ToString(Params[0].AsVariant);
      Prompt := ToString(Params[1].AsVariant);
    end;

//    result.AsString := InputBox(Caption, Prompt, '');
  end;
end;

procedure _InStr(MethodBody: TPAXMethodBody);
var
  V1, V2: Variant;
  S1, S2: String;
  start: Integer;
begin
  start := 0;
  with MethodBody do
  begin
    case ParamCount of
      2:
      begin
        start := 1;
        V1 := Params[0].AsVariant;
        V2 := Params[1].AsVariant;
      end;
      3: