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.




附件列表

    原文地址:https://www.cnblogs.com/xe2011/p/2541065.html