How to make C++-like templates in Object Pascal.(转)(0分)

Question/Problem/Abstract:

How to make C++-like templates in Object Pascal.
Answer:





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.



Suggestions and comments are welcomed at : rossen_assenov@yahoo.com.

很好。但此方法有着明显的缺陷，那就是每一个类型都要重新定义一个类。

很好。
但如果有两个集合类怎么办？interface中的_COLLECTION_ITEM_将会冲突啊。

请问，能否在编译时动态的将 _COLLECTION_ITEM_ 替换成 TMyCollectionItem 而不是使用
_COLLECTION_ITEM_ = TMyCollectionItem语句？

谢谢。