有关JVCL里的 TJvInterpreterProgram 控件的例子 demo

[电脑玩家]

{******************************************************************

JEDI-VCL Demo

Copyright (C) 2002 Project JEDI

Original author:

Contributor(s):

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

The contents of this file are used with permission, 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_1Final.html

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

******************************************************************}

unit fMain;

{$I jvcl.inc}

//!!! (p3) NB! All storage commented out using //!!!

interface

uses
Windows, Messages, {$IFDEF COMPILER6_UP} Variants, {$ENDIF}
SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ComCtrls, JvEditor, JvEditorCommon, JvHLEditor, Menus,
ShellApi, JvInterpreter, ImgList, JvComponent,
JvHLEditorPropertyForm, JvFormPlacement,
JvExControls;

const
WM_CHECKFILEMODIFIED = WM_USER + $101;

type
TMain = class(TForm)
RegAuto1: TJvFormStorage;
RAHLEditor1: TJvHLEditor;
StatusBar: TStatusBar;
MainMenu1: TMainMenu;
miFile: TMenuItem;
miFileOpen: TMenuItem;
N1: TMenuItem;
miExit: TMenuItem;
miFileSave: TMenuItem;
miFileSaveAs: TMenuItem;
raCommon: TJvFormStorage;
N2: TMenuItem;
miHelpAbout: TMenuItem;
OpenDialog1: TOpenDialog;
SaveDialog1: TSaveDialog;
FindDialog1: TFindDialog;
ReplaceDialog1: TReplaceDialog;
miSearch: TMenuItem;
Search1: TMenuItem;
miSearchAgain: TMenuItem;
miSearchReplace: TMenuItem;
N3: TMenuItem;
miOptions: TMenuItem;
PopupMenu1: TPopupMenu;
miEditorProperties: TMenuItem;
JvInterpreterProgram1: TJvInterpreterProgram;
GutterImages: TImageList;
miEdit: TMenuItem;
RAHLEdPropDlg1: TJvHLEdPropDlg;
procedure RAHLEditor1ChangeStatus(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure miFileSaveClick(Sender: TObject);
procedure miHelpAboutClick(Sender: TObject);
procedure miExitClick(Sender: TObject);
procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
procedure raCommonAfterLoad(Sender: TObject);
procedure miFileOpenClick(Sender: TObject);
procedure miFileSaveAsClick(Sender: TObject);
procedure Search1Click(Sender: TObject);
procedure miSearchAgainClick(Sender: TObject);
procedure miSearchReplaceClick(Sender: TObject);
procedure miOptionsClick(Sender: TObject);
procedure raCommonAfterSave(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure JvInterpreterProgram1GetValue(Sender: TObject;
Identifer: String;
var Value: Variant; Args: TJvInterpreterArgs; var Done:
Boolean);
procedure RAHLEditor1KeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
procedure RAHLEditor1KeyUp(Sender: TObject; var Key: Word;
Shift: TShiftState);
procedure RAHLEditor1KeyPress(Sender: TObject; var Key: Char);
procedure JvInterpreterProgram1GetUnitSource(UnitName: String;
var Source: String; var Done: Boolean);
procedure FindDialog1Find(Sender: TObject);
procedure RAHLEditor1PaintGutter(Sender: TObject; Canvas:
TCanvas);
procedure FormShow(Sender: TObject);
procedure JvInterpreterProgram1SetValue(Sender: TObject;
Identifer: String;
const Value: Variant; Args: TJvInterpreterArgs; var Done:
Boolean);
private
FFileName: TFileName;
FileTime: Integer;
Exts: array[TJvHighlighter] of string;
Capt: string;
BaseLine: Integer;
procedure OpenFile(AFileName: TFileName);
procedure SetHighlighter;
procedure LoadColors;
procedure UpdateCaption;
procedure CheckSave;
procedure UpdateEditorSettings;
procedure WMDropFiles(var Message: TMessage); message
WM_DROPFILES;
procedure FindNext;
procedure CheckFileModified;
procedure ApplicationActivate(Sender: TObject);
procedure WMCheckFileModified(var Message: TMessage); message
WM_CHECKFILEMODIFIED;
private { JvInterpreter support }
JvInterpreterFileName: TFileName;
Args: TJvInterpreterArgs;
procedure ErrorLogFmt(const Message: string; const Args: array of
const);
function JvInterpreterScript: boolean;
procedure JvInterpreterInitialize;
procedure JvInterpreterUnInitialize;
function JvInterpreterSafeCall(const FunName: string; Args:
TJvInterpreterArgs;
Params: array of Variant): Variant;
procedure JvInterpreterFileOpened;
procedure JvInterpreterFileClosed;
public
{ Public declarations }
end;

var
Main: TMain;

implementation

uses JvJCLUtils, JvConsts,
JvJVCLUtils, JvInterpreter_JvUtils,
JvInterpreter_System, JvInterpreter_Windows, JvInterpreter_SysUtils,
JvInterpreter_Graphics, JvInterpreter_Classes,
JvInterpreter_Controls,
JvInterpreter_StdCtrls, JvInterpreter_ComCtrls,
JvInterpreter_ExtCtrls, JvInterpreter_Forms,
JvInterpreter_Menus, JvInterpreter_Dialogs,
JvInterpreterFm,
JvInterpreter_JvEditor;

{$R *.DFM}

const
PadExt = '.pad'; { extension for macro-files }

{
procedure FailProc;
var
Func: procedure; far;
begin
end;
}

procedure TMain.RAHLEditor1ChangeStatus(Sender: TObject);
const
Modi: array[boolean] of string[10] = ('', 'Modified');
Modes: array[boolean] of string[10] = ('Overwrite', 'Insert');
begin
with StatusBar, RAHLEditor1 do
begin
Panels[0].Text := IntToStr(CaretY + 1 - BaseLine) + ':' + IntToStr
(CaretX + 1);
Panels[1].Text := Modi[Modified];
if ReadOnly then
Panels[2].Text := 'ReadOnly'
else if Recording then
Panels[2].Text := 'Recording'
else
Panels[2].Text := Modes[InsertMode];
miFileSave.Enabled := Modified;
end;
end;

procedure TMain.OpenFile(AFileName: TFileName);
begin
{$IFDEF COMPILER3_UP}
AFileName := TargetFileName(AFileName);
{$ENDIF COMPILER3_UP}
RAHLEditor1.BeginUpdate;
try
RAHLEditor1.Lines.LoadFromFile(AFileName);
FileTime := FileAge(AFileName);
RAHLEditor1.SetLeftTop(0, 0);
RAHLEditor1.Modified := False;
RAHLEditor1ChangeStatus(nil);
FFileName := AFileName;
SetHighlighter;
UpdateCaption;
Application.BringToFront;
JvInterpreterFileOpened;
finally
RAHLEditor1.EndUpdate;
end;
end;

procedure TMain.CheckFileModified;
begin
if FFileName = '' then Exit;
if FileExists(FFileName) then
begin
if FileTime <> FileAge(FFileName) then
begin
if RAHLEditor1.Modified then
if MessageDlg('File time/date changed.'#13 +
'Reload ?'#13#13 +
'WARNING: Document has been modified.',
mtWarning, [mbYes, mbNo], 0) = idYes then
OpenFile(FFileName) else
else
if MessageDlg('File time/date changed.'#13 +
'Reload ?', mtInformation, [mbYes, mbNo], 0) = idYes then
OpenFile(FFileName);
end;
end
else
{ To inform, that the user should save the file somewhere
[translated] }
MessageDlg('File removed from disk.'#13 +
'Choose File|SaveAs menu item to save file.',
mtWarning, [mbOK], 0);
end;

procedure TMain.ApplicationActivate(Sender: TObject);
begin
PostMessage(Handle, WM_CHECKFILEMODIFIED, 0, 0);
end;

procedure TMain.WMCheckFileModified(var Message: TMessage);
begin
CheckFileModified;
end;

procedure TMain.miFileSaveClick(Sender: TObject);
begin
RAHLEditor1.Lines.SaveToFile(FFileName);
FileTime := FileAge(FFileName);
RAHLEditor1.Modified := False;
RAHLEditor1ChangeStatus(nil);
end;

procedure TMain.FormCreate(Sender: TObject);
begin
Application.OnActivate := ApplicationActivate;
Capt := Caption;
//!!! raCommon.IniFile := ExtractFilePath(ParamStr(0)) +
'ranotepad.ini';
Exts[hlPascal] := '*.pas;*.dpk;*.dpr;*.inc;*.pad';
Exts[hlCBuilder] := '*.cpp;*.c;*.hpp;*.h';
Exts[hlSql] := '*.sql';
Exts[hlPython] := '*.py';
Exts[hlJava] := '*.java';
Exts[hlVB] := '*.bas';
Exts[hlHtml] := '*.htm;*.html;*.asp';
Exts[hlPerl] := '*.pl';
Exts[hlIni] := '*.ini';
DragAcceptFiles(Handle, True);
//!!! raCommon.Load;
JvInterpreterInitialize;
end;

procedure TMain.FormDestroy(Sender: TObject);
begin
JvInterpreterUnInitialize;
//!!! raCommon.Save;
end;

procedure TMain.FormShow(Sender: TObject);
begin
if ParamCount > 0 then
OpenFile(GetLongFileName(ParamStr(1)));
end;

procedure TMain.UpdateEditorSettings;
begin
SetHighlighter;
end; { UpdateEditorSettings }

procedure TMain.SetHighlighter;
var
Ext: TFileName;
i, H: TJvHighlighter;
begin
Ext := ExtractFileExt(FFileName);
H := hlNone;
if RAHLEditor1.SyntaxHighlighting then
for i := Low(TJvHighlighter) to High(TJvHighlighter) do
if FileEquMasks(FFileName, Exts[i]) then
begin
H := i;
break;
end;
RAHLEditor1.HighLighter := H;
LoadColors;
end;

procedure TMain.raCommonAfterSave(Sender: TObject);
begin
RAHLEdPropDlg1.Save;
end;

procedure TMain.raCommonAfterLoad(Sender: TObject);
// var
// i: TJvHighlighter;
begin
//!!! for i := Low(TJvHighlighter) to High(TJvHighlighter) do
//!!! Exts[i] := Trim(raCommon.ReadString('Highlighters',
HighLighters[i], Exts[i]));
RAHLEdPropDlg1.Restore;
UpdateEditorSettings;
end;

