529 lines
15 KiB
ObjectPascal
529 lines
15 KiB
ObjectPascal
{-----------------------------------------------------------------------------
|
|
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 <a dott prygounkov att gmx dott de>
|
|
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:
|
|
-----------------------------------------------------------------------------}
|
|
|
|
unit fJvInterpreterTest;
|
|
|
|
{$I jvcl.inc}
|
|
|
|
interface
|
|
|
|
uses
|
|
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
|
|
StdCtrls, ExtCtrls, ComCtrls,
|
|
JvInterpreter, JvInterpreterFm, JvEditor, JvHLParser, JvHLEditor,
|
|
Db, DBTables, Grids, DBGrids,
|
|
{$IFDEF COMPILER6_UP}
|
|
Variants,
|
|
{$ENDIF}
|
|
JvExControls, JvComponent, JvFormPlacement, JvComponentBase,
|
|
JvEditorCommon, JvAppStorage, JvAppIniStorage;
|
|
|
|
|
|
type
|
|
TTest = class(TForm)
|
|
Panel1: TPanel;
|
|
OpenDialog1: TOpenDialog;
|
|
Table1: TTable;
|
|
DataSource1: TDataSource;
|
|
JvInterpreterProgram1: TJvInterpreterFm;
|
|
memSource: TJvHLEditor;
|
|
Panel2: TPanel;
|
|
Notebook1: TNotebook;
|
|
bRunReport: TButton;
|
|
bRunForm: TButton;
|
|
Label1: TLabel;
|
|
Button1: TButton;
|
|
Button5: TButton;
|
|
memDescription: TMemo;
|
|
pnlTime: TPanel;
|
|
Label3: TLabel;
|
|
cmbExamples: TComboBox;
|
|
Panel3: TPanel;
|
|
pnlResult: TPanel;
|
|
Button2: TButton;
|
|
Button3: TButton;
|
|
AppStorage: TJvAppIniFileStorage;
|
|
JvFormStorage1: TJvFormStorage;
|
|
FixedExamplesStorage: TJvAppIniFileStorage;
|
|
procedure FormCreate(Sender: TObject);
|
|
procedure FormDestroy(Sender: TObject);
|
|
procedure Button1Click(Sender: TObject);
|
|
procedure bRunFormClick(Sender: TObject);
|
|
procedure bRunReportClick(Sender: TObject);
|
|
procedure JvInterpreterProgram1GetUnitSource(UnitName: string; var Source: string;
|
|
var Done: Boolean);
|
|
procedure cmbExamplesChange(Sender: TObject);
|
|
procedure Panel1Resize(Sender: TObject);
|
|
procedure JvInterpreterProgram1Statement(Sender: TObject);
|
|
procedure memSourceKeyDown(Sender: TObject; var Key: Word;
|
|
Shift: TShiftState);
|
|
procedure cmbExamplesDropDown(Sender: TObject);
|
|
procedure JvInterpreterProgram1GetDfmFileName(Sender: TObject; UnitName: String;
|
|
var FileName: String; var Done: Boolean);
|
|
procedure JvInterpreterProgram1GetValue(Sender: TObject;
|
|
Identifier: String; var Value: Variant; Args: TJvInterpreterArgs;
|
|
var Done: Boolean);
|
|
procedure JvFormStorage1StoredValues0Restore(Sender: TJvStoredValue;
|
|
var AValue: Variant);
|
|
procedure JvFormStorage1StoredValues0Save(Sender: TJvStoredValue;
|
|
var AValue: Variant);
|
|
private
|
|
{ Private declarations }
|
|
Parser : TJvIParser;
|
|
FFixedExampleCount: Integer;
|
|
CurFileName: TFileName;
|
|
public
|
|
{ Public declarations }
|
|
V: Variant;
|
|
|
|
procedure GotoExample(const AName: string);
|
|
procedure GotoFixedExample(const AName: string);
|
|
procedure GotoCustomExample(const AName: string);
|
|
procedure FillExamples(Examples: TStrings);
|
|
procedure ClearScreen;
|
|
procedure SaveCustomExample;
|
|
end;
|
|
|
|
var
|
|
Test: TTest;
|
|
|
|
implementation
|
|
|
|
uses JclFileUtils, JclStrings, JvJCLUtils, JvJVCLUtils, 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(PathAddSeparator(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;
|
|
paths : TStringList;
|
|
begin
|
|
i := 0;
|
|
Result := '';
|
|
paths := TStringList.Create;
|
|
try
|
|
StrToStrings(PathList, ';', paths, False);
|
|
while i < paths.Count do
|
|
begin
|
|
Result := PathAddSeparator(paths[i]) + FileName;
|
|
if FileExists(Result) then
|
|
Exit;
|
|
inc(i);
|
|
end;
|
|
Result := '';
|
|
finally
|
|
paths.Free;
|
|
end;
|
|
end;
|
|
|
|
{ constructor Create(Msg: string) }
|
|
procedure EZeroDivide_Create(var Value: Variant; Args: TJvInterpreterArgs);
|
|
begin
|
|
Value := O2V(EZeroDivide.Create(Args.Values[0]));
|
|
end;
|
|
|
|
function SourceDir: string;
|
|
var
|
|
AExeDir: string;
|
|
begin
|
|
AExeDir := ExtractFilePath(Application.ExeName);
|
|
Result := ExtractFilePath(ExcludeTrailingPathDelimiter(AExeDir)) + 'examples\RaLib\RaInterpreter\';
|
|
end;
|
|
|
|
function SamplesDir: string;
|
|
begin
|
|
Result := SourceDir + 'samples\';
|
|
end;
|
|
|
|
procedure TTest.FormCreate(Sender: TObject);
|
|
begin
|
|
FillExamples(cmbExamples.Items);
|
|
|
|
JvInterpreterProgram1.Adapter.AddGet(EZeroDivide, 'Create', EZeroDivide_Create, 1, [varEmpty], varEmpty);
|
|
DecimalSeparator := '.';
|
|
Parser := TJvIParser.Create;
|
|
end;
|
|
|
|
procedure TTest.FormDestroy(Sender: TObject);
|
|
begin
|
|
Parser.Free;
|
|
end;
|
|
|
|
{$IFNDEF COMPILER6_UP}
|
|
type TVarType = Word;
|
|
{$ENDIF}
|
|
procedure TTest.Button1Click(Sender: TObject);
|
|
const
|
|
Bool : array [boolean] of string = ('False', 'True');
|
|
var
|
|
T1: longword;
|
|
obj:TObject;
|
|
vtype:TVarType;
|
|
begin
|
|
SaveCustomExample;
|
|
|
|
if (Sender = Button1) or (Sender = Button2) or (Sender = Button5) then
|
|
begin
|
|
JvInterpreterProgram1.Source := memSource.Lines.Text;
|
|
CurFileName := '';
|
|
end
|
|
else if Sender = Button3 then
|
|
begin
|
|
if not OpenDialog1.Execute then Exit;
|
|
CurFileName := OpenDialog1.FileName;
|
|
memSource.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);
|
|
|
|
vtype := VarType(JvInterpreterProgram1.VResult);
|
|
if vtype = varBoolean then
|
|
pnlResult.Caption := Bool[boolean(JvInterpreterProgram1.VResult)]
|
|
else if (vtype = varString) or (vtype = varInteger) or (vtype = varDouble) then
|
|
pnlResult.Caption := JvInterpreterProgram1.VResult
|
|
else if vtype = varEmpty then
|
|
pnlResult.Caption := 'Empty'
|
|
else if vtype = varNull then
|
|
pnlResult.Caption := 'Null'
|
|
else if vtype = varObject then begin
|
|
obj := V2O(JvInterpreterProgram1.VResult);
|
|
if Assigned(obj) then
|
|
pnlResult.Caption := 'Object: nil'
|
|
else
|
|
pnlResult.Caption := 'Object: ' + obj.ClassName;
|
|
end
|
|
else if vtype = varSet then
|
|
pnlResult.Caption := 'Set: ' + IntToStr(V2S(JvInterpreterProgram1.VResult))
|
|
else
|
|
pnlResult.Caption := '!Unknown!';
|
|
|
|
except
|
|
on E : EJvInterpreterError do
|
|
begin
|
|
pnlResult.Caption := IntToStr(E.ErrCode) + ': ' + ReplaceString(E.Message, #10, ' ');
|
|
if E.ErrPos > -1 then
|
|
begin
|
|
memSource.SelStart := E.ErrPos;
|
|
memSource.SelLength := 0;
|
|
end;
|
|
memSource.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
|
|
memSource.SelStart := JvInterpreterProgram1.LastError.ErrPos;
|
|
memSource.SelLength := 0;
|
|
end;
|
|
memSource.SetFocus;
|
|
raise;
|
|
end
|
|
else
|
|
begin
|
|
pnlResult.Caption := 'error';
|
|
raise;
|
|
end;
|
|
end;
|
|
finally
|
|
pnlResult.Color := clBtnFace;
|
|
end;
|
|
end;
|
|
|
|
procedure TTest.SaveCustomExample;
|
|
begin
|
|
if cmbExamples.ItemIndex > FFixedExampleCount then
|
|
begin
|
|
memSource.Lines.SaveToFile(SourceDir + 'samples\' + cmbExamples.Text);
|
|
end;
|
|
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),
|
|
SourceDir + ';' + SamplesDir, ';'));
|
|
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),
|
|
SourceDir + ';' + SamplesDir, ';'));
|
|
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.cmbExamplesChange(Sender: TObject);
|
|
begin
|
|
GotoExample(cmbExamples.Text);
|
|
end;
|
|
|
|
procedure TTest.Panel1Resize(Sender: TObject);
|
|
begin
|
|
cmbExamples.Width := Panel1.Width - cmbExamples.Left - Pixels(Self, 8);
|
|
end;
|
|
|
|
procedure TTest.JvInterpreterProgram1Statement(Sender: TObject);
|
|
begin
|
|
Application.ProcessMessages;
|
|
end;
|
|
|
|
procedure TTest.memSourceKeyDown(Sender: TObject; var Key: Word;
|
|
Shift: TShiftState);
|
|
begin
|
|
if (Key = ord('S')) and ([ssCtrl] = Shift) then
|
|
SaveCustomExample;
|
|
end;
|
|
|
|
procedure TTest.cmbExamplesDropDown(Sender: TObject);
|
|
begin
|
|
SaveCustomExample;
|
|
end;
|
|
|
|
procedure TTest.JvInterpreterProgram1GetValue(Sender: TObject;
|
|
Identifier: String; var Value: Variant; Args: TJvInterpreterArgs;
|
|
var Done: Boolean);
|
|
begin
|
|
if Cmp(Identifier, 'Test') then
|
|
begin
|
|
Done := True;
|
|
Value := O2V(Self);
|
|
end
|
|
else if Cmp(Identifier, 'Rec') then
|
|
begin
|
|
Done := True;
|
|
//Value := SearchRec2Var(temp);
|
|
JvInterpreterVarCopy(Value, SearchRec2Var(temp));
|
|
end
|
|
else
|
|
if Cmp(Identifier, 'ShowMessage') and (Args.Obj = Self) then
|
|
begin
|
|
Done := True;
|
|
ShowMessage(Args.Values[0]);
|
|
Value := Null;
|
|
end
|
|
else
|
|
if Cmp(Identifier, 'MyFunction') then
|
|
begin
|
|
Done := True;
|
|
Value := Args.Values[0] + 1;
|
|
end
|
|
else
|
|
if Cmp(Identifier, 'SamplesDir') then
|
|
begin
|
|
Done := True;
|
|
Value := SamplesDir;
|
|
end
|
|
end;
|
|
|
|
procedure TTest.GotoFixedExample(const AName: string);
|
|
begin
|
|
memSource.Lines.BeginUpdate;
|
|
try
|
|
memSource.Clear;
|
|
FixedExamplesStorage.ReadStringList(AName + '\Source', memSource.Lines);
|
|
finally
|
|
memSource.Lines.EndUpdate;
|
|
end;
|
|
|
|
memDescription.Lines.BeginUpdate;
|
|
try
|
|
memDescription.Clear;
|
|
FixedExamplesStorage.ReadStringList(AName + '\Description', memDescription.Lines);
|
|
finally
|
|
memDescription.Lines.EndUpdate;
|
|
end;
|
|
|
|
Notebook1.ActivePage := FixedExamplesStorage.ReadString(AName + '\Page', 'Default');
|
|
end;
|
|
|
|
procedure TTest.GotoCustomExample(const AName: string);
|
|
begin
|
|
memSource.Lines.LoadFromFile(SamplesDir + AName);
|
|
memDescription.Clear;
|
|
Notebook1.ActivePage := 'Default';
|
|
end;
|
|
|
|
procedure TTest.FillExamples(Examples: TStrings);
|
|
var
|
|
CustomExamples: TStringList;
|
|
I: Integer;
|
|
begin
|
|
FixedExamplesStorage.FileName := SourceDir + 'JvInterpreterTest.ini';
|
|
|
|
Examples.BeginUpdate;
|
|
try
|
|
Examples.Clear;
|
|
|
|
// add fixed examples from the ini file
|
|
FixedExamplesStorage.ReadStringList('Demos',Examples);
|
|
FFixedExampleCount :=Examples.Count;
|
|
|
|
// add custom examples from the samples directory
|
|
CustomExamples := TStringList.Create;
|
|
try
|
|
ReadFolder(SamplesDir, 'sample - *.pas', CustomExamples);
|
|
if CustomExamples.Count > 0 then
|
|
begin
|
|
Examples.Add('------ custom files (samples folder) ------');
|
|
CustomExamples.Sort;
|
|
for i := 0 to CustomExamples.Count - 1 do
|
|
Examples.Add(CustomExamples[i]);
|
|
end;
|
|
finally
|
|
CustomExamples.Free;
|
|
end;
|
|
finally
|
|
Examples.EndUpdate;
|
|
end;
|
|
end;
|
|
|
|
procedure TTest.JvFormStorage1StoredValues0Restore(Sender: TJvStoredValue;
|
|
var AValue: Variant);
|
|
begin
|
|
GotoExample(AValue);
|
|
end;
|
|
|
|
procedure TTest.JvFormStorage1StoredValues0Save(Sender: TJvStoredValue;
|
|
var AValue: Variant);
|
|
begin
|
|
AValue := cmbExamples.Text;
|
|
end;
|
|
|
|
procedure TTest.GotoExample(const AName: string);
|
|
var
|
|
Index: Integer;
|
|
begin
|
|
Index := cmbExamples.Items.IndexOf(AName);
|
|
cmbExamples.ItemIndex := Index;
|
|
|
|
if Index < 0 then
|
|
ClearScreen
|
|
else if Index < FFixedExampleCount then
|
|
GotoFixedExample(AName)
|
|
else if Index = FFixedExampleCount then
|
|
ClearScreen
|
|
else if Index > FFixedExampleCount then
|
|
GotoCustomExample(AName);
|
|
end;
|
|
|
|
procedure TTest.ClearScreen;
|
|
begin
|
|
memSource.Clear;
|
|
memDescription.Clear;
|
|
Notebook1.ActivePage := 'Empty';
|
|
end;
|
|
|
|
initialization
|
|
//JvInterpreter_QRExpr.RegisterJvInterpreterAdapter(GlobalJvInterpreterAdapter);
|
|
//JvInterpreter_iMTracer.RegisterJvInterpreterAdapter(GlobalJvInterpreterAdapter);
|
|
end.
|