home *** CD-ROM | disk | FTP | other *** search
/ ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng) / ProfitPress-MegaCDROM2.B6I / WINDOWS / PROGRAM / PCHART.ZIP / DICTS.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1991-05-02  |  3.9 KB  |  175 lines
  1. {**************************************************}
  2. {  This unit defines the dictionary types used in  }
  3. {  the Windows charting program PCHART.PAS.        }
  4. {                  Zack Urlocker                   }
  5. {                    05/02/91                      }
  6. {                                                  }
  7. {  Two types are defined:                          }
  8. {       TAssoc: a key value pair of a C style      }
  9. {               string and an Integer value        }
  10. {       TDict : a dictionary of TAssocs            }
  11. {  both types include methods for stream storage   }
  12. {**************************************************}
  13.  
  14. unit Dicts;
  15.  
  16. {$IFDEF Final}        { Remove debug code for final version}
  17. {$D-,I-,L-,R-,S-}
  18. {$ELSE}
  19. {$D+,I+,L+,R+,S+}
  20. {$ENDIF}
  21.  
  22. interface
  23.  
  24. uses WObjects, Strings;
  25.  
  26. type
  27.   PAssoc = ^TAssoc;
  28.   TAssoc = Object(TObject)
  29.     key : PChar;
  30.     value : Integer;
  31.     constructor Init(NewKey : PChar; NewValue : Integer);
  32.     destructor Done; virtual;
  33.     constructor Load(var S: TStream);
  34.     procedure Store(var S: TStream);
  35.   end;
  36.  
  37.   PDict = ^TDict;
  38.   TDict = Object(TCollection)
  39.    current : PAssoc;
  40. { Functions and procedures }
  41.    function Size : Integer;
  42.    function MaxValue : Integer;
  43.    procedure Add(key : PChar; value : Integer);
  44.    function Find(key : PChar): Boolean;
  45.    procedure Remove(key : PChar);
  46.    procedure Update(key : PChar; value : Integer);
  47. end;
  48.  
  49.  
  50. implementation
  51.  
  52.  
  53. { *********   TAssoc  ********* }
  54.  
  55. { Initialize a new association, allocating memory }
  56. constructor TAssoc.Init(NewKey : PChar; NewValue : Integer);
  57. begin
  58.   Key := StrNew(NewKey);
  59.   Value := NewValue;
  60. end;
  61.  
  62. { Dispose of the association by deallocating memory}
  63. destructor TAssoc.Done;
  64. begin
  65.   StrDispose(Key);
  66. end;
  67.  
  68. { Load the key, value from the stream, and allocate memory }
  69. constructor TAssoc.Load(var S: TStream);
  70. begin
  71. { Allocate, and read C style string}
  72.   Key := S.StrRead;
  73.   S.Read(Value, sizeOf(Value));
  74. end;
  75.  
  76. { Store the key, value on the stream }
  77. procedure TAssoc.Store(var S: TStream);
  78. begin
  79.   S.StrWrite(Key);
  80.   S.write(Value, sizeOf(Value));
  81. end;
  82.  
  83.  
  84. { *********   TDict  ********* }
  85.  
  86. { Return the size of the dictionary }
  87. function TDict.Size : Integer;
  88. begin
  89.   Size := count;
  90. end;
  91.  
  92. { Find the maximum value in the dictionary }
  93. function TDict.MaxValue : Integer;
  94. var Max : Integer;
  95.  
  96. { Is its value bigger than current maximum? }
  97. procedure GetMax(Item: PAssoc); far;
  98. begin
  99.   if Item^.value > Max then
  100.     Max := Item^.Value;
  101. end;
  102.  
  103. begin { MaxValue }
  104.   Max := 0;
  105.   ForEach(@GetMax);
  106.   MaxValue := Max;
  107. end;
  108.  
  109. { Add a key value pair to the dictionary }
  110. procedure TDict.Add(key : PChar; value : Integer);
  111. begin
  112.   Insert(New(PAssoc, Init(key, value)));
  113. end;
  114.  
  115. { Search the Dictionary for a key }
  116. function TDict.Find(key : PChar) : Boolean;
  117. var Found : Boolean;
  118.  
  119. { Does the item match the key? }
  120. function Match(Item:PAssoc) : Boolean; far;
  121. begin
  122.   Match := (StrComp(Item^.key, Key)=0);
  123. end;
  124.  
  125. begin {Find}
  126.   Current := FirstThat(@Match);
  127.   If Current <> nil then
  128.     Found := True
  129.   else
  130.     Found := False;
  131.   Find := Found;
  132. end;
  133.  
  134. { Find the item and then remove it }
  135. procedure TDict.Remove(key : PChar);
  136. begin
  137.   if Find(key) then
  138.     Delete(Current);
  139. end;
  140.  
  141. { If it exists, then update it, otherwise add it. }
  142. procedure TDict.Update(key : PChar; value : Integer);
  143. begin
  144.   if Find(Key) then
  145.     Current^.Value := value
  146.   else
  147.     Add(Key, Value);
  148. end;
  149.  
  150.  
  151. { Stream registration records }
  152.  
  153. const
  154.  
  155.   RAssoc : TStreamRec = (
  156.     ObjType : 1000;
  157.     VmtLink : Ofs(TypeOf(TAssoc)^);
  158.     Load : @TAssoc.Load;
  159.     Store: @TAssoc.Store
  160.   );
  161.  
  162.   RDict : TStreamRec = (
  163.     ObjType : 1001;
  164.     VmtLink : Ofs(TypeOf(TDict)^);
  165.     Load : @TCollection.Load;
  166.     Store: @TCollection.Store
  167.   );
  168.  
  169.  
  170. { Initialization }
  171. begin
  172.   RegisterType(RAssoc);
  173.   RegisterType(RDict);
  174. end.
  175.