1
0
mirror of https://github.com/moparisthebest/Simba synced 2024-11-25 10:42:20 -05:00

Extensions should have acces to some MML-objects now as well!

This commit is contained in:
Raymond 2010-05-19 20:24:30 +02:00
parent b045268ba5
commit 65f37d861e
4 changed files with 57 additions and 44 deletions

View File

@ -27,8 +27,6 @@ type
function FreeScript: boolean; function FreeScript: boolean;
function InitScript: Boolean; function InitScript: Boolean;
procedure OutputMessages; procedure OutputMessages;
procedure SIRegister_Settings(Cl: TPSPascalCompiler);
procedure RIRegister_Settings(Cl: TPSRuntimeClassImporter);
public public
function HookExists(const HookName: String): Boolean;override; function HookExists(const HookName: String): Boolean;override;
@ -46,9 +44,9 @@ type
implementation implementation
uses uses
uPSC_std, uPSC_controls,uPSC_classes,uPSC_graphics,uPSC_stdctrls,uPSC_forms, 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_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 SimbaUnit,updateform,settingssandbox,bitmaps,files,Dialogs, mmisc//Writeln
; ;
@ -176,40 +174,6 @@ begin
inherited SetEnabled(bool); inherited SetEnabled(bool);
end; 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); procedure TSimbaPSExtension.RegisterPSCComponents(Sender: TObject; x: TPSPascalCompiler);
begin begin
@ -221,7 +185,7 @@ begin
SIRegister_Forms(x); SIRegister_Forms(x);
SIRegister_ExtCtrls(x); SIRegister_ExtCtrls(x);
SIRegister_Menus(x); SIRegister_Menus(x);
SIRegister_Settings(x); SIRegister_MML(x);
end; end;
procedure TSimbaPSExtension.RegisterPSRComponents(Sender: TObject; se: TPSExec; x: TPSRuntimeClassImporter); procedure TSimbaPSExtension.RegisterPSRComponents(Sender: TObject; se: TPSExec; x: TPSRuntimeClassImporter);
@ -234,7 +198,7 @@ begin
RIRegister_Forms(x); RIRegister_Forms(x);
RIRegister_ExtCtrls(x); RIRegister_ExtCtrls(x);
RIRegister_Menus(x); RIRegister_Menus(x);
RIRegister_Settings(x); RIRegister_MML(x);
end; end;
destructor TSimbaPSExtension.Destroy; destructor TSimbaPSExtension.Destroy;

View File

@ -1,3 +1,11 @@
unit uPSC_mml;
interface
uses
uPSCompiler;
procedure SIRegister_MML(cl: TPSPascalCompiler);
implementation
procedure SIRegister_MML(cl: TPSPascalCompiler); procedure SIRegister_MML(cl: TPSPascalCompiler);
var var
PSClass : TPSCompileTimeClass; PSClass : TPSCompileTimeClass;
@ -98,4 +106,18 @@ begin
RegisterProperty('Count','Integer',iptrw); RegisterProperty('Count','Integer',iptrw);
RegisterProperty('Points','TMDTMPointArray',iptr); 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;
end.

View File

@ -1,3 +1,15 @@
unit uPSR_mml;
interface
uses
uPSRuntime;
procedure RIRegister_MML(cl: TPSRuntimeClassImporter);
implementation
uses
SynRegExpr,bitmaps,dtm,mufasatypes,settingssandbox;
type type
TRegExp = class(SynRegExpr.TRegExpr); TRegExp = class(SynRegExpr.TRegExpr);
procedure MBmp_Index_r(self : TMufasaBitmap; var Index : integer);begin; Index := self.Index; end; 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_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 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 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); procedure RIRegister_MML(cl: TPSRuntimeClassImporter);
var var
@ -144,6 +157,20 @@ begin;
Registermethod(@TMDTM.MovePoint,'MovePoint'); Registermethod(@TMDTM.MovePoint,'MovePoint');
RegisterMethod(@TMDTM.AddPoint,'AddPoint'); RegisterMethod(@TMDTM.AddPoint,'AddPoint');
RegisterPropertyHelper(@TMDTMCount_R,@TMDTMCount_W,'Count'); 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; end;
end.

View File

@ -34,8 +34,6 @@ type
{ TMDTM } { TMDTM }
{ TMDTM }
TMDTM = class(TObject) TMDTM = class(TObject)
private private
FPoints : TMDTMPointArray; FPoints : TMDTMPointArray;
@ -55,6 +53,8 @@ type
property Count : integer read FLen write SetPointCount; property Count : integer read FLen write SetPointCount;
property Points : TMDTMPointArray read FPoints; property Points : TMDTMPointArray read FPoints;
end; end;
{ TMDTMS }
TMDTMS = class(TObject) //Manages the DTMs TMufasaDTMs TMDTMS = class(TObject) //Manages the DTMs TMufasaDTMs
private private
Client: TObject; Client: TObject;