unit CollWrappers; (***************************************************************************** * Copyright 2003 by Matthew Greet * This library is free software; you can redistribute it and/or modify it * under the terms of the GNU Lesser General Public License as published by the * Free Software Foundation; either version 2.1 of the License, or (at your * option) any later version. * * This library is distributed in the hope that it will be useful, but WITHOUT * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS * FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for more * details. (http://opensource.org/licenses/lgpl-license.php) * * See http://www.warmachine.u-net.com/delphi_collections for updates and downloads. * * $Version: v1.0.3 $ * $Revision: 1.1.1.1 $ * $Log: D:\QVCS Repositories\Delphi Collections\CollWrappers.qbt $ * * Various primitive type wrappers, adapters and abstract base classes for * natural items. * * Revision 1.1.1.1 by: Matthew Greet Rev date: 24/10/03 16:48:16 * v1.0 branch. * * Revision 1.1 by: Matthew Greet Rev date: 06/04/03 10:51:04 * Primitive type wrapper interfaces added. * Abstract, template classes added. * All classes implement reference counting by descending from * TInterfacedObject. * * * Revision 1.0 by: Matthew Greet Rev date: 01/03/03 10:50:02 * Initial revision. * * FPC compatibility fixes by: UltraStar Deluxe Team * * $Endlog$ *****************************************************************************) {$IFDEF FPC} {$MODE Delphi}{$H+} {$ENDIF} interface uses SysUtils, Collections; type IAssociationWrapper = interface ['{54DF42E0-64F2-11D7-8120-0002E3165EF8}'] function GetAutoDestroy: Boolean; procedure SetAutoDestroy(Value: Boolean); function GetKey: ICollectable; function GetValue: TObject; property AutoDestroy: Boolean read GetAutoDestroy write SetAutoDestroy; property Key: ICollectable read GetKey; property Value: TObject read GetValue; end; IBoolean = interface ['{62D1D160-64F2-11D7-8120-0002E3165EF8}'] function GetValue: Boolean; property Value: Boolean read GetValue; end; ICardinal = interface ['{6AF7B1C0-64F2-11D7-8120-0002E3165EF8}'] function GetValue: Cardinal; property Value: Cardinal read GetValue; end; IChar = interface ['{73AD00E0-64F2-11D7-8120-0002E3165EF8}'] function GetValue: Char; property Value: Char read GetValue; end; IClass = interface ['{7A84B660-64F2-11D7-8120-0002E3165EF8}'] function GetValue: TClass; property Value: TClass read GetValue; end; IDouble = interface ['{815C6BE0-64F2-11D7-8120-0002E3165EF8}'] function GetValue: Double; property Value: Double read GetValue; end; IInteger = interface ['{88ECC300-64F2-11D7-8120-0002E3165EF8}'] function GetValue: Integer; property Value: Integer read GetValue; end; IIntegerAssociationWrapper = interface ['{8F582220-64F2-11D7-8120-0002E3165EF8}'] function GetAutoDestroy: Boolean; procedure SetAutoDestroy(Value: Boolean); function GetKey: Integer; function GetValue: TObject; property AutoDestroy: Boolean read GetAutoDestroy write SetAutoDestroy; property Key: Integer read GetKey; property Value: TObject read GetValue; end; IInterfaceWrapper = interface ['{962E5100-64F2-11D7-8120-0002E3165EF8}'] function GetValue: IUnknown; property Value: IUnknown read GetValue; end; IObject = interface ['{9C675580-64F2-11D7-8120-0002E3165EF8}'] function GetAutoDestroy: Boolean; procedure SetAutoDestroy(Value: Boolean); function GetValue: TObject; property Value: TObject read GetValue; end; IString = interface ['{A420DF80-64F2-11D7-8120-0002E3165EF8}'] function GetValue: String; property Value: String read GetValue; end; IStringAssociationWrapper = interface ['{AB98CCA0-64F2-11D7-8120-0002E3165EF8}'] function GetAutoDestroy: Boolean; procedure SetAutoDestroy(Value: Boolean); function GetKey: String; function GetValue: TObject; property AutoDestroy: Boolean read GetAutoDestroy write SetAutoDestroy; property Key: String read GetKey; property Value: TObject read GetValue; end; TAbstractItem = class(TInterfacedObject, ICollectable) public function GetInstance: TObject; virtual; end; TAbstractIntegerMappable = class(TAbstractItem, IEquatable, IIntegerMappable) private FKey: Integer; protected function MakeKey: Integer; virtual; abstract; public procedure AfterConstruction; override; function Equals(const Item: ICollectable): Boolean; virtual; function GetKey: Integer; virtual; end; TAbstractMappable = class(TAbstractItem, IEquatable, IMappable) private FKey: ICollectable; protected function MakeKey: ICollectable; virtual; abstract; public destructor Destroy; override; procedure AfterConstruction; override; function Equals(const Item: ICollectable): Boolean; virtual; function GetKey: ICollectable; virtual; end; TAbstractStringMappable = class(TAbstractItem, IEquatable, IStringMappable) private FKey: String; protected function MakeKey: String; virtual; abstract; public procedure AfterConstruction; override; function Equals(const Item: ICollectable): Boolean; virtual; function GetKey: String; virtual; end; TAssociationWrapper = class(TAbstractItem, IEquatable, IMappable, IAssociationWrapper) private FAutoDestroy: Boolean; FKey: ICollectable; FValue: TObject; public constructor Create(const Key: ICollectable; Value: TObject); overload; constructor Create(Key: Integer; Value: TObject); overload; constructor Create(Key: String; Value: TObject); overload; constructor Create(Key, Value: TObject; AutoDestroyKey: Boolean = true); overload; destructor Destroy; override; function GetAutoDestroy: Boolean; procedure SetAutoDestroy(Value: Boolean); function GetKey: ICollectable; function GetValue: TObject; function Equals(const Item: ICollectable): Boolean; property AutoDestroy: Boolean read GetAutoDestroy write SetAutoDestroy; property Key: ICollectable read GetKey; property Value: TObject read GetValue; end; TBooleanWrapper = class(TAbstractItem, IEquatable, IHashable, IComparable, IBoolean) private FValue: Boolean; public constructor Create(Value: Boolean); function GetValue: Boolean; function CompareTo(const Item: ICollectable): Integer; function Equals(const Item: ICollectable): Boolean; function HashCode: Integer; property Value: Boolean read GetValue; end; TCardinalWrapper = class(TAbstractItem, IEquatable, IHashable, IComparable, ICardinal) private FValue: Cardinal; public constructor Create(Value: Cardinal); function GetValue: Cardinal; function Equals(const Item: ICollectable): Boolean; function HashCode: Integer; function CompareTo(const Item: ICollectable): Integer; property Value: Cardinal read GetValue; end; TCharWrapper = class(TAbstractItem, IEquatable, IHashable, IComparable, IChar) private FValue: Char; public constructor Create(Value: Char); function GetValue: Char; function Equals(const Item: ICollectable): Boolean; function HashCode: Integer; function CompareTo(const Item: ICollectable): Integer; property Value: Char read GetValue; end; TClassWrapper = class(TAbstractItem, IEquatable, IHashable, IClass) private FValue: TClass; public constructor Create(Value: TClass); function GetValue: TClass; function Equals(const Item: ICollectable): Boolean; function HashCode: Integer; property Value: TClass read GetValue; end; TDoubleWrapper = class(TAbstractItem, IEquatable, IHashable, IComparable, IDouble) private FValue: Double; public constructor Create(Value: Double); function GetValue: Double; function Equals(const Item: ICollectable): Boolean; function HashCode: Integer; function CompareTo(const Item: ICollectable): Integer; property Value: Double read GetValue; end; TIntegerWrapper = class(TAbstractItem, IEquatable, IHashable, IComparable, IInteger) private FValue: Integer; public constructor Create(Value: Integer); function GetValue: Integer; function Equals(const Item: ICollectable): Boolean; function HashCode: Integer; function CompareTo(const Item: ICollectable): Integer; property Value: Integer read GetValue; end; TIntegerAssociationWrapper = class(TAbstractItem, IEquatable, IIntegerMappable, IIntegerAssociationWrapper) private FAutoDestroy: Boolean; FKey: Integer; FValue: TObject; public constructor Create(const Key: Integer; Value: TObject); overload; destructor Destroy; override; function Equals(const Item: ICollectable): Boolean; function GetAutoDestroy: Boolean; procedure SetAutoDestroy(Value: Boolean); function GetKey: Integer; function GetValue: TObject; property AutoDestroy: Boolean read GetAutoDestroy write SetAutoDestroy; property Key: Integer read GetKey; property Value: TObject read GetValue; end; TInterfaceWrapper = class(TAbstractItem, IHashable, IEquatable, IInterfaceWrapper) private FValue: IUnknown; public constructor Create(const Value: IUnknown); destructor Destroy; override; function GetValue: IUnknown; function Equals(const Item: ICollectable): Boolean; function HashCode: Integer; property Value: IUnknown read GetValue; end; TObjectWrapper = class(TAbstractItem, IEquatable, IComparable, IHashable, IObject) private FAutoDestroy: Boolean; FValue: TObject; public constructor Create(Value: TObject); overload; destructor Destroy; override; function GetAutoDestroy: Boolean; procedure SetAutoDestroy(Value: Boolean); function GetValue: TObject; function CompareTo(const Item: ICollectable): Integer; function Equals(const Item: ICollectable): Boolean; function HashCode: Integer; property AutoDestroy: Boolean read FAutoDestroy write FAutoDestroy; property Value: TObject read GetValue; end; TStringWrapper = class(TAbstractItem, IEquatable, IHashable, IComparable, IString) private FValue: String; public constructor Create(Value: String); function GetValue: String; function Equals(const Item: ICollectable): Boolean; function HashCode: Integer; function CompareTo(const Item: ICollectable): Integer; property Value: String read FValue; end; TStringAssociationWrapper = class(TAbstractItem, IEquatable, IStringMappable, IStringAssociationWrapper) private FAutoDestroy: Boolean; FKey: String; FValue: TObject; public constructor Create(const Key: String; Value: TObject); overload; destructor Destroy; override; function GetAutoDestroy: Boolean; procedure SetAutoDestroy(Value: Boolean); function GetKey: String; function GetValue: TObject; function Equals(const Item: ICollectable): Boolean; property AutoDestroy: Boolean read GetAutoDestroy write SetAutoDestroy; property Key: String read GetKey; property Value: TObject read GetValue; end; implementation { TAbstractItem } function TAbstractItem.GetInstance: TObject; begin Result := Self; end; { TAbstractIntegerMappable } procedure TAbstractIntegerMappable.AfterConstruction; begin inherited AfterConstruction; FKey := MakeKey; end; function TAbstractIntegerMappable.Equals(const Item: ICollectable): Boolean; begin Result := (Self = Item.GetInstance); end; function TAbstractIntegerMappable.GetKey: Integer; begin Result := FKey; end; { TAbstractMappable } destructor TAbstractMappable.Destroy; begin FKey := nil; inherited Destroy; end; procedure TAbstractMappable.AfterConstruction; begin inherited AfterConstruction; FKey := MakeKey; end; function TAbstractMappable.Equals(const Item: ICollectable): Boolean; begin Result := (Self = Item.GetInstance); end; function TAbstractMappable.GetKey: ICollectable; begin Result := FKey; end; { TAbstractStringMappable } procedure TAbstractStringMappable.AfterConstruction; begin inherited AfterConstruction; FKey := MakeKey; end; function TAbstractStringMappable.Equals(const Item: ICollectable): Boolean; begin Result := (Self = Item.GetInstance); end; function TAbstractStringMappable.GetKey: String; begin Result := FKey; end; { TAssociationWrapper } constructor TAssociationWrapper.Create(const Key: ICollectable; Value: TObject); begin inherited Create; FAutoDestroy := true; FKey := Key; FValue := Value; end; constructor TAssociationWrapper.Create(Key: Integer; Value: TObject); begin Create(TIntegerWrapper.Create(Key) as ICollectable, Value); end; constructor TAssociationWrapper.Create(Key: String; Value: TObject); begin Create(TStringWrapper.Create(Key) as ICollectable, Value); end; constructor TAssociationWrapper.Create(Key, Value: TObject; AutoDestroyKey: Boolean); var KeyWrapper: TObjectWrapper; begin KeyWrapper := TObjectWrapper.Create(Key); KeyWrapper.AutoDestroy := AutoDestroyKey; Create(KeyWrapper as ICollectable, Value); end; destructor TAssociationWrapper.Destroy; begin if FAutoDestroy then FValue.Free; FKey := nil; inherited Destroy; end; function TAssociationWrapper.GetAutoDestroy: Boolean; begin Result := FAutoDestroy; end; procedure TAssociationWrapper.SetAutoDestroy(Value: Boolean); begin FAutoDestroy := Value; end; function TAssociationWrapper.GetKey: ICollectable; begin Result := FKey; end; function TAssociationWrapper.GetValue: TObject; begin Result := FValue; end; function TAssociationWrapper.Equals(const Item: ICollectable): Boolean; begin Result := (Self.Value = (Item.GetInstance as TAssociationWrapper).Value) end; { TCardinalWrapper } constructor TCardinalWrapper.Create(Value: Cardinal); begin inherited Create; FValue := Value; end; function TCardinalWrapper.GetValue: Cardinal; begin Result := FValue; end; function TCardinalWrapper.Equals(const Item: ICollectable): Boolean; begin Result := (Self.Value = (Item.GetInstance as TCardinalWrapper).Value) end; function TCardinalWrapper.HashCode: Integer; begin Result := FValue; end; function TCardinalWrapper.CompareTo(const Item: ICollectable): Integer; var Value2: Cardinal; begin Value2 := (Item.GetInstance as TCardinalWrapper).Value; if Value < Value2 then Result := -1 else if Value > Value2 then Result := 1 else Result := 0; end; { TBooleanWrapper } constructor TBooleanWrapper.Create(Value: Boolean); begin inherited Create; FValue := Value; end; function TBooleanWrapper.GetValue: Boolean; begin Result := FValue; end; function TBooleanWrapper.Equals(const Item: ICollectable): Boolean; begin Result := (Self.Value = (Item.GetInstance as TBooleanWrapper).Value) end; function TBooleanWrapper.HashCode: Integer; begin Result := Ord(FValue); end; function TBooleanWrapper.CompareTo(const Item: ICollectable): Integer; var Value2: Boolean; begin Value2 := (Item.GetInstance as TBooleanWrapper).Value; if not Value and Value2 then Result := -1 else if Value and not Value2 then Result := 1 else Result := 0; end; { TCharWrapper } constructor TCharWrapper.Create(Value: Char); begin inherited Create; FValue := Value; end; function TCharWrapper.GetValue: Char; begin Result := FValue; end; function TCharWrapper.Equals(const Item: ICollectable): Boolean; begin Result := (Self.Value = (Item.GetInstance as TCharWrapper).Value) end; function TCharWrapper.HashCode: Integer; begin Result := Integer(FValue); end; function TCharWrapper.CompareTo(const Item: ICollectable): Integer; var Value2: Char; begin Value2 := (Item.GetInstance as TCharWrapper).Value; if Value < Value2 then Result := -1 else if Value > Value2 then Result := 1 else Result := 0; end; { TClassWrapper } constructor TClassWrapper.Create(Value: TClass); begin inherited Create; FValue := Value; end; function TClassWrapper.GetValue: TClass; begin Result := FValue; end; function TClassWrapper.Equals(const Item: ICollectable): Boolean; begin Result := (Self.Value = (Item.GetInstance as TClassWrapper).Value) end; function TClassWrapper.HashCode: Integer; begin Result := Integer(FValue.ClassInfo); end; { TDoubleWrapper } constructor TDoubleWrapper.Create(Value: Double); begin inherited Create; FValue := Value; end; function TDoubleWrapper.GetValue: Double; begin Result := FValue; end; function TDoubleWrapper.Equals(const Item: ICollectable): Boolean; begin Result := (Self.Value = (Item.GetInstance as TDoubleWrapper).Value) end; function TDoubleWrapper.HashCode: Integer; var DblAsInt: array[0..1] of Integer; begin Double(DblAsInt) := Value; Result := DblAsInt[0] xor DblAsInt[1]; end; function TDoubleWrapper.CompareTo(const Item: ICollectable): Integer; var Value2: Double; begin Value2 := (Item.GetInstance as TDoubleWrapper).Value; if Value < Value2 then Result := -1 else if Value > Value2 then Result := 1 else Result := 0; end; { TIntegerWrapper } constructor TIntegerWrapper.Create(Value: Integer); begin inherited Create; FValue := Value; end; function TIntegerWrapper.GetValue: Integer; begin Result := FValue; end; function TIntegerWrapper.Equals(const Item: ICollectable): Boolean; begin Result := (Self.Value = (Item.GetInstance as TIntegerWrapper).Value) end; function TIntegerWrapper.HashCode: Integer; begin Result := FValue; end; function TIntegerWrapper.CompareTo(const Item: ICollectable): Integer; var Value2: Integer; begin Value2 := (Item.GetInstance as TIntegerWrapper).Value; if Value < Value2 then Result := -1 else if Value > Value2 then Result := 1 else Result := 0; end; { TIntegerAssociationWrapper } constructor TIntegerAssociationWrapper.Create(const Key: Integer; Value: TObject); begin inherited Create; FAutoDestroy := true; FKey := Key; FValue := Value; end; destructor TIntegerAssociationWrapper.Destroy; begin if FAutoDestroy then FValue.Free; inherited Destroy; end; function TIntegerAssociationWrapper.GetAutoDestroy: Boolean; begin Result := FAutoDestroy; end; procedure TIntegerAssociationWrapper.SetAutoDestroy(Value: Boolean); begin FAutoDestroy := Value; end; function TIntegerAssociationWrapper.GetValue: TObject; begin Result := FValue; end; function TIntegerAssociationWrapper.Equals(const Item: ICollectable): Boolean; begin Result := (Self.Value = (Item.GetInstance as TIntegerAssociationWrapper).Value) end; function TIntegerAssociationWrapper.GetKey: Integer; begin Result := FKey; end; { TStringAssociationWrapper } constructor TStringAssociationWrapper.Create(const Key: String; Value: TObject); begin inherited Create; FAutoDestroy := true; FKey := Key; FValue := Value; end; destructor TStringAssociationWrapper.Destroy; begin if FAutoDestroy then FValue.Free; inherited Destroy; end; function TStringAssociationWrapper.GetAutoDestroy: Boolean; begin Result := FAutoDestroy; end; procedure TStringAssociationWrapper.SetAutoDestroy(Value: Boolean); begin FAutoDestroy := Value; end; function TStringAssociationWrapper.GetValue: TObject; begin Result := FValue; end; function TStringAssociationWrapper.Equals(const Item: ICollectable): Boolean; begin Result := (Self.Value = (Item.GetInstance as TStringAssociationWrapper).Value) end; function TStringAssociationWrapper.GetKey: String; begin Result := FKey; end; { TInterfaceWrapper } constructor TInterfaceWrapper.Create(const Value: IUnknown); begin inherited Create; FValue := Value; end; destructor TInterfaceWrapper.Destroy; begin FValue := nil; inherited Destroy; end; function TInterfaceWrapper.GetValue: IUnknown; begin Result := FValue; end; function TInterfaceWrapper.Equals(const Item: ICollectable): Boolean; begin Result := (Self.Value = (Item.GetInstance as TInterfaceWrapper).Value) end; function TInterfaceWrapper.HashCode: Integer; begin Result := Integer(Pointer(FValue)); end; { TObjectWrapper } constructor TObjectWrapper.Create(Value: TObject); begin inherited Create; FAutoDestroy := true; FValue := Value; end; destructor TObjectWrapper.Destroy; begin if FAutoDestroy then FValue.Free; inherited Destroy; end; function TObjectWrapper.GetAutoDestroy: Boolean; begin Result := FAutoDestroy; end; procedure TObjectWrapper.SetAutoDestroy(Value: Boolean); begin FAutoDestroy := Value; end; function TObjectWrapper.GetValue: TObject; begin Result := FValue; end; function TObjectWrapper.CompareTo(const Item: ICollectable): Integer; var Value1, Value2: Integer; begin Value1 := Integer(Pointer(Self)); if Item <> nil then Value2 := Integer(Pointer(Item)) else Value2 := Low(Integer); if (Value1 < Value2) then Result := -1 else if (Value1 > Value2) then Result := 1 else Result := 0; end; function TObjectWrapper.Equals(const Item: ICollectable): Boolean; begin Result := (Self.Value = (Item.GetInstance as TObjectWrapper).Value) end; function TObjectWrapper.HashCode: Integer; begin Result := Integer(Pointer(FValue)); end; { TStringWrapper } constructor TStringWrapper.Create(Value: String); begin inherited Create; FValue := Value; end; function TStringWrapper.GetValue: String; begin Result := FValue; end; function TStringWrapper.Equals(const Item: ICollectable): Boolean; begin Result := (Self.Value = (Item.GetInstance as TStringWrapper).Value) end; function TStringWrapper.HashCode: Integer; var I: Integer; begin Result := 0; for I := 1 to Length(FValue) do Result := (Result shl 1) xor Ord(FValue[I]); end; function TStringWrapper.CompareTo(const Item: ICollectable): Integer; begin Result := CompareStr(Self.Value, (Item.GetInstance as TStringWrapper).Value) end; end.