jclstacks.pas

East make Tray Icon in delphi

{**************************************************************************************************}
{                                                                                                  }
{ 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 Stack.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/02/27 11:36:20 $
// For history see end of file

unit JclStacks;

{$I jcl.inc}

interface

uses
  JclBase, JclAbstractContainers, JclContainerIntf;

type
  TJclIntfStack = class(TJclAbstractContainer, IJclIntfStack)
  private
    FElements: TDynIInterfaceArray;
    FCount: Integer;
    FCapacity: Integer;
  protected
    procedure Grow; virtual;
    { IJclIntfStack }
    function Contains(AInterface: IInterface): Boolean;
    function Empty: Boolean;
    function Pop: IInterface;
    procedure Push(AInterface: IInterface);
    function Size: Integer;
  public
    constructor Create(ACapacity: Integer = DefaultContainerCapacity);
  end;

  TJclStrStack = class(TJclAbstractContainer, IJclStrStack)
  private
    FElements: TDynStringArray;
    FCount: Integer;
    FCapacity: Integer;
  protected
    procedure Grow; virtual;
    { IJclStrStack }
    function Contains(const AString: string): Boolean;
    function Empty: Boolean;
    function Pop: string;
    procedure Push(const AString: string);
    function Size: Integer;
  public
    constructor Create(ACapacity: Integer = DefaultContainerCapacity);
  end;

  TJclStack = class(TJclAbstractContainer, IJclStack)
  private
    FElements: TDynObjectArray;
    FCount: Integer;
    FCapacity: Integer;
  protected
    procedure Grow; virtual;
    { IJclStack }
    function Contains(AObject: TObject): Boolean;
    function Empty: Boolean;
    function Pop: TObject;
    procedure Push(AObject: TObject);
    function Size: Integer;
  public
    constructor Create(ACapacity: Integer = DefaultContainerCapacity);
  end;

implementation

//=== { TJclIntfStack } ======================================================

constructor TJclIntfStack.Create(ACapacity: Integer = DefaultContainerCapacity);
begin
  inherited Create;
  FCount := 0;
  if ACapacity < 0 then
    FCapacity := 0
  else
    FCapacity := ACapacity;
  SetLength(FElements, FCapacity);
end;

function TJclIntfStack.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;
  for I := 0 to FCount - 1 do
    if FElements[I] = AInterface then
    begin
      Result := True;
      Break;
    end;
end;

function TJclIntfStack.Empty: Boolean;
begin
  Result := FCount = 0;
end;

procedure TJclIntfStack.Grow;
begin
  if FCapacity > 64 then
    FCapacity := FCapacity + FCapacity div 4
  else
    FCapacity := FCapacity * 4;
  SetLength(FElements, FCapacity);
end;

function TJclIntfStack.Pop: IInterface;
{$IFDEF THREADSAFE}
var
  CS: IInterface;
{$ENDIF THREADSAFE}
begin
  {$IFDEF THREADSAFE}
  CS := EnterCriticalSection;
  {$ENDIF THREADSAFE}
  if FCount = 0 then
    Exit;
  Dec(FCount);
  Result := FElements[FCount];
end;

procedure TJclIntfStack.Push(AInterface: IInterface);
{$IFDEF THREADSAFE}
var
  CS: IInterface;
{$ENDIF THREADSAFE}
begin
  {$IFDEF THREADSAFE}
  CS := EnterCriticalSection;
  {$ENDIF THREADSAFE}
  if AInterface = nil then
    Exit;
  if FCount = FCapacity then
    Grow;
  FElements[FCount] := AInterface;
  Inc(FCount);
end;

function TJclIntfStack.Size: Integer;
begin
  Result := FCount;
end;

//=== { TJclStrStack } =======================================================

constructor TJclStrStack.Create(ACapacity: Integer = DefaultContainerCapacity);
begin
  inherited Create;
  FCount := 0;
  if ACapacity < 0 then
    FCapacity := 0
  else
    FCapacity := ACapacity;
  SetLength(FElements, FCapacity);
end;

function TJclStrStack.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;
  for I := 0 to FCount - 1 do
    if FElements[I] = AString then
    begin
      Result := True;
      Exit;
    end;
end;

function TJclStrStack.Empty: Boolean;
begin
  Result := FCount = 0;
end;

procedure TJclStrStack.Grow;
begin
  if FCapacity > 64 then
    FCapacity := FCapacity + FCapacity div 4
  else
    FCapacity := FCapacity * 4;
  SetLength(FElements, FCapacity);
end;

function TJclStrStack.Pop: string;
{$IFDEF THREADSAFE}
var
  CS: IInterface;
{$ENDIF THREADSAFE}
begin
  {$IFDEF THREADSAFE}
  CS := EnterCriticalSection;
  {$ENDIF THREADSAFE}
  if FCount = 0 then
    Exit;
  Dec(FCount);
  Result := FElements[FCount];
end;

procedure TJclStrStack.Push(const AString: string);
{$IFDEF THREADSAFE}
var
  CS: IInterface;
{$ENDIF THREADSAFE}
begin
  {$IFDEF THREADSAFE}
  CS := EnterCriticalSection;
  {$ENDIF THREADSAFE}
  if AString = '' then
    Exit;
  if FCount = FCapacity then
    Grow;
  FElements[FCount] := AString;
  Inc(FCount);
end;

function TJclStrStack.Size: Integer;
begin
  Result := FCount;
end;

//=== { TJclStack } ==========================================================

constructor TJclStack.Create(ACapacity: Integer = DefaultContainerCapacity);
begin
  inherited Create;
  FCount := 0;
  if ACapacity < 0 then
    FCapacity := 0
  else
    FCapacity := ACapacity;
  SetLength(FElements, FCapacity);
end;

function TJclStack.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;
  for I := 0 to FCount - 1 do
    if FElements[I] = AObject then
    begin
      Result := True;
      Break;
    end;
end;

function TJclStack.Empty: Boolean;
begin
  Result := FCount = 0;
end;

procedure TJclStack.Grow;
begin
  if FCapacity > 64 then
    FCapacity := FCapacity + FCapacity div 4
  else
    FCapacity := FCapacity * 4;
  SetLength(FElements, FCapacity);
end;

function TJclStack.Pop: TObject;
{$IFDEF THREADSAFE}
var
  CS: IInterface;
{$ENDIF THREADSAFE}
begin
  {$IFDEF THREADSAFE}
  CS := EnterCriticalSection;
  {$ENDIF THREADSAFE}
  Result := nil;
  if FCount = 0 then
    Exit;
  Dec(FCount);
  Result := FElements[FCount];
end;

procedure TJclStack.Push(AObject: TObject);
{$IFDEF THREADSAFE}
var
  CS: IInterface;
{$ENDIF THREADSAFE}
begin
  {$IFDEF THREADSAFE}
  CS := EnterCriticalSection;
  {$ENDIF THREADSAFE}
  if AObject = nil then
    Exit;
  if FCount = FCapacity then
    Grow;
  FElements[FCount] := AObject;
  Inc(FCount);
end;

function TJclStack.Size: Integer;
begin
  Result := FCount;
end;

// History:

// $Log: JclStacks.pas,v $
// 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.