home *** CD-ROM | disk | FTP | other *** search
/ Chip 2003 January / Chip_2003-01_cd1.bin / zkuste / delphi / kolekce / d567 / FLEXCEL.ZIP / XLSAdapter / UBreakList.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  2002-09-26  |  2.1 KB  |  91 lines
  1. unit UBreakList;
  2.  
  3. interface
  4. uses Classes, SysUtils, XlsMessages, UXlsBaseRecords;
  5.  
  6. type
  7.   TBreakList=class(TList)
  8.   private
  9.     CurrentPos: integer;
  10.     ZeroPos: integer;
  11.   protected
  12.     procedure Notify(Ptr: Pointer; Action: TListNotification); override;
  13.   public
  14.     constructor Create(const aZeroPos: integer);
  15.  
  16.     function CurrentId: integer;
  17.     function CurrentSize: integer;
  18.     function AcumSize: integer;
  19.  
  20.     procedure IncCurrent;
  21.     procedure Add(const aId, aSize: integer);
  22.  
  23.     procedure AddToZeroPos(const Delta: integer);
  24.   end;
  25.  
  26. implementation
  27. type
  28.   TRBreakList=record
  29.     Id, Size, AcumSize: integer;
  30.   end;
  31.  
  32.   PRBreakList= ^TRBreakList;
  33.  
  34.  
  35. { TBreakList }
  36.  
  37. function TBreakList.AcumSize: integer;
  38. begin
  39.   if (CurrentPos>= Count)or (CurrentPos<0) then Raise Exception.Create(ErrInternal);
  40.   Result:= PRBreakList(Items[CurrentPos]).AcumSize + ZeroPos + SizeOf(TRecordHeader)*(CurrentPos);
  41. end;
  42.  
  43. procedure TBreakList.Add(const aId, aSize: integer);
  44. var
  45.   RBreakList: PRBreakList;
  46. begin
  47.   New( RBreakList);
  48.   RBreakList.Id:=aId;
  49.   RBreakList.Size:=aSize;
  50.   RBreakList.AcumSize:=aSize;
  51.   if Count>0 then inc(RBreakList.AcumSize, PRBreakList(Items[Count-1]).AcumSize);
  52.   inherited Add(RBreakList);
  53. end;
  54.  
  55. procedure TBreakList.AddToZeroPos(const Delta: integer);
  56. begin
  57.   inc(ZeroPos, Delta);
  58. end;
  59.  
  60. constructor TBreakList.Create(const aZeroPos: integer);
  61. begin
  62.   inherited Create;
  63.   ZeroPos:= aZeroPos;
  64. end;
  65.  
  66. function TBreakList.CurrentId: integer;
  67. begin
  68.   if (CurrentPos>= Count)or (CurrentPos<0) then Raise Exception.Create(ErrInternal);
  69.   Result:= PRBreakList(Items[CurrentPos]).Id;
  70. end;
  71.  
  72. function TBreakList.CurrentSize: integer;
  73. begin
  74.   if (CurrentPos+1>= Count)or (CurrentPos+1<0) then Raise Exception.Create(ErrInternal);
  75.   Result:= PRBreakList(Items[CurrentPos+1]).Size;
  76. end;
  77.  
  78. procedure TBreakList.IncCurrent;
  79. begin
  80.   inc(CurrentPos);
  81. end;
  82.  
  83. procedure TBreakList.Notify(Ptr: Pointer; Action: TListNotification);
  84. begin
  85.   inherited;
  86.   if Action = lnDeleted then Dispose(PRBreakList(Ptr));
  87.   inherited Notify(Ptr, Action);
  88. end;
  89.  
  90. end.
  91.