{　デチューン版 GikoBasic
 1..　元のソースと喧嘩しないようにTGikoScrと変名しました
 2..　変数領域を固定ではく動的変数に変更
 3..  インスタンスを作成する関数GikoScriptを追加
 4..　四則演算の機能だけが使い易いように
  　　 procedure LET(scr: String);
   　　function ExecToVar(scr: String):
　　　 function ExecToStr(scr: String):string;
  　　この３つを追加しました

以上の結果
 uses UGikoScr;　のように追加し
 GikoScript.ExecToVar('1+2*3') と呼ぶだけで値 6が得られるようになりました
　また変数を使いたい場合は
 GikoScript.LET('L1=123');
　のように 変数名=式の文字列を渡すだけです

...なお、旧来のギコBASICの機能はそのまま残っています
 GikoScript.LET('ｲﾚﾃﾐﾛ ここに');　とやれば ここにという変数に入力出来ます
 　
　ラベルを含む場合は、LETでは実行出来ないので   メモにスクリプトを書いて
 GikoScript.RUN(Memo1.Lines);と実行します　
サンプルコード
  変数=0
  ｲﾚﾃﾐﾛ 回数
  ﾒｼﾞﾙｼ ここだよ
  変数=変数+回数
  回数=回数-1
  ﾓｼﾓﾀﾞﾖ 0 < 回数 ﾀﾞｯﾀﾗ ｲｯﾃﾖｼ ここだよ
  ﾎｻﾞｹ  toStr(変数)+"だよ"


}

