а виждал ли си тази статия ?
Малко грозно се получи с директното пастване от хтмл - ама ако някой изяви желание ще му го пратя в по добър формат.
----------------------------
Suggestions and comments are welcomed at : rossen_assenov@yahoo.com.


Templates in Object Pascal


Did it happen to you ? You're talking with a C++ programmer about Delphi
and how powerful it is, but at the end they usually say something like
"Ok, but Delphi uses Pascal and it doesn't support multiple-inheritance
and templates. So it is not as good as C++.". Multiple inheritance
is easy - Delphi has interfaces and they do the job just fine, but you
have to agree about templates - Object Pascal doesn't support them as
a language feature. Well, guess what - you can actually implement templates
in Delphi as good as in C++.



Templates give you the possibility to make generic containers,
like lists, stacks, queues, etc. If you want to implement something
like this in Delphi you have two choices :



1) use a container like TList which holds pointers -
in this case you have to make explicit typecast all the time

2) subclass a container like TCollection or TObjectList
and override all the type-dependent methods each time you want to use
new data type



A third alternative is to make a unit with generic container
and each time you want to use it for a new data type you can perform search-and-replace
in the editor. This will work, but if you change the implementation you
have to change all of the units for the different types by hand. It would
be nice if the compiler can do the dirty work for you and this is exactly
what we'll do.



Take for example the TCollection / TCollectionItem classes.
When you declare a new TCollectionItem descendant you also subclass
a new class from TOwnedCollection and override most of the methods so
now they use the new collection item class type and then call the inherited
method with the proper typecast.



Here is how to implement a generic collection class template in
3 easy steps :



1) create a new TEXT file (not an unit file) called
"TemplateCollectionInterface.pas" :

_COLLECTION_ = class (TOwnedCollection)
protected
function GetItem (const aIndex : Integer) : _COLLECTION_ITEM_;
procedure SetItem (const aIndex : Integer; const aValue : _COLLECTION_ITEM_);public
constructor Create (const aOwner : TComponent); function Add : _COLLECTION_ITEM_; function FindItemID (const aID : Integer) : _COLLECTION_ITEM_; function Insert (const aIndex : Integer) : _COLLECTION_ITEM_; property Items [const aIndex : Integer] : _COLLECTION_ITEM_ read GetItem write SetItem;end;

Note that there are no "uses" or "interface" clauses, just
a generic type declaration, where :



a) _COLLECTION_ is the name of the generic collection
class.

b) _COLLECTION_ITEM_ is the name of the collection item
subclass the collection will hold.



2) Create a second TEXT file called "TemplateCollectionImplementation.pas"
:

constructor _COLLECTION_.Create (const aOwner : TComponent);begin
inherited Create (aOwner, _COLLECTION_ITEM_);end;function _COLLECTION_.Add : _COLLECTION_ITEM_;begin
Result := _COLLECTION_ITEM_ (inherited Add);end;function _COLLECTION_.FindItemID (const aID : Integer) : _COLLECTION_ITEM_;begin
Result := _COLLECTION_ITEM_ (inherited FindItemID (aID));end;function _COLLECTION_.GetItem (const aIndex : Integer) : _COLLECTION_ITEM_;begin
Result := _COLLECTION_ITEM_ (inherited GetItem (aIndex));end;function _COLLECTION_.Insert (const aIndex : Integer) : _COLLECTION_ITEM_;begin
Result := _COLLECTION_ITEM_ (inherited Insert (aIndex));end;procedure _COLLECTION_.SetItem (const aIndex : Integer; const aValue : _COLLECTION_ITEM_);begin
inherited SetItem (aIndex, aValue);end;

Again, there are no "uses" or "implementation" clauses here
- just the implementation code of the generic type, which is pretty
straight-forward.



3) Now, create a new unit file called "MyCollectionUnit.pas" :


unit MyCollectionUnit;interface

uses Classes;type TMyCollectionItem = class (TCollectionItem) private
FMyStringData : String; FMyIntegerData : Integer; public
procedure Assign (aSource : TPersistent); override; published
property MyStringData : String read FMyStringData write FMyStringData; property MyIntegerData : Integer read FMyIntegerData write FMyIntegerData; end; // !!! tell the generic collection class what is the actual collection item class type

_COLLECTION_ITEM_ = TMyCollectionItem;

// !!! insert the generic collection class interface file - preprocessor directive

{$INCLUDE TemplateCollectionInterface} // !!! rename the generic collection class

TMyCollection = _COLLECTION_;

implementation

uses SysUtils;// !!! insert the generic collection class implementation file - preprocessor directive

{$INCLUDE TemplateCollectionImplementation} procedure TMyCollectionItem.Assign (aSource : TPersistent);begin
if aSource is TMyCollectionItem then
begin
FMyStringData := TMyCollectionItem(aSource).FMyStringData;
FMyIntegerData := TMyCollectionItem(aSource).FMyIntegerData;
end
else inherited;end;end.

That's it! With only four lines of code the new collection
class is ready and the compiler did all the work for you. If you change
the interface or implementation of the generic collection class the
changes will propagate to all the units which use it.



One more example. This time we'll implement a generic class wrapper
for dynamic arrays.



1) Create a new TEXT file named "TemplateVectorInterface.pas" :

