mirror of
https://github.com/moparisthebest/Simba
synced 2024-11-29 04:22:16 -05:00
RUTIS to the source
This commit is contained in:
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