home *** CD-ROM | disk | FTP | other *** search
/ Chip 2000 February / Chip_2000-02_cd.bin / zkuste / Delphi / navody / tt / objvm.exe / UNITS / ClassValue.pas next >
Encoding:
Pascal/Delphi Source File  |  1998-06-26  |  2.5 KB  |  89 lines
  1. unit ClassValue;
  2.  
  3. interface
  4. uses VisualValue,
  5.      ConstValues,LangValue,ObjectValue,Classes,
  6.      ValueUtils,ProxyValue;
  7. const nCreate='Create';
  8. type
  9.        {TClassValue is value to implement classes in objVM language }
  10.      TClassValue=class(TVisualValue)
  11.      protected
  12.        fValues:TConstValues;
  13.        function rdValues(const s:string):ILangValue;override;
  14.      public
  15.         function HasValue(const s:string):boolean;override;
  16.         procedure AddValue(const aName:string;a:ILangValue);override;
  17.         procedure RemoveValue(a:ILangValue);override;
  18.         function CreateObject(o:TComponent):ILangValue;
  19.      published
  20.         constructor Create(o:TComponent);override;
  21.         destructor  Destroy;override;
  22.      end;
  23. type TCreateValue=class(ILangValue)
  24.      protected
  25.         fClass:TClassValue;
  26.      public
  27.         Constructor CreateFrom(a:TClassValue);
  28.         procedure   Exec(s:IValStack;MustReturn:boolean);override;
  29.      end;
  30. implementation
  31. function TClassValue.rdValues;
  32.          begin
  33.            Result:=nil;
  34.            if S=nCreate then
  35.            Result:=TCreateValue.CreateFrom(Self);
  36.          end;
  37. function TClassValue.HasValue;
  38.          begin
  39.            Result:=s=nCreate;
  40.          end;
  41. procedure   TClassValue.AddValue;
  42.             begin
  43.               fValues.AddValue(aName,a);
  44.             end;
  45. procedure   TClassValue.RemoveValue;
  46.             begin
  47.               fValues.RemoveValue(a);
  48.             end;
  49. function    TClassValue.CreateObject;
  50.             begin
  51.               Result:=TDefObjectValue.Create(o);
  52.               fValues.AddTo(Result);
  53.               Result:=TProxyValue.CreateFrom(Result);
  54.             end;
  55. constructor TClassValue.Create;
  56.             begin
  57.               Inherited Create(o);
  58.               fValues:=TConstValues.Create;
  59.             end;
  60. destructor  TClassValue.Destroy;
  61.             begin
  62.               fValues.Free;
  63.               Inherited Destroy;
  64.             end;
  65. Constructor TCreateValue.CreateFrom;
  66.             begin
  67.               inherited Create(nil);
  68.               fClass:=a;
  69.             end;
  70. procedure   TCreateValue.Exec;
  71.             Var o:ILangValue;
  72.                 cm:ILangValue;
  73.             begin
  74.               o:=fClass.CreateObject(nil);
  75.               cm:=o.Values[nCreate];
  76.               if cm=nil then
  77.               begin
  78.                 s.DropFrame;
  79.               end
  80.               else
  81.               begin
  82.                 cm.Exec(s,false);
  83.               end;
  84.               if MustReturn then
  85.                 s.Push(o);
  86.             end;
  87.  
  88. end.
  89.