procedure TMain.LoadColors;
begin
RAHLEdPropDlg1.LoadCurrentHighLighterColors;
end;

procedure TMain.miHelpAboutClick(Sender: TObject);
begin
Application.MessageBox('JVCL Notepad 2.0 Freeware'#13#13 +
'Based on Delphi components TJvHLEditor and
TJvInterpreterProgram.'#13 +
'Available (free) at JVCL Library home page:'#13 +
' http://jvcl.sourceforge.net'#13#13 +
'programming - Andrei Prygounkov:'#13 +
' a dott prygounkov att gmx dott de'#13,
'About', MB_ICONINFORMATION);
end;

procedure TMain.miExitClick(Sender: TObject);
begin
Close;
end;

procedure TMain.FormCloseQuery(Sender: TObject; var CanClose:
Boolean);
begin
CheckSave;
CanClose := True;
end;

procedure TMain.CheckSave;
begin
if RAHLEditor1.Modified then
case MessageDlg('Save changes ?', mtConfirmation,
[mbYes, mbNo, mbCancel], 0) of
mrYes:
miFileSave.Click;
mrCancel:
Abort;
end;
JvInterpreterFileClosed;
end;

procedure TMain.miFileOpenClick(Sender: TObject);
begin
CheckSave;
if OpenDialog1.Execute then
begin
OpenFile(OpenDialog1.FileName);
end;
end;

