delphi脚本

 

unit Unit1;

 

interface

 

uses

  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

  Dialogs, StdCtrls, Menus, ComCtrls, ToolWin, Buttons;

 

type

  TForm1 = class(TForm)

    MainMenu1: TMainMenu;

    mniRun1: TMenuItem;

    Run: TMenuItem;

    File1: TMenuItem;

    Exit1: TMenuItem;

    SaveAs1: TMenuItem;

    Open1: TMenuItem;

    N1: TMenuItem;

    Edit1: TMenuItem;

    Clear1: TMenuItem;

    Memo1: TMemo;

    PopupMenu1: TPopupMenu;

    Copy1: TMenuItem;

    Del1: TMenuItem;

    Paste1: TMenuItem;

    SelectAll1: TMenuItem;

    N3: TMenuItem;

    ScriptsClear1: TMenuItem;

    ClearAll1: TMenuItem;

    SaveDialog1: TSaveDialog;

    OpenDialog1: TOpenDialog;

    Memo2: TMemo;

    New1: TMenuItem;

    procedure FormCreate(Sender: TObject);

    procedure RunClick(Sender: TObject);

    procedure Exit1Click(Sender: TObject);

    procedure Clear1Click(Sender: TObject);

    procedure ScriptsClear1Click(Sender: TObject);

    procedure ClearAll1Click(Sender: TObject);

    procedure Copy1Click(Sender: TObject);

    procedure SelectAll1Click(Sender: TObject);

    procedure Paste1Click(Sender: TObject);

    procedure Del1Click(Sender: TObject);

    procedure Open1Click(Sender: TObject);

    procedure SaveAs1Click(Sender: TObject);

    procedure New1Click(Sender: TObject);

  private

    { Private declarations }

  public

    { Public declarations }

  end;

 

var

  Form1: TForm1;

 

implementation

 

uses

  Unit2;

 

{$R *.dfm}

 

//运行

procedure TForm1.RunClick(Sender: TObject);
var
    I:integer;
    ms:string;
begin
  try
    for i:=0 to Memo2.Lines.Count -1 do 
      begin
         ms:=Memo2.Lines.Strings[i];
         if  transformCmd(@cmds,ms)<>-1 then cmd(cmds);
      end;
  except
    form1.Memo1.Lines.Add('scripts error!');
  end;
end;

end.

 

////////////////Unit2

unit Unit2;

interface
uses
   Unit1,
   Dialogs,
   Forms,
   SysUtils; {format}

type
   TcmdLine = array[0..10] of string;
  pTcmdLine =^TcmdLine;
   var  cmds:TcmdLine;

   function transformCmd(cmd:ptcmdLine;s: string):Integer;
   procedure cmd(cmd:Tcmdline);
   ///customize define
   function add(a,b:integer):integer;
   function sub(a,b:integer):integer;
   function print( const Text:PAnsiChar): string;
implementation


////Function lists
function add(a,b:integer):integer;
begin
  Result :=a +b;
  Form1.Memo1.Lines.Add(format( '"add (%d,%d)" --> %d',[a,b,Result]));
end;

function sub(a,b:integer):integer;
begin
  Result :=a -b;
  Form1.Memo1.Lines.Add(format( '"sub (%d,%d)" --> %d',[a,b,Result]));
end;

function print( const Text:PAnsiChar): string;
begin
  Result := text;               
  Form1.Memo1.Lines.Add(format( '"print (%s)" --> %s',[Result,Result]));
end;



///command lists
procedure cmd(cmd:Tcmdline);
begin
      if cmd[ 0] =( 'add')     then  add(strToint(cmd[ 1]),strToint(cmd[ 2]));
    if cmd[ 0] =( 'sub')     then  sub(strToint(cmd[ 1]),strToint(cmd[ 2]));
    if cmd[ 0] =( 'print')   then  print(PAnsiChar(cmd[ 1]));
///add more define commands

end;


/// transform command
function transformCmd(cmd:PTcmdline;s: string):integer;
var
    p:pchar;
    st: string;
    i,j:integer;
begin
     result := 1;
    if s = '' then
      begin
       result := - 1;
       exit;
      end;

     i := 0;
   j := 0;
   st := '';
     p :=@s[ 1];
     while (p[i] <> '(') do
       begin 
         st :=st +p[i];
         i :=i + 1;
       end;
         cmd[j] :=st;j :=j + 1;

         if (p[i] = '(') then
      i :=i + 1;
      st := '';

         while (p[i] <> ')') do 
       begin
          while (p[i] <> ',' )    do
          begin
            st :=st +p[i];
            i :=i + 1;
             if p[i] = ')' then break;
          end;

         if p[i] = ','   then
          begin
            cmd[j] :=st;
            st := '';
            j :=j + 1;
            i :=i + 1;
          end;

         if p[i] = ')' then
         begin
          cmd[j] :=st;
          st := '';
          break;
         end;
       end;
end;

end.

通过 Wiz 发布

附件列表