home *** CD-ROM | disk | FTP | other *** search
/ Chip 1998 March / Chip_1998-03_cd.bin / zkuste / delphi / WhiteAnts / CONTSTRM.ZIP / StrmSamp.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1997-01-09  |  3.3 KB  |  145 lines
  1. {
  2. *-------------------------------------------------------------------------*
  3. | file    : StrmSamp
  4. | date    : 09-01-97
  5. | time    : 12:29:40
  6.  
  7. This unit contains the TSample and TSampleList classes which demonstrate the
  8. use of Containers (TCollection ect.) and the TFilter / TStreamable base classes.
  9.  
  10. *-------------------------------------------------------------------------*
  11. }
  12.  
  13. unit StrmSamp;
  14.  
  15. interface
  16.  
  17. uses Classes, Filters, Containr;
  18.  
  19. type
  20.   TSampleOrder = (soName, soValue);
  21.   
  22.   TSample = class (TStreamable)
  23.   private
  24.     FName: PString;
  25.     FValue: LongInt;
  26.   protected
  27.     function GetName: String;
  28.     procedure SetName(const Value: String);
  29.   public
  30.     constructor Create;
  31.     constructor Load(Filter: TFilter); override;
  32.     destructor Destroy; override;
  33.     procedure Store(Filter: TFilter); override;
  34.     property Name: String read GetName write SetName;
  35.     property Value: LongInt read FValue write FValue;
  36.   end;
  37.  
  38.   TSampleList = class (TCollection)
  39.   private
  40.     FSortOn: TSampleOrder;
  41.   protected
  42.     function Compare(Key1, Key2: Pointer): Integer; override;
  43.     procedure SetSortOn(Value: TSampleOrder);
  44.   public
  45.     constructor Create;
  46.     property SortOn: TSampleOrder read FSortOn write SetSortOn;
  47.   end;
  48.  
  49.  
  50. implementation
  51.  
  52. uses SysUtils, StrUtils, NumUtils;
  53.  
  54. {
  55. *********************************** TSample ************************************
  56. }
  57. constructor TSample.Create;
  58.   const InstanceCnt: Integer = 0;
  59. begin
  60.   inherited Create;
  61.   Name := 'Default';
  62.   Inc(InstanceCnt);
  63.   Value := InstanceCnt;
  64. end;
  65.  
  66. constructor TSample.Load(Filter: TFilter);
  67. begin
  68.   inherited Load(Filter);
  69.   FName := NewStr(Filter.ReadStr);
  70.   Filter.Read(FValue, SizeOf(FValue));
  71.   { TFilter and unit FILTERS contain methods and procedure to
  72.     load and store strings, PChars, TStrings etc from a TFilter }
  73. end;
  74.  
  75. destructor TSample.Destroy;
  76. begin
  77.   DisposeStr(FName);
  78.   inherited Destroy;
  79. end;
  80.  
  81. function TSample.GetName: String;
  82. begin
  83.   Result := StringValue(FName);
  84. end;
  85.  
  86. procedure TSample.SetName(const Value: String);
  87. begin
  88.   AssignStr(FName, Value);
  89. end;
  90.  
  91. procedure TSample.Store(Filter: TFilter);
  92. begin
  93.   inherited Store(Filter);
  94.   Filter.WriteStr(StringValue(FName));
  95.   Filter.Write(FValue, SizeOf(FValue));
  96. end;
  97.  
  98. {
  99. ********************************* TSampleList **********************************
  100. }
  101. constructor TSampleList.Create;
  102. begin
  103.   inherited Create;
  104.   CanSort := True;
  105.   Sorted := True;
  106.   Duplicates := CONTAINR.dupAccept;
  107. end;
  108.  
  109. function TSampleList.Compare(Key1, Key2: Pointer): Integer;
  110. var
  111.   N, V: Integer;
  112. begin
  113.   N := CompareText(TSample(Key1).Name, TSample(Key2).Name);
  114.   V := CompareInt(TSample(Key1).Value, TSample(Key2).Value);
  115.   if FSortOn = soName then
  116.     if N <> 0 then
  117.       Result := N
  118.     else
  119.       Result := V
  120.   else
  121.     if V <> 0 then
  122.       Result := V
  123.     else
  124.       Result := N;
  125. end;
  126.  
  127. procedure TSampleList.SetSortOn(Value: TSampleOrder);
  128. begin
  129.   if FSortOn <> Value then
  130.   begin
  131.     FSortOn := Value;
  132.     { Since we changed the sorting conditions we need to re-sort the
  133.       collection. Toggling Sorted will do this }
  134.     Sorted := False;
  135.     Sorted := True;
  136.   end;
  137. end;
  138.  
  139.  
  140. initialization
  141.   RegisterStreamable(TSample);
  142.   RegisterStreamable(TSampleList);
  143. end.
  144.  
  145.