procedure TMain.miFileSaveAsClick(Sender: TObject);
begin
if FFileName <> '' then
SaveDialog1.FileName := FFileName
else
SaveDialog1.FileName := ExtractFilePath(OpenDialog1.FileName) +
'NONAME.TXT';
if SaveDialog1.Execute then
begin
RAHLEditor1.Lines.SaveToFile(SaveDialog1.FileName);
FFileName := SaveDialog1.FileName;
FileTime := FileAge(FFileName);
end
else
Abort;
OpenDialog1.FileName := SaveDialog1.FileName;
UpdateCaption;
end;

procedure TMain.UpdateCaption;
begin
if FFileName <> '' then
begin
Caption := Capt + ' - ' + FFileName;
Application.Title := ExtractFileName(FFileName) + ' - ' + Capt;
end
else
begin
Caption := Capt + ' - new file' ;
Application.Title := 'new file - ' + Capt;
end;
end;

procedure TMain.WMDropFiles(var Message: TMessage);
var
FN: string;
begin
SetLength(FN, 260);
SetLength(FN, DragQueryFile(Message.WParam, 0, PChar(FN), 260));
CheckSave;
OpenFile(FN);
end;

procedure TMain.Search1Click(Sender: TObject);
begin
FindDialog1.FindText := RAHLEditor1.GetWordOnCaret;
FindDialog1.Execute;
end;

procedure TMain.miSearchAgainClick(Sender: TObject);
begin
FindNext;
end;

procedure TMain.FindDialog1Find(Sender: TObject);
begin
FindNext;
end;

procedure TMain.FindNext;
var
S, S1: string;
F: PChar;
begin
S := RAHLEditor1.Lines.Text;
S1 := FindDialog1.FindText;
if not (frMatchCase in FindDialog1.Options) then
begin
S := ANSIUpperCase(S);
S1 := ANSIUpperCase(S1);
end;
F := StrPos(PChar(S) + RAHLEditor1.SelStart, PChar(S1));
if F <> nil then
begin
RAHLEditor1.SelStart := F - PChar(S);
RAHLEditor1.SelLength := Length(S1);
end;
end;

