home *** CD-ROM | disk | FTP | other *** search
/ POINT Software Programming / PPROG1.ISO / pascal / swag / oop.swg / 0018_STROBJ.PAS.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1993-05-28  |  5.4 KB  |  189 lines
  1. Program KenTest;
  2. { a short program to check out collecting TObject Descendents, as
  3.   opposed to binding data types directly to a collection object}
  4.  
  5. Uses Objects;
  6. Type
  7.     PBaseData = ^BaseData;
  8.      BaseData = Object(TObject)
  9.                    name : PString;
  10.                    DType: Word;
  11.                    Data : Pointer;
  12.                    Constructor Init(AName:String;Var AData);
  13.                    Procedure PutData(Var S:TStream); virtual;
  14.                    Function GetData(Var S:TStream):Pointer; virtual;
  15.                    Procedure SetData(Var ADAta); virtual;
  16.                    Constructor Load(Var S:TStream);
  17.                    Procedure Store(Var S:TStream); virtual;
  18.                    Destructor Done; virtual;
  19.                  end;
  20. Constructor BaseData.Init(AName:String;Var AData);
  21.    Begin
  22.      Name := NewStr(Aname);
  23.      Data := Nil;
  24.      SetData(AData);
  25.    End;
  26. Constructor BaseData.Load(Var S:TStream);
  27.    Begin
  28.      Name := S.ReadStr;
  29.      S.Read(DType,2);
  30.      Data := GetData(S);
  31.    End;
  32. Procedure BaseData.SetData(Var AData);
  33.    Begin
  34.      DType := 0;
  35.    End;
  36. Procedure BaseData.Store(Var S:TStream);
  37.    Begin
  38.      S.WriteStr(Name);
  39.      S.Write(DType,2);
  40.      PutData(S);
  41.    End;
  42. Function BaseData.GetData(Var S:TStream):Pointer;
  43.    Begin
  44.      GetData := Nil;
  45.    End;
  46. Procedure BaseData.PutData(Var S:TStream);
  47.    Begin
  48.    End;
  49. Destructor BaseData.Done;
  50.   Begin
  51.     DisposeStr(Name);
  52.   End;
  53.  
  54. Type
  55.    PStrData = ^StrData;
  56.    StrData = Object(BaseData)
  57.                    Procedure PutData(Var S:TStream); virtual;
  58.                    Function GetData(Var S:TStream):Pointer; virtual;
  59.                    Procedure SetData(Var ADAta); virtual;
  60.                    Destructor Done; virtual;
  61.                 end;
  62.    LongPtr   = ^LongInt;
  63.    PNumData = ^NumData;
  64.    NumData = Object(BaseData)
  65.                    Procedure PutData(Var S:TStream); virtual;
  66.                    Function GetData(Var S:TStream):Pointer; virtual;
  67.                    Procedure SetData(Var ADAta); virtual;
  68.                    Destructor Done; virtual;
  69.                 end;
  70.  
  71. Procedure StrData.PutData(Var S:TStream);
  72.    Begin
  73.      S.WriteStr(PString(Data));
  74.    End;
  75. Function StrData.GetData(Var S:TStream):Pointer;
  76.    Begin
  77.      GetData := S.ReadStr;
  78.    End;
  79. Procedure StrData.SetData(Var AData);
  80.    Var S:String Absolute AData;
  81.    Begin
  82.      Data := NewStr(S);
  83.      DType := 1;
  84.    End;
  85. Destructor StrData.Done;
  86.    Begin
  87.      DisposeStr(PString(Data));
  88.      Inherited Done;
  89.    End;
  90.  
  91. Procedure NumData.PutData(Var S:TStream);
  92.    Begin
  93.      S.Write(LongPtr(Data)^,SizeOf(LongInt));
  94.    End;
  95. Function NumData.GetData(Var S:TStream):Pointer;
  96.    Var L : LongPtr;
  97.    Begin
  98.      New(L);
  99.      S.Read(L^,SizeOf(LongInt));
  100.      GetData := L;
  101.    End;
  102. Procedure NumData.SetData(Var AData);
  103.    Var L:LongInt Absolute AData;
  104.    Begin
  105.      DType := 2;
  106.      New(LongPtr(Data));
  107.      LongPtr(Data)^ := L;
  108.    End;
  109. Destructor NumData.Done;
  110.    Begin
  111.      Dispose(LongPtr(Data));
  112.      Inherited Done;
  113.    End;
  114.  
  115. Const
  116. RStrDataRec : TStreamRec = (ObjType : 19561;
  117.                              VMTLink : Ofs(TypeOf(StrData)^);
  118.                              Load    : @StrData.Load;
  119.                              Store   : @StrData.Store);
  120.  
  121. RNumDataRec : TStreamRec = (ObjType : 19562;
  122.                              VMTLink : Ofs(TypeOf(NumData)^);
  123.                              Load    : @NumData.Load;
  124.                              Store   : @NumData.Store);
  125.  
  126. Procedure ShowStuff(P:PCollection);
  127.    Procedure ShowName(P:PBaseData); far;
  128.       Begin
  129.         if P^.Name <> Nil
  130.         then Write(P^.Name^,'   ');
  131.         Case P^.DType of
  132.            1 : if PString(P^.Data) <> Nil then Writeln(PString(P^.Data)^);
  133.            2 : writeln(LongPtr(P^.Data)^);
  134.          end;
  135.       end;
  136.    Begin
  137.      P^.ForEach(@ShowName);
  138.    End;
  139.  
  140. Var
  141.   P : PCollection;
  142.   Ps : PDosStream;
  143.   m : Longint;
  144.   S : String;
  145.   I : LongInt;
  146. Begin
  147.   m := MaxAvail;
  148.   RegisterType(RCollection);
  149.   RegisterType(RStrDataRec);
  150.   RegisterType(RNumDataRec);
  151.   New(P,init(5,5));
  152.   if P <> Nil then
  153.       Begin
  154.         S := 'String data # 1';
  155.         P^.insert(New(PStrData,init('A string data type ',S)));
  156.         S := 'String data # 2';
  157.         P^.insert(New(PStrData,init('A second string data type ',S)));
  158.         I := 1234567;
  159.         P^.Insert(New(PNumData,init('Numeric Data Type',I)));
  160.         S := 'String Data #3';
  161.         P^.Insert(New(PStrData,init('A third string data type ',S)));
  162.         I := 987654;
  163.         P^.Insert(New(PNumData,init('A second Numeric data type ',I)));
  164.         New(Ps,init('Test1.dta',StCreate));
  165.         if Ps <> Nil then
  166.             begin
  167.               P^.Store(Ps^);
  168.               dispose(P,Done);
  169.               Dispose(Ps,Done);
  170.               if maxavail = m then writeln('mem disposed')
  171.                               else writeln('Failed to release memory');
  172.               new(Ps,init('test1.dta',stopenread));
  173.               if Ps <> Nil then
  174.                  Begin
  175.                    New(P,Load(Ps^));
  176.                    dispose(Ps,done);
  177.                    if P <> Nil then showstuff(P);
  178.                    if p <> Nil then dispose(P,done);
  179.                  end;
  180.             end;
  181.      end;
  182.   if maxavail = m then writeln('mem disposed')
  183.                   else writeln('Failed to release memory');
  184. End.
  185.  
  186. ...ken
  187. ---
  188.  * Origin: Telos Point of Source. Replied From Saved Mail.  (Max 1:249/201.21)
  189.