imp_basic.pas

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

PAS
1,628 行
字号
123
////////////////////////////////////////////////////////////////////////////
// PAXScript Importing
// Author: Alexander Baranovsky (ab@cable.netlux.org)
// ========================================================================
// Copyright (c) Alexander Baranovsky, 2003-2005. All rights reserved.
// Code Version: 3.0
// ========================================================================
// Unit: IMP_Basic.pas
// ========================================================================
////////////////////////////////////////////////////////////////////////////


{$I PaxScript.def}

unit IMP_Basic;
interface
uses
{$IFDEF LINUX}
  QForms,
{$ENDIF}
{$IFDEF WIN32}
  Windows,
  {$IFNDEF FP}
  ComObj,
  {$ENDIF}
{$ENDIF}

{$ifdef VARIANTS}
  Variants,
{$endif}

  SysUtils,
  Classes,
  Math,
  BASE_SYS,
  BASE_CLASS,
  BASE_PARSER,
  BASE_EXTERN,
  BASE_SCRIPTER,
  PAX_BASIC,
  PaxScripter;

implementation

uses IMP_ActiveX;

const
  vbEmpty = 0;
  vbNull = 1;
  vbInteger = 2;
  vbLong = 3;
  vbSingle = 4;
  vbDouble = 5;
  vbCurrency = 6;
  vbDate = 7;
  vbString = 8;
  vbObject = 9;
  vbError = 10;
  vbBoolean = 11;
  vbVariant = 12;
  vbDataObject = 13;
  vbByte = 17;
  vbArray = 8192;

  vbGeneralDate = 0;
  vbLongDate = 1;
  vbShortDate = 2;
  vbLongTime = 3;
  vbShortTime = 4;

const
  MonthNames: array [1..12] of string =
  (
  'January',
  'February',
  'March',
  'April',
  'May',
  'June',
  'July',
  'August',
  'September',
  'October',
  'November',
  'December'
  );

  WeekDayNames: array [1..7] of string =
  (
  'Sunday',
  'Monday',
  'Tuesday',
  'Wednesday',
  'Thursday',
  'Friday',
  'Saturday'
  );

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

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

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

procedure _Sqr(MethodBody: TPAXMethodBody);
begin
  with MethodBody do
    result.AsVariant := Sqr(Params[0].AsDouble);
end;


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

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

procedure _CByte(MethodBody: TPAXMethodBody);
var
  I: Integer;
begin
  with MethodBody do
  begin
    I := ToInt32(Params[0].AsVariant);
    result.AsVariant := I mod 256;
  end;
end;

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

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

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

procedure _Chr(MethodBody: TPAXMethodBody);
begin
  with MethodBody do
    result.AsString := Chr(Params[0].AsInteger);
end;

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

procedure _CreateObject(MethodBody: TPAXMethodBody);
begin
{$ifndef fp}
  with MethodBody do
  begin
    Self := ActiveXObject.Create(Scripter);
    ActiveXObject(Self).D := CreateOleObject(Params[0].AsString);
  end;
  {$endif}
end;

procedure _GetObject(MethodBody: TPAXMethodBody);
var
  ClassRec: TPaxClassRec;
  SO: TPaxScriptObject;
begin
{$ifndef fp}
  with MethodBody do
  begin
    ClassRec := TPAXBaseScripter(Scripter).ClassList.FindClassByName('ActiveXObject');
    if ClassRec <> nil then
    begin
      SO := TPAXScriptObject.Create(ClassRec);
      SO.Instance := ActiveXObject.Create(Scripter);
{$IFDEF WIN32}
      ActiveXObject(SO.Instance).D := GetActiveOleObject(Params[0].AsString);
{$ENDIF}
      result.AsVariant := ScriptObjectToVariant(SO);
    end;
  end;
{$endif}
end;

procedure _GetRef(MethodBody: TPAXMethodBody);
var
  S: String;
  I: Integer;
begin
  with MethodBody do
  begin
    S := ToString(Params[0].AsVariant);
    with TPaxBaseScripter(Scripter).SymbolTable do
      for I:=1 to Card do
        if Kind[I] = KindSUB then
        if StrEql(Name[I], S) then
        begin
          result.AsInteger := I;
          Exit;
        end;
  end;
end;

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

procedure _Asc(MethodBody: TPAXMethodBody);
begin
  with MethodBody do
    result.AsInteger := Ord(Params[0].AsString[1]);
end;

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

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

procedure _Date(MethodBody: TPAXMethodBody);
begin
  with MethodBody do
    result.AsVariant := Date;
end;

procedure _DateAdd(MethodBody: TPAXMethodBody);
begin
  with MethodBody do
    result.AsVariant := Date;
end;

procedure _DateDiff(MethodBody: TPAXMethodBody);
begin
  with MethodBody do
    result.AsVariant := Date;
end;

procedure _DatePart(MethodBody: TPAXMethodBody);
begin
  with MethodBody do
    result.AsVariant := Date;
end;

procedure _DateSerial(MethodBody: TPAXMethodBody);
var
  Y, M, D: Word;