procedure TMain.miSearchReplaceClick(Sender: TObject);
begin
// SAR1.ReplaceDialog;
end;

procedure TMain.miOptionsClick(Sender: TObject);
begin
if RAHLEdPropDlg1.Execute then
RAHLEditor1.Invalidate;
end;




{*********************** JvInterpreter support
***********************}
type
{ small hack }
TMyProgram = class(TJvInterpreterProgram);

procedure TMain.ErrorLogFmt(const Message: string; const Args: array
of const);
var
S: string;
begin
S := Format(Message, Args);
{ save S to log file }
//.. not implemented
ShowMessage(S);
end; { ErrorLogFmt }

procedure TMain.JvInterpreterInitialize;
begin
Args := TJvInterpreterArgs.Create;
{ from JvInterpreter_all.pas }
JvInterpreter_System.RegisterJvInterpreterAdapter
(GlobalJvInterpreterAdapter);
JvInterpreter_Windows.RegisterJvInterpreterAdapter
(GlobalJvInterpreterAdapter);
JvInterpreter_SysUtils.RegisterJvInterpreterAdapter
(GlobalJvInterpreterAdapter);
JvInterpreter_Classes.RegisterJvInterpreterAdapter
(GlobalJvInterpreterAdapter);
JvInterpreter_Graphics.RegisterJvInterpreterAdapter
(GlobalJvInterpreterAdapter);
JvInterpreter_Controls.RegisterJvInterpreterAdapter
(GlobalJvInterpreterAdapter);

JvInterpreter_StdCtrls.RegisterJvInterpreterAdapter
(GlobalJvInterpreterAdapter);
JvInterpreter_ComCtrls.RegisterJvInterpreterAdapter
(GlobalJvInterpreterAdapter);
JvInterpreter_ExtCtrls.RegisterJvInterpreterAdapter
(GlobalJvInterpreterAdapter);
JvInterpreter_Forms.RegisterJvInterpreterAdapter
(GlobalJvInterpreterAdapter);
JvInterpreter_Dialogs.RegisterJvInterpreterAdapter
(GlobalJvInterpreterAdapter);
JvInterpreter_Menus .RegisterJvInterpreterAdapter
(GlobalJvInterpreterAdapter);

JvInterpreterFm.RegisterJvInterpreterAdapter
(GlobalJvInterpreterAdapter);

JvInterpreter_JvEditor.RegisterJvInterpreterAdapter
(GlobalJvInterpreterAdapter);
JvInterpreter_JvUtils.RegisterJvInterpreterAdapter
(GlobalJvInterpreterAdapter);

//!!! JvInterpreterFileName := raCommon.ReadString('Params',
'JvInterpreterFile', '');
if JvInterpreterFileName = '' then Exit;
JvInterpreterFileName := AddPath(JvInterpreterFileName, ExePath);
if not FileExists(JvInterpreterFileName) then
begin
ErrorLogFmt('File %s not found', [JvInterpreterFileName]);
Exit;
end;
try
JvInterpreterProgram1.Pas.LoadFromFile(JvInterpreterFileName);
except
ErrorLogFmt('Failed to load file %s', [JvInterpreterFileName]);
Exit;
end;
JvInterpreterProgram1.Compile;
JvInterpreterSafeCall('main', nil, [Null]);
end; { RegisterJvInterpreterAdapters }

procedure TMain.JvInterpreterUnInitialize;
begin
JvInterpreterSafeCall('done', nil, [Null]);
Args.Free;
end;

function TMain.JvInterpreterScript: boolean;
begin
Result := JvInterpreterProgram1.Source <> '';
end; { }

function TMain.JvInterpreterSafeCall(const FunName: string; Args:
TJvInterpreterArgs;
Params: array of Variant): Variant;
begin
Result := Null;
if JvInterpreterScript and JvInterpreterProgram1.FunctionExists('',
FunName) then
try
Result := JvInterpreterProgram1.CallFunction(FunName, Args,
Params);
except
on E: EJvInterpreterError do
ErrorLogFmt('Call to function %s failed: %s', [FunName,
E.Message]);
end
end; { JvInterpreterSafeCall }

procedure TMain.JvInterpreterFileOpened;
begin
JvInterpreterSafeCall('FileOpened', nil, [FFileName]);
end; { JvInterpreterOpen }