{	ギコBASIC   Ver 0.001  2000/6/20 名無しさん＠１周年(by 2ちゃんねる)
	            Ver 0.002  2000/6/21 某ランド じゃそのままDelphiに移植したから
   	            Ver 0.003  2000/6/22 某ランド ついでに全角対応にした
   	            Ver 0.004  2000/6/23 >27さん   変数をバリアントにしたよ
   	            Ver 0.005  2000/6/24 某ランド 外部関数が呼べるような改造
   	            Ver 0.006  2000/6/24 >41  プロパティ対応


文法覚え書き(2000/6/20)

  ・変数は整数型のみです
     =>27さんにより文字も可能に
     =>41により 16進対応 例 $ff

  ・ラベル・変数の命名規則は最初の文字は半角かなと英字、
  　二文字目以降は半角かなと英数字で構成します。
     =>某ランドさんにより全角ラベル変数に対応

  ・表示は変数のみです

  ・命令は以下の通りです。

	ﾒｼﾞﾙｼ <ラベル名>       ・・・  ラベルです。ｲｯﾃﾖｼ命令の逝き先の指定に使います
	ｲｯﾃﾖｼ <ラベル名>       ・・・  ﾒｼﾞﾙｼ命令で指定したラベルの位置に逝きます
	ﾎｻﾞｹ  <変数名>         ・・・  変数の内容を表示します
	ｲﾚﾃﾐﾛ <変数名>         ・・・  ユーザーの入力を待ち、入力された数字を変数に格納します
	ﾓｼﾓﾀﾞﾖ <式> ﾀﾞｯﾀﾗ <文> ・・・  式を評価し、真ならばﾀﾞｯﾀﾗの後の文を実行し、偽ならば無視します
	ｼﾈ                     ・・・  プログラムを終了します

  ・演算子は以下通りです

  　+, -, *, / ,% ・・・ 四則演算
    =             ・・・ 代入（ﾓｼﾓﾀﾞﾖ命令内では比較演算子）
	<, >, <>      ・・・ 比較演算子
    AND OR XOR NOT

  ・関数が使えます。
     >41 により published メソッドなら自動的にギコBasic側から呼出し可能に。

  ・プロパテイ
    @プロパテイ名
    例: @Canvas.Pen.Color:=$0000ff
    この為にCanvasをpublishdにしなければならなくなった・・・・(^^;

        ----------------------------------------------------
 名無しさん＠１周年 Write
	元のソースは(http://member.nifty.ne.jp/nakamula/cb.c)にあります。
	この修正は元の作者の許可なく行っていますのでこのソースに関して
	元の作者に質問するのはやめてください。

	大まかな修正点：
		インデントの修正。マルチステートメントの分解
		{の位置を修正。代入や比較文等に空白文字を付加、
		コメントの付加。マクロのスペルを大文字に変更
		関数のプロトタイプ等をANSIに準拠するように修正
		一部の関数を除いて戻り値の型をvoidに修正
		main関数をANSIに準拠するように修正、パラメータを受け取れるようにした。
		getch()関数は標準ライブラリに存在するのでbgetch()に変更
		仕様をギコBASICに変更(わら

	元のｿｰｽを見て感想：
		凄まじい・・・1992年頃のプログラミングってこんな感じだったのか!?

}
unit UGIKOSCR_2005;
interface
uses SysUtils,Classes ,Dialogs,Controls,TypInfo ,Variants,windows;
type
   TGikoVar=record
    name:string;
    value:Variant;
 end;
 Type TGikoMsgEvent= procedure (Sender: TObject;msg:string) of object;
 Type TGikoDtEvent = procedure (Sender: TObject;dt:Variant) of object;
 Type TGikoCallEvent= procedure (Sender: TObject;func:string;var res:boolean;const dt:array of Variant;var return:Variant) of object;
 Type TGikoPropEvent= procedure (Sender: TObject;pname:string;var res:boolean;var return:Variant) of object;
/////////////////////////////////
// ギコCalc基本クラス
type TGikoScr=class
protected
  line:string;
  lc:integer;
  pc:integer;
  str:string;
   ch:string;
  sym:char;
  numVar:Variant;
 OldErrMsg:string;
 procedure  writemsg(msg:string);
 procedure  printmsg(dt:Variant);
 procedure  error(errstr:string);
 function   PrepareChr:string;
 procedure  GetSym;
 procedure  expression;
 procedure  addsub;
 procedure  muldiv;
 procedure  factor;
 procedure  FuncCall;
 function   CallFunc(funcname:string;const v:array of variant):variant;
 function   GetVariable(const name:string; newval:integer):integer;
private
 fOperates:TComponent;
 fOnMsg:TGikoMsgEvent;
 fOnDt: TGikoDtEvent;
 fOnCall:TGikoCallEvent;
   function  bGetChr:string;
   function  PropGet:Variant;
    function GetOperates: TComponent;
protected
   procedure func(Sender: TObject; fname: string; var res: boolean;
      const dt: array of Variant; var return: Variant);virtual;
public
  source:TStrings;
  RunFlag:boolean; {実行中断用}
 constructor Create;
 procedure  labelread;
 procedure   exec;
 procedure  statement;
    procedure RUN(src: TStrings);
published
 property OnMsg: TGikoMsgEvent read fOnMsg write fOnMsg;
 property OnData:TGikoDtEvent read fOnDt write fOnDt;
 property OnCall:TGikoCallEvent read fOnCall write fOnCall;
{パブリッシュに登録した関数はそのままギコbasicの関数になる}
 function MID(const dt: array of Variant): Variant;

 function toStr(const dt: array of Variant): Variant;
 function toInt(const dt: array of Variant): Variant;
 function toType(const dt: array of Variant): Variant;
 function GoCall(const dt: array of Variant): Variant;
 function ExecToVar(scr: String): Variant;virtual;
 function ExecToStr(scr: String):string;
  procedure LET(scr: String);virtual;

 {Operatesに指定したオブジェクトのPublishプロパティが操作可能}
 property Operates:TComponent read fOperates write fOperates;

end;
var  variable: array of TGikoVar;
function GikoScript:TGikoScr;

///////////////////////////////////////////////////////
Type TGikoFuncIvent= function(const dt:array of Variant):Variant of object;
procedure GikoCall(obj:TObject;fname: string;var  res: boolean;
  const dt: array of Variant; var return: Variant);

implementation

//////////// ここからが実装 /////////////////////////////////////////
const  IDENTSYM       =   #1; {strにシンボル(変数名又はラベル)がある)}
const  NUMSYM         =   #2; {numVarに数値又は文字列がある}
const  FUNCSYM        =   #3; {strに関数名がある}
const  PROPSYM        =   #5; {プロパティ}

const asciilab=['A'..'Z','a'..'z','｡'..'ﾟ' ];
const asciinum=['A'..'Z','a'..'z','｡'..'ﾟ' ,'0'..'9'];
const  sjis1  =[#$81..#$9f,#$E0..#$FC] ;{漢字第1バイト}
const  sjis2  =[#$40..#$7e,#$80..#$FC] ;{漢字第２バイト}

procedure  TGikoScr.error(errstr:string);
begin
      OldErrMsg:='　　 　　　　∧ ∧　 ／￣￣￣￣￣￣￣￣￣￣￣￣￣'
        +#13+#10+'〜′￣￣( ﾟДﾟ)＜   '+errstr+'っつーの'
        +#13+#10+'  UU￣￣　U U　　＼＿＿＿＿＿＿＿＿＿＿＿＿＿'
        +#13+#10+format('%d %s',[lc,line] ) ;
      writemsg(OldErrMsg);
        abort;
end;

/////////////////////////////////////
// 次の文字を 引っ張って来る
function  TGikoScr.bGetChr:string;
begin
  if length(line)< pc then
  begin
   Result:=#13;
   pc:=0;
   exit;
  end;
  if pc = 0 then
    begin
     if (Source=nil) or (lc>=Source.count)  then
      begin
        Result:=#0;
       exit;
      end;
       repeat
        if lc>=Source.count   then
          begin
            Result:=#0;
           exit;
          end;
        line:= Trim(Source.Strings[lc]);
        inc(lc);
      until line<>'';
      pc:=1;
    end;
     Result:= line[pc]; inc(pc);
    if  Result[1] in sjis1 then //全角文字なら
      begin
       Result:= Result+line[pc];inc(pc);//一つの文字にする
      end;
  if  Result[1] in[#1..#20] then  Result:=' ';
end;
/////////////////////////////////////
// 全角文字の一部を半角にする
procedure CvtSjisChr(var ch:string);
begin
         if ch='　' then ch:=' ' //全角文字の一部は半角に
    else if ch='．' then ch:='.'
    else if ch='＝' then ch:='='
    else if ch[1]=#$82 then
     begin
           if ch='０' then ch:='0'
      else if ch='１' then ch:='1'
      else if ch='２' then ch:='2'
      else if ch='３' then ch:='3'
      else if ch='４' then ch:='4'
      else if ch='５' then ch:='5'
      else if ch='６' then ch:='6'
      else if ch='７' then ch:='7'
      else if ch='８' then ch:='8'
      else if ch='９' then ch:='9';
     end;
end;

function  TGikoScr.PrepareChr:string;
begin
  Result:=bGetChr;
  CvtSjisChr(Result);
end;
//////////////////////////////////////
//次のシンボルをsymに取り出す
// symがラベルならstrに、値なら numVarに
procedure TGikoScr.GetSym;
var s:string;
var c:set of char;
  /// ラベル ///
  procedure isLabel;
  begin
       sym := IDENTSYM;                   //ラベルか変数である
       while ( ch[1] in (  asciinum+sjis1 )) do
        begin
         str:=str+ch;
         ch:=PrepareChr;
         end;
       if ch[1]='(' then  {直後に(があるのは関数}
         begin
         sym := FUNCSYM;
         ch:=PrepareChr;
         end;
      {AND OR XOR は &|^に変換しておく}
      if       str='AND' then begin sym:='&';str:='';end
      else if  str='OR'  then begin sym:='|';str:='';end
      else if  str='NOT' then begin sym:='!';str:='';end
      else if  str='XOR' then begin sym:='^';str:='';end ;
  end;
  /// プロパティ ///
  procedure isProp;
  begin
       sym := PROPSYM;
         ch:=PrepareChr;
       while ( ch[1] in (  asciinum+['.'] )) do
        begin
         str:=str+ch;
         ch:=PrepareChr;
         end;
  end;
  /// 数字 ///
  procedure isNum;
  begin
  if ch[1]='$' then {１６進数}
   begin
    sym := NUMSYM;
      s:=ch;
     ch:=PrepareChr;
        while ch[1] in ['0'..'9','A'..'Z','a'..'z'] do
           begin
            s:=s+ch;
            ch:=PrepareChr;
            end;
          numVar:=StrToInt(s)
   end else
   begin  {10進数 又は小数点}
    sym := NUMSYM;
       s:='';
        while ch[1] in ['0'..'9','.'] do
           begin
            s:=s+ch;
            ch:=PrepareChr;
            end;
        numVar:=StrTOFloat(s);
   end;
  end;
  /// 文字列 ////
  procedure isString;
  begin
       sym := NUMSYM;
       c:=[ch[1],#13,#0]; {文字列終わり条件}
       ch:=bGetChr;{文字列中は全角半角変換しない}
       while not (ch[1] in c) do
           begin
             s:=s+ch;
             ch:=bGetChr;{文字列}
           end;
       ch:=PrepareChr;
       numVar:=s;

  end;
//////    TGikoScr.GetSym /////
begin
  str := '';
  while(ch = ' ') do ch:=PrepareChr;      //最初に空白を飛ばす
  if ch[1] in( asciilab+sjis1) then       //英字か全角文字なら
    begin
       isLabel;
    end else if ch[1] in ['@'] then       //先頭@がプロパティ
    begin
       isProp;
    end else if ch[1] in ['0'..'9','$'] then //数字
    begin
       isNum;
    end else if ch[1] in ['''','"']  then //文字列
    begin
       isString;
    end else begin                       //ラベル 数字以外なら
       sym := ch[1];
       ch:=PrepareChr;
    end;
end;

{条件判断}
procedure TGikoScr.expression;
var savenum:Variant;
var oldsym:char;
begin
        addsub;
        savenum := numVar;
 while sym in ['=', '>' , '<'] do
  begin
      oldsym:=sym;
      GetSym;
    case oldsym of
    '=' :begin addsub; numVar:= savenum =  numVar;end;
    '>' :begin addsub; numVar:= savenum >  numVar;end;
    '<' :begin
            if(sym='>') then
            begin
               GetSym;
               addsub; numVar:= savenum <> numVar;
            end else  begin
               addsub; numVar:= savenum <  numVar;
            end;
           end;
         end;
    savenum := numVar ;
  end;
end;

procedure TGikoScr.addsub;
var savenum:Variant;
var oldsym:char;
begin
       case sym of
        '+': begin
                GetSym;
                muldiv;
                savenum := numVar;
             end;
        '-': begin
                GetSym;
                muldiv;
                numVar := -numVar;
                savenum := numVar;
             end;
        '!':begin
                GetSym;
                muldiv;
                numVar := not numVar;
                savenum := numVar;
             end;
          else
                muldiv;  //単項演算子が無い場合
                savenum := numVar;
        end;
       //////////////////////////
       while(sym in [ '+', '-','&','|','^'] )do
       begin
       oldsym:=sym;
                        GetSym;
                        muldiv;
        case oldsym of
        '+':            numVar := savenum  +  numVar;
        '-':            numVar := savenum  -  numVar;
        '&':            numVar := savenum and numVar;
        '|':            numVar := savenum or  numVar;
        '^':            numVar := savenum xor numVar;
         end;
                        savenum := numVar;
        end;
end;

procedure TGikoScr.muldiv;
var savenum:Variant;
var oldsym:char;
begin
        factor;
        savenum := numVar;
      while sym in [ '*' , '/','%'] do
      begin
        oldsym:=sym;
        GetSym;
        factor;
       case oldsym of
       '*':   begin
                        numVar := savenum*numVar;
                end ;
       '/':   begin
                        if(numVar = 0) then error('0で割るな');
                        numVar := savenum / numVar;
                end;
       '%':   begin
                        if(numVar = 0) then error('0で割るな');
                        numVar := savenum mod numVar;
                end;
        end;
       end;
end;

{関数なら}
procedure TGikoScr.FuncCall;
var funcname:string;
var param:array[0..16] of variant;
var params:integer;
var oldsym:char;
begin
 funcname:=str;
     GetSym;
 params:=0;
  if sym = ')' then
   begin
    NumVar:=CallFunc(funcname,[]); //変数が無い high()は負数になる
    GetSym;
    exit;
   end;
 repeat;
  expression;
  if    params>high(param) then error('パラメータ数が多い');
  param[params]:=numVar;
  inc(  params );
  oldsym:=sym;
    GetSym;
 until oldsym<>',' ;

  if oldsym = ')' then
   begin
    NumVar:=CallFunc(funcname,slice(param,params));
    exit;
   end;
 error('")"の対応がまちがってる');
end;
{ カッコと関数の処理 }
procedure TGikoScr.factor;
var  i:integer;
begin
     if(sym = FUNCSYM) then
     begin
       FuncCall;
     end else
     if(sym = IDENTSYM) then begin
       i:=GetVariable(str, 1);
       numVar:=variable[i].value;
       GetSym;
     end else
     if(sym = PROPSYM) then begin
       numVar:=PropGet;
       GetSym;
     end else
     if(sym = NUMSYM) then  begin
       GetSym;
     end else
     if(sym = '(') then begin
       GetSym;
       expression;
       if(sym <> ')') then error('")"の対応がまちがってる');
       GetSym;
     end else begin
       error('文法エラーだ');
     end;
end;

{ 変数の値のセットと取得 }
function   TGikoScr.GetVariable(const name:string; newval:integer):integer;
begin
Result := 0;
  while( name <> variable[Result].name) do
  begin
    if variable[Result].name  = '' then
      begin
          if(newval = 0)then
          begin
            error(name+'ラベルが見つからん');
          end else begin
            variable[Result].name:= name;
            exit ;
          end;
      end;
   inc(Result);
   if(Result > High(variable)) then
    SetLength(variable,Length(variable)+10);//変数は10個単位に確保する
  end;
end;

{ラベルの先読み}
procedure TGikoScr.labelread;
var  i,n:integer;
begin
    pc:=0;
    lc:=0;
    ch:=' ';
 for i:= 0 to Source.count -1 do
 begin
  lc:=i;
  pc:=0;
  ch:=' ';
  GetSym;
     if(str= 'ﾒｼﾞﾙｼ')or (str='メジルシ') then
       begin
        GetSym;
        if(sym <> IDENTSYM) then error('文法エラーだ');
        str:=str+ ':';
        n := GetVariable(str, 1);
        variable[n].value := lc-1;
        end;
 end;
end;

//////////////////////
function Bunkatu(str:string):TStringList;
 var i:integer;
begin
  Bunkatu:=TStringList.Create;
  repeat
  i:=pos('.',str);
  if i>0 then begin
      Bunkatu.Add(copy(str,1,i-1));
      delete(str,1,i);
     end else
     begin
      Bunkatu.Add(str);
      str:='';
     end;
  until str='';
end;
function GetPropInfoName(var obj:TObject;str:string):PPropInfo;
var s:TStringList;
var i:integer;
begin
 Result:=nil;
        if not Assigned(obj) then  exit;

 s:=Bunkatu(str);
 try
 if s.Count>=1 then
   begin
    Result:=GetPropInfo(obj.ClassInfo,s.Strings[0]);
if Result=nil then exit;
 if s.Count>1 then
  for i:=1 to s.Count -1 do
     begin
      if  Result^.PropType^.Kind<>tkClass then
        begin
         Result:=nil;
         exit;
        end;
       obj:=TObject(GetOrdProp(obj,Result));
        if not Assigned(obj) then
         begin
          Result:=nil;
          exit;
         end;
       Result:=GetPropInfo(obj.ClassInfo,s.Strings[i]);
     end;
   end;
finally
 s.free;
 end;
end;
function SetPropVar(obj:TObject;str:string;numVar:Variant):boolean;
   var PropInfo:PPRopInfo;
begin
    Result:=False;
    PropInfo:=GetPropInfoName(obj,str);
    if PropInfo=nil then exit;

  case  PropInfo^.PropType^.kind  of
  tkString,tkLString,tkWString:
      SetStrProp(obj,PropInfo,VarToStr(numVar));

  tkInteger,tkChar,tkWChar:
      SetOrdProp(obj,PropInfo,VarAsType(numVar,varInteger));
  tkFloat:
      SetFloatProp(obj,PropInfo,numVar);
  tkEnumeration:
   begin
    if VarType(numVar)=varString then
         SetOrdProp(obj,PropInfo,GetEnumValue( PropInfo^.PropType^ ,numVar))
    else SetOrdProp(obj,PropInfo,VarAsType(numVar,varInteger));
   end
  else  Result:=True;
  end;
end;

function GetPropVar(obj:TObject;str:string;var r:Variant):boolean;
   var PropInfo:PPRopInfo;
begin
    Result:=True;
    PropInfo:=GetPropInfoName(obj,str);
    if PropInfo=nil then exit;
    Result:=False;

  case  PropInfo^.PropType^.kind  of
  tkString,tkLString,tkWString:
      r:=GetStrProp(obj,PropInfo);

  tkInteger,tkChar,tkWChar:
      r:=GetOrdProp(obj,PropInfo);
  tkFloat:
      r:=GetFloatProp(obj,PropInfo);

  tkEnumeration:
   begin
     r:=GetEnumName( PropInfo^.PropType^ ,GetOrdProp(obj,PropInfo))
   end
  else  Result:=True;
  end;
end;



function TGikoScr.GetOperates:TComponent;
begin
  Result:=Operates;
  if Result=nil then error('Operates未定義');
exit;
end;

function TGikoScr.PropGet:Variant;
begin
  if GetPropVar(GetOperates,str,Result) then error(str+'が無い');
end;


{シンボルを解釈し実行}
procedure TGikoScr.statement;
var  i:integer;
var s:string;
 procedure print;
 begin
     GetSym;
     expression;
     printmsg(numVar);
 end;
 procedure Input;
 begin
      GetSym;
      if(sym = IDENTSYM) then begin
         i:=GetVariable(str, 1);
         s:=InputBox('イレテミロ',str,
         VarToStr(variable[i].value) );
         variable[i].value:=s;
         GetSym;
       end;
 end;
 procedure jump;
 begin
      GetSym;
      if(sym <> IDENTSYM) then error('文法エラーだ');
      str:=str+ ':';
      i:=GetVariable(str, 0);
      lc:=round(variable[i].value);
      pc:=0;
      ch:=' ';
      GetSym;
 end;
 procedure if_then;
 begin
      GetSym;
      expression;
      if not((str =  'ﾀﾞｯﾀﾗ') or (str='ダッタラ')or(str='then') )then error('文法エラーだ');
      if(numVar=False) then begin
              while not (sym in [#0,#13] )do
               begin
                      GetSym;
              end;
      end;
      GetSym;
  end;
  procedure setVariable;
  begin
      i:=GetVariable(str, 1);
      GetSym;
      if(sym <> '=')then  error('文法エラーだ');
      GetSym;
      expression;
      variable[i].value := numVar;
  end;

  procedure PropSet;
   var oldstr:string;
  begin
   oldstr:=str;
    try
      GetSym;
      if(sym <> '=')then  error('文法エラーだ');
      GetSym;
      expression;
      // プロパティのセット
     if  SetPropVar(GetOperates,oldstr,numVar) then error(oldstr+'が無い');
    except free;end;
  end;
  procedure ProgEnd;
  begin
      writemsg('ｵﾜﾘﾀﾞｿﾞ');
      RunFlag:=False;
  end;

begin
{ AllocConsole;
 writeln(lc:3,str);
//debug}
if (sym = #0 ) then begin  RunFlag:=False;  exit end;
         if(sym = FUNCSYM)     then FuncCall
    else if(sym = PROPSYM)     then PropSet
    else if (str= 'ﾎｻﾞｹ')      then print
    else if (str='ホザケ')     then print
    else if (str='ｲﾚﾃﾐﾛ')      then input
    else if (str='イレテミロ') then input
    else if (str='ｲｯﾃﾖｼ')      then jump
    else if (str='イッテヨシ') then jump
    else if (str='if')         then if_then
    else if (str='ﾓｼﾓﾀﾞﾖ')     then if_then
    else if (str='モシモダヨ') then if_then
    else if (str='Exit')       then RunFlag:=False
    else if (str='end')        then progend
    else if (str='ｼﾈ')         then progend
    else if (str='シネ')       then progend
    else if (str = 'ﾒｼﾞﾙｼ') or (str='メジルシ') then
     begin
        GetSym; {実行文では単に読み飛ばす}
        GetSym;
     end
    else if sym  in[ ':' ,#13 ]then GetSym
    else if sym  in[ '?']      then print
    else if(sym = IDENTSYM)    then setVariable
    else error('文法エラーだ');
end;

constructor TGikoScr.Create;
var i:integer;
begin
inherited Create;
     for i := 0  to   high(variable) do
      begin
       variable[i].name := '';
       variable[i].value:= 0;
      end;
   lc:=0;
   pc:=0;
   ch:=' ';
end;
{/////////////// main ////////////}
procedure TGikoScr.exec;
begin
    labelread;
    pc:=0;
    lc:=0;
    ch:=' ';
    RunFlag:=True;
    GetSym;
    while  RunFlag do  statement;
end;
procedure TGikoScr.RUN(src:TStrings);
begin
    source:=src;
    numVar:=Null;
    line:='';
    labelread;
    pc:=0;
    lc:=0;
    ch:=' ';
    RunFlag:=True;
    GetSym;
    while  RunFlag do  statement;
end;
procedure TGikoScr.LET(scr:String);
begin
    numVar:=Null;
    line:=scr;
    source:=nil;
    pc:=1;
    lc:=0;
    ch:=' ';
    RunFlag:=True;
    GetSym;
    while  RunFlag do  statement;
end;
function TGikoScr.ExecToVar(scr:String):Variant;
begin
    numVar:=Null;
    line:=scr;
    source:=nil;
    pc:=1;
    lc:=0;
    ch:=' ';
    GetSym;
    expression;
    Result:=numVar;
end;


procedure TGikoScr.printmsg(dt: Variant);
begin
 if assigned(FOnDt) then  FOnDt(self,dt)
 else
//出力イベントが定義されてないなら　メッセージを勝手に出す
writemsg(
         #13+#10+'　　 　　　　∧ ∧　 ／￣￣￣￣￣￣￣￣￣￣￣￣￣'
        +#13+#10+'〜′￣￣( ﾟДﾟ)＜   '+VarToStr(dt)
        +#13+#10+'  UU￣￣　U U　　＼＿＿＿＿＿＿＿＿＿＿＿＿＿' );

end;

procedure TGikoScr.writemsg(msg: string);
begin
 if assigned(FOnMsg) then  FOnMsg(self,msg)
 else
  begin
   ShowMessage(msg);
  end;
end;

///////////////
function TGikoScr.CallFunc(funcname:string;const v:array of variant):variant;
var s:string;
var i:integer;
var flag:boolean;
begin
 flag:=False;{関数があればTrueを返す}
 if assigned(fonCall) then  fonCall(self,funcname,flag,v,result);
 if flag then exit;
  GikoCall(self,funcname,flag,v,result);
 if flag then exit;

 if high(v)>=0 then
  begin
 Result:=v[0];
  s:=VarToStr(v[0]);
  for i:=1 to high(v) do s:=s+','+VarToStr(v[i]);
  end else begin
  s:='';
  Result:=0;
  end;
 error(funcname+'('+s+')が無い');
end;

function TGikoScr.toType(const dt: array of Variant): Variant;
begin
 case high(dt) of
   1: Result:= VarAsType(dt[0],dt[1]);
   0: Result:= VarToStr (dt[0]);
 else error('変数数が合わない');
 end;
end;
function TGikoScr.toStr(const dt: array of Variant): Variant;
begin
 case high(dt) of
   0: Result:= VarToStr (dt[0]);
 else error('変数数が合わない');
 end;
end;

function TGikoScr.GoCall(const dt: array of Variant): Variant;
begin
      lc:=round(variable[GetVariable(dt[0]+':', 0)].value);
      pc:=0;
      ch:=' ';
      GetSym;
    RunFlag:=True;
    while  RunFlag do  statement;
    Result:=variable[GetVariable('Result', 1)].value;
end;

function TGikoScr.MID(const dt: array of Variant): Variant;
 function toInt(d:Variant):Integer;begin Result:=d;end;
begin
 case high(dt) of
   0: Result:= VarToStr(dt[0]);
   1: Result:= copy(VarToStr(dt[0]),toInt(dt[1]),High(Integer));
   2: Result:= copy(VarToStr(dt[0]),toInt(dt[1]),toInt(dt[2]));
 else error('変数の数が合わない');
 end;
end;

function TGikoScr.toInt(const dt: array of Variant): Variant;
begin
Result:=strToInt(dt[0]);
end;
{ これを使えば関数の検索はとても楽になる }
procedure GikoCall(obj:TObject;fname: string;var  res: boolean;
  const dt: array of Variant; var return: Variant);
var fp:TGikoFuncIvent;
var method:TMethod;
begin
method.Code:= obj.MethodAddress(fname);{メソッド名を探させて}
 if assigned(method.Code) then
   begin
   method.Data:=obj;     {メソッドがあれば objとセットにして}
   fp:=TGikoFuncIvent(method);{メソッドポインタを作り出す}
     return:=fp(dt);
      res:=True;
   end ;
end;

procedure TGikoScr.func(Sender: TObject; fname: string;var  res: boolean;
  const dt: array of Variant; var return: Variant);
begin
 if assigned(fonCall) then  fonCall(self,fname,res,dt,return);
 if res then exit;
  GikoCall(self,fname,res,dt,return);
 if res then exit;
end;

var GikoCalcInst:TGikoScr = nil;

function GikoScript:TGikoScr;
begin
if GikoCalcInst=nil then GikoCalcInst:=TGikoScr.Create;
Result:=GikoCalcInst;
end;

function TGikoScr.ExecToStr(scr: String): string;
begin
Result:=VarToStr(ExecToVar(scr));
end;


initialization
 SetLength(variable,10);//動的配列に変更した
finalization
 SetLength(variable,0);//変数の消去
if GikoCalcInst<>nil then GikoCalcInst.Free;

end.