home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / OOF20.ZIP / OOF.INC < prev   
Encoding:
Text File  |  1987-09-19  |  2.9 KB  |  102 lines
  1.  
  2. {                          Version 2.00                        87/09/19
  3.  
  4.                      OOF! (Object Oriented Fudge)
  5.  
  6.        Utilities for Object Oriented Programming in TURBO Pascal.
  7.  
  8.  
  9. COPYRIGHT NOTICE:
  10.  
  11.   These utilities are COPYRIGHT (c) 1987 by Mike Babulic. They may be used
  12.   as if they were in the public domain so long as the following conditions are
  13.   met:
  14.          1) This notice of copyright must be included in full unless the
  15.             copyright owner's permission is obtained.
  16.  
  17.          2) Commercial publishers must obtain the copyright owner's permission
  18.             before physically publishing this work. Anyone may publish this
  19.             work in a non-physical form.
  20.                 - some examples of non-physical publication (allowed):
  21.                     - Electronic Bulletin Boards, Compuserve
  22.                 - some examples of physical publication (prohibited):
  23.                     - Books, Magazines, Floppy Disks
  24.                 - Computer clubs are NOT considered to be commercial publishers
  25.  
  26. AUTHOR:     Mike Babulic
  27.             3827 Charleswood Drive N.W.
  28.             Calgary, Alberta
  29.             CANADA
  30.             T2L 2C7
  31.  
  32.             Compuserve Id.:  72307,314
  33. }
  34. {----------------------------------------------------------------------------}
  35.  
  36. TYPE Class = Integer;
  37.  
  38. {----------------------------------------------------------------------------}
  39.  
  40. PROCEDURE Message(MethodTimes3:Integer);  EXTERNAL  'Message.bin';
  41.  
  42. PROCEDURE DoMethod(MethodOffset:Integer); EXTERNAL  'DoMethod.bin';
  43.  
  44. PROCEDURE DoParent(MethodOffset:Integer); EXTERNAL  'DoParent.bin';
  45.  
  46. {----------------------------------------------------------------------------}
  47.  
  48.  
  49. TYPE TObject = record
  50.        dispatcher: Class;
  51.        end;
  52.  
  53.  
  54. {MESSAGES}
  55.  
  56.     FUNCTION GetParent(var class):Integer;      BEGIN  Message(0)  END;
  57.  
  58.  
  59. {METHODS}  PROCEDURE CObject(message,no:integer);  FORWARD;
  60.  
  61.     FUNCTION TObject_GetParent(var classFunction):Class;  FORWARD;
  62.  
  63. {IMPLEMENTATION}
  64.  
  65.     FUNCTION TObject_GetParent{var classFunction):Class};
  66.       BEGIN
  67.         TObject_GetParent := ofs(CObject);
  68.       END;
  69.  
  70.  
  71. {DISPATCHER}
  72.  
  73.     PROCEDURE CObject{message,no:integer};
  74.       BEGIN
  75.         IF message = ofs(GetParent) then DoMethod(ofs(TObject_GetParent));
  76.       END;
  77.  
  78.  
  79. {----------------------------------------------------------------------------}
  80.  
  81.  
  82. PROCEDURE SetClass(var self; c:Class);
  83.   VAR my : TObject  ABSOLUTE  self;
  84.   BEGIN
  85.     my.dispatcher := c;
  86.   END;
  87.  
  88. FUNCTION GetClass(var self):Class;
  89.   VAR my : TObject  ABSOLUTE  self;
  90.   BEGIN
  91.     GetClass := my.dispatcher;
  92.   END;
  93.  
  94. FUNCTION Member(var anObject; c:Class):Boolean;
  95.   {True if anObject is a descendant of c}
  96.   VAR  me  : class;
  97.   BEGIN
  98.     me := GetClass(anObject);
  99.     while (me<>c) and (me<>ofs(CObject)) do
  100.       me := GetParent(me);
  101.     Member := (me = c);
  102.   END;