fjvinterpretertest.pas

Jedi Code Library JCL JVCL 组件包 JCL+JVCL超过300个组件的非可视/可视大型组件包。

{-----------------------------------------------------------------------------
The contents of this file are subject to the Mozilla Public License
Version 1.1 (the "License"); you may not use this file except in compliance
with the License. You may obtain a copy of the License at
http://www.mozilla.org/MPL/MPL-1.1.html

Software distributed under the License is distributed on an "AS IS" basis,
WITHOUT WARRANTY OF ANY KIND, either expressed or implied. See the License for
the specific language governing rights and limitations under the License.

The Original Code is: RAFDAlignPalette.PAS, released on 2002-07-04.

The Initial Developers of the Original Code are: Andrei Prygounkov <[e-mail]>
Copyright (c) 1999, 2002 Andrei Prygounkov   
All Rights Reserved.

Contributor(s): 

Last Modified: 2002-07-04

You may retrieve the latest version of this file at the Project JEDI's JVCL home page,
located at http://jvcl.sourceforge.net

Known Issues:
-----------------------------------------------------------------------------}


{$I JVCL.INC}

unit fJvInterpreterTest;

interface

{$INCLUDE JVCL.INC}

uses
{$IFDEF COMPILER3_UP} 
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ExtCtrls, JvRegAuto, ComCtrls,
  JvInterpreter, JvInterpreterFm, JvEditor, JvHLParser, JvHLEditor,
  Db, DBTables, Grids, DBGrids, Quickrpt, QRCtrls
 {$IFDEF COMPILER6_UP}, Variants, JvComponent {$ENDIF};
{$ELSE}
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ExtCtrls, JvRegAuto, ComCtrls,
  JvInterpreter, JvInterpreterFm, JvEditor, JvHLParser, JvHLEditor,
  Db, DBTables, Grids, DBGrids, Quickrep;
{$ENDIF}

type
  TTest = class(TForm)
    RegAuto1: TJvRegAuto;
    Panel1: TPanel;
    OpenDialog1: TOpenDialog;
    Table1: TTable;
    DataSource1: TDataSource;
    JvInterpreterProgram1: TJvInterpreterFm;
    Memo1: TJvHLEditor;
    Panel2: TPanel;
    Notebook1: TNotebook;
    bRunReport: TButton;
    bRunForm: TButton;
    Button4: TButton;
    Label1: TLabel;
    Button1: TButton;
    Button5: TButton;
    Memo2: TMemo;
    pnlTime: TPanel;
    Label3: TLabel;
    ComboBox1: TComboBox;
    RegAuto2: TJvRegAuto;
    Panel3: TPanel;
    pnlResult: TPanel;
    Button2: TButton;
    Button3: TButton;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure RegAuto1AfterSave(Sender: TObject);
    procedure RegAuto1AfterLoad(Sender: TObject);
    procedure bRunFormClick(Sender: TObject);
    procedure bRunReportClick(Sender: TObject);
    procedure JvInterpreterProgram1GetUnitSource(UnitName: string; var Source: string;
      var Done: Boolean);
    procedure ComboBox1Change(Sender: TObject);
    procedure Panel1Resize(Sender: TObject);
    procedure JvInterpreterProgram1Statement(Sender: TObject);
    procedure Memo1KeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure ComboBox1DropDown(Sender: TObject);
    procedure JvInterpreterProgram1GetDfmFileName(Sender: TObject; UnitName: String;
      var FileName: String; var Done: Boolean);
    procedure JvInterpreterProgram1GetValue(Sender: TObject;
      Identifer: String; var Value: Variant; Args: TJvInterpreterArgs;
      var Done: Boolean);
  private
    { Private declarations }
    Parser : TJvIParser;
    InternalExamplesCount: Integer;
    CurFileName: TFileName;
  public
    { Public declarations }
    V: Variant;
  end;

var
  Test: TTest;

implementation

uses JvStrUtil, JvInterpreter_all, JvInterpreter_SysUtils{, JvInterpreter_iMTracer};

{$R *.DFM}

{$IFNDEF COMPILER3_UP}
type
  TQuickRep = TQuickReport;
{$ENDIF}

//======================================================
function ReadFolder(const Folder, Mask : TFileName; FileList : TStrings) : integer;
var
  SearchRec : TSearchRec;
  DosError  : integer;
begin
  FileList.Clear;
  Result := FindFirst(AddSlash2(Folder)+Mask, faAnyFile, SearchRec);
  DosError := Result;
  while DosError = 0 do begin
    if not ((SearchRec.Attr and faDirectory) = faDirectory)  then
      FileList.Add(SearchRec.Name);
    DosError := FindNext(SearchRec);
  end;
  FindClose(SearchRec);
end;

function Pixels(Control : TControl; APixels : integer) : integer;
var
  Form : TForm;
begin
  Result := APixels;
  if Control is TForm then
    Form := TForm(Control) else
    Form := TForm(GetParentForm(Control));
  if Form.Scaled then
    Result := Result * Form.PixelsPerInch div 96;
