home *** CD-ROM | disk | FTP | other *** search
/ Chip 2000 February / Chip_2000-02_cd.bin / zkuste / Delphi / navody / tt / objvm.exe / SAMPLE / Unit1.pas < prev    next >
Pascal/Delphi Source File  |  1998-07-02  |  4KB  |  150 lines
  1. unit Unit1;
  2.  
  3. interface
  4.  
  5. uses
  6.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  7.   LangValMessages,CompEd, StdCtrls, Compiler, RXSplit, Grids, Outline,
  8.   ExtCtrls,CmpUtils,ObjLangF, Code, SpeedBar, Buttons,Decompiler,ShowProc,
  9.   uObjVM, ObjVM, LangValue, VisualValue, LangProc, ProxyValue;
  10.  
  11. type
  12.   TForm1 = class(TForm)
  13.     Panel1: TPanel;
  14.     CompileBut: TButton;
  15.     Memo1: TMemo;
  16.     RxSplitter1: TRxSplitter;
  17.     aCode: TCode;
  18.     SpeedBar1: TSpeedBar;
  19.     SpeedbarSection1: TSpeedbarSection;
  20.     BitBtn1: TBitBtn;
  21.     Memo2: TMemo;
  22.     BitBtn2: TBitBtn;
  23.     LangProc1: TLangProc;
  24.     Button1: TButton;
  25.     Button2: TButton;
  26.     OpenDialog1: TOpenDialog;
  27.     SaveDialog1: TSaveDialog;
  28.     procedure CompileButClick(Sender: TObject);
  29.     procedure Compiler1Error(Sender: TObject; LineNo, TokenNo,
  30.       ErrorType: Integer; const Token, Msg: string);
  31.     procedure Compiler1TreeReady(Sender: TObject);
  32.     procedure Panel1Click(Sender: TObject);
  33.     procedure BitBtn1Click(Sender: TObject);
  34.     procedure BitBtn2Click(Sender: TObject);
  35.     procedure LangProc1Exec(Sender: TVisualValue; S: IValStack;
  36.       MustReturn: Boolean);
  37.     procedure Button1Click(Sender: TObject);
  38.     procedure Button2Click(Sender: TObject);
  39.   private
  40.     { Private declarations }
  41.   public
  42.     { Public declarations }
  43.   end;
  44.  
  45. var
  46.   Form1: TForm1;
  47.  
  48. implementation
  49. uses InputQueryProc,VarLangValue, uRunTime;
  50. {$R *.DFM}
  51.  
  52. procedure TForm1.CompileButClick(Sender: TObject);
  53. begin
  54.   if ObjLang.CompileTo(Memo1.Lines,aCode)
  55.   then
  56.     Caption:='Ok'
  57.   else
  58.     Caption:='Error';
  59. end;
  60.  
  61. procedure TForm1.Compiler1Error(Sender: TObject; LineNo, TokenNo,
  62.   ErrorType: Integer; const Token, Msg: string);
  63. begin
  64.   MessageDlg(Format('Error %s %s',[Token,Msg]),mtInformation,[mbOk],0)
  65. end;
  66.  
  67. procedure TForm1.Compiler1TreeReady(Sender: TObject);
  68. begin
  69. //  TreeToOutline(Compiler1.Tree,Outline1);
  70. end;
  71.  
  72. procedure TForm1.Panel1Click(Sender: TObject);
  73. begin
  74. //  EditCompiler(Compiler1,nil);
  75. end;
  76.  
  77. procedure TForm1.BitBtn1Click(Sender: TObject);
  78. begin
  79.   With TObjLang.Create(nil) do // Create new instance of language
  80.   begin
  81.     try
  82.     try
  83.       CompileTo(Memo1.Lines,aCode); // Compile contents of Memo1.Lines to aCode
  84.       Caption:='Ok'; // if no exceptions then Caption = Ok
  85.       Decompile(aCode,Memo2.Lines); // Memo2 is filled with string representation
  86.                                     // of aCode
  87.      except
  88.       On e:ECompilerError do // If any language error
  89.       begin
  90.         MessageDlg('Line:'+IntToStr(e.LineNo)+' Token:'+IntToStr(e.TokenNo)+': "'
  91.                     +e.Token+'"  Error: "'+e.Message+'"',mtError,[mbOk],0);
  92.         Form1.Caption:=e.Message;
  93.       end;
  94.       On e:Exception do  // If other errors
  95.       begin
  96.         Form1.Caption:=e.Message;
  97.       end;
  98.     end;
  99.     finally Free end;
  100.   end;
  101. end;
  102.  
  103. procedure TForm1.BitBtn2Click(Sender: TObject);
  104. begin
  105.   RunTime.VM.Run(aCode);
  106. end;
  107.  
  108. procedure TForm1.LangProc1Exec(Sender: TVisualValue; S: IValStack;
  109.   MustReturn: Boolean);
  110.          // S is a stack with input parameters
  111.          // MustReturn shows if procedure must return a value
  112.          // (used as a function)
  113.          Var I:Integer;
  114.               str:string; // str - string to set to caption
  115.               Res:TVarLangValue; // Result of call
  116.           begin
  117.             str:='';
  118.             for i:=0 to S.FrameCount-1 do  // For all input parameters do
  119.             begin
  120.               str:=str+s.FrameValues[i].AsString;// concatenate all parameters tp
  121.                                                  // str
  122.             end;
  123.             if s.FrameCount<>0 then Caption:=str; // If any parameter given - set it to caption
  124.             S.DropFrame; // Drop input frame of stack
  125.             if MustReturn then // If we must return a result
  126.             begin
  127.               Res:=TVarLangValue.Create(nil); // Create new variant value
  128.               Res.AsString:=Caption; // Set it from caption
  129.               S.Push(Res); // Push it to data stack
  130.             end;
  131.           end;
  132.  
  133. procedure TForm1.Button1Click(Sender: TObject);
  134. begin
  135.   if OpenDialog1.Execute then
  136.   begin
  137.     Memo1.Lines.LoadFromFile(OpenDialog1.Filename);
  138.   end;
  139. end;
  140.  
  141. procedure TForm1.Button2Click(Sender: TObject);
  142. begin
  143.   if SaveDialog1.Execute then
  144.   begin
  145.     Memo1.Lines.SaveTofile(SaveDialog1.Filename);
  146.   end;
  147. end;
  148.  
  149. end.
  150.