home *** CD-ROM | disk | FTP | other *** search
/ Chip 2001 December / Chip_2001-12_cd1.bin / zkuste / delphi / kompon / d23456 / CAJSCRTP.ZIP / libraries / delphiforms / ifsctrlstd.pas next >
Pascal/Delphi Source File  |  2001-10-03  |  12KB  |  317 lines
  1. unit ifsctrlstd;
  2.  
  3. {
  4.   Innerfuse Pascal Script Forms Library
  5.   For license see Innerfuse Pascal Script license file
  6.  
  7. }
  8. interface
  9. uses
  10.   ifspas, ifs_var, ifs_utl, ifsdfrm;
  11.  
  12. procedure RegisterStdControlsLibrary(p: TIfPasScript);
  13. {
  14. Before registering this, you must also register the forms library.
  15. This Will register:
  16. type
  17.   TMemo = class(TControl)
  18.   private
  19.     function GetText: string;
  20.     procedure SetText(S: String);
  21.     function GetReadonly: Boolean;
  22.     procedure SetReadonly(B: Boolean);
  23.   public
  24.     Constructor Create(AParent: TControl);
  25.     property Text: string read GetText write SetText;
  26.     property readonly: Boolean read GetReadonly write SetReadonly;
  27.   end;
  28.   TButton = class(TControl)
  29.   private
  30.     function GetDefault: Boolean;
  31.     procedure SetDefault(b: Boolean);
  32.     function GetCancel: Boolean;
  33.     procedure SetCancel(b: Boolean);
  34.     function GetCaption: string;
  35.     procedure SetCaption(s: string);
  36.   public
  37.     Constructor Create(AParent: TControl);
  38.     property Caption: string read GetCaption write SetCaption;
  39.     property Cancel: Boolean read GetCancel write SetCancel;
  40.     property Default: Boolean read GetDefault write SetDefault;
  41.   end;
  42.   TEdit = class(TControl)
  43.   private
  44.     function GetReadonly: Boolean;
  45.     procedure SetReadonly(B: Boolean);
  46.     funtion GetText: string;
  47.     procedure SetText(s: string);
  48.   public
  49.     constructor Create(AParent: TControl);
  50.     property Text: string read GetText write SetText;
  51.     property readonly: Boolean read GetReadonly write SetReadonly;
  52.   end;
  53.   TLabel = class(TControl)
  54.   private
  55.     function GetCaption: string;
  56.     procedure SetCaption(s: string);
  57.   public
  58.     constructory Create(Aparent: TControl);
  59.     property Caption: string read GetCaption write SetCaption;
  60.   end;
  61. }
  62. {$I ifs_def.inc}
  63. implementation
  64. uses
  65.   Classes{$IFDEF CLX}, QControls, QStdCtrls{$ELSE}, Controls, StdCtrls{$ENDIF};
  66. const
  67.   TButtonClass = 'class(TControl)' +
  68.     'private ' +
  69.     'function GetCaption: string;' +
  70.     'function GetDefault: Boolean;' +
  71.     'procedure SetDefault(b: Boolean);' +
  72.     'function GetCancel: Boolean;' +
  73.     'procedure SetCancel(b: Boolean);' +
  74.     'procedure SetCaption(s: string);' +
  75.     'public ' +
  76.     'Constructor Create(AParent: TControl);' +
  77.     'property Caption: string read GetCaption write SetCaption;' +
  78.     'property Cancel: Boolean read GetCancel write SetCancel;' +
  79.     'property Default: Boolean read GetDefault write SetDefault;' +
  80.     'end;';
  81.   TEditClass = 'class(TControl)private '+'function GetReadonly: Boolean;'+
  82.   'procedure SetReadonly(B: Boolean);'+'function GetText: string;procedure SetText(s' +
  83.     ': string);public constructor Create(AParent: TControl);property Text: string ' +
  84.     'read GetText write SetText;property ReadOnly: Boolean read GetReadonly write SetReadonly;end;';
  85.   TLabelClass = 'class(TControl)private function GetCaption: string;procedure ' +
  86.     'SetCaption(s: string);public constructor Create(Aparent: TControl);property ' +
  87.     'Caption: string read GetCaption write SetCaption;end;';
  88.   TMemoClass = 'class(TControl)private '+
  89.     'function GetText: string;'+
  90.     'procedure SetText(S: String);'+
  91.     'function GetReadonly: Boolean;'+
  92.     'procedure SetReadonly(B: Boolean);'+
  93.   'public '+
  94.     'Constructor Create(AParent: TControl);'+
  95.     'property Text: string read GetText write SetText;'+
  96.     'property Readonly: Boolean read GetReadonly write SetReadonly;'+
  97.   'end;';
  98.  
  99.  
  100. function TButtonProc(Sender: TIfPasScript; ScriptID: Pointer; proc: PProcedure; Params: PVariableManager; res: PIfVariant): TIfPasScriptError;
  101. var
  102.   Ctrl, Self: PIfVariant;
  103.   v: PVariableManager;
  104. begin
  105.   Self := Vm_Get(Params, 0);
  106.   if (not GetClassVariable(Self, proc^.ClassType^.Ext, 'FCONTROL', Ctrl, True)) then begin
  107.     TButtonProc := ENotSupported; // internal error
  108.     exit;
  109.   end;
  110.   TButtonProc := ENoError;
  111.   if proc^.Name = '!GETCAPTION' then begin
  112.     if Ctrl^.Cv_Int1 = nil then begin
  113.       TButtonProc := ENotSupported;
  114.       exit;
  115.     end;
  116.     SetString(res, TButton(Ctrl^.Cv_Int1).Caption);
  117.   end else if proc^.Name = '!SETCANCEL' then begin
  118.     if Ctrl^.Cv_Int1 = nil then begin
  119.       TButtonProc := ENotSupported;
  120.       exit;
  121.     end;
  122.     TButton(Ctrl^.Cv_Int1).Cancel := GetBoolean(Vm_Get(Params, 1));
  123.   end else if proc^.Name = '!SETDEFAULT' then begin
  124.     if Ctrl^.Cv_Int1 = nil then begin
  125.       TButtonProc := ENotSupported;
  126.       exit;
  127.     end;
  128.     TButton(Ctrl^.Cv_Int1).Default := GetBoolean(Vm_Get(Params, 1));
  129.   end else if proc^.Name = '!GETCANCEL' then begin
  130.     if Ctrl^.Cv_Int1 = nil then begin
  131.       TButtonProc := ENotSupported;
  132.       exit;
  133.     end;
  134.     SetBoolean(res, TButton(Ctrl^.Cv_Int1).Cancel);
  135.   end else if proc^.Name = '!GETDEFAULT' then begin
  136.     if Ctrl^.Cv_Int1 = nil then begin
  137.       TButtonProc := ENotSupported;
  138.       exit;
  139.     end;
  140.     SetBoolean(res, TButton(Ctrl^.Cv_Int1).Default);
  141.   end else if proc^.Name = '!SETCAPTION' then begin
  142.     if Ctrl^.Cv_Int1 = nil then begin
  143.       TButtonProc := ENotSupported;
  144.       exit;
  145.     end;
  146.     TButton(Ctrl^.Cv_Int1).Caption := GetString(Vm_Get(Params, 1));
  147.   end else if proc^.Name = '!CREATE' then begin
  148.     Ctrl^.Cv_Int1 := TButton.Create(nil);
  149.     Ctrl^.Cv_Int2 := GetCV_Int2;
  150.     TControl(Ctrl^.Cv_Int1).Tag := Integer(Self^.CV_Class);
  151.     v := VM_Create;
  152.     Vm_Add(v, Self, 'SELF');
  153.     Vm_Add(v, Sender.CopyVariant(Vm_Get(Params, 1)), '');
  154.     Sender.RunScriptProc(GetInheritedProc(proc), v);
  155.     VM_Delete(v, 0);
  156.     VM_Destroy(v);
  157.     TButton(Ctrl^.Cv_Int1).OnClick := TNotifyEvent(Proc2Method(@MyOnClick, Sender));
  158.     TButton(Ctrl^.Cv_Int1).OnKeyPress := TKeyPressEvent(Proc2Method(@MyOnKeyPress, Sender));
  159.   end;
  160. end;
  161.  
  162. function TLabelProc(Sender: TIfPasScript; ScriptID: Pointer; proc: PProcedure; Params: PVariableManager; res: PIfVariant): TIfPasScriptError;
  163. var
  164.   Ctrl, Self: PIfVariant;
  165.   v: PVariableManager;
  166. begin
  167.   Self := Vm_Get(Params, 0);
  168.   if (not GetClassVariable(Self, proc^.ClassType^.Ext, 'FCONTROL', Ctrl, True)) then begin
  169.     TLabelProc := ENotSupported; // internal error
  170.     exit;
  171.   end;
  172.   TLabelProc := ENoError;
  173.   if proc^.Name = '!GETCAPTION' then begin
  174.     if Ctrl^.Cv_Int1 = nil then begin
  175.       TLabelProc := ENotSupported;
  176.       exit;
  177.     end;
  178.     SetString(res, TLabel(Ctrl^.Cv_Int1).Caption);
  179.   end else if proc^.Name = '!SETCAPTION' then begin
  180.     if Ctrl^.Cv_Int1 = nil then begin
  181.       TLabelProc := ENotSupported;
  182.       exit;
  183.     end;
  184.     TLabel(Ctrl^.Cv_Int1).Caption := GetString(Vm_Get(Params, 1));
  185.   end else if proc^.Name = '!CREATE' then begin
  186.     Ctrl^.Cv_Int1 := TLabel.Create(nil);
  187.     Ctrl^.Cv_Int2 := GetCV_Int2;
  188.     TControl(Ctrl^.Cv_Int1).Tag := Integer(Self^.CV_Class);
  189.     v := VM_Create;
  190.     Vm_Add(v, Self, 'SELF');
  191.     Vm_Add(v, Sender.CopyVariant(Vm_Get(Params, 1)), '');
  192.     Sender.RunScriptProc(GetInheritedProc(proc), v);
  193.     VM_Delete(v, 0);
  194.     VM_Destroy(v);
  195.     TLabel(Ctrl^.Cv_Int1).OnClick := TNotifyEvent(Proc2Method(@MyOnClick, Sender));
  196.     TLabel(Ctrl^.Cv_Int1).OnDblClick := TNotifyEvent(Proc2Method(@MyOnDblClick, Sender));
  197.   end;
  198. end;
  199.  
  200. function TEditProc(Sender: TIfPasScript; ScriptID: Pointer; proc: PProcedure; Params: PVariableManager; res: PIfVariant): TIfPasScriptError;
  201. var
  202.   Ctrl, Self: PIfVariant;
  203.   v: PVariableManager;
  204. begin
  205.   Self := Vm_Get(Params, 0);
  206.   if (not GetClassVariable(Self, proc^.ClassType^.Ext, 'FCONTROL', Ctrl, True)) then begin
  207.     TEditProc := ENotSupported; // internal error
  208.     exit;
  209.   end;
  210.   TEditProc := ENoError;
  211.   if proc^.Name = '!GETTEXT' then begin
  212.     if Ctrl^.Cv_Int1 = nil then begin
  213.       TEditProc := ENotSupported;
  214.       exit;
  215.     end;
  216.     SetString(res, TEdit(Ctrl^.Cv_Int1).Text);
  217.   end else if proc^.Name = '!SETTEXT' then begin
  218.     if Ctrl^.Cv_Int1 = nil then begin
  219.       TEditProc := ENotSupported;
  220.       exit;
  221.     end;
  222.     TEdit(Ctrl^.Cv_Int1).Text := GetString(Vm_Get(Params, 1));
  223.   end else if Proc^.Name ='!SETREADONLY' then begin
  224.     if Ctrl^.Cv_Int1 = nil then begin
  225.       TEditProc := ENotSupported;
  226.       exit;
  227.     end;
  228.     SetBoolean(res, TEdit(Ctrl^.Cv_Int1).Readonly);
  229.   end
  230.   else if Proc^.Name ='!GETREADONLY' then begin
  231.     if Ctrl^.Cv_Int1 = nil then begin
  232.       TEditProc := ENotSupported;
  233.       exit;
  234.     end;
  235.     TEdit(Ctrl^.CV_Int1).Readonly := GetBoolean(VM_Get(Params, 1));
  236.   end else if proc^.Name = '!CREATE' then begin
  237.     Ctrl^.Cv_Int1 := TEdit.Create(nil);
  238.     Ctrl^.Cv_Int2 := GetCV_Int2;
  239.     TControl(Ctrl^.Cv_Int1).Tag := Integer(Self^.CV_Class);
  240.     v := VM_Create;
  241.     Vm_Add(v, Self, 'SELF');
  242.     Vm_Add(v, Sender.CopyVariant(Vm_Get(Params, 1)), '');
  243.     Sender.RunScriptProc(GetInheritedProc(proc), v);
  244.     VM_Delete(v, 0);
  245.     VM_Destroy(v);
  246.     TEdit(Ctrl^.Cv_Int1).OnClick := TNotifyEvent(Proc2Method(@MyOnClick, Sender));
  247.     TEdit(Ctrl^.Cv_Int1).OnDblClick := TNotifyEvent(Proc2Method(@MyOnDblClick, Sender));
  248.     TEdit(Ctrl^.Cv_Int1).OnChange := TNotifyEvent(Proc2Method(@MyOnChange, Sender));
  249.     TEdit(Ctrl^.Cv_Int1).OnKeyPress := TKeyPressEvent(Proc2Method(@MyOnKeyPress, Sender));
  250.   end;
  251. end;
  252.  
  253. function TMemoProc(Sender: TIfPasScript; ScriptID: Pointer; proc: PProcedure; Params: PVariableManager; res: PIfVariant): TIfPasScriptError;
  254. var
  255.   Ctrl, Self: PIfVariant;
  256.   v: PVariableManager;
  257. begin
  258.   Self := Vm_Get(Params, 0);
  259.   if (not GetClassVariable(Self, proc^.ClassType^.Ext, 'FCONTROL', Ctrl, True)) then begin
  260.     TMemoProc := ENotSupported; // internal error
  261.     exit;
  262.   end;
  263.   TMemoProc := ENoError;
  264.   if proc^.Name = '!GETTEXT' then begin
  265.     if Ctrl^.Cv_Int1 = nil then begin
  266.       TMemoProc := ENotSupported;
  267.       exit;
  268.     end;
  269.     SetString(res, TMemo(Ctrl^.Cv_Int1).Text);
  270.   end else if proc^.Name = '!SETTEXT' then begin
  271.     if Ctrl^.Cv_Int1 = nil then begin
  272.       TMemoProc := ENotSupported;
  273.       exit;
  274.     end;
  275.     TMemo(Ctrl^.Cv_Int1).Text := GetString(Vm_Get(Params, 1));
  276.   end
  277.   else if Proc^.Name ='!SETREADONLY' then begin
  278.     if Ctrl^.Cv_Int1 = nil then begin
  279.       TMemoProc := ENotSupported;
  280.       exit;
  281.     end;
  282.     TMemo(Ctrl^.CV_Int1).Readonly := GetBoolean(VM_Get(Params, 1));
  283.   end
  284.   else if Proc^.Name ='!GETREADONLY' then begin
  285.     if Ctrl^.Cv_Int1 = nil then begin
  286.       TMemoProc := ENotSupported;
  287.       exit;
  288.     end;
  289.     SetBoolean(res, TMemo(Ctrl^.Cv_Int1).Readonly);
  290.   end else if proc^.Name = '!CREATE' then begin
  291.     Ctrl^.Cv_Int1 := TMemo.Create(nil);
  292.     Ctrl^.Cv_Int2 := GetCV_Int2;
  293.     TControl(Ctrl^.Cv_Int1).Tag := Integer(Self^.CV_Class);
  294.     v := VM_Create;
  295.     Vm_Add(v, Self, 'SELF');
  296.     Vm_Add(v, Sender.CopyVariant(Vm_Get(Params, 1)), '');
  297.     Sender.RunScriptProc(GetInheritedProc(proc), v);
  298.     VM_Delete(v, 0);
  299.     VM_Destroy(v);
  300.     TMemo(Ctrl^.Cv_Int1).OnClick := TNotifyEvent(Proc2Method(@MyOnClick, Sender));
  301.     TMemo(Ctrl^.Cv_Int1).OnDblClick := TNotifyEvent(Proc2Method(@MyOnDblClick, Sender));
  302.     TMemo(Ctrl^.Cv_Int1).OnChange := TNotifyEvent(Proc2Method(@MyOnChange, Sender));
  303.     TMemo(Ctrl^.Cv_Int1).OnKeyPress := TKeyPressEvent(Proc2Method(@MyOnKeyPress, Sender));
  304.   end;
  305. end;
  306.  
  307. procedure RegisterStdControlsLibrary(p: TIfPasScript);
  308. begin
  309.   p.AddClass('TBUTTON', TButtonClass, @TButtonProc);
  310.   p.AddClass('TEDIT', TEditClass, @TEditProc);
  311.   p.AddClass('TLABEL', TLabelClass, @TLabelProc);
  312.   p.AddClass('TMEMO', TMemoClass, @TMemoProc);
  313. end;
  314.  
  315. end.
  316.  
  317.