procedure TMain.JvInterpreterFileClosed;
begin
JvInterpreterSafeCall('FileClosed', nil, [FFileName]);
end; { JvInterpreterFileClosed }

procedure TMain.JvInterpreterProgram1GetValue(Sender: TObject;
Identifer: String;
var Value: Variant; Args: TJvInterpreterArgs; var Done: Boolean);
var
S: string;
begin
if Cmp(Identifer, 'MainWindow') then
begin
Value := O2V(Self);
Done := True;
end
else if Cmp(Identifer, 'Editor') then
begin
Value := O2V(RAHLEditor1);
Done := True;
end
else if Cmp(Identifer, 'ODS') then
begin
//ODS(Args.Values[0]);
Value := Null;
Done := True;
end
else if Cmp(Identifer, 'Call') then
begin
S := Args.Values[0];
Args.Delete(0);
Value := JvInterpreterProgram1.CallFunction(S, Args, [Null]);
Done := True;
end
else if Cmp(Identifer, 'UseUnit') then
begin
TMyProgram(JvInterpreterProgram1).ReadUnit(Args.Values[0]);
Value := Null;
Done := True;
end
else if Args.Obj = RAHLEditor1 then
begin
if Cmp(Identifer, 'FileName') then
begin
Value := FFileName;
Done := True;
end
else if Cmp(Identifer, 'FileOpen') then
begin
OpenFile(Args.Values[0]);
Value := Null;
Done := True;
end
else if Cmp(Identifer, 'FileSave') then
begin
miFileSave.Click;
Value := Null;
Done := True;
end
else if Cmp(Identifer, 'CheckSave') then
begin
CheckSave;
Value := Null;
Done := True;
end
else if Cmp(Identifer, 'HighlighterName') then
begin
Value := string(Highlighters[RAHLEditor1.Highlighter]);
Done := True;
end
else if Cmp(Identifer, 'LoadColors') then
begin
LoadColors;
Done := True;
end
else if Cmp(Identifer, 'BaseLine') then
begin
Value := BaseLine;
Done := True;
end
end;
end;

procedure TMain.JvInterpreterProgram1SetValue(Sender: TObject;
Identifer: String;
const Value: Variant; Args: TJvInterpreterArgs; var Done: Boolean);
begin
if Args.Obj = RAHLEditor1 then
begin
if Cmp(Identifer, 'BaseLine') then
begin
BaseLine := Value;
Done := True;
end
end;
end;

procedure TMain.JvInterpreterProgram1GetUnitSource(UnitName: String;
var Source: String; var Done: Boolean);
begin
try
Source := LoadTextFile(AddPath(UnitName + PadExt, ExtractFilePath
(JvInterpreterFileName)));
Done := True;
except
end;
end;

procedure TMain.RAHLEditor1KeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
Args.Clear;
Args.Values[0] := Key;
Args.Values[1] := S2V(Byte(Shift));
Args.Types[0] := varInteger or varByRef;
Args.Count := 2;
JvInterpreterSafeCall('KeyDown', Args, [Null]);
Key := Args.Values[0];
end;

procedure TMain.RAHLEditor1KeyUp(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
Args.Clear;
Args.Values[0] := Key;
Args.Values[1] := S2V(Byte(Shift));
Args.Types[0] := varInteger or varByRef;
Args.Count := 2;
JvInterpreterSafeCall('KeyUp', Args, [Null]);
Key := Args.Values[0];
end;

procedure TMain.RAHLEditor1KeyPress(Sender: TObject; var Key: Char);
begin
Args.Clear;
Args.Values[0] := Key;
Args.Types[0] := varInteger or varByRef;
Args.Count := 1;
JvInterpreterSafeCall('KeyPress', Args, [Null]);
if string(Args.Values[0]) <> '' then
Key := string(Args.Values[0])[1]
else
Key := #0;
end;


procedure TMain.RAHLEditor1PaintGutter(Sender: TObject; Canvas:
TCanvas);
procedure Draw(Y, ImageIndex : integer);
var
Ro : integer;
R : TRect;
begin
if Y <> -1 then
with Sender as TJvEditor do begin
Ro := Y - TopRow;
R := CalcCellRect(0, Ro);
GutterImages.Draw(Canvas,
GutterWidth -GutterRightMargin -GutterImages.Width{R.Left},
R.Top + (CellRect.Height - GutterImages.Height) div 2 +1,
ImageIndex);
end;
end;
var
i : integer;
begin
for i := 0 to 9 do
if (Sender as TJvEditor).Bookmarks[i].Valid then
Draw((Sender as TJvEditor).Bookmarks[i].Y, i);
end;



end.