home *** CD-ROM | disk | FTP | other *** search
/ Chip 2001 December / Chip_2001-12_cd1.bin / zkuste / delphi / kompon / d23456 / CAJSCRTP.ZIP / ifs_obj.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  2001-04-26  |  3.2 KB  |  135 lines
  1. //  Filename: ifs_obj.pas
  2. //  Author: Carlo Kok (ckok.1@hccnet.nl)
  3. //
  4. // Innerfuse Pascal Script Custom Objects
  5. //
  6. // When created properly, it will free itself.
  7.  
  8. unit ifs_obj;
  9.  
  10. interface
  11. {$I ifs_def.inc}
  12.  
  13. uses
  14.   ifs_var, ifs_utl;
  15.  
  16. type
  17.   TIfsCustomObject = class;
  18.   TIFsCustomObjectType = class of TIfsCustomObject;
  19.   PCreatedCustomObject = ^TCreatedCustomObject;
  20.   TCreatedCustomObject = packed record
  21.     AlreadyFreed: Boolean;
  22.     P: TIfsCustomObject;
  23.   end;
  24.   TIfsCustomObject = class
  25.   private
  26.     FScriptEngine: Pointer;
  27.     FCCO: PCreatedCustomObject;
  28.   protected
  29.     property CreatedCustomObject: PCreatedCustomObject read FCCo write FCCO;
  30.   public
  31.     property ScriptEngine: Pointer read FScriptEngine;
  32.  
  33.     constructor Create(ScriptEngine: Pointer);
  34.  
  35.     function GetPropertyType(I: Longint): PTypeRec; virtual;
  36.     function SetProperty(I: Longint; P: PIfVariant): Boolean; virtual;
  37.     function GetProperty(I: Longint; Dest: PIfVariant): Boolean; virtual;
  38.     function FindProperty(const Name: string): Longint; virtual;
  39.     function GetPropertyCount: Longint; virtual;
  40.  
  41.     function FindProc(const Name: string): Longint; virtual;
  42.     function GetProcHeader(I: Longint): string; virtual;
  43.     function CallProc(I: Longint; Params: PVariableManager): PIFVariant; virtual;
  44.     function GetProcCount: Longint; virtual;
  45.   end;
  46.  
  47. function CreateResource(S: TIfsCustomObject): PCreatedCustomObject;
  48. { Add it to the resource list, so it will be automaticly freed. }
  49. procedure FreeResource(S: PCreatedCustomObject);
  50. { Free the class, but not the PCreatedCustomObject type. } 
  51.  
  52. implementation
  53. uses
  54.  ifspas;
  55.  
  56. procedure RealFreeResource(id: Pointer; Data: PCreatedCustomObject);
  57. begin
  58.   if not Data.AlreadyFreed then
  59.     Data.P.Free;
  60.   Dispose(Data);
  61. end;
  62.  
  63. function CreateResource(S: TIfsCustomObject): PCreatedCustomObject;
  64. begin
  65.   New(Result);
  66.   Result.AlreadyFreed := False;
  67.   Result.P := S;
  68.   s.FCCO := Result;
  69.   TIFPasScript(s.FScriptEngine).AddResource(@RealFreeResource, Result);
  70. end;
  71.  
  72. procedure FreeResource(S: PCreatedCustomObject);
  73. { Free the class, but not the PCreatedCustomObject type. }
  74. begin
  75.   if not s.AlreadyFreed then
  76.   begin
  77.     S.AlreadyFreed := True;
  78.     s.P.Free;
  79.   end;
  80. end;
  81.  
  82.  
  83. constructor TIfsCustomObject.Create(ScriptEngine: Pointer);
  84. begin
  85.   inherited Create;
  86.   FScriptEngine := ScriptEngine;
  87. end;
  88.  
  89. function TIfsCustomObject.GetPropertyType(I: Longint): PTypeRec;
  90. begin
  91.   Result := nil;
  92. end;
  93.  
  94. function TIfsCustomObject.FindProc(const Name: string): Longint;
  95. begin
  96.   Result := -1;
  97. end;
  98.     
  99. function TIfsCustomObject.SetProperty(I: Longint; P: PIfVariant): Boolean;
  100. begin
  101.   Result := False;
  102. end;
  103.  
  104. function TIfsCustomObject.GetProperty(I: Longint; Dest: PIfVariant): Boolean;
  105. begin
  106.   Result := False;
  107. end;
  108.  
  109. function TIfsCustomObject.FindProperty(const Name: string): Longint;
  110. begin
  111.   Result := -1;
  112. end;
  113.  
  114. function TIfsCustomObject.GetPropertyCount: Longint;
  115. begin
  116.   Result := 0;
  117. end;
  118.  
  119. function TIfsCustomObject.GetProcHeader(I: Longint): string;
  120. begin
  121.   Result := '';
  122. end;
  123.  
  124. function TIfsCustomObject.CallProc(I: Longint; Params: PVariableManager): PIFVariant;
  125. begin
  126.   Result := nil;
  127. end;
  128.  
  129. function TIfsCustomObject.GetProcCount: Longint;
  130. begin
  131.   Result := 0;
  132. end;
  133.  
  134. end.
  135.