mirror of
https://github.com/moparisthebest/Simba
synced 2024-12-22 07:18:51 -05:00
RUTIS to the source
This commit is contained in:
Raymond
parent
1eba2fdb8f
commit
9d162c1bfb
86
Units/RUTIS/Delphi_Versions.inc
Normal file
86
Units/RUTIS/Delphi_Versions.inc
Normal file
@ -0,0 +1,86 @@
|
||||
|
||||
{$IFDEF FPC}
|
||||
{$DEFINE DELPHI_2006}
|
||||
{$DEFINE DELPHI_2006_UP}
|
||||
{$DEFINE DELPHI_2005_UP}
|
||||
{$DEFINE DELPHI_8_UP}
|
||||
{$DEFINE DELPHI_7_UP}
|
||||
{$DEFINE DELPHI_6_UP}
|
||||
{$DEFINE DELPHI_5_UP}
|
||||
{$DEFINE DELPHI_4_UP}
|
||||
{$DEFINE DELPHI_3_UP}
|
||||
{$ENDIF}
|
||||
|
||||
{$IFDEF VER180}
|
||||
{$DEFINE DELPHI_2006}
|
||||
{$DEFINE DELPHI_2006_UP}
|
||||
{$DEFINE DELPHI_2005_UP}
|
||||
{$DEFINE DELPHI_8_UP}
|
||||
{$DEFINE DELPHI_7_UP}
|
||||
{$DEFINE DELPHI_6_UP}
|
||||
{$DEFINE DELPHI_5_UP}
|
||||
{$DEFINE DELPHI_4_UP}
|
||||
{$DEFINE DELPHI_3_UP}
|
||||
{$ENDIF}
|
||||
|
||||
{$IFDEF VER170}
|
||||
{$DEFINE DELPHI_2005}
|
||||
{$DEFINE DELPHI_2005_UP}
|
||||
{$DEFINE DELPHI_8_UP}
|
||||
{$DEFINE DELPHI_7_UP}
|
||||
{$DEFINE DELPHI_6_UP}
|
||||
{$DEFINE DELPHI_5_UP}
|
||||
{$DEFINE DELPHI_4_UP}
|
||||
{$DEFINE DELPHI_3_UP}
|
||||
{$ENDIF}
|
||||
|
||||
{$IFDEF VER160}
|
||||
{$DEFINE DELPHI_8}
|
||||
{$DEFINE DELPHI_8_UP}
|
||||
{$DEFINE DELPHI_7_UP}
|
||||
{$DEFINE DELPHI_6_UP}
|
||||
{$DEFINE DELPHI_5_UP}
|
||||
{$DEFINE DELPHI_4_UP}
|
||||
{$DEFINE DELPHI_3_UP}
|
||||
{$ENDIF}
|
||||
|
||||
{$IFDEF VER150}
|
||||
{$DEFINE DELPHI_7}
|
||||
{$DEFINE DELPHI_7_UP}
|
||||
{$DEFINE DELPHI_6_UP}
|
||||
{$DEFINE DELPHI_5_UP}
|
||||
{$DEFINE DELPHI_4_UP}
|
||||
{$DEFINE DELPHI_3_UP}
|
||||
{$ENDIF}
|
||||
|
||||
{$IFDEF VER140}
|
||||
{$DEFINE DELPHI_6}
|
||||
{$DEFINE DELPHI_6_UP}
|
||||
{$DEFINE DELPHI_5_UP}
|
||||
{$DEFINE DELPHI_4_UP}
|
||||
{$DEFINE DELPHI_3_UP}
|
||||
{$ENDIF}
|
||||
|
||||
{$IFDEF VER130}
|
||||
{$DEFINE DELPHI_5}
|
||||
{$DEFINE DELPHI_5_UP}
|
||||
{$DEFINE DELPHI_4_UP}
|
||||
{$DEFINE DELPHI_3_UP}
|
||||
{$ENDIF}
|
||||
|
||||
{$IFDEF VER120}
|
||||
{$DEFINE DELPHI_4}
|
||||
{$DEFINE DELPHI_4_UP}
|
||||
{$DEFINE DELPHI_3_UP}
|
||||
{$ENDIF}
|
||||
|
||||
{$IFDEF VER110}
|
||||
{$DEFINE DELPHI_3}
|
||||
{$DEFINE DELPHI_3_UP}
|
||||
{$ENDIF}
|
||||
|
||||
{$IFDEF VER100}
|
||||
{$DEFINE DELPHI_3}
|
||||
{$DEFINE DELPHI_3_UP}
|
||||
{$ENDIF}
|
||||
|
||||
204
Units/RUTIS/File_Manager.pas
Normal file
204
Units/RUTIS/File_Manager.pas
Normal file
@ -0,0 +1,204 @@
|
||||
unit File_Manager;
|
||||
|
||||
interface
|
||||
|
||||
uses SysUtils;
|
||||
|
||||
Type
|
||||
TFileItem = Record
|
||||
Item : Pointer;
|
||||
Name : String;
|
||||
FName: String;
|
||||
End;
|
||||
|
||||
TFileLoadFunc = Function(FileName: String; var Item: Pointer): Boolean;
|
||||
TFreeDataFunc = procedure(Item: Pointer);
|
||||
TObjFileLoadFunc = Function(FileName: String; var Item: Pointer): Boolean of Object;
|
||||
TObjFreeDataFunc = procedure(Item: Pointer) of Object;
|
||||
|
||||
TFileManager = class
|
||||
constructor Create;
|
||||
Destructor Destroy; override;
|
||||
private
|
||||
Function SearchFileInPath(Name, Path: String): String;
|
||||
Function GetItem(Name: String): Pointer;
|
||||
Function IsFail(Name: String): Boolean;
|
||||
public
|
||||
fItems : Array Of TFileItem;
|
||||
Paths : Array Of String;
|
||||
FileExts : Array Of String;
|
||||
NotFoundFiles : Array Of String;
|
||||
LoadFunc : TFileLoadFunc;
|
||||
FreeFunc : TFreeDataFunc;
|
||||
ObjLoadFunc : TObjFileLoadFunc;
|
||||
ObjFreeFunc : TObjFreeDataFunc;
|
||||
property Items[Name: string]: Pointer read GetItem;
|
||||
Procedure Clear;
|
||||
Procedure AddExtension(Ext: String);
|
||||
Procedure AddPath(Path: String);
|
||||
Function AddItem(Name: String): Boolean;
|
||||
Function SearchFile(Name: String): String;
|
||||
Function IndexOf(Name: String): Integer;
|
||||
end;
|
||||
|
||||
|
||||
Implementation
|
||||
|
||||
|
||||
//==============================================================================
|
||||
//==================== File Procedures =========================================
|
||||
//==============================================================================
|
||||
|
||||
constructor TFileManager.Create;
|
||||
begin
|
||||
//AddPath(ExtractFileDir(ParamStr(0)));
|
||||
end;
|
||||
|
||||
Destructor TFileManager.Destroy;
|
||||
begin
|
||||
Clear;
|
||||
end;
|
||||
|
||||
Procedure TFileManager.Clear;
|
||||
var i: Integer;
|
||||
begin
|
||||
If Assigned(FreeFunc) then
|
||||
for i := 0 to high(fItems) do
|
||||
FreeFunc(fItems[i].Item);
|
||||
If Assigned(ObjFreeFunc) then
|
||||
for i := 0 to high(fItems) do
|
||||
ObjFreeFunc(fItems[i].Item);
|
||||
SetLength(fItems, 0);
|
||||
SetLength(NotFoundFiles, 0);
|
||||
end;
|
||||
|
||||
Function TFileManager.SearchFileInPath(Name, Path: String): String;
|
||||
Var SR: TSearchRec;
|
||||
i: Integer;
|
||||
Begin
|
||||
If FindFirst(Path + Name + '.*', faAnyFile, SR) = 0 Then
|
||||
Begin
|
||||
Repeat
|
||||
If (SR.Name <> '.') And (SR.Name <> '..') And Not ((sr.Attr And faDirectory) <> 0) Then
|
||||
Begin
|
||||
Result := lowerCase(ExtractFileExt(SR.Name));
|
||||
For i := 0 To high(FileExts) Do
|
||||
If Result = FileExts[i] Then
|
||||
Begin
|
||||
Result := Path + SR.Name;
|
||||
exit;
|
||||
End;
|
||||
End;
|
||||
Until FindNext(SR) <> 0;
|
||||
FindClose(SR);
|
||||
End;
|
||||
Result := '';
|
||||
End;
|
||||
|
||||
Function TFileManager.SearchFile(Name: String): String;
|
||||
Var i: Integer;
|
||||
Begin
|
||||
For i := 0 To high(Paths) Do
|
||||
Begin
|
||||
If length(Paths[i]) = 0 then Continue;
|
||||
If Paths[i][length(Paths[i])] <> '\' Then Paths[i] := Paths[i] + '\';
|
||||
Result := SearchFileInPath(Name, Paths[i]);
|
||||
If Result <> '' Then exit;
|
||||
End;
|
||||
End;
|
||||
|
||||
Procedure TFileManager.AddPath(Path: String);
|
||||
Begin
|
||||
setLength(Paths, length(Paths) + 1);
|
||||
Paths[high(Paths)] := Path;
|
||||
End;
|
||||
|
||||
Procedure TFileManager.AddExtension(Ext: string);
|
||||
begin
|
||||
If Ext[1] <> '.' then
|
||||
Ext := '.' + Ext;
|
||||
SetLength(FileExts,Length(FileExts)+1);
|
||||
FileExts[high(FileExts)] := LowerCase(Ext);
|
||||
end;
|
||||
|
||||
Function TFileManager.IndexOf(Name: String): Integer;
|
||||
Var i: Integer;
|
||||
Begin
|
||||
Name := LowerCase(Name);
|
||||
Result := -1;
|
||||
For i := 0 To high(fItems) Do
|
||||
If fItems[i].Name = Name Then
|
||||
Begin
|
||||
Result := i;
|
||||
exit;
|
||||
End;
|
||||
End;
|
||||
|
||||
Function TFileManager.IsFail(Name: String): Boolean;
|
||||
Var i: Integer;
|
||||
Begin
|
||||
Result := true;
|
||||
For i := 0 To length(NotFoundFiles) - 1 Do
|
||||
If NotFoundFiles[i] = Name Then exit;
|
||||
Result := false;
|
||||
End;
|
||||
|
||||
Function TFileManager.AddItem(Name: String): Boolean;
|
||||
Var fn: String;
|
||||
Begin
|
||||
Name := LowerCase(Name);
|
||||
Result := false;
|
||||
If (Assigned(LoadFunc) or Assigned(ObjLoadFunc)) and not
|
||||
(Assigned(FreeFunc) or Assigned(ObjFreeFunc)) then exit;
|
||||
If IsFail(Name) Then exit;
|
||||
fn := SearchFile(Name);
|
||||
If fn = '' Then
|
||||
Begin
|
||||
setLength(NotFoundFiles, length(NotFoundFiles) + 1);
|
||||
NotFoundFiles[high(NotFoundFiles)] := Name;
|
||||
exit;
|
||||
End;
|
||||
setLength(fItems, length(fItems) + 1);
|
||||
fItems[high(fItems)].Name := Name;
|
||||
fItems[high(fItems)].FName := FN;
|
||||
If Assigned(LoadFunc) then
|
||||
begin
|
||||
If Not LoadFunc(fn, fItems[high(fItems)].Item) Then
|
||||
Begin
|
||||
setLength(fItems, length(fItems)-1);
|
||||
setLength(NotFoundFiles, length(NotFoundFiles) + 1);
|
||||
NotFoundFiles[high(NotFoundFiles)] := Name;
|
||||
exit;
|
||||
End;
|
||||
end
|
||||
else
|
||||
If Assigned(ObjLoadFunc) then
|
||||
If Not ObjLoadFunc(fn, fItems[high(fItems)].Item) Then
|
||||
Begin
|
||||
setLength(fItems, length(fItems)-1);
|
||||
setLength(NotFoundFiles, length(NotFoundFiles) + 1);
|
||||
NotFoundFiles[high(NotFoundFiles)] := Name;
|
||||
exit;
|
||||
End;
|
||||
Result := true;
|
||||
End;
|
||||
|
||||
Function TFileManager.GetItem(Name: String): Pointer;
|
||||
Var index: Integer;
|
||||
Begin
|
||||
Result := nil;
|
||||
If (Assigned(LoadFunc) or Assigned(ObjLoadFunc)) and not
|
||||
(Assigned(FreeFunc) or Assigned(ObjFreeFunc)) then exit;
|
||||
Name := LowerCase(Name);
|
||||
index := IndexOf(Name);
|
||||
If Index>=0 then
|
||||
begin
|
||||
Result := fItems[index].Item;
|
||||
exit;
|
||||
end;
|
||||
If not AddItem(Name) Then exit;
|
||||
index := high(fItems);
|
||||
Result := fItems[index].Item;
|
||||
End;
|
||||
|
||||
End.
|
||||
2105
Units/RUTIS/RUTIS_Classes.pas
Normal file
2105
Units/RUTIS/RUTIS_Classes.pas
Normal file
File diff suppressed because it is too large
Load Diff
4178
Units/RUTIS/RUTIS_Compiler_Delphi.pas
Normal file
4178
Units/RUTIS/RUTIS_Compiler_Delphi.pas
Normal file
File diff suppressed because it is too large
Load Diff
50
Units/RUTIS/RUTIS_Errors.pas
Normal file
50
Units/RUTIS/RUTIS_Errors.pas
Normal file
@ -0,0 +1,50 @@
|
||||
Unit RUTIS_Errors;
|
||||
|
||||
Interface
|
||||
|
||||
Resourcestring
|
||||
ERR_UNEXPECTED_ERROR = 'E000: Unexpected error occurred. Please contect the support!';
|
||||
|
||||
ERR_SCANNER_UNEXPECTED_CHAR = 'E010: Unexpected char found in code';
|
||||
ERR_UNIT_NOT_FOUND = 'E011: Unit ''%s'' not found';
|
||||
ERR_FILENAME_NOT_UNITNAME = 'E012: Name of the unit is not the same as the filename';
|
||||
ERR_NOT_IMPLEMENTED_YET = 'E013: This function is not implemented in RUTIS at this time - Please wait for me to implement it';
|
||||
ERR_NOT_AVAILABLE = 'E014: This function is not available in this Version of RUTIS';
|
||||
ERR_NOT_AVAILABLE_C_TYPE = 'E015: This type of const is not available in RUTIS at this time';
|
||||
|
||||
ERR_UNKNOWN_IDENT = 'E020: Unknown Identifier ''%s''';
|
||||
ERR_INDENT_REDEFINED = 'E021: Identifier redefined ''%s''';
|
||||
ERR_UNKNOWN_TYPE = 'E022: Unknown type ''%s''';
|
||||
ERR_UNALLOWED_STATEMENT = 'E023: Unallowed Statement';
|
||||
|
||||
ERR_EXPECTED_FOUND = 'E030: ''%s'' expected, ''%s'' found instead';
|
||||
ERR_NEEDED_FOUND = 'E031: ''%s'' needed, ''%s'' found instead';
|
||||
ERR_OP_OR_SEMI_EXPECTED = 'E032: Operator or semicolon expected';
|
||||
ERR_VAR_CONSTANT_EXPECTED = 'E033: Variable or Constant expected';
|
||||
ERR_VAR_EXPECTED = 'E034: Variable expected';
|
||||
ERR_REC_EXPECTED = 'E035: Record expected';
|
||||
ERR_ARRAY_EXPECTED = 'E036: Array expected';
|
||||
ERR_PROCEDURE_EXPECTED = 'E037: Procedure expected';
|
||||
ERR_STRING_EXPECTED = 'E038: String expected';
|
||||
ERR_TYPE_EXPECTED = 'E039: Type expected';
|
||||
ERR_EXPECTED = 'E040: ''%s'' expected';
|
||||
|
||||
ERR_NOT_ENOUGH_PARAMETERS = 'E070: Not enough actual parameters';
|
||||
ERR_TOO_MANY_PARAMETERS = 'E071: Too many parameters';
|
||||
ERR_ONLY_PARAMLESS_PROCS = 'E072: Only parameterless procedures are allowed';
|
||||
ERR_NO_CONST_ALLOWED = 'E073: No constant allowed here';
|
||||
ERR_NO_OVERLOADED_FUNC = 'E073: There is no overloaded function with these parameters';
|
||||
|
||||
ERR_UNALLOWED_STRING_ACTION = 'E080: Unallowed String action';
|
||||
ERR_POINTER_ONLY_FOR_VAR = 'E081: Pointers can only be created for vars';
|
||||
|
||||
ERR_INCOMPATIBLE_TYPES = 'E090: Incompatible types ''%s'' and ''%s''';
|
||||
ERR_UNALLOWED_DATATYPE = 'E091: Unallowed type';
|
||||
|
||||
ERR_CODE_AFTER_PROGRAM_END = 'W001: Code after Program END. is ignored';
|
||||
ERR_CODE_AFTER_UNIT_END = 'W002: Code after Unit END. is ignored';
|
||||
|
||||
Implementation
|
||||
|
||||
End.
|
||||
|
||||
82
Units/RUTIS/RUTIS_Errors.rst
Normal file
82
Units/RUTIS/RUTIS_Errors.rst
Normal file
@ -0,0 +1,82 @@
|
||||
|
||||
# hash value = 257594117
|
||||
rutis_errors.err_scanner_unexpected_char='E000: Unexpected char found in '+
|
||||
'code'
|
||||
|
||||
|
||||
# hash value = 23719812
|
||||
rutis_errors.err_unallowed_statement='E002: Unallowed Statement'
|
||||
|
||||
|
||||
# hash value = 248294455
|
||||
rutis_errors.err_unknown_ident='E003: Unknown Identifier '#39'%s'#39
|
||||
|
||||
# hash value = 195210244
|
||||
rutis_errors.err_expected_found='E010: '#39'%s'#39' expected, '#39'%s'#39+
|
||||
' found instead'
|
||||
|
||||
|
||||
# hash value = 2386388
|
||||
rutis_errors.err_op_or_semi_expected='E011: Operator or semicolon expecte'+
|
||||
'd'
|
||||
|
||||
|
||||
# hash value = 184443412
|
||||
rutis_errors.err_var_constant_expected='E012: Variable or Constant expect'+
|
||||
'ed'
|
||||
|
||||
|
||||
# hash value = 80568548
|
||||
rutis_errors.err_var_expected='E013: Variable expected'
|
||||
|
||||
|
||||
# hash value = 25156852
|
||||
rutis_errors.err_rec_expected='E014: Record expected'
|
||||
|
||||
|
||||
# hash value = 95149172
|
||||
rutis_errors.err_array_expected='E015: Array expected'
|
||||
|
||||
|
||||
# hash value = 90164228
|
||||
rutis_errors.err_procedure_expected='E016: Procedure expected'
|
||||
|
||||
|
||||
# hash value = 50540276
|
||||
rutis_errors.err_string_expected='E017: String expected'
|
||||
|
||||
|
||||
# hash value = 51366068
|
||||
rutis_errors.err_expected='E019: %s expected'
|
||||
|
||||
|
||||
# hash value = 159220885
|
||||
rutis_errors.err_no_const_allowed='E020: No Constant allowed here'
|
||||
|
||||
|
||||
# hash value = 3854691
|
||||
rutis_errors.err_not_enough_parameters='E030: Not enough actual parameter'+
|
||||
's'
|
||||
|
||||
|
||||
# hash value = 50133859
|
||||
rutis_errors.err_too_many_parameters='E031: Too many parameters'
|
||||
|
||||
|
||||
# hash value = 62647742
|
||||
rutis_errors.err_unallowed_string_action='E040: Unallowed String action'
|
||||
|
||||
|
||||
# hash value = 255120181
|
||||
rutis_errors.err_unallowed_datatype='E041: Unallowed Datatype'
|
||||
|
||||
|
||||
# hash value = 91098180
|
||||
rutis_errors.err_code_after_program_end='W001: Code after Program END. is'+
|
||||
' ignored'
|
||||
|
||||
|
||||
# hash value = 102976020
|
||||
rutis_errors.err_code_after_unit_end='W002: Code after Unit END. is ignor'+
|
||||
'ed'
|
||||
|
||||
1482
Units/RUTIS/Rutis_Defs.pas
Normal file
1482
Units/RUTIS/Rutis_Defs.pas
Normal file
File diff suppressed because it is too large
Load Diff
429
Units/RUTIS/Rutis_EXT_Canvas.pas
Normal file
429
Units/RUTIS/Rutis_EXT_Canvas.pas
Normal file
@ -0,0 +1,429 @@
|
||||
Unit Rutis_EXT_Canvas;
|
||||
|
||||
Interface
|
||||
|
||||
Uses
|
||||
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
|
||||
StdCtrls, ComCtrls, ExtCtrls,
|
||||
Rutis_Stack, Rutis_Engine, Rutis_Defs;
|
||||
|
||||
Type
|
||||
TUniversalCanvas = Class(TControlCanvas)
|
||||
Protected
|
||||
fDCHandle : HWND;
|
||||
Public
|
||||
Destructor Destroy; Override;
|
||||
Procedure ReleaseTarget;
|
||||
Procedure SetTargetDC(DC : HDC);
|
||||
Procedure SetTargetHandle(AHandle : HWND);
|
||||
Procedure SetTargetControl(AControl : TControl);
|
||||
End;
|
||||
|
||||
Var
|
||||
RC_Buffer : TBitmap;
|
||||
RC_DrawCanvas : TCanvas;
|
||||
RC_TargetCanvas : TCanvas;
|
||||
RC_DoubleBuffered : Boolean;
|
||||
RC_Width,
|
||||
RC_Height : Integer;
|
||||
RC_BGColor : TColor;
|
||||
|
||||
|
||||
Procedure RC_SetTargetDC(DC : HDC);
|
||||
Procedure RC_SetTargetHandle(Handle : HWND);
|
||||
Procedure RC_SetTargetCanvas(Canvas : TCanvas);
|
||||
Procedure RC_SetTargetControl(Control : TControl);
|
||||
Procedure RC_Repaint;
|
||||
Procedure RegisterEXTMethods(Engine : TRutisEngine);
|
||||
|
||||
Implementation
|
||||
|
||||
Var
|
||||
RC_DCCanvas : TUniversalCanvas;
|
||||
|
||||
Type
|
||||
PControl = ^TControl;
|
||||
|
||||
//==============================================================================
|
||||
//==============================================================================
|
||||
{ TUniversalCanvas }
|
||||
|
||||
Destructor TUniversalCanvas.Destroy;
|
||||
Begin
|
||||
ReleaseTarget;
|
||||
Inherited;
|
||||
End;
|
||||
|
||||
Procedure TUniversalCanvas.ReleaseTarget;
|
||||
Begin
|
||||
If HandleAllocated Then
|
||||
Begin
|
||||
If (fDCHandle <> 0) Then
|
||||
ReleaseDC(Handle, fDCHandle);
|
||||
Handle := 0;
|
||||
fDCHandle := 0;
|
||||
End;
|
||||
End;
|
||||
|
||||
Procedure TUniversalCanvas.SetTargetDC(DC : HDC);
|
||||
Begin
|
||||
ReleaseTarget;
|
||||
If DC = 0 Then exit;
|
||||
Handle := DC;
|
||||
End;
|
||||
|
||||
Procedure TUniversalCanvas.SetTargetHandle(AHandle : HWND);
|
||||
Begin
|
||||
ReleaseTarget;
|
||||
//If AHandle = 0 then exit;
|
||||
fDCHandle := AHandle;
|
||||
Try
|
||||
Handle := GetDC(fDCHandle);
|
||||
Except
|
||||
Handle := 0;
|
||||
fDCHandle := 0;
|
||||
End;
|
||||
End;
|
||||
|
||||
Procedure TUniversalCanvas.SetTargetControl(AControl : TControl);
|
||||
Begin
|
||||
ReleaseTarget;
|
||||
If AControl <> nil Then
|
||||
Control := AControl;
|
||||
End;
|
||||
|
||||
//==============================================================================
|
||||
//==============================================================================
|
||||
|
||||
Procedure RC_SetTargetDC(DC : HDC);
|
||||
Begin
|
||||
RC_DCCanvas.SetTargetDC(DC);
|
||||
RC_TargetCanvas := RC_DCCanvas;
|
||||
|
||||
If RC_DoubleBuffered Then
|
||||
RC_DrawCanvas := RC_Buffer.Canvas
|
||||
Else
|
||||
RC_DrawCanvas := RC_TargetCanvas;
|
||||
End;
|
||||
|
||||
Procedure RC_SetTargetHandle(Handle : HWND);
|
||||
Begin
|
||||
RC_DCCanvas.SetTargetHandle(Handle);
|
||||
RC_TargetCanvas := RC_DCCanvas;
|
||||
|
||||
If RC_DoubleBuffered Then
|
||||
RC_DrawCanvas := RC_Buffer.Canvas
|
||||
Else
|
||||
RC_DrawCanvas := RC_TargetCanvas;
|
||||
End;
|
||||
|
||||
Procedure RC_SetTargetControl(Control : TControl);
|
||||
Begin
|
||||
If (Control is TImage) Then
|
||||
Begin
|
||||
RC_TargetCanvas := TImage(Control).Canvas;
|
||||
RC_DCCanvas.ReleaseTarget;
|
||||
End
|
||||
Else
|
||||
Begin
|
||||
RC_DCCanvas.SetTargetControl(Control);
|
||||
RC_TargetCanvas := RC_DCCanvas;
|
||||
End;
|
||||
|
||||
If RC_DoubleBuffered Then
|
||||
RC_DrawCanvas := RC_Buffer.Canvas
|
||||
Else
|
||||
RC_DrawCanvas := RC_TargetCanvas;
|
||||
End;
|
||||
|
||||
Procedure RC_SetTargetCanvas(Canvas : TCanvas);
|
||||
Begin
|
||||
RC_DCCanvas.ReleaseTarget;
|
||||
|
||||
RC_TargetCanvas := Canvas;
|
||||
|
||||
If RC_DoubleBuffered Then
|
||||
RC_DrawCanvas := RC_Buffer.Canvas
|
||||
Else
|
||||
RC_DrawCanvas := RC_TargetCanvas;
|
||||
End;
|
||||
|
||||
Procedure RC_Repaint;
|
||||
Begin
|
||||
If RC_DoubleBuffered Then
|
||||
RC_TargetCanvas.Draw(0, 0, RC_Buffer);
|
||||
End;
|
||||
|
||||
//==============================================================================
|
||||
//==============================================================================
|
||||
|
||||
Procedure _CanvasDC(Params : PRutisParamInfoArray; Result : PRutisParamInfo);
|
||||
Begin
|
||||
RC_SetTargetDC(PCardinal(Params^[0].Data)^);
|
||||
End;
|
||||
|
||||
Procedure _CanvasHandle(Params : PRutisParamInfoArray; Result : PRutisParamInfo);
|
||||
Begin
|
||||
RC_SetTargetHandle(PCardinal(Params^[0].Data)^);
|
||||
End;
|
||||
|
||||
Procedure _CanvasControl(Params : PRutisParamInfoArray; Result : PRutisParamInfo);
|
||||
Begin
|
||||
RC_SetTargetControl(PControl(Params^[0].Data)^);
|
||||
End;
|
||||
|
||||
Procedure _CanvasDoubleBuffered(Params : PRutisParamInfoArray; Result : PRutisParamInfo);
|
||||
Begin
|
||||
RC_DoubleBuffered := PBoolean(Params^[0].Data)^;
|
||||
If RC_DoubleBuffered Then
|
||||
RC_DrawCanvas := RC_Buffer.Canvas
|
||||
Else
|
||||
RC_DrawCanvas := RC_TargetCanvas;
|
||||
End;
|
||||
|
||||
Procedure _CanvasClear(Params : PRutisParamInfoArray; Result : PRutisParamInfo);
|
||||
Var
|
||||
rect : TRect;
|
||||
TmpColor : TColor;
|
||||
Begin
|
||||
// RC_BGColor := RC_DrawCanvas.Brush.Color;
|
||||
// If RC_DoubleBuffered Then
|
||||
// Begin
|
||||
// //RC_Buffer.Width := 0;
|
||||
// //RC_Buffer.Width := RC_Width;
|
||||
// rect := RC_Buffer.Canvas.ClipRect;
|
||||
// inc(rect.Right);
|
||||
// inc(rect.Bottom);
|
||||
|
||||
// TmpColor := RC_Buffer.Canvas.Pen.Color;
|
||||
// RC_Buffer.Canvas.Pen.Color := RC_BGColor;
|
||||
|
||||
// RC_Buffer.Canvas.FillRect(rect);
|
||||
|
||||
// RC_Buffer.Canvas.Pen.Color := TmpColor;
|
||||
// End
|
||||
// Else
|
||||
// Begin
|
||||
// rect := RC_TargetCanvas.ClipRect;
|
||||
// inc(rect.Right);
|
||||
// inc(rect.Bottom);
|
||||
|
||||
// RC_TargetCanvas.Brush.Color := RC_BGColor;
|
||||
// RC_TargetCanvas.Pen.Color := RC_BGColor;
|
||||
// RC_TargetCanvas.FillRect(rect);
|
||||
// End;
|
||||
|
||||
RC_BGColor := RC_DrawCanvas.Brush.Color;
|
||||
TmpColor := RC_DrawCanvas.Pen.Color;
|
||||
|
||||
rect := RC_DrawCanvas.ClipRect;
|
||||
Inc(rect.Right);
|
||||
Inc(rect.Bottom);
|
||||
|
||||
RC_DrawCanvas.Pen.Color := RC_BGColor;
|
||||
|
||||
RC_DrawCanvas.FillRect(rect);
|
||||
|
||||
RC_DrawCanvas.Pen.Color := TmpColor;
|
||||
End;
|
||||
|
||||
Procedure _CanvasSize(Params : PRutisParamInfoArray; Result : PRutisParamInfo);
|
||||
Var
|
||||
AColor : TColor;
|
||||
Begin
|
||||
RC_Width := PInteger(Params^[0].Data)^;
|
||||
RC_Height := PInteger(Params^[1].Data)^;
|
||||
//CorrectBufferSize(RC_Width, RC_Height);
|
||||
If RC_DoubleBuffered Then
|
||||
With RC_Buffer Do
|
||||
Begin
|
||||
AColor := Canvas.Brush.Color;
|
||||
Canvas.Brush.Color := RC_BGColor;
|
||||
If (RC_Width <> Width) Then Width := RC_Width;
|
||||
If (RC_Height <> Height) Then Height := RC_Height;
|
||||
Canvas.Brush.Color := AColor;
|
||||
End;
|
||||
End;
|
||||
|
||||
Procedure _CanvasDisplay(Params : PRutisParamInfoArray; Result : PRutisParamInfo);
|
||||
Begin
|
||||
If RC_DoubleBuffered Then
|
||||
RC_TargetCanvas.Draw(0, 0, RC_Buffer);
|
||||
End;
|
||||
|
||||
//==============================================================================
|
||||
|
||||
Procedure _BrushSolid(Params : PRutisParamInfoArray; Result : PRutisParamInfo);
|
||||
Begin
|
||||
RC_DrawCanvas.Brush.Style := bsSolid;
|
||||
End;
|
||||
|
||||
Procedure _BrushClear(Params : PRutisParamInfoArray; Result : PRutisParamInfo);
|
||||
Begin
|
||||
RC_DrawCanvas.Brush.Style := bsClear;
|
||||
End;
|
||||
|
||||
Procedure _PenColor(Params : PRutisParamInfoArray; Result : PRutisParamInfo);
|
||||
Begin
|
||||
RC_DrawCanvas.Pen.Color := PColor(Params^[0].Data)^;
|
||||
End;
|
||||
|
||||
Procedure _BrushColor(Params : PRutisParamInfoArray; Result : PRutisParamInfo);
|
||||
Begin
|
||||
RC_DrawCanvas.Brush.Color := PColor(Params^[0].Data)^;
|
||||
End;
|
||||
|
||||
Procedure _PenColorRGB(Params : PRutisParamInfoArray; Result : PRutisParamInfo);
|
||||
Begin
|
||||
RC_DrawCanvas.Pen.Color := rgb(PByte(Params^[0].Data)^, PByte(Params^[1].Data)^, PByte(Params^[2].Data)^);
|
||||
End;
|
||||
|
||||
Procedure _BrushColorRGB(Params : PRutisParamInfoArray; Result : PRutisParamInfo);
|
||||
Begin
|
||||
RC_DrawCanvas.Brush.Color := rgb(PByte(Params^[0].Data)^, PByte(Params^[1].Data)^, PByte(Params^[2].Data)^);
|
||||
End;
|
||||
|
||||
Procedure _PenWidth(Params : PRutisParamInfoArray; Result : PRutisParamInfo);
|
||||
Begin
|
||||
RC_DrawCanvas.Pen.Width := PInteger(Params^[0].Data)^;
|
||||
End;
|
||||
|
||||
Procedure _Rectangle(Params : PRutisParamInfoArray; Result : PRutisParamInfo);
|
||||
Var x1, y1, x2, y2 : Integer;
|
||||
Begin
|
||||
x1 := PInteger(Params^[0].Data)^;
|
||||
y1 := PInteger(Params^[1].Data)^;
|
||||
x2 := PInteger(Params^[2].Data)^;
|
||||
y2 := PInteger(Params^[3].Data)^;
|
||||
//CorrectBufferSize(Max(x1, x2), Max(y1, y2));
|
||||
RC_DrawCanvas.Rectangle(x1, y1, x2, y2);
|
||||
End;
|
||||
|
||||
Procedure _Ellipse(Params : PRutisParamInfoArray; Result : PRutisParamInfo);
|
||||
Var x1, y1, x2, y2 : Integer;
|
||||
Begin
|
||||
x1 := PInteger(Params^[0].Data)^;
|
||||
y1 := PInteger(Params^[1].Data)^;
|
||||
x2 := PInteger(Params^[2].Data)^;
|
||||
y2 := PInteger(Params^[3].Data)^;
|
||||
//CorrectBufferSize(Max(x1, x2), Max(y1, y2));
|
||||
RC_DrawCanvas.Ellipse(x1, y1, x2, y2);
|
||||
End;
|
||||
|
||||
Procedure _MoveTo(Params : PRutisParamInfoArray; Result : PRutisParamInfo);
|
||||
Var x1, y1 : Integer;
|
||||
Begin
|
||||
x1 := PInteger(Params^[0].Data)^;
|
||||
y1 := PInteger(Params^[1].Data)^;
|
||||
//CorrectBufferSize(x1,y1);
|
||||
RC_DrawCanvas.MoveTo(x1, y1);
|
||||
End;
|
||||
|
||||
Procedure _LineTo(Params : PRutisParamInfoArray; Result : PRutisParamInfo);
|
||||
Var x1, y1 : Integer;
|
||||
Begin
|
||||
x1 := PInteger(Params^[0].Data)^;
|
||||
y1 := PInteger(Params^[1].Data)^;
|
||||
//CorrectBufferSize(x1,y1);
|
||||
RC_DrawCanvas.LineTo(x1, y1);
|
||||
End;
|
||||
|
||||
Procedure _TextOut(Params : PRutisParamInfoArray; Result : PRutisParamInfo);
|
||||
Var x1, y1 : Integer;
|
||||
Begin
|
||||
x1 := PInteger(Params^[0].Data)^;
|
||||
y1 := PInteger(Params^[1].Data)^;
|
||||
With RC_DrawCanvas Do
|
||||
Begin
|
||||
//CorrectBufferSize(x1 + TextHeight(Params^[2]), y1 + TextWidth(Params^[2]));
|
||||
RC_DrawCanvas.Font.Color := RC_DrawCanvas.Pen.Color;
|
||||
TextOut(x1, y1, PAnsiString(Params^[2].Data)^);
|
||||
End;
|
||||
End;
|
||||
|
||||
Procedure _TextSize(Params : PRutisParamInfoArray; Result : PRutisParamInfo);
|
||||
Begin
|
||||
RC_DrawCanvas.Font.Size := GetPInteger(Params^[0].Data);
|
||||
End;
|
||||
|
||||
Procedure _GetPixel(Params : PRutisParamInfoArray; Result : PRutisParamInfo);
|
||||
Begin
|
||||
PCardinal(Result^.Data)^ := Cardinal(RC_DrawCanvas.Pixels[PInteger(Params^[0].Data)^,
|
||||
PInteger(Params^[1].Data)^]);
|
||||
End;
|
||||
|
||||
Procedure _SetPixel(Params : PRutisParamInfoArray; Result : PRutisParamInfo);
|
||||
Begin
|
||||
RC_DrawCanvas.Pixels[PInteger(Params^[0].Data)^,
|
||||
PInteger(Params^[1].Data)^] := TColor(PCardinal(Params^[2].Data)^);
|
||||
End;
|
||||
|
||||
//==============================================================================
|
||||
//==============================================================================
|
||||
|
||||
Procedure RegisterEXTMethods(Engine : TRutisEngine);
|
||||
Begin
|
||||
OutputDebugString(PChar('Rutis_EXT_Canvas.RegisterEXTMethods - Registering RUTIS Canvas Support'));
|
||||
|
||||
//==============================================================================
|
||||
//====================== CANVAS ================================================
|
||||
//==============================================================================
|
||||
|
||||
Engine.RegExtMethod('CanvasControl',{$IfDef FPC}@{$EndIf}_CanvasControl, ['TControl'], '',
|
||||
'Set the Control for the Canvas');
|
||||
Engine.RegExtMethod('CanvasHandle',{$IfDef FPC}@{$EndIf}_CanvasHandle, ['HWND'], '',
|
||||
'Set the Handle for the Canvas' + sLineBreak +
|
||||
'The needed Device Context will be retrived automatically');
|
||||
Engine.RegExtMethod('CanvasDC',{$IfDef FPC}@{$EndIf}_CanvasDC, ['HDC'], '',
|
||||
'Set the DeviceContext for the Canvas' + sLineBreak +
|
||||
'You need to get the DC with GetDC first' + sLineBreak +
|
||||
'CanvasDC should normally not be used - use CanvasHandle instead');
|
||||
|
||||
Engine.RegExtMethod('CanvasSize',{$IfDef FPC}@{$EndIf}_CanvasSize, ['Integer', 'Integer'], '',
|
||||
'Set up the Buffer-Size' + sLineBreak +
|
||||
'Only needed when using DoubleBuffered-ON');
|
||||
Engine.RegExtMethod('CanvasDisplay',{$IfDef FPC}@{$EndIf}_CanvasDisplay, [], '',
|
||||
'Displays the Buffer' + sLineBreak +
|
||||
'Only needed when using DoubleBuffered-ON');
|
||||
Engine.RegExtMethod('CanvasClear',{$IfDef FPC}@{$EndIf}_CanvasClear, [], '',
|
||||
'Clears the painted content');
|
||||
Engine.RegExtMethod('CanvasDoubleBuffered',{$IfDef FPC}@{$EndIf}_CanvasDoubleBuffered, ['Boolean'], '',
|
||||
'If set, all content will be painted into a separate Buffer' + sLineBreak +
|
||||
'You will need to set up the Buffer with CanvasSize and CanvasClear first and' + sLineBreak +
|
||||
'you have to call CanvasDisplay to show the painted content');
|
||||
|
||||
Engine.RegExtMethod('MoveTo',{$IfDef FPC}@{$EndIf}_Moveto, ['Integer', 'Integer'], '');
|
||||
Engine.RegExtMethod('LineTo',{$IfDef FPC}@{$EndIf}_Lineto, ['Integer', 'Integer'], '');
|
||||
Engine.RegExtMethod('Rectangle',{$IfDef FPC}@{$EndIf}_Rectangle, ['Integer', 'Integer', 'Integer', 'Integer'], '');
|
||||
Engine.RegExtMethod('Ellipse',{$IfDef FPC}@{$EndIf}_Ellipse, ['Integer', 'Integer', 'Integer', 'Integer'], '');
|
||||
Engine.RegExtMethod('TextOut',{$IfDef FPC}@{$EndIf}_TextOut, ['Integer', 'Integer', 'String'], '');
|
||||
Engine.RegExtMethod('TextSize',{$IfDef FPC}@{$EndIf}_TextSize, ['Integer'], '');
|
||||
Engine.RegExtMethod('PenColorRGB',{$IfDef FPC}@{$EndIf}_PenColorRGB, ['Byte', 'Byte', 'Byte'], '');
|
||||
Engine.RegExtMethod('BrushColorRGB',{$IfDef FPC}@{$EndIf}_BrushColorRGB, ['Byte', 'Byte', 'Byte'], '');
|
||||
Engine.RegExtMethod('PenColor',{$IfDef FPC}@{$EndIf}_PenColor, ['Integer'], '');
|
||||
Engine.RegExtMethod('BrushColor',{$IfDef FPC}@{$EndIf}_BrushColor, ['Integer'], '');
|
||||
Engine.RegExtMethod('BrushSolid',{$IfDef FPC}@{$EndIf}_BrushSolid, [], '');
|
||||
Engine.RegExtMethod('BrushClear',{$IfDef FPC}@{$EndIf}_BrushClear, [], '');
|
||||
Engine.RegExtMethod('PenWidth',{$IfDef FPC}@{$EndIf}_PenWidth, ['Integer'], '');
|
||||
|
||||
Engine.RegExtMethod('GetPixel',{$IfDef FPC}@{$EndIf}_GetPixel, ['Integer', 'Integer'], 'Integer');
|
||||
Engine.RegExtMethod('SetPixel',{$IfDef FPC}@{$EndIf}_SetPixel, ['Integer', 'Integer', 'Integer'], '');
|
||||
|
||||
|
||||
OutputDebugString(PChar('Rutis_EXT_Canvas.RegisterEXTMethods - Successfully registered RUTIS Canvas Support'));
|
||||
End;
|
||||
|
||||
//==============================================================================
|
||||
//==============================================================================
|
||||
|
||||
Initialization
|
||||
RC_Buffer := TBitmap.Create;
|
||||
RC_DCCanvas := TUniversalCanvas.Create;
|
||||
|
||||
RC_DoubleBuffered := True;
|
||||
RC_TargetCanvas := RC_Buffer.Canvas;
|
||||
Finalization
|
||||
RC_DCCanvas.Free;
|
||||
RC_Buffer.Free;
|
||||
End.
|
||||
|
||||
603
Units/RUTIS/Rutis_EXT_Common.pas
Normal file
603
Units/RUTIS/Rutis_EXT_Common.pas
Normal file
@ -0,0 +1,603 @@
|
||||
Unit Rutis_EXT_Common;
|
||||
|
||||
Interface
|
||||
|
||||
{$i Delphi_Versions.inc}
|
||||
|
||||
{$IFDEF FPC}
|
||||
{$mode objfpc}{$H+}
|
||||
{$ENDIF}
|
||||
|
||||
Uses
|
||||
Windows, Forms, Math, Dialogs, SysUtils,
|
||||
Rutis_Stack, Rutis_Defs, Rutis_Classes, TypInfo;
|
||||
|
||||
Type
|
||||
PObject = ^TObject;
|
||||
PSearchRec = ^TSearchRec;
|
||||
PClass = ^TClass;
|
||||
|
||||
Procedure RegisterEXTMethods(Engine : TRutisEngineBase);
|
||||
|
||||
Implementation
|
||||
|
||||
//==============================================================================
|
||||
//======== Strings
|
||||
//==============================================================================
|
||||
{$REGION 'Strings'}
|
||||
|
||||
Procedure _ToStr(Params : PRutisParamInfoArray; Result : PRutisParamInfo);
|
||||
Begin
|
||||
Case Params^[0].IntType Of
|
||||
// intCardinal : PAnsiString(Result^.Data)^ := IntToStr(GetPCardinal(Params^[0].Data));
|
||||
// intInteger : PAnsiString(Result^.Data)^ := IntToStr(GetPInteger(Params^[0].Data));
|
||||
// intExtended : PAnsiString(Result^.Data)^ := FloatToStr(GetPExtended(Params^[0].Data));
|
||||
|
||||
intCardinal : SetPAnsiString(Result^.Data, IntToStr(GetPCardinal(Params^[0].Data)));
|
||||
intInteger : SetPAnsiString(Result^.Data, IntToStr(GetPInteger(Params^[0].Data)));
|
||||
intExtended : SetPAnsiString(Result^.Data, FloatToStr(GetPExtended(Params^[0].Data)));
|
||||
|
||||
// intCardinal : PAnsiString(Result^.Data)^ := IntToStr(PCardinal(Params^[0].Data)^);
|
||||
// intInteger : PAnsiString(Result^.Data)^ := IntToStr(PInteger(Params^[0].Data)^);
|
||||
// intExtended : PAnsiString(Result^.Data)^ := FloatToStr(PExtended(Params^[0].Data)^);
|
||||
End;
|
||||
End;
|
||||
|
||||
Procedure _ToInt(Params : PRutisParamInfoArray; Result : PRutisParamInfo);
|
||||
Begin
|
||||
Try
|
||||
SetPInteger(Result^.Data, StrToInt(AnsiString(GetPPointer(Params^[0].Data))));
|
||||
Except
|
||||
SetPInteger(Result^.Data, 0);
|
||||
End;
|
||||
End;
|
||||
|
||||
Procedure _ToFloat(Params : PRutisParamInfoArray; Result : PRutisParamInfo);
|
||||
Begin
|
||||
Try
|
||||
SetPExtended(Result^.Data, StrToFloat(AnsiString(GetPPointer(Params^[0].Data))));
|
||||
Except
|
||||
SetPExtended(Result^.Data, 0);
|
||||
End;
|
||||
End;
|
||||
|
||||
Procedure _SetDecimalSeparator(Params : PRutisParamInfoArray; Result : PRutisParamInfo);
|
||||
Begin
|
||||
DecimalSeparator := PAnsiChar(Params^[0].Data)^;
|
||||
End;
|
||||
|
||||
Procedure _GetDecimalSeparator(Params : PRutisParamInfoArray; Result : PRutisParamInfo);
|
||||
Begin
|
||||
PAnsiChar(Result^.Data)^ := DecimalSeparator;
|
||||
End;
|
||||
|
||||
Procedure _Chr(Params : PRutisParamInfoArray; Result : PRutisParamInfo);
|
||||
Begin
|
||||
PAnsiChar(Result^.Data)^ := Chr(PByte(Params^[0].Data)^);
|
||||
End;
|
||||
|
||||
Procedure _Ord(Params : PRutisParamInfoArray; Result : PRutisParamInfo);
|
||||
Begin
|
||||
PByte(Result^.Data)^ := Ord(PAnsiChar(Params^[0].Data)^);
|
||||
End;
|
||||
|
||||
Procedure _UpperCase(Params : PRutisParamInfoArray; Result : PRutisParamInfo);
|
||||
Begin
|
||||
SetPAnsiString(Result^.Data, UpperCase(AnsiString(GetPPointer(Params^[0].Data))));
|
||||
End;
|
||||
|
||||
Procedure _LowerCase(Params : PRutisParamInfoArray; Result : PRutisParamInfo);
|
||||
Begin
|
||||
SetPAnsiString(Result^.Data, LowerCase(AnsiString(GetPPointer(Params^[0].Data))));
|
||||
End;
|
||||
|
||||
Procedure _StringReplace(Params : PRutisParamInfoArray; Result : PRutisParamInfo);
|
||||
Type PReplaceFlags = ^TReplaceFlags;
|
||||
Begin
|
||||
PAnsiString(Result^.Data)^ := StringReplace(
|
||||
AnsiString(GetPPointer(Params^[0].Data)),
|
||||
AnsiString(GetPPointer(Params^[1].Data)),
|
||||
AnsiString(GetPPointer(Params^[2].Data)),
|
||||
{$ifdef WinCe}unaligned({$endif}PReplaceFlags(Params^[3].Data)^{$ifdef WinCe}){$endif});
|
||||
End;
|
||||
|
||||
Procedure _ExtractFilePath(Params : PRutisParamInfoArray; Result : PRutisParamInfo);
|
||||
Begin
|
||||
SetPAnsiString(Result^.Data, ExtractFilePath(AnsiString(GetPPointer(Params^[0].Data))));
|
||||
End;
|
||||
|
||||
Procedure _ExtractFileName(Params : PRutisParamInfoArray; Result : PRutisParamInfo);
|
||||
Begin
|
||||
SetPAnsiString(Result^.Data, ExtractFileName(AnsiString(GetPPointer(Params^[0].Data))));
|
||||
End;
|
||||
|
||||
Procedure _ExtractFileExt(Params : PRutisParamInfoArray; Result : PRutisParamInfo);
|
||||
Begin
|
||||
SetPAnsiString(Result^.Data, ExtractFileExt(AnsiString(GetPPointer(Params^[0].Data))));
|
||||
End;
|
||||
|
||||
Procedure _ExpandFileName(Params : PRutisParamInfoArray; Result : PRutisParamInfo);
|
||||
Begin
|
||||
SetPAnsiString(Result^.Data, ExpandFileName(AnsiString(GetPPointer(Params^[0].Data))));
|
||||
End;
|
||||
|
||||
{$ENDREGION}
|
||||
|
||||
//======== Internal ========
|
||||
{$REGION 'Internal'}
|
||||
|
||||
Procedure _InheritsClass(Params : PRutisParamInfoArray; Result : PRutisParamInfo);
|
||||
var
|
||||
AObject : TObject;
|
||||
AClass : TClass;
|
||||
Begin
|
||||
AObject := TObject(GetPPointer(Params^[0].Data));
|
||||
If AObject = nil then exit;
|
||||
AClass := TClass(GetPPointer(Params^[1].Data));
|
||||
If AClass = nil then exit;
|
||||
PBoolean(Result^.Data)^ := AObject is AClass;
|
||||
End;
|
||||
|
||||
{$ENDREGION}
|
||||
|
||||
//======== Files ========
|
||||
{$REGION 'Files'}
|
||||
|
||||
Procedure _FileExists(Params : PRutisParamInfoArray; Result : PRutisParamInfo);
|
||||
Begin
|
||||
PBoolean(Result^.Data)^ := FileExists(AnsiString(GetPPointer(Params^[0].Data)));
|
||||
End;
|
||||
|
||||
Procedure _FindFirst(Params : PRutisParamInfoArray; Result : PRutisParamInfo);
|
||||
Begin
|
||||
SetPInteger(Result^.Data, FindFirst(
|
||||
AnsiString(GetPPointer(Params^[0].Data)),
|
||||
GetPInteger(Params^[1].Data),
|
||||
PSearchRec(Params^[2].Data)^));
|
||||
End;
|
||||
|
||||
Procedure _FindNext(Params : PRutisParamInfoArray; Result : PRutisParamInfo);
|
||||
Begin
|
||||
SetPInteger(Result^.Data, FindNext(PSearchRec(Params^[0].Data)^));
|
||||
End;
|
||||
|
||||
Procedure _FindClose(Params : PRutisParamInfoArray; Result : PRutisParamInfo);
|
||||
Begin
|
||||
FindClose(PSearchRec(Params^[0].Data)^);
|
||||
End;
|
||||
|
||||
{$ENDREGION}
|
||||
|
||||
//==============================================================================
|
||||
//======== Windows
|
||||
//==============================================================================
|
||||
{$REGION 'Windows'}
|
||||
|
||||
Procedure _Sleep(Params : PRutisParamInfoArray; Result : PRutisParamInfo);
|
||||
Begin
|
||||
Sleep(GetPInteger(Params^[0].Data));
|
||||
End;
|
||||
|
||||
Procedure _Delay(Params : PRutisParamInfoArray; Result : PRutisParamInfo);
|
||||
Var
|
||||
GTC : Cardinal;
|
||||
Begin
|
||||
GTC := GetTickCount + GetPInteger(Params^[0].Data);
|
||||
While GTC >= GetTickCount Do
|
||||
Begin
|
||||
//Application.ProcessMessages;
|
||||
sleep(1);
|
||||
End;
|
||||
End;
|
||||
|
||||
Procedure _RVal(Params : PRutisParamInfoArray; Result : PRutisParamInfo);
|
||||
Begin
|
||||
PByte(Result^.Data)^ := GetRValue(GetPCardinal(Params^[0].Data));
|
||||
End;
|
||||
|
||||
Procedure _GVal(Params : PRutisParamInfoArray; Result : PRutisParamInfo);
|
||||
Begin
|
||||
PByte(Result^.Data)^ := GetRValue(GetPCardinal(Params^[0].Data));
|
||||
End;
|
||||
|
||||
Procedure _BVal(Params : PRutisParamInfoArray; Result : PRutisParamInfo);
|
||||
Begin
|
||||
PByte(Result^.Data)^ := GetRValue(GetPCardinal(Params^[0].Data));
|
||||
End;
|
||||
|
||||
Procedure _RGB(Params : PRutisParamInfoArray; Result : PRutisParamInfo);
|
||||
Begin
|
||||
SetPCardinal(Result^.Data, Cardinal(rgb(PByte(Params^[0].Data)^, PByte(Params^[1].Data)^, PByte(Params^[2].Data)^)));
|
||||
End;
|
||||
|
||||
{$ifndef FPC}
|
||||
Procedure _DynCallDLLProc(Params : PRutisParamInfoArray; Result : PRutisParamInfo);
|
||||
Type
|
||||
TPointerArray = Array Of Pointer;
|
||||
PPointerArray = ^TPointerArray;
|
||||
Var
|
||||
DLLName : PAnsiString;
|
||||
ProcName : PAnsiString;
|
||||
ProcParams : TPointerArray;
|
||||
HasResult : Boolean;
|
||||
ProcResult : Cardinal;
|
||||
Begin
|
||||
DLLName := PAnsiString(Params^[0].Data);
|
||||
ProcName := PAnsiString(Params^[1].Data);
|
||||
HasResult := PBoolean(Params^[2].Data)^;
|
||||
ProcParams := PPointerArray(PPointer(Params^[3].Data))^;
|
||||
If length(ProcParams) > 100 Then exit;
|
||||
If not DynamicDllCall(DLLName^, ProcName^, HasResult, ProcResult, ProcParams) Then
|
||||
Begin
|
||||
//ShowMessage('Function could not be found!');
|
||||
PCardinal(Result^.Data)^ := 0;
|
||||
End
|
||||
Else
|
||||
Begin
|
||||
PCardinal(Result^.Data)^ := ProcResult;
|
||||
End;
|
||||
End;
|
||||
{$endif}
|
||||
|
||||
Procedure _GetTickCount(Params : PRutisParamInfoArray; Result : PRutisParamInfo);
|
||||
Begin
|
||||
SetPCardinal(Result^.Data, GetTickCount);
|
||||
End;
|
||||
|
||||
Procedure _GetAsyncKeyState(Params : PRutisParamInfoArray; Result : PRutisParamInfo);
|
||||
Begin
|
||||
PBoolean(Result^.Data)^ := Boolean(GetAsyncKeyState(GetPWord(Params^[0].Data)) <> 0);
|
||||
End;
|
||||
|
||||
{$ifndef WINCE}
|
||||
Procedure _Beep(Params : PRutisParamInfoArray; Result : PRutisParamInfo);
|
||||
Begin
|
||||
Windows.Beep(GetPCardinal(Params^[0].Data), GetPCardinal(Params^[1].Data));
|
||||
End;
|
||||
{$endif WINCE}
|
||||
|
||||
Procedure _InputDlg(Params : PRutisParamInfoArray; Result : PRutisParamInfo);
|
||||
Var
|
||||
str : AnsiString;
|
||||
StrOut : Pointer;
|
||||
Begin
|
||||
str := AnsiString(GetPPointer(Params^[1].Data));
|
||||
If not InputQuery('Input', AnsiString(GetPPointer(Params^[0].Data)), str) Then
|
||||
SetPAnsiString(Result^.Data, '')
|
||||
else
|
||||
SetPAnsiString(Result^.Data, Str);
|
||||
End;
|
||||
|
||||
{$ENDREGION}
|
||||
|
||||
//==============================================================================
|
||||
//======== Properties
|
||||
//==============================================================================
|
||||
{$REGION 'Properties'}
|
||||
|
||||
Procedure _SetIntProperty(Params : PRutisParamInfoArray; Result : PRutisParamInfo);
|
||||
Var
|
||||
Obj : TObject;
|
||||
PropInfo : PPropInfo;
|
||||
PropName : AnsiString;
|
||||
Begin
|
||||
Obj := TObject(GetPPointer(Params^[0].Data));
|
||||
PropName := AnsiString(GetPPointer(Params^[1].Data));
|
||||
Try
|
||||
PropInfo := GetPropInfo(Obj, PropName);
|
||||
If PropInfo <> nil Then
|
||||
SetOrdProp(Obj, PropInfo, GetPInteger(Params^[2].Data));
|
||||
Except
|
||||
End;
|
||||
End;
|
||||
|
||||
Procedure _GetIntProperty(Params : PRutisParamInfoArray; Result : PRutisParamInfo);
|
||||
Var
|
||||
Obj : TObject;
|
||||
PropInfo : PPropInfo;
|
||||
PropName : AnsiString;
|
||||
Begin
|
||||
Obj := TObject(GetPPointer(Params^[0].Data));
|
||||
PropName := AnsiString(GetPPointer(Params^[1].Data));
|
||||
Try
|
||||
PropInfo := GetPropInfo(Obj, PropName);
|
||||
If PropInfo <> nil Then
|
||||
SetPInteger(Result^.Data, GetOrdProp(Obj, PropInfo));
|
||||
Except
|
||||
End;
|
||||
End;
|
||||
|
||||
Procedure _SetBoolProperty(Params : PRutisParamInfoArray; Result : PRutisParamInfo);
|
||||
Var
|
||||
Obj : TObject;
|
||||
PropInfo : PPropInfo;
|
||||
PropName : AnsiString;
|
||||
Begin
|
||||
Obj := TObject(GetPPointer(Params^[0].Data));
|
||||
PropName := AnsiString(GetPPointer(Params^[1].Data));
|
||||
Try
|
||||
PropInfo := GetPropInfo(Obj, PropName);
|
||||
If PropInfo <> nil Then
|
||||
SetOrdProp(Obj, PropInfo, PByte(Params^[2].Data)^);
|
||||
Except
|
||||
End;
|
||||
End;
|
||||
|
||||
Procedure _GetBoolProperty(Params : PRutisParamInfoArray; Result : PRutisParamInfo);
|
||||
Var
|
||||
Obj : TObject;
|
||||
PropInfo : PPropInfo;
|
||||
PropName : AnsiString;
|
||||
Begin
|
||||
Obj := TObject(GetPPointer(Params^[0].Data));
|
||||
PropName := AnsiString(GetPPointer(Params^[1].Data));
|
||||
Try
|
||||
PropInfo := GetPropInfo(Obj, PropName);
|
||||
If PropInfo <> nil Then
|
||||
PByte(Result^.Data)^ := GetOrdProp(Obj, PropInfo);
|
||||
Except
|
||||
End;
|
||||
End;
|
||||
|
||||
Procedure _SetStrProperty(Params : PRutisParamInfoArray; Result : PRutisParamInfo);
|
||||
Var
|
||||
Obj : TObject;
|
||||
PropInfo : PPropInfo;
|
||||
PropName : AnsiString;
|
||||
Begin
|
||||
Obj := TObject(GetPPointer(Params^[0].Data));
|
||||
PropName := AnsiString(GetPPointer(Params^[1].Data));
|
||||
Try
|
||||
PropInfo := GetPropInfo(Obj, PropName);
|
||||
If PropInfo <> nil Then
|
||||
SetStrProp(Obj, PropInfo, AnsiString(GetPPointer(Params^[2].Data)));
|
||||
Except
|
||||
End;
|
||||
End;
|
||||
|
||||
Procedure _GetStrProperty(Params : PRutisParamInfoArray; Result : PRutisParamInfo);
|
||||
Var
|
||||
Obj : TObject;
|
||||
PropInfo : PPropInfo;
|
||||
PropName : AnsiString;
|
||||
Begin
|
||||
Obj := TObject(GetPPointer(Params^[0].Data));
|
||||
PropName := AnsiString(GetPPointer(Params^[1].Data));
|
||||
Try
|
||||
PropInfo := GetPropInfo(Obj, PropName);
|
||||
If PropInfo <> nil Then
|
||||
SetPAnsiString(Result^.Data, GetStrProp(Obj, PropInfo));
|
||||
Except
|
||||
End;
|
||||
End;
|
||||
|
||||
{$ENDREGION}
|
||||
|
||||
//==============================================================================
|
||||
//======== Math
|
||||
//==============================================================================
|
||||
{$REGION 'Maths'}
|
||||
|
||||
Procedure _Round(Params : PRutisParamInfoArray; Result : PRutisParamInfo);
|
||||
Begin
|
||||
SetPInteger(Result^.Data, round(GetPSingle(Params^[0].Data)));
|
||||
End;
|
||||
|
||||
Procedure _abs(Params : PRutisParamInfoArray; Result : PRutisParamInfo);
|
||||
Begin
|
||||
Case Params^[0].IntType Of
|
||||
intInteger : SetPInteger(Result^.Data, abs(GetPInteger(Params^[0].Data)));
|
||||
intSingle : SetPSingle(Result^.Data, abs(GetPSingle(Params^[0].Data)));
|
||||
intDouble : SetPDouble(Result^.Data, abs(GetPDouble(Params^[0].Data)));
|
||||
End;
|
||||
End;
|
||||
|
||||
Procedure _RandomF(Params : PRutisParamInfoArray; Result : PRutisParamInfo);
|
||||
Begin
|
||||
SetPDouble(Result^.Data, random);
|
||||
End;
|
||||
|
||||
Procedure _Random(Params : PRutisParamInfoArray; Result : PRutisParamInfo);
|
||||
Begin
|
||||
SetPInteger(Result^.Data, random(GetPInteger(Params^[0].Data)));
|
||||
End;
|
||||
|
||||
Procedure _sqr(Params : PRutisParamInfoArray; Result : PRutisParamInfo);
|
||||
Var d : Single;
|
||||
Begin
|
||||
d := GetPSingle(Params^[0].Data);
|
||||
SetPSingle(Result^.Data, d * d);
|
||||
End;
|
||||
|
||||
Procedure _sqrt(Params : PRutisParamInfoArray; Result : PRutisParamInfo);
|
||||
Begin
|
||||
SetPSingle(Result^.Data, sqrt(GetPSingle(Params^[0].Data)));
|
||||
End;
|
||||
|
||||
Procedure _sqrtvari(Params : PVariantArray; Result : PVariant);
|
||||
Begin
|
||||
Result^ := sqrt(Params^[0]);
|
||||
End;
|
||||
|
||||
Procedure _Sin(Params : PRutisParamInfoArray; Result : PRutisParamInfo);
|
||||
Begin
|
||||
SetPSingle(Result^.Data, Sin(GetPSingle(Params^[0].Data)));
|
||||
End;
|
||||
|
||||
Procedure _Cos(Params : PRutisParamInfoArray; Result : PRutisParamInfo);
|
||||
Begin
|
||||
SetPSingle(Result^.Data, Cos(GetPSingle(Params^[0].Data)));
|
||||
End;
|
||||
|
||||
Procedure _ArcSin(Params : PRutisParamInfoArray; Result : PRutisParamInfo);
|
||||
Begin
|
||||
SetPSingle(Result^.Data, ArcSin(GetPSingle(Params^[0].Data)));
|
||||
End;
|
||||
|
||||
Procedure _ArcCos(Params : PRutisParamInfoArray; Result : PRutisParamInfo);
|
||||
Begin
|
||||
SetPSingle(Result^.Data, ArcCos(GetPSingle(Params^[0].Data)));
|
||||
End;
|
||||
|
||||
Procedure _Arctan2(Params : PRutisParamInfoArray; Result : PRutisParamInfo);
|
||||
Begin
|
||||
SetPSingle(Result^.Data, Arctan2(GetPSingle(Params^[0].Data), GetPSingle(Params^[1].Data)));
|
||||
End;
|
||||
|
||||
{$ENDREGION}
|
||||
|
||||
//==============================================================================
|
||||
//==============================================================================
|
||||
|
||||
Procedure RegisterEXTMethods(Engine : TRutisEngineBase);
|
||||
Begin
|
||||
//======== Strings ========
|
||||
{$REGION 'Strings'}
|
||||
|
||||
Engine.RegExtMethod('IntToStr',{$IfDef FPC}@{$EndIf}_ToStr, ['Integer'], 'String');
|
||||
Engine.RegExtMethod('FloatToStr',{$IfDef FPC}@{$EndIf}_ToStr, ['Extended'], 'String');
|
||||
Engine.RegExtMethod('StrToInt',{$IfDef FPC}@{$EndIf}_ToInt, ['String'], 'Integer');
|
||||
Engine.RegExtMethod('StrToFloat',{$IfDef FPC}@{$EndIf}_ToFloat, ['String'], 'Extended');
|
||||
Engine.RegExtMethod('DecimalSeparator',{$IfDef FPC}@{$EndIf}_GetDecimalSeparator, [], 'Char');
|
||||
Engine.RegExtMethod('DecimalSeparator',{$IfDef FPC}@{$EndIf}_SetDecimalSeparator, ['Char'], '');
|
||||
|
||||
Engine.RegExtMethod('Chr',{$IfDef FPC}@{$EndIf}_Chr, ['Byte'], 'AnsiChar');
|
||||
Engine.RegExtMethod('Ord',{$IfDef FPC}@{$EndIf}_Ord, ['AnsiChar'], 'Byte');
|
||||
Engine.RegExtMethod('UpperCase',{$IfDef FPC}@{$EndIf}_UpperCase, ['AnsiString'], 'AnsiString');
|
||||
Engine.RegExtMethod('LowerCase',{$IfDef FPC}@{$EndIf}_LowerCase, ['AnsiString'], 'AnsiString');
|
||||
|
||||
Engine.RegExtMethod('StringReplace',{$IfDef FPC}@{$EndIf}_LowerCase, ['AnsiString', 'AnsiString', 'AnsiString', 'Cardinal'], 'AnsiString');
|
||||
|
||||
Engine.RegExtMethod('ExtractFilePath',{$IfDef FPC}@{$EndIf}_ExtractFilePath, ['AnsiString'], 'AnsiString');
|
||||
Engine.RegExtMethod('ExtractFileName',{$IfDef FPC}@{$EndIf}_ExtractFileName, ['AnsiString'], 'AnsiString');
|
||||
Engine.RegExtMethod('ExtractFileExt',{$IfDef FPC}@{$EndIf}_ExtractFileExt, ['AnsiString'], 'AnsiString');
|
||||
Engine.RegExtMethod('ExpandFileName',{$IfDef FPC}@{$EndIf}_ExpandFileName, ['AnsiString'], 'AnsiString');
|
||||
|
||||
{$ENDREGION}
|
||||
|
||||
//======== Internal ========
|
||||
{$REGION 'Internal'}
|
||||
Engine.RegExtMethod('InheritsClass',{$IfDef FPC}@{$EndIf}_InheritsClass, ['TObject', 'TClass'], 'Boolean');
|
||||
{$ENDREGION}
|
||||
|
||||
//======== MATHS ========
|
||||
{$REGION 'Maths'}
|
||||
|
||||
Engine.RegExtMethod('Round',{$IfDef FPC}@{$EndIf}_Round, ['Single'], 'Integer');
|
||||
Engine.RegExtMethod('abs_int',{$IfDef FPC}@{$EndIf}_abs, ['Integer'], 'Integer',
|
||||
'Makes an integer value positive');
|
||||
Engine.RegExtMethod('abs',{$IfDef FPC}@{$EndIf}_abs, ['Double'], 'Double',
|
||||
'Makes a float value positive');
|
||||
|
||||
Engine.RegExtMethod('RandomF',{$IfDef FPC}@{$EndIf}_RandomF, [], 'Double',
|
||||
'Returns a random float value in the Intervall [0..1]');
|
||||
Engine.RegExtMethod('Random',{$IfDef FPC}@{$EndIf}_Random, ['Integer'], 'Integer',
|
||||
'Returns a random Integer number in the Intervall [0..a-1]');
|
||||
|
||||
Engine.RegExtMethod('sin',{$IfDef FPC}@{$EndIf}_sin, ['Single'], 'Single');
|
||||
Engine.RegExtMethod('cos',{$IfDef FPC}@{$EndIf}_cos, ['Single'], 'Single');
|
||||
Engine.RegExtMethod('Arcsin',{$IfDef FPC}@{$EndIf}_Arcsin, ['Single'], 'Single');
|
||||
Engine.RegExtMethod('Arccos',{$IfDef FPC}@{$EndIf}_Arccos, ['Single'], 'Single');
|
||||
Engine.RegExtMethod('Arctan2',{$IfDef FPC}@{$EndIf}_Arctan2, ['Single', 'Single'], 'Single',
|
||||
'Returns the Angle of an triangle with the two given sides');
|
||||
|
||||
Engine.RegExtMethod('sqr',{$IfDef FPC}@{$EndIf}_sqr, ['Single'], 'Single');
|
||||
Engine.RegExtMethod('sqrt',{$IfDef FPC}@{$EndIf}_sqrt, ['Single'], 'Single',
|
||||
'Returns the squareroot of the value');
|
||||
Engine.RegExtMethodV('sqrtvari',{$IfDef FPC}@{$EndIf}_sqrtvari, ['Single'], 'Single',
|
||||
'for testing only');
|
||||
|
||||
{$ENDREGION}
|
||||
|
||||
//======== Properties ========
|
||||
{$REGION 'Properties'}
|
||||
|
||||
Engine.RegExtMethod('SetIntProperty',{$IfDef FPC}@{$EndIf}_SetIntProperty, ['TObject', 'String', 'Integer'], '',
|
||||
'Sets the (Integer) property value for an Object' + sLineBreak +
|
||||
'#1 : Control' + sLineBreak +
|
||||
'#2 : Property-Name' + sLineBreak +
|
||||
'#3 : New Value for Property');
|
||||
Engine.RegExtMethod('GetIntProperty',{$IfDef FPC}@{$EndIf}_GetIntProperty, ['TObject', 'String'], 'Integer',
|
||||
'Returns the (Integer) property value for an Object' + sLineBreak +
|
||||
'#1 : Control' + sLineBreak +
|
||||
'#2 : Property-Name' + sLineBreak +
|
||||
'Returns : Value of Property');
|
||||
|
||||
Engine.RegExtMethod('SetStrProperty',{$IfDef FPC}@{$EndIf}_SetStrProperty, ['TObject', 'String', 'String'], '',
|
||||
'Sets the (String) property value for an Object' + sLineBreak +
|
||||
'#1 : Control' + sLineBreak +
|
||||
'#2 : Property-Name' + sLineBreak +
|
||||
'#3 : New Value for Property');
|
||||
Engine.RegExtMethod('GetStrProperty',{$IfDef FPC}@{$EndIf}_GetStrProperty, ['TObject', 'String'], 'String',
|
||||
'Returns the (String) property value for an Object' + sLineBreak +
|
||||
'#1 : Control' + sLineBreak +
|
||||
'#2 : Property-Name' + sLineBreak +
|
||||
'Returns : Value of Property');
|
||||
|
||||
Engine.RegExtMethod('SetBoolProperty',{$IfDef FPC}@{$EndIf}_SetBoolProperty, ['TObject', 'String', 'Boolean'], '',
|
||||
'Sets the (Boolean) property value for an Object' + sLineBreak +
|
||||
'#1 : Control' + sLineBreak +
|
||||
'#2 : Property-Name' + sLineBreak +
|
||||
'#3 : New Value for Property');
|
||||
Engine.RegExtMethod('GetBoolProperty',{$IfDef FPC}@{$EndIf}_GetBoolProperty, ['TObject', 'String'], 'Boolean',
|
||||
'Returns the (Boolean) property value for an Object' + sLineBreak +
|
||||
'#1 : Control' + sLineBreak +
|
||||
'#2 : Property-Name' + sLineBreak +
|
||||
'Returns : Value of Property');
|
||||
|
||||
{$ENDREGION}
|
||||
|
||||
//======== Files ========
|
||||
{$REGION 'Files'}
|
||||
|
||||
Engine.RegExtMethod('FileExists',{$IfDef FPC}@{$EndIf}_FileExists, ['AnsiString'], 'Boolean');
|
||||
Engine.RegExtMethod('FindFirst',{$IfDef FPC}@{$EndIf}_FindFirst, ['AnsiString', 'Integer', 'PSearchRec'], 'Integer');
|
||||
Engine.RegExtMethod('FindNext',{$IfDef FPC}@{$EndIf}_FindNext, ['PSearchRec'], 'Integer');
|
||||
Engine.RegExtMethod('FindClose',{$IfDef FPC}@{$EndIf}_FindClose, ['PSearchRec'], '');
|
||||
|
||||
{$ENDREGION}
|
||||
|
||||
//======== Windows ========
|
||||
{$REGION 'Windows'}
|
||||
|
||||
{$ifndef FPC}
|
||||
Engine.RegExtMethod('CallDLLProc',{$IfDef FPC}@{$EndIf}_DynCallDLLProc, ['String', 'String', 'Boolean', 'Pointer'], 'Cardinal',
|
||||
'Executes a DLL Method');
|
||||
{$endif}
|
||||
|
||||
Engine.RegExtMethod('GetAsyncKeyState',{$IfDef FPC}@{$EndIf}_GetAsyncKeyState, ['Word'], 'Boolean',
|
||||
'Checks whether a certain key is pressed' + sLineBreak + 'Returns true, if the key was pressed since the last call of GetAsyncKeyState for this key');
|
||||
|
||||
Engine.RegExtMethod('GetTickCount',{$IfDef FPC}@{$EndIf}_GetTickCount, [], 'Cardinal',
|
||||
'Returns the current System-Time in milli-seconds');
|
||||
|
||||
{$ifndef WINCE}
|
||||
Engine.RegExtMethod('Beep',{$IfDef FPC}@{$EndIf}_Beep, ['Cardinal', 'Cardinal'], '');
|
||||
{$endif WINCE}
|
||||
|
||||
Engine.RegExtMethod('Sleep',{$IfDef FPC}@{$EndIf}_Sleep, ['Integer'], '');
|
||||
Engine.RegExtMethod('Delay',{$IfDef FPC}@{$EndIf}_Delay, ['Integer'], '',
|
||||
'Delays the execution of the script for a certain time');
|
||||
|
||||
Engine.RegExtMethod('InputDlg',{$IfDef FPC}@{$EndIf}_InputDlg, ['String', 'String'], 'String',
|
||||
'Shows an Input-Dialog for the user' + sLineBreak +
|
||||
'#1: Question' + sLineBreak +
|
||||
'#2: Default value' + sLineBreak +
|
||||
'Returns the string the user has entered or '' if the' + sLineBreak + 'user has pressed the Cancel-Button');
|
||||
|
||||
Engine.RegExtMethod('RVal',{$IfDef FPC}@{$EndIf}_RVal, ['Cardinal'], 'Byte',
|
||||
'Extracts the Red-Component of a TColor value');
|
||||
Engine.RegExtMethod('GVal',{$IfDef FPC}@{$EndIf}_GVal, ['Cardinal'], 'Byte',
|
||||
'Extracts the Green-Component of a TColor value');
|
||||
Engine.RegExtMethod('BVal',{$IfDef FPC}@{$EndIf}_BVal, ['Cardinal'], 'Byte',
|
||||
'Extracts the Blue-Component of a TColor value');
|
||||
Engine.RegExtMethod('RGB',{$IfDef FPC}@{$EndIf}_RGB, ['Byte', 'Byte', 'Byte'], 'Cardinal',
|
||||
'Creates a TColor Value out of the red, green and blue components');
|
||||
|
||||
{$ENDREGION}
|
||||
End;
|
||||
|
||||
Initialization
|
||||
randomize;
|
||||
End.
|
||||
|
||||
126
Units/RUTIS/Rutis_EXT_Dialogs.pas
Normal file
126
Units/RUTIS/Rutis_EXT_Dialogs.pas
Normal file
@ -0,0 +1,126 @@
|
||||
Unit Rutis_EXT_Dialogs;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
Interface
|
||||
|
||||
Uses
|
||||
Classes, SysUtils,
|
||||
Rutis_Defs,
|
||||
{$IfDef WinCE}WinCE_FileDialog,{$EndIf WinCE}
|
||||
Dialogs;
|
||||
|
||||
Procedure RegisterEXTMethods(MethodList : PExtMethodList);
|
||||
|
||||
Implementation
|
||||
|
||||
Procedure _OpenFileDialog(Stack : PRutisStack; Param0 : Integer; Result : PRutisStackItem);
|
||||
Var
|
||||
{$IfDef WinCE}
|
||||
dlg : TFFileDialog;
|
||||
{$Else WinCE}
|
||||
dlg : TOpenDialog;
|
||||
{$EndIf WinCE}
|
||||
Begin
|
||||
MakeVType(@Stack^[Param0], VString);
|
||||
MakeVType(@Stack^[Param0 + 1], VString);
|
||||
|
||||
Result^.VTyp := VString;
|
||||
New(Result^.VString);
|
||||
|
||||
{$IfDef WinCE}
|
||||
dlg := TFFileDialog.Create(nil);
|
||||
try
|
||||
dlg.FileName := Stack^[Param0].VString^;
|
||||
dlg.ACaption := 'Open File';
|
||||
dlg.Filter := Stack^[Param0+1].VString^;
|
||||
If dlg.Filter = '' then
|
||||
dlg.Filter := 'All Files (*.*)|*.*';
|
||||
If dlg.Execute then
|
||||
Result^.VString^ := dlg.FileName
|
||||
else
|
||||
Result^.VString^ := '';
|
||||
finally
|
||||
dlg.Free;
|
||||
end;
|
||||
|
||||
{$Else WinCE}
|
||||
|
||||
dlg := TOpenDialog.Create(nil);
|
||||
Try
|
||||
dlg.FileName := Stack^[Param0].VString^;
|
||||
dlg.Filter := Stack^[Param0 + 1].VString^;
|
||||
If dlg.Filter = '' Then
|
||||
dlg.Filter := 'All Files (*.*)|*.*';
|
||||
If dlg.Execute Then
|
||||
Result^.VString^ := dlg.FileName
|
||||
Else
|
||||
Result^.VString^ := '';
|
||||
Finally
|
||||
dlg.Free;
|
||||
End;
|
||||
|
||||
{$EndIf WinCE}
|
||||
End;
|
||||
|
||||
Procedure _SaveFileDialog(Stack : PRutisStack; Param0 : Integer; Result : PRutisStackItem);
|
||||
Var
|
||||
{$IfDef WinCE}
|
||||
dlg: TFFileDialog;
|
||||
{$Else WinCE}
|
||||
dlg : TSaveDialog;
|
||||
{$EndIf WinCE}
|
||||
Begin
|
||||
MakeVType(@Stack^[Param0], VString);
|
||||
MakeVType(@Stack^[Param0 + 1], VString);
|
||||
|
||||
Result^.VTyp := VString;
|
||||
New(Result^.VString);
|
||||
{$IfDef WinCE}
|
||||
dlg := TFFileDialog.Create(nil);
|
||||
try
|
||||
dlg.FileName := Stack^[Param0].VString^;
|
||||
dlg.ACaption := 'Open File';
|
||||
dlg.Filter := Stack^[Param0+1].VString^;
|
||||
If dlg.Filter = '' then
|
||||
dlg.Filter := 'All Files (*.*)|*.*';
|
||||
If dlg.Execute then
|
||||
Result^.VString^ := dlg.FileName
|
||||
else
|
||||
Result^.VString^ := '';
|
||||
finally
|
||||
dlg.Free;
|
||||
end;
|
||||
|
||||
{$Else WinCE}
|
||||
|
||||
dlg := TOpenDialog.Create(nil);
|
||||
Try
|
||||
dlg.FileName := Stack^[Param0].VString^;
|
||||
dlg.Filter := Stack^[Param0 + 1].VString^;
|
||||
If dlg.Filter = '' Then
|
||||
dlg.Filter := 'All Files (*.*)|*.*';
|
||||
If dlg.Execute Then
|
||||
Result^.VString^ := dlg.FileName
|
||||
Else
|
||||
Result^.VString^ := '';
|
||||
Finally
|
||||
dlg.Free;
|
||||
End;
|
||||
|
||||
{$EndIf WinCE}
|
||||
End;
|
||||
|
||||
//==============================================================================
|
||||
//==============================================================================
|
||||
|
||||
Procedure RegisterEXTMethods(MethodList : PExtMethodList);
|
||||
Begin
|
||||
RegExtMethod('OpenFileDialog',{$IfDef FPC}@{$EndIf}_OpenFileDialog,
|
||||
[VString, VString], VString, MethodList);
|
||||
RegExtMethod('SaveFileDialog',{$IfDef FPC}@{$EndIf}_SaveFileDialog,
|
||||
[VString, VString], VString, MethodList);
|
||||
End;
|
||||
|
||||
End.
|
||||
|
||||
253
Units/RUTIS/Rutis_EXT_Files.pas
Normal file
253
Units/RUTIS/Rutis_EXT_Files.pas
Normal file
@ -0,0 +1,253 @@
|
||||
Unit Rutis_EXT_Files;
|
||||
|
||||
{$ifdef FPC}
|
||||
{$mode objfpc}
|
||||
{$H+}
|
||||
{$endif}
|
||||
|
||||
Interface
|
||||
|
||||
Uses
|
||||
Windows, Classes, SysUtils,
|
||||
Rutis_Defs, Rutis_Classes, Rutis_Engine;
|
||||
|
||||
Procedure REFiles_CloseFiles;
|
||||
Procedure RegisterEXTMethods(Engine : TRutisEngine);
|
||||
|
||||
//==============================================================================
|
||||
Implementation
|
||||
//==============================================================================
|
||||
|
||||
Type
|
||||
PObject = ^TObject;
|
||||
PFileStream = ^TFileStream;
|
||||
|
||||
Var
|
||||
REFiles_Streams : Array Of TFileStream;
|
||||
|
||||
//==============================================================================
|
||||
|
||||
Procedure REFiles_CloseFiles;
|
||||
Var i : Integer;
|
||||
Begin
|
||||
For i := 0 To high(REFiles_Streams) Do
|
||||
REFiles_Streams[i].Free;
|
||||
SetLength(REFiles_Streams, 0);
|
||||
End;
|
||||
|
||||
//==============================================================================
|
||||
//==============================================================================
|
||||
|
||||
Procedure _StreamCreate(Params : PRutisParamInfoArray; Result : PRutisParamInfo);
|
||||
Begin
|
||||
PPointer(Result^.Data)^ := nil;
|
||||
SetLength(REFiles_Streams, length(REFiles_Streams) + 1);
|
||||
Try
|
||||
REFiles_Streams[high(REFiles_Streams)] := TFileStream.Create(PAnsiString(Params^[0].Data)^, PWord(Params^[1].Data)^); //fmCreate or fmShareDenyWrite
|
||||
Except
|
||||
REFiles_Streams[high(REFiles_Streams)].Free;
|
||||
SetLength(REFiles_Streams, length(REFiles_Streams) - 1);
|
||||
exit;
|
||||
End;
|
||||
PPointer(Result^.Data)^ := REFiles_Streams[high(REFiles_Streams)];
|
||||
End;
|
||||
|
||||
Procedure _StreamClose(Params : PRutisParamInfoArray; Result : PRutisParamInfo);
|
||||
Var i : Integer;
|
||||
Begin
|
||||
For i := 0 To high(REFiles_Streams) Do
|
||||
If REFiles_Streams[i] = PPointer(Params^[0].Data)^ Then
|
||||
Begin
|
||||
REFiles_Streams[i].Free;
|
||||
REFiles_Streams[i] := REFiles_Streams[high(REFiles_Streams)];
|
||||
SetLength(REFiles_Streams, length(REFiles_Streams) - 1);
|
||||
exit;
|
||||
End;
|
||||
End;
|
||||
|
||||
Procedure _StreamGetPosition(Params : PRutisParamInfoArray; Result : PRutisParamInfo);
|
||||
Begin
|
||||
PCardinal(Result^.Data)^ := 0;
|
||||
If PObject(Params^[0].Data)^ = nil Then exit;
|
||||
If not (PObject(Params^[0].Data)^ is TFileStream) Then exit;
|
||||
|
||||
PCardinal(Result^.Data)^ := PFileStream(Params^[0].Data)^.Position;
|
||||
End;
|
||||
|
||||
Procedure _StreamSetPosition(Params : PRutisParamInfoArray; Result : PRutisParamInfo);
|
||||
Begin
|
||||
If PObject(Params^[0].Data)^ = nil Then exit;
|
||||
If not (PObject(Params^[0].Data)^ is TFileStream) Then exit;
|
||||
|
||||
PFileStream(Params^[0].Data)^.Position := PCardinal(Params^[1].Data)^;
|
||||
End;
|
||||
|
||||
Procedure _StreamGetSize(Params : PRutisParamInfoArray; Result : PRutisParamInfo);
|
||||
Begin
|
||||
PCardinal(Result^.Data)^ := 0;
|
||||
If PObject(Params^[0].Data)^ = nil Then exit;
|
||||
If not (PObject(Params^[0].Data)^ is TFileStream) Then exit;
|
||||
|
||||
PCardinal(Result^.Data)^ := PFileStream(Params^[0].Data)^.Size;
|
||||
End;
|
||||
|
||||
Procedure _StreamSetSize(Params : PRutisParamInfoArray; Result : PRutisParamInfo);
|
||||
Begin
|
||||
If PObject(Params^[0].Data)^ = nil Then exit;
|
||||
If not (PObject(Params^[0].Data)^ is TFileStream) Then exit;
|
||||
|
||||
PFileStream(Params^[0].Data)^.Size := PCardinal(Params^[1].Data)^;
|
||||
End;
|
||||
|
||||
//==============================================================================
|
||||
|
||||
Procedure _StreamWriteByte(Params : PRutisParamInfoArray; Result : PRutisParamInfo);
|
||||
Begin
|
||||
PBoolean(Result^.Data)^ := False;
|
||||
If PObject(Params^[0].Data)^ = nil Then exit;
|
||||
If not (PObject(Params^[0].Data)^ is TFileStream) Then exit;
|
||||
|
||||
PFileStream(Params^[0].Data)^.Write(PByte(Params^[1].Data)^, 1);
|
||||
|
||||
PBoolean(Result^.Data)^ := True;
|
||||
End;
|
||||
|
||||
Procedure _StreamWriteWord(Params : PRutisParamInfoArray; Result : PRutisParamInfo);
|
||||
Begin
|
||||
PBoolean(Result^.Data)^ := False;
|
||||
If PObject(Params^[0].Data)^ = nil Then exit;
|
||||
If not (PObject(Params^[0].Data)^ is TFileStream) Then exit;
|
||||
|
||||
PFileStream(Params^[0].Data)^.Write(PWord(Params^[1].Data)^, 2);
|
||||
|
||||
PBoolean(Result^.Data)^ := True;
|
||||
End;
|
||||
|
||||
Procedure _StreamWriteDWord(Params : PRutisParamInfoArray; Result : PRutisParamInfo);
|
||||
Begin
|
||||
PBoolean(Result^.Data)^ := False;
|
||||
If PObject(Params^[0].Data)^ = nil Then exit;
|
||||
If not (PObject(Params^[0].Data)^ is TFileStream) Then exit;
|
||||
|
||||
PFileStream(Params^[0].Data)^.Write(PCardinal(Params^[1].Data)^, 4);
|
||||
|
||||
PBoolean(Result^.Data)^ := True;
|
||||
End;
|
||||
|
||||
Procedure _StreamWriteSingle(Params : PRutisParamInfoArray; Result : PRutisParamInfo);
|
||||
Begin
|
||||
PBoolean(Result^.Data)^ := False;
|
||||
If PObject(Params^[0].Data)^ = nil Then exit;
|
||||
If not (PObject(Params^[0].Data)^ is TFileStream) Then exit;
|
||||
|
||||
PFileStream(Params^[0].Data)^.Write(PCardinal(Params^[1].Data)^, 4);
|
||||
|
||||
PBoolean(Result^.Data)^ := True;
|
||||
End;
|
||||
|
||||
Procedure _StreamWriteString(Params : PRutisParamInfoArray; Result : PRutisParamInfo);
|
||||
Var
|
||||
str : Ansistring;
|
||||
Begin
|
||||
PBoolean(Result^.Data)^ := False;
|
||||
If PObject(Params^[0].Data)^ = nil Then exit;
|
||||
If not (PObject(Params^[0].Data)^ is TFileStream) Then exit;
|
||||
|
||||
str := PAnsiString(Params^[1].Data)^;
|
||||
StreamWriteString(str, PFileStream(Params^[0].Data)^);
|
||||
|
||||
PBoolean(Result^.Data)^ := True;
|
||||
End;
|
||||
|
||||
Procedure _StreamWrite(Params : PRutisParamInfoArray; Result : PRutisParamInfo);
|
||||
Begin
|
||||
PBoolean(Result^.Data)^ := False;
|
||||
If PObject(Params^[0].Data)^ = nil Then exit;
|
||||
If not (PObject(Params^[0].Data)^ is TFileStream) Then exit;
|
||||
|
||||
PFileStream(Params^[0].Data)^.Write(PPChar(Params^[1].Data)^^, PInteger(Params^[2].Data)^);
|
||||
|
||||
PBoolean(Result^.Data)^ := True;
|
||||
End;
|
||||
|
||||
//==============================================================================
|
||||
|
||||
Procedure _StreamReadByte(Params : PRutisParamInfoArray; Result : PRutisParamInfo);
|
||||
Begin
|
||||
PByte(Result^.Data)^ := 0;
|
||||
If PObject(Params^[0].Data)^ = nil Then exit;
|
||||
If not (PObject(Params^[0].Data)^ is TFileStream) Then exit;
|
||||
|
||||
PFileStream(Params^[0].Data)^.Read(PByte(Result^.Data)^, 1);
|
||||
End;
|
||||
|
||||
Procedure _StreamReadWord(Params : PRutisParamInfoArray; Result : PRutisParamInfo);
|
||||
Begin
|
||||
PWord(Result^.Data)^ := 0;
|
||||
If PObject(Params^[0].Data)^ = nil Then exit;
|
||||
If not (PObject(Params^[0].Data)^ is TFileStream) Then exit;
|
||||
|
||||
PFileStream(Params^[0].Data)^.Read(PWord(Result^.Data)^, 2);
|
||||
End;
|
||||
|
||||
Procedure _StreamReadDWord(Params : PRutisParamInfoArray; Result : PRutisParamInfo);
|
||||
Begin
|
||||
PInteger(Result^.Data)^ := 0;
|
||||
If PObject(Params^[0].Data)^ = nil Then exit;
|
||||
If not (PObject(Params^[0].Data)^ is TFileStream) Then exit;
|
||||
|
||||
PFileStream(Params^[0].Data)^.Read(PInteger(Result^.Data)^, 4);
|
||||
End;
|
||||
|
||||
Procedure _StreamReadString(Params : PRutisParamInfoArray; Result : PRutisParamInfo);
|
||||
Begin
|
||||
PAnsiString(Result^.Data)^ := '';
|
||||
If PObject(Params^[0].Data)^ = nil Then exit;
|
||||
If not (PObject(Params^[0].Data)^ is TFileStream) Then exit;
|
||||
|
||||
PAnsiString(Result^.Data)^ := StreamReadString(PFileStream(Params^[0].Data)^);
|
||||
End;
|
||||
|
||||
Procedure _StreamRead(Params : PRutisParamInfoArray; Result : PRutisParamInfo);
|
||||
Begin
|
||||
PByte(Result^.Data)^ := 0;
|
||||
If PObject(Params^[0].Data)^ = nil Then exit;
|
||||
If not (PObject(Params^[0].Data)^ is TFileStream) Then exit;
|
||||
|
||||
PFileStream(Params^[0].Data)^.Read(PPChar(Params^[1].Data)^^, PInteger(Params^[2].Data)^);
|
||||
End;
|
||||
|
||||
//==============================================================================
|
||||
//==============================================================================
|
||||
|
||||
Procedure RegisterEXTMethods(Engine : TRutisEngine);
|
||||
Begin
|
||||
Engine.RegExtMethod('StreamCreate',{$IfDef FPC}@{$EndIf}_StreamCreate, ['String', 'Word'], 'Pointer');
|
||||
Engine.RegExtMethod('StreamClose',{$IfDef FPC}@{$EndIf}_StreamClose, ['Pointer'], 'Pointer');
|
||||
Engine.RegExtMethod('StreamGetPosition',{$IfDef FPC}@{$EndIf}_StreamGetPosition, ['Pointer'], 'Cardinal');
|
||||
Engine.RegExtMethod('StreamSetPosition',{$IfDef FPC}@{$EndIf}_StreamSetPosition, ['Pointer', 'Cardinal'], '');
|
||||
Engine.RegExtMethod('StreamGetSize',{$IfDef FPC}@{$EndIf}_StreamGetSize, ['Pointer'], 'Cardinal');
|
||||
Engine.RegExtMethod('StreamSetSize',{$IfDef FPC}@{$EndIf}_StreamSetSize, ['Pointer', 'Cardinal'], '');
|
||||
|
||||
Engine.RegExtMethod('StreamWriteByte',{$IfDef FPC}@{$EndIf}_StreamWriteByte, ['Pointer', 'Byte'], 'Boolean');
|
||||
Engine.RegExtMethod('StreamWriteWord',{$IfDef FPC}@{$EndIf}_StreamWriteWord, ['Pointer', 'Word'], 'Boolean');
|
||||
Engine.RegExtMethod('StreamWriteInteger',{$IfDef FPC}@{$EndIf}_StreamWriteDWord, ['Pointer', 'Integer'], 'Boolean');
|
||||
Engine.RegExtMethod('StreamWriteCardinal',{$IfDef FPC}@{$EndIf}_StreamWriteDWord, ['Pointer', 'Cardinal'], 'Boolean');
|
||||
Engine.RegExtMethod('StreamWriteSingle',{$IfDef FPC}@{$EndIf}_StreamWriteDWord, ['Pointer', 'Single'], 'Boolean');
|
||||
Engine.RegExtMethod('StreamWriteString',{$IfDef FPC}@{$EndIf}_StreamWriteString, ['Pointer', 'String'], 'Boolean');
|
||||
Engine.RegExtMethod('StreamWrite',{$IfDef FPC}@{$EndIf}_StreamWrite, ['Pointer', 'Pointer', 'Integer'], 'Boolean');
|
||||
|
||||
Engine.RegExtMethod('StreamReadByte',{$IfDef FPC}@{$EndIf}_StreamReadByte, ['Pointer'], 'Byte');
|
||||
Engine.RegExtMethod('StreamReadWord',{$IfDef FPC}@{$EndIf}_StreamReadWord, ['Pointer'], 'Word');
|
||||
Engine.RegExtMethod('StreamReadInteger',{$IfDef FPC}@{$EndIf}_StreamReadDWord, ['Pointer'], 'Integer');
|
||||
Engine.RegExtMethod('StreamReadCardinal',{$IfDef FPC}@{$EndIf}_StreamReadDWord, ['Pointer'], 'Cardinal');
|
||||
Engine.RegExtMethod('StreamReadSingle',{$IfDef FPC}@{$EndIf}_StreamReadDWord, ['Pointer'], 'Single');
|
||||
Engine.RegExtMethod('StreamReadString',{$IfDef FPC}@{$EndIf}_StreamReadString, ['Pointer'], 'String');
|
||||
Engine.RegExtMethod('StreamRead',{$IfDef FPC}@{$EndIf}_StreamRead, ['Pointer', 'Pointer', 'Integer'], 'Boolean');
|
||||
End;
|
||||
|
||||
Initialization
|
||||
Finalization
|
||||
REFiles_CloseFiles;
|
||||
End.
|
||||
|
||||
753
Units/RUTIS/Rutis_EXT_Forms.pas
Normal file
753
Units/RUTIS/Rutis_EXT_Forms.pas
Normal file
@ -0,0 +1,753 @@
|
||||
Unit Rutis_EXT_Forms;
|
||||
|
||||
Interface
|
||||
|
||||
Uses
|
||||
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
|
||||
StdCtrls, ComCtrls, ExtCtrls, TypInfo,
|
||||
Rutis_Engine, Rutis_Defs;
|
||||
|
||||
Type
|
||||
TUnownedForm = Class(TForm)
|
||||
Protected
|
||||
Procedure CreateWnd; Override;
|
||||
End;
|
||||
|
||||
TEXTF_EventType = (
|
||||
etClick, etChange, etResize, etTimer,
|
||||
etMouseDown, etMouseUp, etMouseMove,
|
||||
etKeyPress, etKeyDown, etKeyUp,
|
||||
etNone);
|
||||
Const
|
||||
EventNames : Array [TEXTF_EventType] Of String[64] = (
|
||||
'OnClick', 'OnChange', 'OnResize', 'OnTimer',
|
||||
'OnMouseDown', 'OnMouseUp', 'OnMouseMove',
|
||||
'OnKeyPress', 'OnKeyDown', 'OnKeyUp',
|
||||
'');
|
||||
|
||||
Type
|
||||
TEXTF_EventLink = Record
|
||||
EventType : TEXTF_EventType;
|
||||
Control : TControl;
|
||||
Address : Cardinal;
|
||||
DoCall : Boolean;
|
||||
End;
|
||||
|
||||
PControl = ^TControl;
|
||||
PComponent = ^TComponent;
|
||||
|
||||
TEventContentHolder = Class
|
||||
Public
|
||||
ASender : TObject;
|
||||
AButton : TMouseButton;
|
||||
AShift : TShiftState;
|
||||
AX, AY : Integer;
|
||||
AKey : Word;
|
||||
Procedure OnClick(Sender : TObject);
|
||||
Procedure OnTimer(Sender : TObject);
|
||||
Procedure OnChange(Sender : TObject);
|
||||
Procedure OnResize(Sender : TObject);
|
||||
Procedure OnMouseDown(Sender : TObject; Button : TMouseButton; Shift : TShiftState; X, Y : Integer);
|
||||
Procedure OnMouseUp(Sender : TObject; Button : TMouseButton; Shift : TShiftState; X, Y : Integer);
|
||||
Procedure OnMouseMove(Sender : TObject; Shift : TShiftState; X, Y : Integer);
|
||||
Procedure OnKeyPress(Sender : TObject; Var Key : Char);
|
||||
Procedure OnKeyDown(Sender : TObject; Var Key : Word; Shift : TShiftState);
|
||||
Procedure OnKeyUp(Sender : TObject; Var Key : Word; Shift : TShiftState);
|
||||
End;
|
||||
|
||||
Var
|
||||
EXTF_Forms : Array Of TForm;
|
||||
EXTF_EventLinks : Array Of TEXTF_EventLink;
|
||||
EXTF_Engine : TRutisEngine;
|
||||
|
||||
Const
|
||||
ControlClasses : Array [1..11] Of TControlClass = (
|
||||
TButton, TLabel, TEdit, TPanel, TMemo, TImage,
|
||||
TListBox, TCheckBox, TRadioButton, TComboBox, TScrollBar
|
||||
);
|
||||
ComponentClasses : Array [1..1] Of TComponentClass = (
|
||||
TTimer
|
||||
);
|
||||
|
||||
Procedure RegisterEXTMethods(Engine : TRutisEngine);
|
||||
Procedure EXTF_DestroyRutisForms;
|
||||
Function EXTF_GetEventID(EventType : TEXTF_EventType; Control : TControl) : Integer;
|
||||
//==============================================================================
|
||||
//==============================================================================
|
||||
Implementation
|
||||
|
||||
Var
|
||||
EventContentHolder : TEventContentHolder;
|
||||
EXTF_CurrentForm : TForm;
|
||||
EXTF_CurrentControl : TControl;
|
||||
//==============================================================================
|
||||
//==============================================================================
|
||||
{ TUnownedForm }
|
||||
|
||||
Procedure TUnownedForm.CreateWnd;
|
||||
Var
|
||||
Params : TCreateParams;
|
||||
TempClass : TWndClass;
|
||||
ClassRegistered : Boolean;
|
||||
Begin
|
||||
CreateParams(Params);
|
||||
With Params Do
|
||||
Begin
|
||||
WndParent := 0;
|
||||
DefWndProc := WindowClass.lpfnWndProc;
|
||||
ClassRegistered := GetClassInfo(WindowClass.hInstance, WinClassName, TempClass);
|
||||
If not ClassRegistered or (TempClass.lpfnWndProc <> @InitWndProc) Then
|
||||
Begin
|
||||
If ClassRegistered Then Windows.UnregisterClass(WinClassName,
|
||||
WindowClass.hInstance);
|
||||
WindowClass.lpfnWndProc := @InitWndProc;
|
||||
WindowClass.lpszClassName := WinClassName;
|
||||
If Windows.RegisterClass(WindowClass) = 0 Then RaiseLastOSError;
|
||||
End;
|
||||
CreationControl := Self;
|
||||
CreateWindowHandle(Params);
|
||||
If WindowHandle = 0 Then
|
||||
RaiseLastOSError;
|
||||
If (GetWindowLong(WindowHandle, GWL_STYLE) and WS_CHILD <> 0) and
|
||||
(GetWindowLong(WindowHandle, GWL_ID) = 0) Then
|
||||
SetWindowLong(WindowHandle, GWL_ID, WindowHandle);
|
||||
End;
|
||||
StrDispose(WindowText);
|
||||
WindowText := nil;
|
||||
UpdateBounds;
|
||||
Perform(WM_SETFONT, Font.Handle, 1);
|
||||
If AutoSize Then AdjustSize;
|
||||
End;
|
||||
|
||||
//==============================================================================
|
||||
//==============================================================================
|
||||
|
||||
Procedure EXTF_DestroyRutisForms;
|
||||
Var i : Integer;
|
||||
Begin
|
||||
For I := 0 To high(EXTF_Forms) Do
|
||||
EXTF_Forms[i].Free;
|
||||
SetLength(EXTF_Forms, 0);
|
||||
SetLength(EXTF_EventLinks, 0);
|
||||
End;
|
||||
|
||||
Function EXTF_GetEventID(EventType : TEXTF_EventType; Control : TControl) : Integer;
|
||||
Begin
|
||||
For Result := 0 To high(EXTF_EventLinks) Do
|
||||
If (EXTF_EventLinks[Result].EventType = EventType) and
|
||||
(EXTF_EventLinks[Result].Control = Control) Then
|
||||
exit;
|
||||
Result := -1;
|
||||
End;
|
||||
|
||||
Function EXTF_CallEvents : Boolean;
|
||||
Var
|
||||
i : Integer;
|
||||
CMD : TRutisScriptCmd;
|
||||
Begin
|
||||
Result := False;
|
||||
For i := 0 To high(EXTF_EventLinks) Do
|
||||
If EXTF_EventLinks[i].DoCall Then
|
||||
Begin
|
||||
Result := True;
|
||||
EXTF_EventLinks[i].DoCall := False;
|
||||
|
||||
{CMD.Cmd := _Gen4;
|
||||
CMD.P1 := EXTF_EventLinks[i].Address;
|
||||
CMD.P2 := 0;
|
||||
CMD.P3 := 0;
|
||||
EXTF_Engine.ExecuteCMD(CMD);}
|
||||
|
||||
CMD.Cmd := _Call;
|
||||
CMD.P1 := EXTF_EventLinks[i].Address;
|
||||
CMD.P2 := 1;
|
||||
CMD.P3 := 0;
|
||||
EXTF_Engine.ExecuteCMD(CMD);
|
||||
End;
|
||||
End;
|
||||
|
||||
Procedure RegisterObjectEvent(Obj : TObject; EventName : String; Adr : Pointer);
|
||||
Var
|
||||
PropInfo : PPropInfo;
|
||||
AMethod : TMethod;
|
||||
Begin
|
||||
AMethod.Code := Adr;
|
||||
AMethod.Data := EventContentHolder;
|
||||
Try
|
||||
PropInfo := GetPropInfo(Obj, EventName);
|
||||
If PropInfo <> nil Then
|
||||
SetMethodProp(Obj, PropInfo, AMethod);
|
||||
Except
|
||||
End;
|
||||
End;
|
||||
|
||||
//==============================================================================
|
||||
//==============================================================================
|
||||
|
||||
//TEXTF_EventType = (etClick, etMouseDown, etMouseUp, etChange, etKeyPress, etKeyDown, etKeyUp);
|
||||
Procedure TEventContentHolder.OnChange(Sender : TObject);
|
||||
Var id : Integer;
|
||||
Begin
|
||||
ASender := Sender;
|
||||
id := EXTF_GetEventID(etChange, TControl(Sender));
|
||||
If id > -1 Then
|
||||
EXTF_EventLinks[id].DoCall := True;
|
||||
End;
|
||||
|
||||
procedure TEventContentHolder.OnTimer(Sender: TObject);
|
||||
Var id : Integer;
|
||||
Begin
|
||||
ASender := Sender;
|
||||
id := EXTF_GetEventID(etTimer, TControl(Sender));
|
||||
If id > -1 Then
|
||||
EXTF_EventLinks[id].DoCall := True;
|
||||
end;
|
||||
|
||||
Procedure TEventContentHolder.OnClick(Sender : TObject);
|
||||
Var id : Integer;
|
||||
Begin
|
||||
ASender := Sender;
|
||||
id := EXTF_GetEventID(etClick, TControl(Sender));
|
||||
If id > -1 Then
|
||||
EXTF_EventLinks[id].DoCall := True;
|
||||
End;
|
||||
|
||||
Procedure TEventContentHolder.OnResize(Sender : TObject);
|
||||
Var id : Integer;
|
||||
Begin
|
||||
ASender := Sender;
|
||||
id := EXTF_GetEventID(etResize, TControl(Sender));
|
||||
If id > -1 Then
|
||||
EXTF_EventLinks[id].DoCall := True;
|
||||
End;
|
||||
|
||||
Procedure TEventContentHolder.OnMouseDown(Sender : TObject; Button : TMouseButton; Shift : TShiftState; X, Y : Integer);
|
||||
Var id : Integer;
|
||||
Begin
|
||||
ASender := Sender;
|
||||
AButton := Button;
|
||||
AShift := Shift;
|
||||
AX := X;
|
||||
AY := Y;
|
||||
id := EXTF_GetEventID(etMouseDown, TControl(Sender));
|
||||
If id > -1 Then
|
||||
EXTF_EventLinks[id].DoCall := True;
|
||||
End;
|
||||
|
||||
Procedure TEventContentHolder.OnMouseUp(Sender : TObject; Button : TMouseButton; Shift : TShiftState; X, Y : Integer);
|
||||
Var id : Integer;
|
||||
Begin
|
||||
ASender := Sender;
|
||||
AButton := Button;
|
||||
AShift := Shift;
|
||||
AX := X;
|
||||
AY := Y;
|
||||
id := EXTF_GetEventID(etMouseUp, TControl(Sender));
|
||||
If id > -1 Then
|
||||
EXTF_EventLinks[id].DoCall := True;
|
||||
End;
|
||||
|
||||
Procedure TEventContentHolder.OnMouseMove(Sender : TObject; Shift : TShiftState; X, Y : Integer);
|
||||
Var id : Integer;
|
||||
Begin
|
||||
ASender := Sender;
|
||||
AShift := Shift;
|
||||
AX := X;
|
||||
AY := Y;
|
||||
id := EXTF_GetEventID(etMouseMove, TControl(Sender));
|
||||
If id > -1 Then
|
||||
EXTF_EventLinks[id].DoCall := True;
|
||||
End;
|
||||
|
||||
Procedure TEventContentHolder.OnKeyPress(Sender : TObject; Var Key : Char);
|
||||
Var id : Integer;
|
||||
Begin
|
||||
ASender := Sender;
|
||||
AKey := Word(Key);
|
||||
id := EXTF_GetEventID(etKeyPress, TControl(Sender));
|
||||
If id > -1 Then
|
||||
EXTF_EventLinks[id].DoCall := True;
|
||||
End;
|
||||
|
||||
Procedure TEventContentHolder.OnKeyDown(Sender : TObject; Var Key : Word; Shift : TShiftState);
|
||||
Var id : Integer;
|
||||
Begin
|
||||
ASender := Sender;
|
||||
AKey := Key;
|
||||
AShift := Shift;
|
||||
id := EXTF_GetEventID(etKeyDown, TControl(Sender));
|
||||
If id > -1 Then
|
||||
EXTF_EventLinks[id].DoCall := True;
|
||||
End;
|
||||
|
||||
Procedure TEventContentHolder.OnKeyUp(Sender : TObject; Var Key : Word; Shift : TShiftState);
|
||||
Var id : Integer;
|
||||
Begin
|
||||
ASender := Sender;
|
||||
AKey := Key;
|
||||
AShift := Shift;
|
||||
id := EXTF_GetEventID(etKeyUp, TControl(Sender));
|
||||
If id > -1 Then
|
||||
EXTF_EventLinks[id].DoCall := True;
|
||||
End;
|
||||
|
||||
//==============================================================================
|
||||
//==============================================================================
|
||||
|
||||
Procedure _CreateForm(Params : PRutisParamInfoArray; Result : PRutisParamInfo);
|
||||
Var
|
||||
Form : TForm;
|
||||
Begin
|
||||
Form := TUnownedForm.CreateNew(nil);
|
||||
|
||||
Form.Hide;
|
||||
Form.Caption := 'RUTIS Formular';
|
||||
Form.BorderStyle := bsSizeable;
|
||||
Form.Position := poScreenCenter;
|
||||
If PBoolean(Params^[0].Data)^ Then
|
||||
Form.Show;
|
||||
|
||||
EXTF_CurrentForm := Form;
|
||||
EXTF_CurrentControl := EXTF_CurrentForm;
|
||||
|
||||
SetLength(EXTF_Forms, length(EXTF_Forms) + 1);
|
||||
EXTF_Forms[high(EXTF_Forms)] := Form;
|
||||
|
||||
PPointer(Result^.Data)^ := Form;
|
||||
End;
|
||||
|
||||
Procedure _CreateControl(Params : PRutisParamInfoArray; Result : PRutisParamInfo);
|
||||
Var
|
||||
ClassName : String;
|
||||
Control : TControl;
|
||||
ControlParent : TControl;
|
||||
i : Integer;
|
||||
Begin
|
||||
Control := nil;
|
||||
PControl(Result^.Data)^ := Control;
|
||||
ClassName := LowerCase(PAnsiString(Params^[1].Data)^);
|
||||
ControlParent := PControl(Params^[0].Data)^;
|
||||
If ControlParent = nil Then ControlParent := EXTF_CurrentControl;
|
||||
|
||||
For I := Low(ControlClasses) To high(ControlClasses) Do
|
||||
If ClassName = LowerCase(ControlClasses[i].ClassName) Then
|
||||
Control := ControlClasses[i].Create(ControlParent);
|
||||
If Control = nil Then exit;
|
||||
|
||||
While not (ControlParent is TWinControl) Do
|
||||
ControlParent := ControlParent.Parent;
|
||||
Control.Parent := TWinControl(ControlParent);
|
||||
|
||||
PControl(Result^.Data)^ := Control;
|
||||
End;
|
||||
|
||||
Procedure _CreateComponent(Params : PRutisParamInfoArray; Result : PRutisParamInfo);
|
||||
Var
|
||||
ClassName : String;
|
||||
Component : TComponent;
|
||||
ComponentParent : TControl;
|
||||
i : Integer;
|
||||
Begin
|
||||
Component := nil;
|
||||
PComponent(Result^.Data)^ := nil;
|
||||
ClassName := LowerCase(PAnsiString(Params^[1].Data)^);
|
||||
ComponentParent := PControl(Params^[0].Data)^;
|
||||
If ComponentParent = nil Then ComponentParent := EXTF_CurrentControl;
|
||||
|
||||
For I := Low(ComponentClasses) To high(ComponentClasses) Do
|
||||
If ClassName = LowerCase(ComponentClasses[i].ClassName) Then
|
||||
Component := ComponentClasses[i].Create(ComponentParent);
|
||||
If Component = nil Then exit;
|
||||
|
||||
PComponent(Result^.Data)^ := Component;
|
||||
End;
|
||||
|
||||
Procedure _DestroyControl(Params : PRutisParamInfoArray; Result : PRutisParamInfo);
|
||||
Var
|
||||
i : Integer;
|
||||
Control : TControl;
|
||||
Begin
|
||||
Control := TControl(PPointer(Params^[0].Data)^);
|
||||
For I := 0 To high(EXTF_Forms) Do
|
||||
If EXTF_Forms[i] = Control Then
|
||||
Begin
|
||||
EXTF_Forms[i] := EXTF_Forms[high(EXTF_Forms)];
|
||||
SetLength(EXTF_Forms, length(EXTF_Forms) - 1);
|
||||
break;
|
||||
End;
|
||||
Control.Free;
|
||||
End;
|
||||
|
||||
Procedure _RegisterEvent(Params : PRutisParamInfoArray; Result : PRutisParamInfo);
|
||||
Var
|
||||
EName : String;
|
||||
EType : TEXTF_EventType;
|
||||
Crtl : TControl;
|
||||
I : Integer;
|
||||
Begin
|
||||
Crtl := PControl(Params^[0].Data)^;
|
||||
EName := LowerCase(PAnsiString(Params^[1].Data)^);
|
||||
|
||||
For EType := TEXTF_EventType(0) To etNone Do
|
||||
If LowerCase(EventNames[EType]) = EName Then
|
||||
break;
|
||||
If EType = etNone Then exit;
|
||||
|
||||
RegisterObjectEvent(Crtl, 'Onclick', @TEventCOntentHolder.Onclick);
|
||||
RegisterObjectEvent(Crtl, 'OnChange', @TEventCOntentHolder.OnChange);
|
||||
RegisterObjectEvent(Crtl, 'OnResize', @TEventCOntentHolder.OnResize);
|
||||
RegisterObjectEvent(Crtl, 'OnTimer', @TEventCOntentHolder.OnTimer);
|
||||
RegisterObjectEvent(Crtl, 'OnMousedown', @TEventCOntentHolder.OnMousedown);
|
||||
RegisterObjectEvent(Crtl, 'OnMouseup', @TEventCOntentHolder.OnMouseup);
|
||||
RegisterObjectEvent(Crtl, 'OnMouseMove', @TEventCOntentHolder.OnMouseMove);
|
||||
RegisterObjectEvent(Crtl, 'OnKeypress', @TEventCOntentHolder.OnKeypress);
|
||||
RegisterObjectEvent(Crtl, 'OnKeydown', @TEventCOntentHolder.OnKeydown);
|
||||
RegisterObjectEvent(Crtl, 'OnKeyup', @TEventCOntentHolder.OnKeyup);
|
||||
|
||||
For I := 0 To high(EXTF_EventLinks) Do
|
||||
If (EXTF_EventLinks[i].Control = Crtl) and
|
||||
(EXTF_EventLinks[i].EventType = EType) Then
|
||||
Begin
|
||||
If PCardinal(Params^[2].Data)^ = 0 Then
|
||||
Begin
|
||||
EXTF_EventLinks[i] := EXTF_EventLinks[high(EXTF_EventLinks)];
|
||||
SetLength(EXTF_EventLinks, length(EXTF_EventLinks) - 1);
|
||||
exit;
|
||||
End;
|
||||
EXTF_EventLinks[i].Address := PCardinal(Params^[2].Data)^;
|
||||
exit;
|
||||
End;
|
||||
|
||||
SetLength(EXTF_EventLinks, length(EXTF_EventLinks) + 1);
|
||||
With EXTF_EventLinks[high(EXTF_EventLinks)] Do
|
||||
Begin
|
||||
Control := Crtl;
|
||||
Address := PCardinal(Params^[2].Data)^;
|
||||
EventType := EType;
|
||||
DoCall := False;
|
||||
End;
|
||||
End;
|
||||
|
||||
Procedure _CallEvents(Params : PRutisParamInfoArray; Result : PRutisParamInfo);
|
||||
Begin
|
||||
EXTF_CallEvents;
|
||||
End;
|
||||
|
||||
Procedure _WaitForEvent(Params : PRutisParamInfoArray; Result : PRutisParamInfo);
|
||||
Begin
|
||||
While not EXTF_CallEvents Do
|
||||
Begin
|
||||
Application.ProcessMessages;
|
||||
sleep(10);
|
||||
End;
|
||||
End;
|
||||
|
||||
Procedure _EventParamX(Params : PRutisParamInfoArray; Result : PRutisParamInfo);
|
||||
Begin
|
||||
PInteger(Result^.Data)^ := EventContentHolder.Ax;
|
||||
End;
|
||||
|
||||
Procedure _EventParamY(Params : PRutisParamInfoArray; Result : PRutisParamInfo);
|
||||
Begin
|
||||
PInteger(Result^.Data)^ := EventContentHolder.Ay;
|
||||
End;
|
||||
|
||||
Procedure _EventParamSender(Params : PRutisParamInfoArray; Result : PRutisParamInfo);
|
||||
Begin
|
||||
TObject(PPointer(Result^.Data)^) := EventContentHolder.ASender;
|
||||
End;
|
||||
|
||||
Procedure _EventKey(Params : PRutisParamInfoArray; Result : PRutisParamInfo);
|
||||
Begin
|
||||
PWord(Result^.Data)^ := EventContentHolder.AKey;
|
||||
End;
|
||||
|
||||
Procedure _EventParamShiftState(Params : PRutisParamInfoArray; Result : PRutisParamInfo);
|
||||
Type
|
||||
PShiftState = ^TShiftState;
|
||||
Begin
|
||||
PShiftState(Result^.Data)^ := EventContentHolder.AShift;
|
||||
End;
|
||||
|
||||
Procedure _EventParamIsControl(Params : PRutisParamInfoArray; Result : PRutisParamInfo);
|
||||
Begin
|
||||
PBoolean(Result^.Data)^ := ssCtrl in EventContentHolder.AShift;
|
||||
End;
|
||||
|
||||
Procedure _EventParamIsAlt(Params : PRutisParamInfoArray; Result : PRutisParamInfo);
|
||||
Begin
|
||||
PBoolean(Result^.Data)^ := ssAlt in EventContentHolder.AShift;
|
||||
End;
|
||||
|
||||
Procedure _EventParamIsShift(Params : PRutisParamInfoArray; Result : PRutisParamInfo);
|
||||
Begin
|
||||
PBoolean(Result^.Data)^ := ssShift in EventContentHolder.AShift;
|
||||
End;
|
||||
|
||||
Procedure _EventParamIsLeft(Params : PRutisParamInfoArray; Result : PRutisParamInfo);
|
||||
Begin
|
||||
PBoolean(Result^.Data)^ := ssLeft in EventContentHolder.AShift;
|
||||
End;
|
||||
|
||||
Procedure _EventParamIsRight(Params : PRutisParamInfoArray; Result : PRutisParamInfo);
|
||||
Begin
|
||||
PBoolean(Result^.Data)^ := ssRight in EventContentHolder.AShift;
|
||||
End;
|
||||
|
||||
Procedure _EventParamIsMiddle(Params : PRutisParamInfoArray; Result : PRutisParamInfo);
|
||||
Begin
|
||||
PBoolean(Result^.Data)^ := ssMiddle in EventContentHolder.AShift;
|
||||
End;
|
||||
|
||||
//==============================================================================
|
||||
//==============================================================================
|
||||
|
||||
Procedure _SetPos(Params : PRutisParamInfoArray; Result : PRutisParamInfo);
|
||||
Var
|
||||
Control : TControl;
|
||||
Begin
|
||||
Control := PControl(Params^[0].Data)^;
|
||||
If Control is TControl Then
|
||||
Begin
|
||||
Control.Left := PInteger(Params^[1].Data)^;
|
||||
Control.Top := PInteger(Params^[2].Data)^;
|
||||
End;
|
||||
End;
|
||||
|
||||
Procedure _SetSize(Params : PRutisParamInfoArray; Result : PRutisParamInfo);
|
||||
Var
|
||||
Control : TControl;
|
||||
Begin
|
||||
Control := PControl(Params^[0].Data)^;
|
||||
If Control is TForm Then
|
||||
Begin
|
||||
TForm(Control).ClientWidth := PInteger(Params^[1].Data)^;
|
||||
TForm(Control).ClientHeight := PInteger(Params^[2].Data)^;
|
||||
exit;
|
||||
End;
|
||||
If Control is TControl Then
|
||||
Begin
|
||||
Control.Width := PInteger(Params^[1].Data)^;
|
||||
Control.Height := PInteger(Params^[2].Data)^;
|
||||
End;
|
||||
End;
|
||||
|
||||
Procedure _SetVisibility(Params : PRutisParamInfoArray; Result : PRutisParamInfo);
|
||||
Var
|
||||
Control : TControl;
|
||||
Begin
|
||||
Control := TControl(PPointer(Params^[0].Data)^);
|
||||
Control.Visible := PBoolean(Params^[0].Data)^;
|
||||
End;
|
||||
|
||||
Procedure _GetVisibility(Params : PRutisParamInfoArray; Result : PRutisParamInfo);
|
||||
Var
|
||||
Control : TControl;
|
||||
Begin
|
||||
Control := TControl(PPointer(Params^[0].Data)^);
|
||||
PBoolean(Result^.Data)^ := Control.Visible;
|
||||
End;
|
||||
|
||||
Procedure _GetDC(Params : PRutisParamInfoArray; Result : PRutisParamInfo);
|
||||
Begin
|
||||
PCardinal(Result^.Data)^ := GetDC(PCardinal(Params^[0].Data)^);
|
||||
End;
|
||||
|
||||
Procedure _GetHandle(Params : PRutisParamInfoArray; Result : PRutisParamInfo);
|
||||
Var
|
||||
Control : TControl;
|
||||
Begin
|
||||
Control := PControl(Params^[0].Data)^;
|
||||
If Control is TWinControl Then
|
||||
PCardinal(Result^.Data)^ := TWinControl(Control).Handle
|
||||
Else
|
||||
If Control is TControl Then
|
||||
PCardinal(Result^.Data)^ := Control.Parent.Handle;
|
||||
End;
|
||||
|
||||
Procedure _AddLine(Params : PRutisParamInfoArray; Result : PRutisParamInfo);
|
||||
Var
|
||||
Control : TControl;
|
||||
Begin
|
||||
Control := PControl(Params^[0].Data)^;
|
||||
If Control is TCustomListBox Then
|
||||
TCustomListBox(Control).Items.Add(PAnsiString(Params^[1].Data)^);
|
||||
If Control is TCustomMemo Then
|
||||
TCustomMemo(Control).Lines.Add(PAnsiString(Params^[1].Data)^);
|
||||
End;
|
||||
|
||||
Procedure _InsertLine(Params : PRutisParamInfoArray; Result : PRutisParamInfo);
|
||||
Var
|
||||
Control : TControl;
|
||||
Begin
|
||||
Control := PControl(Params^[0].Data)^;
|
||||
If Control is TCustomListBox Then
|
||||
TCustomListBox(Control).Items.Insert(PInteger(Params^[1].Data)^, PAnsiString(Params^[2].Data)^);
|
||||
If Control is TCustomMemo Then
|
||||
TCustomMemo(Control).Lines.Insert(PInteger(Params^[1].Data)^, PAnsiString(Params^[2].Data)^);
|
||||
End;
|
||||
|
||||
Procedure _DeleteLine(Params : PRutisParamInfoArray; Result : PRutisParamInfo);
|
||||
Var
|
||||
Control : TControl;
|
||||
Begin
|
||||
Control := PControl(Params^[0].Data)^;
|
||||
If Control is TCustomListBox Then
|
||||
TCustomListBox(Control).Items.Delete(PInteger(Params^[1].Data)^);
|
||||
If Control is TCustomMemo Then
|
||||
TCustomMemo(Control).Lines.Delete(PInteger(Params^[1].Data)^);
|
||||
End;
|
||||
|
||||
Procedure _SetLine(Params : PRutisParamInfoArray; Result : PRutisParamInfo);
|
||||
Var
|
||||
Control : TControl;
|
||||
Begin
|
||||
Control := PControl(Params^[0].Data)^;
|
||||
If Control is TCustomListBox Then
|
||||
TCustomListBox(Control).Items[PInteger(Params^[1].Data)^] := PAnsiString(Params^[2].Data)^;
|
||||
If Control is TCustomMemo Then
|
||||
TCustomMemo(Control).Lines[PInteger(Params^[1].Data)^] := PAnsiString(Params^[2].Data)^;
|
||||
End;
|
||||
|
||||
Procedure _SetLineCount(Params : PRutisParamInfoArray; Result : PRutisParamInfo);
|
||||
Var
|
||||
Control : TControl;
|
||||
Begin
|
||||
Control := PControl(Params^[0].Data)^;
|
||||
If Control is TCustomListBox Then
|
||||
While TCustomListBox(Control).Items.Count > PInteger(Params^[1].Data)^ Do
|
||||
TCustomListBox(Control).Items.Delete(TCustomListBox(Control).Items.Count - 1);
|
||||
If Control is TCustomMemo Then
|
||||
While TCustomMemo(Control).Lines.Count > PInteger(Params^[1].Data)^ Do
|
||||
TCustomMemo(Control).Lines.Delete(TCustomMemo(Control).Lines.Count - 1);
|
||||
End;
|
||||
|
||||
//==============================================================================
|
||||
//==============================================================================
|
||||
|
||||
Procedure RegisterEXTMethods(Engine : TRutisEngine);
|
||||
Var
|
||||
Decl : TRutisVarType;
|
||||
Begin
|
||||
OutputDebugString(PChar('Rutis_EXT_Formulars.RegisterEXTMethods - Registering RUTIS Formular Support'));
|
||||
|
||||
Engine.RegExtMethod('CreateForm',{$IfDef FPC}@{$EndIf}_CreateForm, ['Boolean'], 'TControl',
|
||||
'Creates a RUTIS-Form' + sLineBreak +
|
||||
'#1: Visibility of form after creation' + sLineBreak +
|
||||
'Returns: Created form');
|
||||
Engine.RegExtMethod('CrtlCreate',{$IfDef FPC}@{$EndIf}_CreateControl, ['TControl', 'String'], 'TControl',
|
||||
'Creates a new Control' + sLineBreak +
|
||||
'#1 : Owner for the new Control' + sLineBreak +
|
||||
'#2 : Class-Name of the new Control' + sLineBreak +
|
||||
'Returns: Created object');
|
||||
Engine.RegExtMethod('CrtlCreateComponent',{$IfDef FPC}@{$EndIf}_CreateComponent, ['TComponent', 'String'], 'TComponent',
|
||||
'Creates a new Component' + sLineBreak +
|
||||
'#1 : Owner for the new Component' + sLineBreak +
|
||||
'#2 : Class-Name of the new Component' + sLineBreak +
|
||||
'Returns: Created Component');
|
||||
Engine.RegExtMethod('CrtlDestroy',{$IfDef FPC}@{$EndIf}_DestroyControl, [], 'TControl',
|
||||
'Destroys a Control');
|
||||
|
||||
Engine.RegExtMethod('CrtlRegisterEvent',{$IfDef FPC}@{$EndIf}_RegisterEvent, ['TControl', 'String', 'Method'], '',
|
||||
'Registers an Event' + sLineBreak +
|
||||
'#1 : Control' + sLineBreak +
|
||||
'#2 : Event Name' + sLineBreak +
|
||||
'#3 : Event Handler' + sLineBreak +
|
||||
'Possible Values for #2 are:' + sLineBreak +
|
||||
'- OnClick, OnMouseDown, OnMouseUp, OnMouseMove,' + sLineBreak +
|
||||
'- OnChange,' + sLineBreak +
|
||||
'- OnKeyPress, OnKeyDown, OnKeyUp');
|
||||
Engine.RegExtMethod('CallEvents',{$IfDef FPC}@{$EndIf}_CallEvents, [], '',
|
||||
'Calls all activated events' + sLineBreak +
|
||||
'You need to link events to actions with RegisterEvent first');
|
||||
Engine.RegExtMethod('WaitForEvent',{$IfDef FPC}@{$EndIf}_WaitForEvent, [], '',
|
||||
'Waits for any Event to happen' + sLineBreak +
|
||||
'You need to link events to actions with RegisterEvent first');
|
||||
|
||||
Engine.RegExtMethod('EventParamX',{$IfDef FPC}@{$EndIf}_EventParamX, [], 'Integer',
|
||||
'Returns the "X" parameter of an occurred event');
|
||||
Engine.RegExtMethod('EventParamY',{$IfDef FPC}@{$EndIf}_EventParamY, [], 'Integer',
|
||||
'Returns the "Y" parameter of an occurred event');
|
||||
Engine.RegExtMethod('EventParamSender',{$IfDef FPC}@{$EndIf}_EventParamSender, [], 'TControl',
|
||||
'Returns the "Sender" parameter of an occurred event');
|
||||
Engine.RegExtMethod('EventParamKey',{$IfDef FPC}@{$EndIf}_EventKey, [], 'Word',
|
||||
'Returns the "Key" parameter of an occurred event');
|
||||
Engine.RegExtMethod('EventParamShiftState',{$IfDef FPC}@{$EndIf}_EventParamShiftState, [], 'Cardinal',
|
||||
'Returns the "ShiftState" parameter of an occurred event');
|
||||
Engine.RegExtMethod('EventParamIsControl',{$IfDef FPC}@{$EndIf}_EventParamIsControl, [], 'Boolean',
|
||||
'Returns true, if "ssCrtl" is in he ShiftState parameter of an occurred event');
|
||||
Engine.RegExtMethod('EventParamIsAlt',{$IfDef FPC}@{$EndIf}_EventParamIsAlt, [], 'Boolean',
|
||||
'Returns true, if "ssAlt" is in he ShiftState parameter of an occurred event');
|
||||
Engine.RegExtMethod('EventParamIsShift',{$IfDef FPC}@{$EndIf}_EventParamIsShift, [], 'Boolean',
|
||||
'Returns true, if "ssShift" is in he ShiftState parameter of an occurred event');
|
||||
Engine.RegExtMethod('EventParamIsLeft',{$IfDef FPC}@{$EndIf}_EventParamIsLeft, [], 'Boolean',
|
||||
'Returns true, if "ssLeft" is in he ShiftState parameter of an occurred event');
|
||||
Engine.RegExtMethod('EventParamIsRight',{$IfDef FPC}@{$EndIf}_EventParamIsRight, [], 'Boolean',
|
||||
'Returns true, if "ssRight" is in he ShiftState parameter of an occurred event');
|
||||
Engine.RegExtMethod('EventParamIsMiddle',{$IfDef FPC}@{$EndIf}_EventParamIsMiddle, [], 'Boolean',
|
||||
'Returns true, if "ssMiddle" is in he ShiftState parameter of an occurred event');
|
||||
|
||||
Engine.RegExtMethod('CrtlSetVisibility',{$IfDef FPC}@{$EndIf}_SetVisibility, ['TControl', 'Boolean'], '',
|
||||
'Sets the Visibility of an Control' + sLineBreak +
|
||||
'#1 : Control' + sLineBreak +
|
||||
'#2 : Visibility');
|
||||
Engine.RegExtMethod('CrtlGetVisibility',{$IfDef FPC}@{$EndIf}_GetVisibility, ['TControl'], 'Boolean',
|
||||
'Sets the Visibility of an Control' + sLineBreak +
|
||||
'#1 : Control' + sLineBreak +
|
||||
'Returns : Visibility of the Control');
|
||||
Engine.RegExtMethod('CrtlSetPos',{$IfDef FPC}@{$EndIf}_SetPos, ['TControl', 'Integer', 'Integer'], '',
|
||||
'Sets the Position of an Control' + sLineBreak +
|
||||
'#1 : Control' + sLineBreak +
|
||||
'#2 : Left' + sLineBreak +
|
||||
'#3 : Top');
|
||||
Engine.RegExtMethod('CrtlSetSize',{$IfDef FPC}@{$EndIf}_SetSize, ['TControl', 'Integer', 'Integer'], '',
|
||||
'Sets the Position of an Control' + sLineBreak +
|
||||
'#1 : Control' + sLineBreak +
|
||||
'#2 : Width' + sLineBreak +
|
||||
'#3 : Height');
|
||||
|
||||
Engine.RegExtMethod('GetDC',{$IfDef FPC}@{$EndIf}_GetDC, ['Cardinal'], 'Cardinal',
|
||||
'Returns the DeviceContext for a specific Handle' + sLineBreak +
|
||||
'#1 : Handle' + sLineBreak +
|
||||
'Returns : DC');
|
||||
Engine.RegExtMethod('GetHandle',{$IfDef FPC}@{$EndIf}_GetHandle, ['TControl'], 'Cardinal',
|
||||
'Returns the Handle of a control (e.g. for GetDC)' + sLineBreak +
|
||||
'#1 : Control' + sLineBreak +
|
||||
'Returns : Handle');
|
||||
|
||||
Engine.RegExtMethod('CrtlAddLine',{$IfDef FPC}@{$EndIf}_AddLine, ['TControl', 'String'], '',
|
||||
'Adds a new Line/Item in TMemo/TListBox/etc.' + sLineBreak +
|
||||
'#1 : Control' + sLineBreak +
|
||||
'#2 : Line to add');
|
||||
Engine.RegExtMethod('CrtlInsertLine',{$IfDef FPC}@{$EndIf}_InsertLine, ['TControl', 'Integer', 'String'], '',
|
||||
'Adds a new Line/Item in TMemo/TListBox/etc.' + sLineBreak +
|
||||
'#1 : Control' + sLineBreak +
|
||||
'#2 : Insert place' + sLineBreak +
|
||||
'#3 : Line to add');
|
||||
|
||||
Engine.RegExtMethod('CrtlDeleteLine',{$IfDef FPC}@{$EndIf}_DeleteLine, ['TControl', 'Integer'], '',
|
||||
'Deletes a Line/Item in TMemo/TListBox/etc.' + sLineBreak +
|
||||
'#1 : Control' + sLineBreak +
|
||||
'#2 : Line to delete');
|
||||
Engine.RegExtMethod('CrtlSetLine',{$IfDef FPC}@{$EndIf}_SetLine, ['TControl', 'Integer', 'String'], '',
|
||||
'Sets the text of a Line/Item in TMemo/TListBox/etc.' + sLineBreak +
|
||||
'#1 : Control' + sLineBreak +
|
||||
'#2 : Line' + sLineBreak +
|
||||
'#2 : New text');
|
||||
Engine.RegExtMethod('CrtlSetLineCount',{$IfDef FPC}@{$EndIf}_SetLineCount, ['TControl', 'Integer'], '',
|
||||
'Sets the number of Lines/Items in TMemo/TListBox/etc.' + sLineBreak +
|
||||
'#1 : Control' + sLineBreak +
|
||||
'#2 : Line-count'); //CrtlSetLineCount
|
||||
|
||||
OutputDebugString(PChar('Rutis_EXT_Formulars.RegisterEXTMethods - Successfully registered RUTIS Formular Support'));
|
||||
End;
|
||||
|
||||
//==============================================================================
|
||||
//==============================================================================
|
||||
|
||||
Initialization
|
||||
EventContentHolder := TEventContentHolder.Create;
|
||||
Finalization
|
||||
EventContentHolder.Free;
|
||||
End.
|
||||
|
||||
1049
Units/RUTIS/Rutis_EXT_OpenGl.pas
Normal file
1049
Units/RUTIS/Rutis_EXT_OpenGl.pas
Normal file
File diff suppressed because it is too large
Load Diff
2278
Units/RUTIS/Rutis_Engine.pas
Normal file
2278
Units/RUTIS/Rutis_Engine.pas
Normal file
File diff suppressed because it is too large
Load Diff
1028
Units/RUTIS/Rutis_ExtDll_OpenGl.pas
Normal file
1028
Units/RUTIS/Rutis_ExtDll_OpenGl.pas
Normal file
File diff suppressed because it is too large
Load Diff
85
Units/RUTIS/Rutis_ExtMethodInfoWin.dfm
Normal file
85
Units/RUTIS/Rutis_ExtMethodInfoWin.dfm
Normal file
@ -0,0 +1,85 @@
|
||||
object FExtMethodListInfo: TFExtMethodListInfo
|
||||
Left = 0
|
||||
Top = 0
|
||||
BorderIcons = [biSystemMenu, biMaximize]
|
||||
Caption = 'EXT Methods Info'
|
||||
ClientHeight = 305
|
||||
ClientWidth = 526
|
||||
Color = clBtnFace
|
||||
Font.Charset = DEFAULT_CHARSET
|
||||
Font.Color = clWindowText
|
||||
Font.Height = -11
|
||||
Font.Name = 'Tahoma'
|
||||
Font.Style = []
|
||||
FormStyle = fsStayOnTop
|
||||
OldCreateOrder = False
|
||||
Position = poScreenCenter
|
||||
OnCreate = FormCreate
|
||||
OnHide = FormHide
|
||||
OnShow = FormShow
|
||||
PixelsPerInch = 96
|
||||
TextHeight = 13
|
||||
object ExtList: TListBox
|
||||
Left = 0
|
||||
Top = 25
|
||||
Width = 526
|
||||
Height = 280
|
||||
Align = alClient
|
||||
Font.Charset = ANSI_CHARSET
|
||||
Font.Color = clWindowText
|
||||
Font.Height = -11
|
||||
Font.Name = 'Courier New'
|
||||
Font.Style = []
|
||||
ItemHeight = 14
|
||||
ParentFont = False
|
||||
ParentShowHint = False
|
||||
ShowHint = True
|
||||
TabOrder = 1
|
||||
OnDblClick = ExtListDblClick
|
||||
OnMouseMove = ExtListMouseMove
|
||||
end
|
||||
object Panel1: TPanel
|
||||
Left = 0
|
||||
Top = 0
|
||||
Width = 526
|
||||
Height = 25
|
||||
Align = alTop
|
||||
BevelOuter = bvNone
|
||||
TabOrder = 0
|
||||
object BtnSortDefault: TButton
|
||||
Left = 0
|
||||
Top = 1
|
||||
Width = 80
|
||||
Height = 25
|
||||
Caption = 'Default'
|
||||
TabOrder = 1
|
||||
OnClick = BtnSortDefaultClick
|
||||
end
|
||||
object BtnSortAlphabetical: TButton
|
||||
Left = 80
|
||||
Top = 1
|
||||
Width = 80
|
||||
Height = 25
|
||||
Caption = 'Alphabetical'
|
||||
TabOrder = 2
|
||||
OnClick = BtnSortAlphabeticalClick
|
||||
end
|
||||
object EdSearch: TEdit
|
||||
Left = 165
|
||||
Top = 3
|
||||
Width = 357
|
||||
Height = 21
|
||||
TabOrder = 0
|
||||
OnChange = EdSearchChange
|
||||
OnMouseDown = EdSearchMouseDown
|
||||
end
|
||||
end
|
||||
object PopupMenu1: TPopupMenu
|
||||
Left = 208
|
||||
Top = 120
|
||||
object Insertintocode1: TMenuItem
|
||||
Caption = 'Insert into code'
|
||||
OnClick = Insertintocode1Click
|
||||
end
|
||||
end
|
||||
end
|
||||
28
Units/RUTIS/Rutis_ExtMethodInfoWin.lfm
Normal file
28
Units/RUTIS/Rutis_ExtMethodInfoWin.lfm
Normal file
@ -0,0 +1,28 @@
|
||||
object FExtMethodListInfo: TFExtMethodListInfo
|
||||
Left = 76
|
||||
Height = 305
|
||||
Top = 99
|
||||
Width = 526
|
||||
BorderIcons = [biSystemMenu, biMaximize]
|
||||
Caption = 'EXT Methods Info'
|
||||
ClientHeight = 305
|
||||
ClientWidth = 526
|
||||
Font.Height = -11
|
||||
Font.Name = 'Tahoma'
|
||||
FormStyle = fsStayOnTop
|
||||
Position = poScreenCenter
|
||||
LCLVersion = '0.9.28.2'
|
||||
object ExtList: TListBox
|
||||
Left = 0
|
||||
Height = 305
|
||||
Top = 0
|
||||
Width = 526
|
||||
Align = alClient
|
||||
Font.CharSet = ANSI_CHARSET
|
||||
Font.Height = -13
|
||||
Font.Name = 'Courier New'
|
||||
ItemHeight = 0
|
||||
ParentFont = False
|
||||
TabOrder = 0
|
||||
end
|
||||
end
|
||||
13
Units/RUTIS/Rutis_ExtMethodInfoWin.lrs
Normal file
13
Units/RUTIS/Rutis_ExtMethodInfoWin.lrs
Normal file
@ -0,0 +1,13 @@
|
||||
{ Das ist eine automatisch erzeugte Lazarus-Ressourcendatei }
|
||||
|
||||
LazarusResources.Add('TFExtMethodListInfo','FORMDATA',[
|
||||
'TPF0'#19'TFExtMethodListInfo'#18'FExtMethodListInfo'#4'Left'#2'L'#6'Height'#3
|
||||
+'1'#1#3'Top'#2'c'#5'Width'#3#14#2#11'BorderIcons'#11#12'biSystemMenu'#10'biM'
|
||||
+'aximize'#0#7'Caption'#6#16'EXT Methods Info'#12'ClientHeight'#3'1'#1#11'Cli'
|
||||
+'entWidth'#3#14#2#11'Font.Height'#2#245#9'Font.Name'#6#6'Tahoma'#9'FormStyle'
|
||||
+#7#11'fsStayOnTop'#8'Position'#7#14'poScreenCenter'#10'LCLVersion'#6#8'0.9.2'
|
||||
+'8.2'#0#8'TListBox'#7'ExtList'#4'Left'#2#0#6'Height'#3'1'#1#3'Top'#2#0#5'Wid'
|
||||
+'th'#3#14#2#5'Align'#7#8'alClient'#12'Font.CharSet'#7#12'ANSI_CHARSET'#11'Fo'
|
||||
+'nt.Height'#2#243#9'Font.Name'#6#11'Courier New'#10'ItemHeight'#2#0#10'Paren'
|
||||
+'tFont'#8#8'TabOrder'#2#0#0#0#0
|
||||
]);
|
||||
223
Units/RUTIS/Rutis_ExtMethodInfoWin.pas
Normal file
223
Units/RUTIS/Rutis_ExtMethodInfoWin.pas
Normal file
@ -0,0 +1,223 @@
|
||||
Unit Rutis_ExtMethodInfoWin;
|
||||
|
||||
Interface
|
||||
|
||||
Uses
|
||||
SysUtils, Classes, Graphics, Controls, Forms,
|
||||
Dialogs, StdCtrls, ExtCtrls, Menus, Math
|
||||
{$IFDEF FPC},LResources{$ENDIF};
|
||||
|
||||
Type
|
||||
TExtMethodInfo = Record
|
||||
Name : String;
|
||||
Category : String;
|
||||
Description : String;
|
||||
IsFunction : Boolean;
|
||||
ExtMethodType : Pointer;
|
||||
End;
|
||||
|
||||
TFExtMethodListInfo = Class(TForm)
|
||||
ExtList : TListBox;
|
||||
Panel1 : TPanel;
|
||||
BtnSortDefault : TButton;
|
||||
BtnSortAlphabetical : TButton;
|
||||
EdSearch : TEdit;
|
||||
PopupMenu1 : TPopupMenu;
|
||||
Insertintocode1 : TMenuItem;
|
||||
Procedure ExtListDblClick(Sender : TObject);
|
||||
Procedure FormCreate(Sender : TObject);
|
||||
Procedure ExtListMouseMove(Sender : TObject; Shift : TShiftState; X, Y : Integer);
|
||||
Procedure FormHide(Sender : TObject);
|
||||
Procedure FormShow(Sender : TObject);
|
||||
Procedure BtnSortDefaultClick(Sender : TObject);
|
||||
Procedure BtnSortAlphabeticalClick(Sender : TObject);
|
||||
Procedure EdSearchChange(Sender : TObject);
|
||||
Procedure EdSearchMouseDown(Sender : TObject; Button : TMouseButton; Shift : TShiftState; X, Y : Integer);
|
||||
Procedure Insertintocode1Click(Sender : TObject);
|
||||
Private
|
||||
LastHoveredRow : Integer;
|
||||
Procedure ShowList;
|
||||
{ Private-Deklarationen }
|
||||
Public
|
||||
ResultIndex : Integer;
|
||||
ResultExtMethod : Pointer;
|
||||
//Hints : TStringList;
|
||||
Sorted : Array Of Integer;
|
||||
ExtMethods : Array Of TExtMethodInfo;
|
||||
{ Public-Deklarationen }
|
||||
End;
|
||||
|
||||
Implementation
|
||||
|
||||
{$IFNDEF FPC}
|
||||
{$R *.dfm}
|
||||
|
||||
{$ENDIF}
|
||||
|
||||
Function IsStr1LowerStr2(s1, s2 : String) : Boolean;
|
||||
Var
|
||||
i : Integer;
|
||||
Begin
|
||||
i := 1;
|
||||
s1 := LowerCase(s1) + #255;
|
||||
s2 := LowerCase(s2) + #254;
|
||||
While s1[i] = s2[i] Do
|
||||
Inc(i);
|
||||
Result := s1[i] < s2[i];
|
||||
End;
|
||||
|
||||
Procedure TFExtMethodListInfo.ShowList;
|
||||
Var
|
||||
i : Integer;
|
||||
s : String;
|
||||
Begin
|
||||
ExtList.Clear;
|
||||
For i := 0 To high(ExtMethods) Do
|
||||
Begin
|
||||
If Sorted[i] < 0 Then Continue;
|
||||
s := ExtMethods[Sorted[i] - 1].Name;
|
||||
// If ExtMethods[Sorted[i]].IsFunction then
|
||||
// s := 'Function ' + ExtMethods[Sorted[i]].Name
|
||||
// else
|
||||
// s := 'Procedure ' + ExtMethods[Sorted[i]].Name;
|
||||
// If ExtMethods[Sorted[i]].IsFunction then
|
||||
// s := 'F ' + ExtMethods[Sorted[i]].Name
|
||||
// else
|
||||
// s := 'P ' + ExtMethods[Sorted[i]].Name;
|
||||
ExtList.Items.Add(s);
|
||||
End;
|
||||
|
||||
Canvas.Font := ExtList.Font;
|
||||
{$ifndef FPC}
|
||||
ExtList.ScrollWidth := 0;
|
||||
For i := 0 To ExtList.Items.Count - 1 Do
|
||||
ExtList.ScrollWidth := Max(ExtList.ScrollWidth, Canvas.TextWidth(ExtList.Items[i]));
|
||||
{$endif}
|
||||
End;
|
||||
|
||||
Procedure TFExtMethodListInfo.BtnSortAlphabeticalClick(Sender : TObject);
|
||||
Var
|
||||
i, j : Integer;
|
||||
completed : Boolean;
|
||||
Begin
|
||||
SetLength(Sorted, length(ExtMethods));
|
||||
For i := 0 To high(ExtMethods) Do
|
||||
Sorted[i] := i + 1;
|
||||
|
||||
Repeat
|
||||
completed := True;
|
||||
For i := 0 To high(ExtMethods) - 1 Do
|
||||
If not IsStr1LowerStr2(ExtMethods[Sorted[i] - 1].Name, ExtMethods[Sorted[i + 1] - 1].Name) Then
|
||||
Begin
|
||||
j := Sorted[i];
|
||||
Sorted[i] := Sorted[i + 1];
|
||||
Sorted[i + 1] := j;
|
||||
completed := False;
|
||||
End;
|
||||
Until completed;
|
||||
|
||||
ShowList;
|
||||
End;
|
||||
|
||||
Procedure TFExtMethodListInfo.BtnSortDefaultClick(Sender : TObject);
|
||||
Var
|
||||
i : Integer;
|
||||
Begin
|
||||
SetLength(Sorted, length(ExtMethods));
|
||||
For i := 0 To high(ExtMethods) Do
|
||||
Sorted[i] := i + 1;
|
||||
|
||||
ShowList;
|
||||
End;
|
||||
|
||||
Procedure TFExtMethodListInfo.EdSearchChange(Sender : TObject);
|
||||
Var
|
||||
i : Integer;
|
||||
Begin
|
||||
For i := 0 To high(ExtMethods) Do
|
||||
Begin
|
||||
Sorted[i] := abs(Sorted[i]);
|
||||
If length(EdSearch.Text) > 0 Then
|
||||
If Pos(LowerCase(EdSearch.Text), LowerCase(ExtMethods[Sorted[i] - 1].Name)) = 0 Then
|
||||
Sorted[i] := -Sorted[i];
|
||||
End;
|
||||
ShowList;
|
||||
End;
|
||||
|
||||
Procedure TFExtMethodListInfo.EdSearchMouseDown(Sender : TObject; Button : TMouseButton; Shift : TShiftState; X, Y : Integer);
|
||||
Begin
|
||||
// EdSearch.SelStart := 0;
|
||||
// EdSearch.SelLength := Length(EdSearch.Text);
|
||||
End;
|
||||
|
||||
Procedure TFExtMethodListInfo.ExtListDblClick(Sender : TObject);
|
||||
Begin
|
||||
Insertintocode1Click(nil);
|
||||
End;
|
||||
|
||||
Procedure TFExtMethodListInfo.ExtListMouseMove(Sender : TObject; Shift : TShiftState; X, Y : Integer);
|
||||
Var
|
||||
HoveredRow : Integer;
|
||||
I : Integer;
|
||||
Begin
|
||||
HoveredRow := ExtList.ItemAtPos(Point(X, Y), True);
|
||||
If (HoveredRow > -1) and
|
||||
(HoveredRow < length(ExtMethods)) and
|
||||
(HoveredRow <> LastHoveredRow) Then
|
||||
Begin
|
||||
LastHoveredRow := HoveredRow;
|
||||
i := -1;
|
||||
Repeat
|
||||
Inc(i);
|
||||
If Sorted[I] > 0 Then
|
||||
Dec(HoveredRow);
|
||||
Until HoveredRow < 0;
|
||||
ExtList.Hint := ExtMethods[abs(Sorted[i]) - 1].Description;
|
||||
Application.Hint := ExtList.Hint;
|
||||
Application.HintPause := 0;
|
||||
Application.HintHidePause := 60000;
|
||||
{$ifndef FPC}
|
||||
Application.ActivateHint(Point(X, Y));
|
||||
{$endif}
|
||||
End;
|
||||
End;
|
||||
|
||||
Procedure TFExtMethodListInfo.FormCreate(Sender : TObject);
|
||||
Begin
|
||||
ResultIndex := -1;
|
||||
LastHoveredRow := -1;
|
||||
ResultExtMethod := nil;
|
||||
End;
|
||||
|
||||
Procedure TFExtMethodListInfo.FormHide(Sender : TObject);
|
||||
Begin
|
||||
Application.HintPause := 2500;
|
||||
End;
|
||||
|
||||
Procedure TFExtMethodListInfo.FormShow(Sender : TObject);
|
||||
Begin
|
||||
BtnSortDefault.Click;
|
||||
End;
|
||||
|
||||
Procedure TFExtMethodListInfo.Insertintocode1Click(Sender : TObject);
|
||||
Var i, item : Integer;
|
||||
Begin
|
||||
item := ExtList.ItemIndex;
|
||||
i := -1;
|
||||
Repeat
|
||||
Inc(i);
|
||||
If Sorted[I] > 0 Then
|
||||
Dec(item);
|
||||
Until item < 0;
|
||||
|
||||
ResultIndex := abs(Sorted[i]) - 1;
|
||||
ResultExtMethod := ExtMethods[ResultIndex].ExtMethodType;
|
||||
Close;
|
||||
End;
|
||||
|
||||
Initialization
|
||||
{$IFDEF FPC}
|
||||
{$I Rutis_ExtMethodInfoWin.lrs}
|
||||
{$ENDIF}
|
||||
End.
|
||||
|
||||
93
Units/RUTIS/Rutis_INI_Settings.pas
Normal file
93
Units/RUTIS/Rutis_INI_Settings.pas
Normal file
@ -0,0 +1,93 @@
|
||||
Unit Rutis_INI_Settings;
|
||||
|
||||
Interface
|
||||
|
||||
Uses
|
||||
SysUtils, IniFiles, registry, Rutis_Engine;
|
||||
|
||||
Var
|
||||
Rutis_INI : TCustomIniFile;
|
||||
|
||||
Procedure RINISettings_Open(AppPath, ScriptPath : String);
|
||||
Function RINISettings_OpenReg : Boolean;
|
||||
Procedure RINISettings_OpenIni(FileName : String);
|
||||
Procedure RINISettings_ApplyMainSettings(Engine : TRutisEngine);
|
||||
|
||||
Implementation
|
||||
|
||||
Procedure RINISettings_Open(AppPath, ScriptPath : String);
|
||||
Begin
|
||||
If FileExists(ScriptPath + '\RutisSettings.ini') Then
|
||||
Begin
|
||||
RINISettings_OpenIni(ScriptPath + '\RutisSettings.ini');
|
||||
exit;
|
||||
End;
|
||||
|
||||
If RINISettings_OpenReg Then exit;
|
||||
|
||||
SetCurrentDir(AppPath);
|
||||
If FileExists('.\Rutis_Settings.ini') Then
|
||||
Begin
|
||||
RINISettings_OpenIni('.\Rutis_Settings.ini');
|
||||
exit;
|
||||
End;
|
||||
|
||||
If FileExists('..\Rutis_Settings.ini') Then
|
||||
Begin
|
||||
RINISettings_OpenIni('..\Rutis_Settings.ini');
|
||||
exit;
|
||||
End;
|
||||
|
||||
RINISettings_OpenReg;
|
||||
End;
|
||||
|
||||
Function RINISettings_OpenReg : Boolean;
|
||||
Begin
|
||||
Rutis_INI.Free;
|
||||
Rutis_INI := TRegistryIniFile.Create('Software\RUTIS');
|
||||
Result := Rutis_INI.SectionExists('');
|
||||
End;
|
||||
|
||||
Procedure RINISettings_OpenIni(FileName : String);
|
||||
Begin
|
||||
Rutis_INI.Free;
|
||||
Rutis_INI := TIniFile.Create(FileName);
|
||||
End;
|
||||
|
||||
Procedure RINISettings_ApplyMainSettings(Engine : TRutisEngine);
|
||||
Var
|
||||
i : Integer;
|
||||
Str : String;
|
||||
Begin
|
||||
If Rutis_INI = nil Then
|
||||
Rutis_INI := TRegistryIniFile.Create('Software\RUTIS');
|
||||
|
||||
//Libary Paths
|
||||
SetLength(Engine.UnitFileManager.Paths, 0);
|
||||
i := 0;
|
||||
While True Do
|
||||
Begin
|
||||
Str := Rutis_INI.ReadString('Compiler\Libary', 'Path' + IntToStr(i), '');
|
||||
If Str = '' Then break;
|
||||
Engine.UnitFileManager.AddPath(Str);
|
||||
Inc(i);
|
||||
End;
|
||||
|
||||
//Compiler Settings
|
||||
Engine.Compiler.optArrangeFields := Rutis_INI.ReadBool('Compiler', 'ArrangeRecordFields', True);
|
||||
Engine.Compiler.optArrangeSize := Rutis_INI.ReadInteger('Compiler', 'RecordArrangeSize', 8);
|
||||
|
||||
Engine.OptProcessTimerCount := Rutis_INI.ReadInteger('VM', 'ProcessTickCount', 100000);
|
||||
|
||||
//SAVE SETTINGS
|
||||
Rutis_INI.WriteBool('Compiler', 'ArrangeRecordFields', Engine.Compiler.optArrangeFields);
|
||||
Rutis_INI.WriteInteger('Compiler', 'RecordArrangeSize', Engine.Compiler.optArrangeSize);
|
||||
|
||||
Rutis_INI.WriteInteger('VM', 'ProcessTickCount', Engine.OptProcessTimerCount);
|
||||
End;
|
||||
|
||||
Initialization
|
||||
Finalization
|
||||
Rutis_INI.Free;
|
||||
End.
|
||||
|
||||
1131
Units/RUTIS/Rutis_Stack.pas
Normal file
1131
Units/RUTIS/Rutis_Stack.pas
Normal file
File diff suppressed because it is too large
Load Diff
Loading…
Reference in New Issue
Block a user