From 65f37d861e670aed56c59d55e5014e81c2f45f58 Mon Sep 17 00:00:00 2001 From: Raymond Date: Wed, 19 May 2010 20:24:30 +0200 Subject: [PATCH] Extensions should have acces to some MML-objects now as well! --- Projects/Simba/psextension.pas | 44 ++----------------- .../PSInc/{pscmml.inc => uPSC_mml.pas} | 24 +++++++++- .../PSInc/{psrmml.inc => uPSR_mml.pas} | 29 +++++++++++- Units/MMLCore/dtm.pas | 4 +- 4 files changed, 57 insertions(+), 44 deletions(-) rename Units/MMLAddon/PSInc/{pscmml.inc => uPSC_mml.pas} (86%) rename Units/MMLAddon/PSInc/{psrmml.inc => uPSR_mml.pas} (91%) diff --git a/Projects/Simba/psextension.pas b/Projects/Simba/psextension.pas index f6418ec..5f0300f 100644 --- a/Projects/Simba/psextension.pas +++ b/Projects/Simba/psextension.pas @@ -27,8 +27,6 @@ type function FreeScript: boolean; function InitScript: Boolean; procedure OutputMessages; - procedure SIRegister_Settings(Cl: TPSPascalCompiler); - procedure RIRegister_Settings(Cl: TPSRuntimeClassImporter); public function HookExists(const HookName: String): Boolean;override; @@ -46,9 +44,9 @@ type implementation uses uPSC_std, uPSC_controls,uPSC_classes,uPSC_graphics,uPSC_stdctrls,uPSC_forms, - uPSC_extctrls,uPSC_menus, //Compile libs + uPSC_extctrls,uPSC_menus, uPSC_mml, //Compile libs uPSR_std, uPSR_controls,uPSR_classes,uPSR_graphics,uPSR_stdctrls,uPSR_forms, - uPSR_extctrls,uPSR_menus, //Runtime-libs + uPSR_extctrls,uPSR_menus, uPSR_mml, //Runtime-libs SimbaUnit,updateform,settingssandbox,bitmaps,files,Dialogs, mmisc//Writeln ; @@ -176,40 +174,6 @@ begin inherited SetEnabled(bool); end; -procedure TSimbaPSExtension.SIRegister_Settings(Cl: TPSPascalCompiler); -begin - with cl.AddClassN(nil,'TMMLSettingsSandbox') do - begin; - RegisterMethod('function IsKey(const KeyName: String): Boolean;'); - RegisterMethod('function IsDirectory(const KeyName: String): Boolean;'); - RegisterMethod('function SetKeyValue(const Keyname, Value : string) : boolean;'); - RegisterMethod('function GetKeyValue(const KeyName: String): String;'); - RegisterMethod('function GetKeyValueDef(const KeyName, defVal: String): String;'); - RegisterMethod('function ListKeys(const KeyName: String; out Keys :TStringArray): boolean;'); - RegisterMethod('function DeleteKey(const KeyName: String): Boolean;'); - RegisterMethod('function DeleteSubKeys(const KeyName: String): Boolean;'); - RegisterProperty('Prefix','String',iptR); - end; -end; - -procedure SettingsPrefix(self : TMMLSettingsSandbox; var Prefix : String); -begin; Prefix := self.Prefix; end; - -procedure TSimbaPSExtension.RIRegister_Settings(Cl: TPSRuntimeClassImporter); -begin - with cl.Add(TMMLSettingsSandbox) do - begin - RegisterMethod(@TMMLSettingsSandbox.IsKey,'ISKEY'); - RegisterMethod(@TMMLSettingsSandbox.IsDirectory,'ISDIRECTORY'); - RegisterMethod(@TMMLSettingsSandbox.SetKeyValue,'SETKEYVALUE'); - RegisterMethod(@TMMLSettingsSandbox.GetKeyValue,'GETKEYVALUE'); - RegisterMethod(@TMMLSettingsSandbox.GetKeyValueDef,'GETKEYVALUEDEF'); - RegisterMethod(@TMMLSettingsSandbox.ListKeys,'LISTKEYS'); - RegisterMethod(@TMMLSettingsSandbox.DeleteKey,'DELETEKEY'); - RegisterMethod(@TMMLSettingsSandbox.DeleteSubKeys,'DELETESUBKEYS'); - RegisterPropertyHelper(@SettingsPrefix,nil,'Prefix'); - end; -end; procedure TSimbaPSExtension.RegisterPSCComponents(Sender: TObject; x: TPSPascalCompiler); begin @@ -221,7 +185,7 @@ begin SIRegister_Forms(x); SIRegister_ExtCtrls(x); SIRegister_Menus(x); - SIRegister_Settings(x); + SIRegister_MML(x); end; procedure TSimbaPSExtension.RegisterPSRComponents(Sender: TObject; se: TPSExec; x: TPSRuntimeClassImporter); @@ -234,7 +198,7 @@ begin RIRegister_Forms(x); RIRegister_ExtCtrls(x); RIRegister_Menus(x); - RIRegister_Settings(x); + RIRegister_MML(x); end; destructor TSimbaPSExtension.Destroy; diff --git a/Units/MMLAddon/PSInc/pscmml.inc b/Units/MMLAddon/PSInc/uPSC_mml.pas similarity index 86% rename from Units/MMLAddon/PSInc/pscmml.inc rename to Units/MMLAddon/PSInc/uPSC_mml.pas index b0adc03..b40e5af 100644 --- a/Units/MMLAddon/PSInc/pscmml.inc +++ b/Units/MMLAddon/PSInc/uPSC_mml.pas @@ -1,3 +1,11 @@ +unit uPSC_mml; +interface +uses + uPSCompiler; + +procedure SIRegister_MML(cl: TPSPascalCompiler); + +implementation procedure SIRegister_MML(cl: TPSPascalCompiler); var PSClass : TPSCompileTimeClass; @@ -98,4 +106,18 @@ begin RegisterProperty('Count','Integer',iptrw); RegisterProperty('Points','TMDTMPointArray',iptr); end; -end; + with cl.AddClassN(nil,'TMMLSettingsSandbox') do + begin; + RegisterMethod('function IsKey(const KeyName: String): Boolean;'); + RegisterMethod('function IsDirectory(const KeyName: String): Boolean;'); + RegisterMethod('function SetKeyValue(const Keyname, Value : string) : boolean;'); + RegisterMethod('function GetKeyValue(const KeyName: String): String;'); + RegisterMethod('function GetKeyValueDef(const KeyName, defVal: String): String;'); + RegisterMethod('function ListKeys(const KeyName: String; out Keys :TStringArray): boolean;'); + RegisterMethod('function DeleteKey(const KeyName: String): Boolean;'); + RegisterMethod('function DeleteSubKeys(const KeyName: String): Boolean;'); + RegisterProperty('Prefix','String',iptR); + end; +end; + +end. diff --git a/Units/MMLAddon/PSInc/psrmml.inc b/Units/MMLAddon/PSInc/uPSR_mml.pas similarity index 91% rename from Units/MMLAddon/PSInc/psrmml.inc rename to Units/MMLAddon/PSInc/uPSR_mml.pas index b92ed01..a89f5fc 100644 --- a/Units/MMLAddon/PSInc/psrmml.inc +++ b/Units/MMLAddon/PSInc/uPSR_mml.pas @@ -1,3 +1,15 @@ +unit uPSR_mml; + +interface +uses + uPSRuntime; + +procedure RIRegister_MML(cl: TPSRuntimeClassImporter); + +implementation +uses + SynRegExpr,bitmaps,dtm,mufasatypes,settingssandbox; + type TRegExp = class(SynRegExpr.TRegExpr); procedure MBmp_Index_r(self : TMufasaBitmap; var Index : integer);begin; Index := self.Index; end; @@ -49,6 +61,7 @@ procedure TRegExprExpression_R(Self: TRegExp; var T: RegExprString);begin T := S procedure TMDTMCount_W(Self: TMDTM; const T: Integer);begin Self.Count := T; end; procedure TMDTMCount_R(Self: TMDTM; var T: Integer);begin T := Self.Count; end; procedure TMDTMPoints_R(Self : TMDTM; var T : TMDTMPointArray); begin t := self.Points; end; +procedure SettingsPrefix(self : TMMLSettingsSandbox; var Prefix : String);begin; Prefix := self.Prefix; end; procedure RIRegister_MML(cl: TPSRuntimeClassImporter); var @@ -144,6 +157,20 @@ begin; Registermethod(@TMDTM.MovePoint,'MovePoint'); RegisterMethod(@TMDTM.AddPoint,'AddPoint'); RegisterPropertyHelper(@TMDTMCount_R,@TMDTMCount_W,'Count'); - RegisterMethod(@TMDTMPoints_R,nil,'Points'); + RegisterPropertyHelper(@TMDTMPoints_R,nil,'Points'); + end; + with cl.Add(TMMLSettingsSandbox) do + begin + RegisterMethod(@TMMLSettingsSandbox.IsKey,'ISKEY'); + RegisterMethod(@TMMLSettingsSandbox.IsDirectory,'ISDIRECTORY'); + RegisterMethod(@TMMLSettingsSandbox.SetKeyValue,'SETKEYVALUE'); + RegisterMethod(@TMMLSettingsSandbox.GetKeyValue,'GETKEYVALUE'); + RegisterMethod(@TMMLSettingsSandbox.GetKeyValueDef,'GETKEYVALUEDEF'); + RegisterMethod(@TMMLSettingsSandbox.ListKeys,'LISTKEYS'); + RegisterMethod(@TMMLSettingsSandbox.DeleteKey,'DELETEKEY'); + RegisterMethod(@TMMLSettingsSandbox.DeleteSubKeys,'DELETESUBKEYS'); + RegisterPropertyHelper(@SettingsPrefix,nil,'Prefix'); end; end; + +end. diff --git a/Units/MMLCore/dtm.pas b/Units/MMLCore/dtm.pas index f58c907..7833c5e 100644 --- a/Units/MMLCore/dtm.pas +++ b/Units/MMLCore/dtm.pas @@ -34,8 +34,6 @@ type { TMDTM } - { TMDTM } - TMDTM = class(TObject) private FPoints : TMDTMPointArray; @@ -55,6 +53,8 @@ type property Count : integer read FLen write SetPointCount; property Points : TMDTMPointArray read FPoints; end; + { TMDTMS } + TMDTMS = class(TObject) //Manages the DTMs TMufasaDTMs private Client: TObject;