364 lines
9.9 KiB
ObjectPascal
364 lines
9.9 KiB
ObjectPascal
{**************************************************************************************************}
|
|
{ }
|
|
{ Project JEDI Code Library (JCL) }
|
|
{ }
|
|
{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); }
|
|
{ you may not use this file except in compliance with the License. You may obtain a copy of the }
|
|
{ License at http://www.mozilla.org/MPL/ }
|
|
{ }
|
|
{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF }
|
|
{ ANY KIND, either express or implied. See the License for the specific language governing rights }
|
|
{ and limitations under the License. }
|
|
{ }
|
|
{ The Original Code is Queue.pas. }
|
|
{ }
|
|
{ The Initial Developer of the Original Code is Jean-Philippe BEMPEL aka RDM. Portions created by }
|
|
{ Jean-Philippe BEMPEL are Copyright (C) Jean-Philippe BEMPEL (rdm_30 att yahoo dott com) }
|
|
{ All rights reserved. }
|
|
{ }
|
|
{**************************************************************************************************}
|
|
{ }
|
|
{ The Delphi Container Library }
|
|
{ }
|
|
{**************************************************************************************************}
|
|
|
|
// Last modified: $Date: 2005/05/05 20:08:44 $
|
|
// For history see end of file
|
|
|
|
unit JclQueues;
|
|
|
|
{$I jcl.inc}
|
|
|
|
interface
|
|
|
|
uses
|
|
JclBase, JclAbstractContainers, JclContainerIntf;
|
|
|
|
type
|
|
TJclIntfQueue = class(TJclAbstractContainer, IJclIntfQueue)
|
|
private
|
|
FCapacity: Integer;
|
|
FElements: TDynIInterfaceArray;
|
|
FHead: Integer;
|
|
FTail: Integer;
|
|
protected
|
|
{ IJclIntfQueue }
|
|
function Contains(AInterface: IInterface): Boolean;
|
|
function Dequeue: IInterface;
|
|
function Empty: Boolean;
|
|
procedure Enqueue(AInterface: IInterface);
|
|
function Size: Integer;
|
|
public
|
|
constructor Create(ACapacity: Integer = DefaultContainerCapacity);
|
|
end;
|
|
|
|
TJclStrQueue = class(TJclAbstractContainer, IJclStrQueue)
|
|
private
|
|
FCapacity: Integer;
|
|
FElements: TDynStringArray;
|
|
FHead: Integer;
|
|
FTail: Integer;
|
|
protected
|
|
{ IJclStrQueue }
|
|
function Contains(const AString: string): Boolean;
|
|
function Dequeue: string;
|
|
function Empty: Boolean;
|
|
procedure Enqueue(const AString: string);
|
|
function Size: Integer;
|
|
public
|
|
constructor Create(ACapacity: Integer = DefaultContainerCapacity);
|
|
end;
|
|
|
|
TJclQueue = class(TJclAbstractContainer, IJclQueue)
|
|
private
|
|
FCapacity: Integer;
|
|
FElements: TDynObjectArray;
|
|
FHead: Integer;
|
|
FTail: Integer;
|
|
protected
|
|
{ IJclQueue }
|
|
function Contains(AObject: TObject): Boolean;
|
|
function Dequeue: TObject;
|
|
function Empty: Boolean;
|
|
procedure Enqueue(AObject: TObject);
|
|
function Size: Integer;
|
|
public
|
|
constructor Create(ACapacity: Integer = DefaultContainerCapacity);
|
|
end;
|
|
|
|
implementation
|
|
|
|
uses
|
|
JclResources;
|
|
|
|
//=== { TJclIntfQueue } ======================================================
|
|
|
|
constructor TJclIntfQueue.Create(ACapacity: Integer = DefaultContainerCapacity);
|
|
begin
|
|
inherited Create;
|
|
FHead := 0;
|
|
FTail := 0;
|
|
if ACapacity < 1 then
|
|
{$IFDEF CLR}
|
|
raise EJclIllegalArgumentError.Create(RsEIllegalQueueCapacity);
|
|
{$ELSE}
|
|
raise EJclIllegalArgumentError.CreateRes(@RsEIllegalQueueCapacity);
|
|
{$ENDIF CLR}
|
|
FCapacity := ACapacity;
|
|
SetLength(FElements, FCapacity);
|
|
end;
|
|
|
|
function TJclIntfQueue.Contains(AInterface: IInterface): Boolean;
|
|
var
|
|
I: Integer;
|
|
{$IFDEF THREADSAFE}
|
|
CS: IInterface;
|
|
{$ENDIF THREADSAFE}
|
|
begin
|
|
{$IFDEF THREADSAFE}
|
|
CS := EnterCriticalSection;
|
|
{$ENDIF THREADSAFE}
|
|
Result := False;
|
|
if AInterface = nil then
|
|
Exit;
|
|
I := FHead;
|
|
while I <> FTail do
|
|
begin
|
|
if FElements[I] = AInterface then
|
|
begin
|
|
Result := True;
|
|
Break;
|
|
end;
|
|
I := (I + 1) mod FCapacity;
|
|
end;
|
|
end;
|
|
|
|
function TJclIntfQueue.Dequeue: IInterface;
|
|
{$IFDEF THREADSAFE}
|
|
var
|
|
CS: IInterface;
|
|
{$ENDIF THREADSAFE}
|
|
begin
|
|
{$IFDEF THREADSAFE}
|
|
CS := EnterCriticalSection;
|
|
{$ENDIF THREADSAFE}
|
|
Result := nil;
|
|
if FTail = FHead then
|
|
Exit;
|
|
Result := FElements[FHead];
|
|
FElements[FHead] := nil;
|
|
FHead := (FHead + 1) mod FCapacity;
|
|
end;
|
|
|
|
function TJclIntfQueue.Empty: Boolean;
|
|
begin
|
|
Result := FTail = FHead;
|
|
end;
|
|
|
|
procedure TJclIntfQueue.Enqueue(AInterface: IInterface);
|
|
{$IFDEF THREADSAFE}
|
|
var
|
|
CS: IInterface;
|
|
{$ENDIF THREADSAFE}
|
|
begin
|
|
{$IFDEF THREADSAFE}
|
|
CS := EnterCriticalSection;
|
|
{$ENDIF THREADSAFE}
|
|
if AInterface = nil then
|
|
Exit;
|
|
FElements[FTail] := AInterface;
|
|
FTail := (FTail + 1) mod FCapacity;
|
|
end;
|
|
|
|
function TJclIntfQueue.Size: Integer;
|
|
begin
|
|
Result := FTail - FHead;
|
|
end;
|
|
|
|
//=== { TJclStrQueue } =======================================================
|
|
|
|
constructor TJclStrQueue.Create(ACapacity: Integer = DefaultContainerCapacity);
|
|
begin
|
|
inherited Create;
|
|
FHead := 0;
|
|
FTail := 0;
|
|
if ACapacity < 1 then
|
|
{$IFDEF CLR}
|
|
raise EJclIllegalArgumentError.Create(RsEIllegalQueueCapacity);
|
|
{$ELSE}
|
|
raise EJclIllegalArgumentError.CreateRes(@RsEIllegalQueueCapacity);
|
|
{$ENDIF CLR}
|
|
FCapacity := ACapacity;
|
|
SetLength(FElements, FCapacity);
|
|
end;
|
|
|
|
function TJclStrQueue.Contains(const AString: string): Boolean;
|
|
var
|
|
I: Integer;
|
|
{$IFDEF THREADSAFE}
|
|
CS: IInterface;
|
|
{$ENDIF THREADSAFE}
|
|
begin
|
|
{$IFDEF THREADSAFE}
|
|
CS := EnterCriticalSection;
|
|
{$ENDIF THREADSAFE}
|
|
Result := False;
|
|
if AString = '' then
|
|
Exit;
|
|
I := FHead;
|
|
while I <> FTail do
|
|
begin
|
|
if FElements[I] = AString then
|
|
begin
|
|
Result := True;
|
|
Break;
|
|
end;
|
|
I := (I + 1) mod FCapacity;
|
|
end;
|
|
end;
|
|
|
|
function TJclStrQueue.Dequeue: string;
|
|
{$IFDEF THREADSAFE}
|
|
var
|
|
CS: IInterface;
|
|
{$ENDIF THREADSAFE}
|
|
begin
|
|
{$IFDEF THREADSAFE}
|
|
CS := EnterCriticalSection;
|
|
{$ENDIF THREADSAFE}
|
|
Result := '';
|
|
if FTail = FHead then
|
|
Exit;
|
|
Result := FElements[FHead];
|
|
FElements[FHead] := '';
|
|
FHead := (FHead + 1) mod FCapacity;
|
|
end;
|
|
|
|
function TJclStrQueue.Empty: Boolean;
|
|
begin
|
|
Result := FTail = FHead;
|
|
end;
|
|
|
|
procedure TJclStrQueue.Enqueue(const AString: string);
|
|
{$IFDEF THREADSAFE}
|
|
var
|
|
CS: IInterface;
|
|
{$ENDIF THREADSAFE}
|
|
begin
|
|
{$IFDEF THREADSAFE}
|
|
CS := EnterCriticalSection;
|
|
{$ENDIF THREADSAFE}
|
|
if AString = '' then
|
|
Exit;
|
|
FElements[FTail] := AString;
|
|
FTail := (FTail + 1) mod FCapacity;
|
|
end;
|
|
|
|
function TJclStrQueue.Size: Integer;
|
|
begin
|
|
Result := FTail - FHead;
|
|
end;
|
|
|
|
//=== { TJclQueue } ==========================================================
|
|
|
|
constructor TJclQueue.Create(ACapacity: Integer = DefaultContainerCapacity);
|
|
begin
|
|
inherited Create;
|
|
if ACapacity < 1 then
|
|
{$IFDEF CLR}
|
|
raise EJclIllegalArgumentError.Create(RsEIllegalQueueCapacity);
|
|
{$ELSE}
|
|
raise EJclIllegalArgumentError.CreateRes(@RsEIllegalQueueCapacity);
|
|
{$ENDIF CLR}
|
|
FCapacity := ACapacity;
|
|
SetLength(FElements, FCapacity);
|
|
end;
|
|
|
|
function TJclQueue.Contains(AObject: TObject): Boolean;
|
|
var
|
|
I: Integer;
|
|
{$IFDEF THREADSAFE}
|
|
CS: IInterface;
|
|
{$ENDIF THREADSAFE}
|
|
begin
|
|
{$IFDEF THREADSAFE}
|
|
CS := EnterCriticalSection;
|
|
{$ENDIF THREADSAFE}
|
|
Result := False;
|
|
if AObject = nil then
|
|
Exit;
|
|
I := FHead;
|
|
while I <> FTail do
|
|
begin
|
|
if FElements[I] = AObject then
|
|
begin
|
|
Result := True;
|
|
Break;
|
|
end;
|
|
I := (I + 1) mod FCapacity;
|
|
end;
|
|
end;
|
|
|
|
function TJclQueue.Dequeue: TObject;
|
|
{$IFDEF THREADSAFE}
|
|
var
|
|
CS: IInterface;
|
|
{$ENDIF THREADSAFE}
|
|
begin
|
|
{$IFDEF THREADSAFE}
|
|
CS := EnterCriticalSection;
|
|
{$ENDIF THREADSAFE}
|
|
Result := nil;
|
|
if FTail = FHead then
|
|
Exit;
|
|
Result := FElements[FHead];
|
|
FElements[FHead] := nil;
|
|
FHead := (FHead + 1) mod FCapacity;
|
|
end;
|
|
|
|
function TJclQueue.Empty: Boolean;
|
|
begin
|
|
Result := FTail = FHead;
|
|
end;
|
|
|
|
procedure TJclQueue.Enqueue(AObject: TObject);
|
|
{$IFDEF THREADSAFE}
|
|
var
|
|
CS: IInterface;
|
|
{$ENDIF THREADSAFE}
|
|
begin
|
|
{$IFDEF THREADSAFE}
|
|
CS := EnterCriticalSection;
|
|
{$ENDIF THREADSAFE}
|
|
if AObject = nil then
|
|
Exit;
|
|
FElements[FTail] := AObject;
|
|
FTail := (FTail + 1) mod FCapacity;
|
|
end;
|
|
|
|
function TJclQueue.Size: Integer;
|
|
begin
|
|
Result := FTail - FHead;
|
|
end;
|
|
|
|
// History:
|
|
|
|
// $Log: JclQueues.pas,v $
|
|
// Revision 1.5 2005/05/05 20:08:44 ahuser
|
|
// JCL.NET support
|
|
//
|
|
// Revision 1.4 2005/03/08 08:33:17 marquardt
|
|
// overhaul of exceptions and resourcestrings, minor style cleaning
|
|
//
|
|
// Revision 1.3 2005/02/27 11:36:20 marquardt
|
|
// fixed and secured Capacity/Grow mechanism, raise exceptions with efficient CreateResRec
|
|
//
|
|
// Revision 1.2 2005/02/27 07:27:47 marquardt
|
|
// changed interface names from I to IJcl, moved resourcestrings to JclResource.pas
|
|
//
|
|
// Revision 1.1 2005/02/24 03:57:10 rrossmair
|
|
// - donated DCL code, initial check-in
|
|
//
|
|
|
|
end.
|