end;
//======================================================

function FindInPath(const FileName, PathList: string): TFileName;
var
  i: Integer;
  S: string;
begin
  i := 0;
  S := SubStr(PathList, i, ';');
  while S <> '' do                  
  begin
    Result := AddSlash2(S) + FileName;
    if FileExists(Result) then
      Exit;
    inc(i);
    S := SubStr(PathList, i, ';');
  end;
  Result := '';
end;

{ constructor Create(Msg: string) }
procedure EZeroDivide_Create(var Value: Variant; Args: TJvInterpreterArgs);
begin
  Value := O2V(EZeroDivide.Create(Args.Values[0]));
end;

procedure TTest.FormCreate(Sender: TObject);
var
  SS: TStringList;
  i: Integer;
begin
  try
    RegAuto2.IniStrings.LoadFromFile(ExePath + 'JvInterpreterTest.ini');
  except
    MessageDlg('Can''t load file "JvInterpreterTest.ini".'#13+
      'Please put it in same folder as JvInterpreterTest.exe.',
      mtError, [mbCancel], -1);
  end;
  RegAuto2.ReadSection('Demos', ComboBox1.Items);
  InternalExamplesCount := ComboBox1.Items.Count;
  SS := TStringList.Create;
  try
    ReadFolder(ExePath + 'samples', 'sample - *.pas', SS);
    if SS.Count > 0 then
      ComboBox1.Items.Add('------ custom files (samples folder) ------');
    SS.Sort;  
    for i := 0 to SS.Count - 1 do
      ComboBox1.Items.Add(SS[i]);
  finally
    SS.Free;
  end;
  JvInterpreterProgram1.Adapter.AddGet(EZeroDivide, 'Create', EZeroDivide_Create, 1, [varEmpty], varEmpty);
  DecimalSeparator := '.';
  Parser := TJvIParser.Create;
end;                            

procedure TTest.FormDestroy(Sender: TObject);
begin
  Parser.Free;
end;

procedure TTest.Button1Click(Sender: TObject);
const
  Bool : array [boolean] of string = ('False', 'True');
var
  T1: longword;
