- Timestamp:
- Apr 3, 2012, 7:35:26 AM (13 years ago)
- Location:
- Generics/TemplateGenerics
- Files:
-
- 2 added
- 7 edited
Legend:
- Unmodified
- Added
- Removed
-
Generics/TemplateGenerics/Generic/GenericList.inc
r312 r342 24 24 FItems: array of TGListItem; 25 25 FCount: TGListIndex; 26 FUpdateCount: NativeInt; 27 FOnUpdate: TNotifyEvent; 26 28 function Get(Index: TGListIndex): TGListItem; 27 29 function GetCapacity: TGListIndex; … … 72 74 procedure Sort(Compare: TGListSortCompare); 73 75 procedure SetArray(Values: array of TGListItem); 76 procedure BeginUpdate; 77 procedure EndUpdate; 78 procedure Update; 74 79 property Count: TGListIndex read FCount write SetCount; 75 80 property Capacity: TGListIndex read GetCapacity write SetCapacity; … … 107 112 I := I + 1; 108 113 end; 114 Update; 109 115 end; 110 116 … … 118 124 I := I + 1; 119 125 end; 126 Update; 120 127 end; 121 128 … … 130 137 I := I + 1; 131 138 end; 139 Update; 132 140 end; 133 141 … … 248 256 I := I + 1; 249 257 end; 258 Update; 250 259 end; 251 260 … … 294 303 InsertCount(Index, 1); 295 304 FItems[Index] := Item; 305 Update; 296 306 end; 297 307 … … 319 329 if Index < FCount then 320 330 System.Move(FItems[Index], FItems[Index + ACount], (FCount - ACount - Index) * SizeOf(TGListItem)); 331 Update; 321 332 end; 322 333 … … 409 420 //Delete(CurIndex); 410 421 //Insert(NewIndex, Temp); 422 Update; 411 423 end; 412 424 … … 434 446 end; 435 447 end; 448 Update; 436 449 end; 437 450 … … 469 482 I := I + 1; 470 483 end; 484 Update; 471 485 end; 472 486 … … 475 489 if FCount > 1 then 476 490 QuickSort(0, FCount - 1, Compare); 491 Update; 477 492 end; 478 493 … … 486 501 I := I + 1; 487 502 end; 503 Update; 488 504 end; 489 505 … … 498 514 I := I + 1; 499 515 end; 516 end; 517 518 procedure TGList.BeginUpdate; 519 begin 520 Inc(FUpdateCount); 521 end; 522 523 procedure TGList.EndUpdate; 524 begin 525 Dec(FUpdateCount); 526 Update; 527 end; 528 529 procedure TGList.Update; 530 begin 531 if Assigned(FOnUpdate) and (FUpdateCount = 0) then FOnUpdate(Self); 500 532 end; 501 533 … … 530 562 Result := FCount - 1; 531 563 FItems[Result] := Item; 564 Update; 532 565 end; 533 566 … … 545 578 J := J + 1; 546 579 end; 580 Update; 547 581 end; 548 582 … … 560 594 J := J + 1; 561 595 end; 596 Update; 562 597 end; 563 598 … … 575 610 System.Move(FItems[Index + 1], FItems[Index], (FCount - Index) * SizeOf(TGListItem)); 576 611 SetCapacityOptimized(Capacity - 1); 612 Update; 577 613 end; 578 614 … … 586 622 I := I + 1; 587 623 end; 624 Update; 588 625 end; 589 626 … … 597 634 I := I + 1; 598 635 end; 636 Update; 599 637 end; 600 638 … … 610 648 FItems[Index1] := FItems[Index2]; 611 649 FItems[Index2] := Temp; 650 Update; 612 651 end; 613 652 -
Generics/TemplateGenerics/Generic/GenericRectangle.inc
r333 r342 11 11 function GetTopRight: TGRectanglePoint; 12 12 function GetWidth: TGRectangleDimension; 13 function GetEmpty: Boolean; 13 14 procedure SetBottom(const AValue: TGRectangleDimension); 14 15 procedure SetBottomLeft(const AValue: TGRectanglePoint); … … 21 22 procedure SetTopLeft(const AValue: TGRectanglePoint); 22 23 procedure SetTopRight(const AValue: TGRectanglePoint); 23 24 24 procedure SetWidth(const AValue: TGRectangleDimension); 25 procedure SetEmpty(const AValue: Boolean); 25 26 public 26 27 FLeft: TGRectangleDimension; … … 52 53 53 54 property Size: TGRectanglePoint read GetSize write SetSize; 55 property Empty: Boolean read GetEmpty write SetEmpty; 54 56 end; 55 57 … … 199 201 procedure TGRectangle.Intersect(Rect1, Rect2: TGRectangle); 200 202 begin 201 Left := Max(Rect1.Left, Rect2.Left); 202 Top := Max(Rect1.Top, Rect2.Top); 203 Right := Min(Rect1.Right, Rect2.Right); 204 Bottom := Min(Rect1.Bottom, Rect2.Bottom); 203 if Rect1.Empty or Rect2.Empty then Empty := True 204 else begin 205 Left := Max(Rect1.Left, Rect2.Left); 206 Top := Max(Rect1.Top, Rect2.Top); 207 Right := Min(Rect1.Right, Rect2.Right); 208 Bottom := Min(Rect1.Bottom, Rect2.Bottom); 209 end; 205 210 end; 206 211 207 212 procedure TGRectangle.IntersectWith(Rect: TGRectangle); 208 213 begin 209 Left := Max(Left, Rect.Left); 210 Top := Max(Top, Rect.Top); 211 Right := Min(Right, Rect.Right); 212 Bottom := Min(Bottom, Rect.Bottom); 214 if Empty or Rect.Empty then Empty := True 215 else begin 216 Left := Max(Left, Rect.Left); 217 Top := Max(Top, Rect.Top); 218 Right := Min(Right, Rect.Right); 219 Bottom := Min(Bottom, Rect.Bottom); 220 end; 213 221 end; 214 222 215 223 procedure TGRectangle.Union(Rect1, Rect2: TGRectangle); 216 224 begin 217 Left := Min(Rect1.Left, Rect2.Left); 218 Top := Min(Rect1.Top, Rect2.Top); 219 Right := Max(Rect1.Right, Rect2.Right); 220 Bottom := Max(Rect1.Bottom, Rect2.Bottom); 225 if Rect1.Empty then Assign(Rect2) 226 else 227 if Rect2.Empty then Assign(Rect1) 228 else begin 229 Left := Min(Rect1.Left, Rect2.Left); 230 Top := Min(Rect1.Top, Rect2.Top); 231 Right := Max(Rect1.Right, Rect2.Right); 232 Bottom := Max(Rect1.Bottom, Rect2.Bottom); 233 end; 221 234 end; 222 235 223 236 procedure TGRectangle.UnionWith(Rect: TGRectangle); 224 237 begin 225 Left := Min(Left, Rect.Left); 226 Top := Min(Top, Rect.Top); 227 Right := Max(Right, Rect.Right); 228 Bottom := Max(Bottom, Rect.Bottom); 238 if Empty then Assign(Rect) 239 else 240 if not Rect.Empty then begin 241 Left := Min(Left, Rect.Left); 242 Top := Min(Top, Rect.Top); 243 Right := Max(Right, Rect.Right); 244 Bottom := Max(Bottom, Rect.Bottom); 245 end; 246 end; 247 248 function TGRectangle.GetEmpty: Boolean; 249 begin 250 Result := (Bottom <= Top) or (Right <= Left); 251 end; 252 253 procedure TGRectangle.SetEmpty(const AValue: Boolean); 254 begin 255 Top := 0; 256 Bottom := 0; 257 Left := 0; 258 Right := 0; 229 259 end; 230 260 -
Generics/TemplateGenerics/Generic/GenericStream.inc
r312 r342 13 13 procedure Write(Item: TGStreamItem); virtual; abstract; 14 14 procedure WriteArray(Item: array of TGStreamItem); virtual; abstract; 15 procedure WriteStream(Stream: TGStream; Count: TGStreamIndex); virtual; abstract; 15 16 function Read: TGStreamItem; virtual; abstract; 16 17 function ReadArray(Count: TGStreamIndex): TGStreamItemArray; virtual; abstract; 18 function ReadStream(Stream: TGStream; Count: TGStreamIndex): TGStreamIndex; virtual; abstract; 17 19 function Insert(Count: TGStreamIndex): TGStreamIndex; virtual; abstract; 18 20 function Remove(Count: TGStreamIndex): TGStreamIndex; virtual; abstract; -
Generics/TemplateGenerics/Specialized/SpecializedList.pas
r304 r342 95 95 procedure AddStream(Stream: TStream); 96 96 procedure AddStreamPart(Stream: TStream; ItemCount: TGListIndex); 97 procedure WriteBuffer(var Buffer; Count: Integer); 98 procedure ReadBuffer(var Buffer; Count: Integer); 97 99 end; 98 100 … … 417 419 end; 418 420 421 procedure TListByte.WriteBuffer(var Buffer; Count: Integer); 422 begin 423 424 end; 425 426 procedure TListByte.ReadBuffer(var Buffer; Count: Integer); 427 begin 428 429 end; 430 419 431 end. -
Generics/TemplateGenerics/Specialized/SpecializedStream.pas
r312 r342 6 6 7 7 uses 8 Classes, SysUtils, SpecializedList ;8 Classes, SysUtils, SpecializedList, DateUtils; 9 9 10 10 type … … 29 29 {$DEFINE TGStreamItem := Byte} 30 30 {$DEFINE TGStreamList := TListStreamByte} 31 {$DEFINE TGStream := T StreamByte}31 {$DEFINE TGStream := TBaseStreamByte} 32 32 {$DEFINE TGStreamSortCompare := TStreamByteSortCompare} 33 33 {$DEFINE TGStreamToStringConverter := TStreamByteToStringConverter} … … 49 49 {$I 'GenericStream.inc'} 50 50 51 TStreamByte = class(TBaseStreamByte) 52 function ReadBuffer(var Buffer; Count: Integer): Integer; virtual; abstract; 53 function WriteBuffer(var Buffer; Count: Integer): Integer; virtual; abstract; 54 end; 55 56 { TMemoryStreamByte } 57 58 TMemoryStreamByte = class(TStreamByte) 59 private 60 FList: TListByte; 61 FOwnsList: Boolean; 62 FPosition: Integer; 63 public 64 procedure Assign(Source: TBaseStreamByte); override; 65 procedure Write(Item: Byte); override; 66 procedure WriteArray(Values: array of Byte); override; 67 procedure WriteList(List: TListByte); 68 function WriteBuffer(var Buffer; Count: Integer): Integer; override; 69 procedure WriteStream(Stream: TBaseStreamByte; Count: Integer); override; 70 function Read: Byte; override; 71 function ReadArray(Count: Integer): TStreamByteItemArray; override; 72 function ReadList(List: TListByte; Count: Integer): Integer; 73 function ReadBuffer(var Buffer; Count: Integer): Integer; override; 74 function ReadStream(Stream: TBaseStreamByte; Count: Integer): Integer; override; 75 function Insert(Count: Integer): Integer; override; 76 function Remove(Count: Integer): Integer; override; 77 function Seek(Offset: Integer; Origin: TSeekOrigin = soCurrent): Integer; override; 78 constructor Create; override; overload; 79 constructor Create(AList: TListByte); overload; 80 destructor Destroy; override; 81 property OwnsList: Boolean read FOwnsList write FOwnsList; 82 property List: TListByte read FList; 83 end; 84 85 86 implementation 87 51 88 { TMemoryStreamByte } 52 89 53 TMemoryStreamByte = class(TStreamByte) 54 private 55 FList: TListByte; 56 FPosition: Integer; 57 public 58 procedure Assign(Source: TStreamByte); override; 59 procedure Write(Item: Byte); override; 60 procedure WriteArray(Values: array of Byte); override; 61 procedure WriteList(List: TListByte); 62 function Read: Byte; override; 63 function ReadArray(Count: Integer): TStreamByteItemArray; override; 64 function ReadList(List: TListByte; Count: Integer): Integer; 65 function Insert(Count: Integer): Integer; override; 66 function Remove(Count: Integer): Integer; override; 67 function Seek(Offset: Integer; Origin: TSeekOrigin = soCurrent): Integer; override; 68 constructor Create; override; 69 destructor Destroy; override; 70 property List: TListByte read FList; 71 end; 72 73 74 implementation 75 76 { TMemoryStreamByte } 77 78 procedure TMemoryStreamByte.Assign(Source: TStreamByte); 90 procedure TMemoryStreamByte.Assign(Source: TBaseStreamByte); 79 91 begin 80 92 inherited; … … 106 118 end; 107 119 120 procedure TMemoryStreamByte.WriteStream(Stream: TBaseStreamByte; Count: Integer); 121 begin 122 123 end; 124 125 function TMemoryStreamByte.WriteBuffer(var Buffer; Count: Integer): Integer; 126 begin 127 128 end; 129 108 130 function TMemoryStreamByte.Read: Byte; 109 131 begin … … 125 147 end; 126 148 149 function TMemoryStreamByte.ReadBuffer(var Buffer; Count: Integer): Integer; 150 begin 151 152 end; 153 154 function TMemoryStreamByte.ReadStream(Stream: TBaseStreamByte; Count: Integer 155 ): Integer; 156 begin 157 158 end; 159 127 160 function TMemoryStreamByte.Insert(Count: Integer): Integer; 128 161 begin … … 154 187 inherited; 155 188 FList := TListByte.Create; 189 OwnsList := True; 190 end; 191 192 constructor TMemoryStreamByte.Create(AList: TListByte); 193 begin 194 inherited Create; 195 FList := AList; 196 OwnsList := False; 156 197 end; 157 198 158 199 destructor TMemoryStreamByte.Destroy; 159 200 begin 160 FList.Free;201 if OwnsList then FList.Free; 161 202 inherited Destroy; 162 203 end; … … 181 222 {$DEFINE TGStreamItem := Byte} 182 223 {$DEFINE TGStreamList := TListStreamByte} 183 {$DEFINE TGStream := T StreamByte}224 {$DEFINE TGStream := TBaseStreamByte} 184 225 {$DEFINE TGStreamSortCompare := TStreamByteSortCompare} 185 226 {$DEFINE TGStreamToStringConverter := TStreamByteToStringConverter} … … 200 241 {$DEFINE IMPLEMENTATION} 201 242 {$I 'GenericStream.inc'} 243 244 245 202 246 end. -
Generics/TemplateGenerics/TemplateGenerics.lpk
r334 r342 11 11 <SearchPaths> 12 12 <IncludeFiles Value="Generic"/> 13 <OtherUnitFiles Value="Specialized;Generic "/>13 <OtherUnitFiles Value="Specialized;Generic;Additional"/> 14 14 <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/> 15 15 </SearchPaths> … … 29 29 <Description Value="Generic classes implemented as templates."/> 30 30 <Version Minor="4"/> 31 <Files Count="2 6">31 <Files Count="27"> 32 32 <Item1> 33 33 <Filename Value="ReadMe.txt"/> … … 88 88 <Item15> 89 89 <Filename Value="Generic\GenericRectangle.inc"/> 90 <UnitName Value="GenericRectangle"/> 90 91 </Item15> 91 92 <Item16> … … 133 134 <UnitName Value="SpecializedRectangle"/> 134 135 </Item26> 136 <Item27> 137 <Filename Value="Additional\UBinarySerializer.pas"/> 138 <UnitName Value="UBinarySerializer"/> 139 </Item27> 135 140 </Files> 136 141 <Type Value="RunAndDesignTime"/> -
Generics/TemplateGenerics/TemplateGenerics.pas
r333 r342 11 11 SpecializedQueue, SpecializedSet, SpecializedPoint, SpecializedMatrix, 12 12 SpecializedBitmap, SpecializedStream, SpecializedRectangle, 13 LazarusPackageIntf;13 UBinarySerializer, LazarusPackageIntf; 14 14 15 15 implementation
Note:
See TracChangeset
for help on using the changeset viewer.