_VECTOR_INTERFACE_ = nterface
function GetLength : Integer; procedure SetLength (const aLength : Integer); function GetItems (const aIndex : Integer) : _VECTOR_DATA_TYPE_; procedure SetItems (const aIndex : Integer; const aValue : _VECTOR_DATA_TYPE_); function GetFirst : _VECTOR_DATA_TYPE_; procedure SetFirst (const aValue : _VECTOR_DATA_TYPE_); function GetLast : _VECTOR_DATA_TYPE_; procedure SetLast (const aValue : _VECTOR_DATA_TYPE_); function High : Integer; function Low : Integer; function Clear : _VECTOR_INTERFACE_; function Extend (const aDelta : Word = 1) : _VECTOR_INTERFACE_; function Contract (const aDelta : Word = 1) : _VECTOR_INTERFACE_; property Length : Integer read GetLength write SetLength; property Items [const aIndex : Integer] : _VECTOR_DATA_TYPE_ read GetItems write SetItems; default; property First : _VECTOR_DATA_TYPE_ read GetFirst write SetFirst; property Last : _VECTOR_DATA_TYPE_ read GetLast write SetLast;end;_VECTOR_CLASS_ = class (TInterfacedObject, _VECTOR_INTERFACE_)private
FArray : array of _VECTOR_DATA_TYPE_;protected
function GetLength : Integer; procedure SetLength (const aLength : Integer); function GetItems (const aIndex : Integer) : _VECTOR_DATA_TYPE_; procedure SetItems (const aIndex : Integer; const aValue : _VECTOR_DATA_TYPE_); function GetFirst : _VECTOR_DATA_TYPE_; procedure SetFirst (const aValue : _VECTOR_DATA_TYPE_); function GetLast : _VECTOR_DATA_TYPE_; procedure SetLast (const aValue : _VECTOR_DATA_TYPE_);public
function High : Integer; function Low : Integer; function Clear : _VECTOR_INTERFACE_; function Extend (const aDelta : Word = 1) : _VECTOR_INTERFACE_; function Contract (const aDelta : Word = 1) : _VECTOR_INTERFACE_; constructor Create (const aLength : Integer);end;

2) Create a new TEXT file named "TemplateVectorImplementation.pas" :


constructor _VECTOR_CLASS_.Create (const aLength : Integer);begin
inherited Create; SetLength (aLength);end;function _VECTOR_CLASS_.GetLength : Integer;begin
Result := System.Length (FArray);
end;procedure _VECTOR_CLASS_.SetLength (const aLength : Integer);begin
System.SetLength (FArray, aLength);
end;function _VECTOR_CLASS_.GetItems (const aIndex : Integer) : _VECTOR_DATA_TYPE_;begin
Result := FArray [aIndex];
end;procedure _VECTOR_CLASS_.SetItems (const aIndex : Integer; const aValue : _VECTOR_DATA_TYPE_);begin
FArray [aIndex] := aValue;
end;function _VECTOR_CLASS_.High : Integer;begin
Result := System.High (FArray);
end;function _VECTOR_CLASS_.Low : Integer;begin
Result := System.Low (FArray);
end;function _VECTOR_CLASS_.GetFirst : _VECTOR_DATA_TYPE_;begin
Result := FArray [System.Low (FArray)];
end;procedure _VECTOR_CLASS_.SetFirst (const aValue : _VECTOR_DATA_TYPE_);begin
FArray [System.Low (FArray)] := aValue;
end;function _VECTOR_CLASS_.GetLast : _VECTOR_DATA_TYPE_;begin
Result := FArray [System.High (FArray)];
end;procedure _VECTOR_CLASS_.SetLast (const aValue : _VECTOR_DATA_TYPE_);begin
FArray [System.High (FArray)] := aValue;
end;function _VECTOR_CLASS_.Clear : _VECTOR_INTERFACE_;begin
FArray := Nil; Result := Self;end;function _VECTOR_CLASS_.Extend (const aDelta : Word) : _VECTOR_INTERFACE_;begin
System.SetLength (FArray, System.Length (FArray) + aDelta);

Result := Self;
end;function _VECTOR_CLASS_.Contract (const aDelta : Word) : _VECTOR_INTERFACE_;begin
System.SetLength (FArray, System.Length (FArray) - aDelta);

Result := Self;
end;

3) Finally, create UNIT file named "FloatVectorUnit.pas" :

unit FloatVectorUnit;interface

uses Classes; // !!! "Classes" unit contains TInterfacedObject class declaration

type _VECTOR_DATA_TYPE_ = Double; // !!! the data type for the array class is Double

{$INCLUDE TemplateVectorInterface}

IFloatVector = _VECTOR_INTERFACE_; // !!! give the interface a meanigful name
TFloatVector = _VECTOR_CLASS_; // !!! give the class a meanigful name

function CreateFloatVector (const aLength : Integer = 0) : IFloatVector; // !!! this is an optional factory function

implementation

{$INCLUDE TemplateVectorImplementation}

function CreateFloatVector (const aLength : Integer = 0) : IFloatVector; begin
Result := TFloatVector.Create (aLength);
end;end.

You can also easily extend the generic vector class with iterators
and some additional functions.



And here is how you can use the new vector interface :

procedure TestFloatVector; var aFloatVector : IFloatVector; aIndex : Integer;begin
aFloatVector := CreateFloatVector;

aFloatVector.Extend.Last := 1;
aFloatVector.Extend.Last := 2;

for aIndex := aFloatVector.Low to aFloatVector.High do
begin
WriteLn (FloatToStr (aFloatVector [aIndex]));
end;end.

The only requirements when implementing templates this way
is that each new type should be declared in a separate unit and you
should have the sources for the generic classes.

---
Е т'ва е живот!