begin
  RegAuto1AfterSave(nil);
  if (Sender = Button1) or (Sender = Button2) or (Sender = Button5) then
  begin
    JvInterpreterProgram1.Source := Memo1.Lines.Text;
    CurFileName := '';
  end
  else if Sender = Button3 then
  begin
    if not OpenDialog1.Execute then Exit;
    CurFileName := OpenDialog1.FileName;
    Memo1.Lines.Text := LoadTextFile(CurFileName);
    JvInterpreterProgram1.Source := LoadTextFile(CurFileName);
  end;                            

  pnlResult.Caption := 'Working';
  pnlResult.Color := clRed;
  pnlResult.Update;
  T1 := GetTickCount;

  try try
    if (Sender = Button1) or (Sender = Button2) or (Sender = Button3) then
      JvInterpreterProgram1.Run
    else if Sender = Button5 then
      JvInterpreterProgram1.Compile;

  pnlTime.Caption := 'ms: ' + IntToStr(GetTickCount - T1);

	case VarType(JvInterpreterProgram1.VResult) of
		varBoolean:
			pnlResult.Caption := Bool[boolean(JvInterpreterProgram1.VResult)];
		varString, varInteger, varDouble :
			pnlResult.Caption := JvInterpreterProgram1.VResult;
		varEmpty:
			pnlResult.Caption := 'Empty';
		varNull:
			pnlResult.Caption := 'Null';
    varObject:
      if V2O(JvInterpreterProgram1.VResult) = nil then
  			pnlResult.Caption := 'Object: nil'
      else
  			pnlResult.Caption := 'Object: ' + V2O(JvInterpreterProgram1.VResult).ClassName;
		varSet:
			pnlResult.Caption := 'Set: ' + IntToStr(V2S(JvInterpreterProgram1.VResult));
		else
			pnlResult.Caption := '!Unknown!';
	end;
  except
    on E : EJvInterpreterError do
    begin
      pnlResult.Caption := IntToStr(E.ErrCode) + ': ' + ReplaceString(E.Message, #10, ' ');
      if E.ErrPos > -1 then
      begin
        Memo1.SelStart := E.ErrPos;
        Memo1.SelLength := 0;
      end;
      Memo1.SetFocus;
    end;
    on E : Exception do
    begin
      pnlResult.Caption := IntToStr(JvInterpreterProgram1.LastError.ErrCode) + ': ' +
        ReplaceString(JvInterpreterProgram1.LastError.Message, #10, ' ');
      if JvInterpreterProgram1.LastError.ErrPos > -1 then
      begin
        Memo1.SelStart := JvInterpreterProgram1.LastError.ErrPos;
        Memo1.SelLength := 0;
      end;
      Memo1.SetFocus;
      raise;
    end
    else
    begin
      pnlResult.Caption := 'error';
      raise;
    end;
  end;
  finally
    pnlResult.Color := clBtnFace;
  end;
end;
              
procedure TTest.RegAuto1AfterSave(Sender: TObject);
begin
  RegAuto1.WriteInteger(Name, 'PrId', ComboBox1.ItemIndex);
  if ComboBox1.ItemIndex >= InternalExamplesCount then
    Memo1.Lines.SaveToFile(ExePath + 'samples\' + ComboBox1.Text);
end;

procedure TTest.RegAuto1AfterLoad(Sender: TObject);
begin
  ComboBox1.ItemIndex := RegAuto1.ReadInteger(Name, 'PrId', 0);
  ComboBox1Change(nil);
end;

var
  temp: TSearchRec;

procedure TTest.JvInterpreterProgram1GetUnitSource(UnitName: string; var Source: string;
  var Done: Boolean);
var
  FN: TFileName;
begin
  FN := FindInPath(UnitName + '.pas', ConcatSep(ExtractFilePath(CurFileName),
    ExePath + ';' + ExePath + 'samples', ';'));
  if FileExists(FN) then
  begin
    Source := LoadTextFile(FN);
    Done := True;
  end;
end;

procedure TTest.JvInterpreterProgram1GetDfmFileName(Sender: TObject; UnitName: String;
  var FileName: String; var Done: Boolean);
begin
  FileName := FindInPath(UnitName + '.dfm', ConcatSep(ExtractFilePath(CurFileName),
      ExePath + ';' + ExePath + 'samples', ';'));
  Done := FileExists(FileName);
end;

procedure TTest.bRunFormClick(Sender: TObject);
begin
  if OpenDialog1.Execute then
    JvInterpreterProgram1.RunFormModal(OpenDialog1.FileName);
end;

procedure TTest.bRunReportClick(Sender: TObject);
var
  QuickRep1: TQuickRep;
begin
  if OpenDialog1.Execute then
  begin
    with JvInterpreterProgram1.MakeForm(OpenDialog1.FileName) do
      try
       {$IFDEF COMPILER3_UP}
        QuickRep1 := (FindComponent('QuickRep1') as TQuickRep);
       {$ELSE}
        QuickRep1 := (FindComponent('QuickReport1') as TQuickRep);
       {$ENDIF COMPILER3_UP}
        if QuickRep1 = nil then raise Exception.Create('QuickRep1 not found on this form');
        QuickRep1.Preview;
      finally { wrap up }
        Free;
      end;    { try/finally } 
  end;
end;

procedure TTest.ComboBox1Change(Sender: TObject);
begin
  Memo1.Lines.Clear;
  Memo2.Lines.Clear;
  if ComboBox1.ItemIndex < InternalExamplesCount then
  begin
    RegAuto2.ReadWholeSection(ComboBox1.Text + '\Source', Memo1.Lines);
    RegAuto2.ReadWholeSection(ComboBox1.Text + '\Description', Memo2.Lines);
    Notebook1.ActivePage := RegAuto2.ReadString(ComboBox1.Text, 'Page', 'Default');
  end else
  begin
    Memo1.Lines.LoadFromFile(ExePath + 'samples\' + ComboBox1.Text);
    Notebook1.ActivePage := 'Default';
  end;
//  Memo1.Refresh;
end;

procedure TTest.Panel1Resize(Sender: TObject);
begin
  ComboBox1.Width := Panel1.Width - ComboBox1.Left - Pixels(Self, 8);
end;

procedure TTest.JvInterpreterProgram1Statement(Sender: TObject);
begin
  Application.ProcessMessages;
end;

procedure TTest.Memo1KeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if (Key = ord('S')) and ([ssCtrl] = Shift) then
    RegAuto1AfterSave(nil);
end;

procedure TTest.ComboBox1DropDown(Sender: TObject);
begin
  RegAuto1AfterSave(nil);
end;
                                                    
procedure TTest.JvInterpreterProgram1GetValue(Sender: TObject;
  Identifer: String; var Value: Variant; Args: TJvInterpreterArgs;
  var Done: Boolean);
begin
  if Cmp(Identifer, 'Test') then
  begin
    Done := True;
    Value := O2V(Self);
  end
  else if Cmp(Identifer, 'Rec') then
  begin
    Done := True;
    //Value := SearchRec2Var(temp);
    JvInterpreterVarCopy(Value, SearchRec2Var(temp));
  end
  else
  if Cmp(Identifer, 'ShowMessage') and (Args.Obj = Self) then
  begin
    Done := True;
    ShowMessage(Args.Values[0]);
    Value := Null;
  end
  else
  if Cmp(Identifer, 'MyFunction') then
  begin
    Done := True;
    Value := Args.Values[0] + 1;
  end
end;

initialization
  //JvInterpreter_QRExpr.RegisterJvInterpreterAdapter(GlobalJvInterpreterAdapter);
  //JvInterpreter_iMTracer.RegisterJvInterpreterAdapter(GlobalJvInterpreterAdapter);
end.