begin
  with MethodBody do
  begin
    Y := ToInt32(Params[0].AsVariant);
    M := ToInt32(Params[1].AsVariant);
    D := ToInt32(Params[2].AsVariant);
    result.AsVariant := EncodeDate(Y,M,D);
  end;
end;

procedure _DateValue(MethodBody: TPAXMethodBody);
var
  S: String;
begin
  with MethodBody do
  begin
    S := ToString(Params[0].AsVariant);
    result.AsVariant := StrToDate(S);
  end;
end;

procedure _Day(MethodBody: TPAXMethodBody);
var
  V: Variant;
  D: TDateTime;
  Y, M, Day: Word;
begin
  with MethodBody do
  begin
    V := Params[0].AsVariant;
    if VarType(V) = varString then
      D := StrToDate(V)
    else
      D := ToNumber(V);
    DecodeDate(D, Y, M, Day);
    result.AsVariant := Day;
  end;
end;

procedure _Hour(MethodBody: TPAXMethodBody);
var
  V: Variant;
  D: TDateTime;
  Hour, Min, Sec, MSec: Word;
begin
  with MethodBody do
  begin
    V := Params[0].AsVariant;
    if VarType(V) = varString then
      D := StrToTime(V)
    else
      D := ToNumber(V);
    DecodeTime(D, Hour, Min, Sec, MSec);
    result.AsVariant := Hour;
  end;
end;

procedure _TimeSerial(MethodBody: TPAXMethodBody);
var
  Hour, Min, Sec: Word;
begin
  with MethodBody do
  begin
    Hour := Params[0].AsInteger;
    Min := Params[0].AsInteger;
    Sec := Params[0].AsInteger;
    result.AsVariant := EncodeTime(Hour, Min, Sec, 0);
  end;
end;

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

procedure _Minute(MethodBody: TPAXMethodBody);
var
  V: Variant;
  D: TDateTime;
  Hour, Min, Sec, MSec: Word;
begin
  with MethodBody do
  begin
    V := Params[0].AsVariant;
    if VarType(V) = varString then
      D := StrToTime(V)
    else
      D := ToNumber(V);
    DecodeTime(D, Hour, Min, Sec, MSec);
    result.AsVariant := Min;
  end;
end;

procedure _Second(MethodBody: TPAXMethodBody);
var
  V: Variant;
  D: TDateTime;
  Hour, Min, Sec, MSec: Word;
begin
  with MethodBody do
  begin
    V := Params[0].AsVariant;
    if VarType(V) = varString then
      D := StrToTime(V)
    else
      D := ToNumber(V);
    DecodeTime(D, Hour, Min, Sec, MSec);
    result.AsVariant := Sec;
  end;
end;

procedure _Month(MethodBody: TPAXMethodBody);
var
  V: Variant;
  D: TDateTime;
  Y, M, Day: Word;
begin
  with MethodBody do
  begin
    V := Params[0].AsVariant;
    if VarType(V) = varString then
      D := StrToDate(V)
    else
      D := ToNumber(V);
    DecodeDate(D, Y, M, Day);
    result.AsVariant := M;
  end;
end;

procedure _MonthName(MethodBody: TPAXMethodBody);
var
  I: Integer;
  S: String;
  Short: Boolean;
begin
  with MethodBody do
  begin
    I := Params[0].AsInteger;
    S := MonthNames[I];
    Short := false;
    if ParamCount = 2 then
      Short := Params[1].AsBoolean;
    if Short then
      S := Copy(S, 1, 3);

    result.AsVariant := S;
  end;
end;

procedure _WeekDayName(MethodBody: TPAXMethodBody);
var
  I: Integer;
  S: String;
  Short: Boolean;
begin
  with MethodBody do
  begin
    I := Params[0].AsInteger;
    S := WeekDayNames[I];
    Short := false;
    if ParamCount = 2 then
      Short := Params[1].AsBoolean;
    if Short then
      S := Copy(S, 1, 3);

    result.AsVariant := S;
  end;
end;

procedure _Now(MethodBody: TPAXMethodBody);
begin
  with MethodBody do
    result.AsVariant := Now;
end;

procedure _Time(MethodBody: TPAXMethodBody);
begin
  with MethodBody do
    result.AsVariant := Time;
end;

procedure _Timer(MethodBody: TPAXMethodBody);
begin
  with MethodBody do
    result.AsVariant := GetTickCount;
end;

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

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

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

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

procedure _StrReverse(MethodBody: TPAXMethodBody);
var
  S1, S2: String;
  I: Integer;
begin
  with MethodBody do
  begin
    S1 := Params[0].AsString;
    S2 := '';
    for I := 1 to Length(S1) do
      S2 := S1[I] + S2;
    result.AsString := S2;
  end;
end;

procedure _Year(MethodBody: TPAXMethodBody);
var
  V: Variant;
  D: TDateTime;
  Y, M, Day: Word;
begin
  with MethodBody do
  begin
    V := Params[0].AsVariant;
    if VarType(V) = varString then
      D := StrToDate(V)
    else
      D := ToNumber(V);
    DecodeDate(D, Y, M, Day);
    result.AsVariant := Y;
123

imp_basic.pas - 源码说明

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

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

⌨️ 快捷键说明

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