Реализация шаблонов в Delphi
| Раздел Сокровищница | ркуша Алексей, дата публикации 07 сентября 2001г. |
Многие скажут что сабж невозможен. Но...посмотрите что у меня получилось (На примере простого списка).
Итак.
Необходимо создать два пустых ((Через File-> New->Text или в файловой системе) без interface, implementation, uses... и т.д.) .pas файла.
Первый назовем InterfaceTemp.pas(заголовок), второй ImplementTemp.pas(реализация). Далее копируем, соответственно, в них в InterfaceTemp.pas (заголовочный файл шаблона): TemplateList = class // заголовочный файл шаблона (для ordinal types или real types, shortstring) private FList: PIntList; FCount: Integer; FCapacity: Integer; protected procedure Grow; function Get(Index: Integer): _DATA_TYPE_; // Вот оно чудо :-) procedure Put(Index: Integer; Item: _DATA_TYPE_); procedure SetCapacity(NewCapacity: Integer); procedure SetCount(NewCount: Integer); public destructor Destroy; override; class procedure Error(const Msg: string; Data: Integer); overload; virtual; class procedure Error(Msg: PResStringRec; Data: Integer); overload; function Add(Item: _DATA_TYPE_): Integer; procedure Clear; function Last: _DATA_TYPE_; function First: _DATA_TYPE_; procedure Delete(Index: Integer); procedure Exchange(Index1, Index2: Integer); function IndexOf(Item: _DATA_TYPE_): Integer; procedure Insert(Index: Integer; Item: _DATA_TYPE_); procedure Move(CurIndex, NewIndex: Integer); procedure Sort; function Min: _DATA_TYPE_; function Max: _DATA_TYPE_; property Count: Integer read FCount write SetCount; property Items[Index: Integer]: _DATA_TYPE_ read Get write Put; default; end; в ImplementTemp.pas (файл реализации шаблона): function TemplateList.Add(Item: _DATA_TYPE_): Integer; begin Result := FCount; if Result = FCapacity then Grow; FList^[Result] := Item; Inc(FCount); end; procedure TemplateList.Clear; begin SetCount(0); SetCapacity(0); end; procedure TemplateList.Delete(Index: Integer); begin if (Index < 0) or (Index >= FCount) then Error(@SListIndexError, Index); Dec(FCount); if Index < FCount then System.Move(FList^[Index + 1], FList^[Index], (FCount - Index) * SizeOf(_DATA_TYPE_)); end; destructor TemplateList.Destroy; begin Clear; end; procedure TemplateList.Exchange(Index1, Index2: Integer); var Item: _DATA_TYPE_; begin if (Index1 < 0) or (Index1 >= FCount) then Error(@SListIndexError, Index1); if (Index2 < 0) or (Index2 >= FCount) then Error(@SListIndexError, Index2); Item := FList^[Index1]; FList^[Index1] := FList^[Index2]; FList^[Index2] := Item; end; function TemplateList.Get(Index: Integer): _DATA_TYPE_; begin if (Index < 0) or (Index >= FCount) then Error(@SListIndexError, Index); Result := FList^[Index]; end; procedure TemplateList.Grow; var Delta: Integer; begin if FCapacity > 64 then Delta := {371053//}FCapacity div 4 else if FCapacity > 8 then Delta := 16 else Delta := 4; SetCapacity(FCapacity + Delta); end; function TemplateList.IndexOf(Item: _DATA_TYPE_): Integer; begin Result := 0; while (Result < FCount) and (FList^[Result] <> Item) do Inc(Result); if Result = FCount then Result := -1; end; procedure TemplateList.Insert(Index: Integer; Item: _DATA_TYPE_); begin if (Index < 0) or (Index > FCount) then Error(@SListIndexError, Index); if FCount = FCapacity then Grow; if Index < FCount then System.Move(FList^[Index], FList^[Index + 1], (FCount - Index) * SizeOf(_DATA_TYPE_)); FList^[Index] := Item; Inc(FCount); end; function TemplateList.Max: _DATA_TYPE_; var i: Integer; begin if Fcount=0 then Error(@SListCountError, 0); Result:=Flist^[0]; for i:=0 to Fcount-1 do if Result < Flist^[i] then Result:=Flist^[i]; end; function TemplateList.Min: _DATA_TYPE_; var i: Integer; begin if Fcount=0 then Error(@SListCountError, 0); Result:=Flist^[0]; for i:=0 to Fcount-1 do if Result>Flist^[i] then Result:=Flist^[i]; end; procedure TemplateList.Move(CurIndex, NewIndex: Integer); var Item: _DATA_TYPE_; begin if CurIndex <> NewIndex then begin if (NewIndex < 0) or (NewIndex >= FCount) then Error(@SListIndexError, NewIndex); Item := Get(CurIndex); Delete(CurIndex); Insert(NewIndex, Item); end; end; procedure TemplateList.Put(Index: Integer; Item: _DATA_TYPE_); begin if (Index < 0) or (Index >= FCount) then Error(@SListIndexError, Index); FList^[Index] := Item; end; procedure TemplateList.SetCapacity(NewCapacity: Integer); begin if (NewCapacity < FCount) or (NewCapacity > MaxListSize) then Error(@SListCapacityError, NewCapacity); if NewCapacity <> FCapacity then begin ReallocMem(FList, NewCapacity * SizeOf(_DATA_TYPE_)); FCapacity := NewCapacity; end; end; procedure TemplateList.SetCount(NewCount: Integer); begin if (NewCount < 0) or (NewCount > MaxListSize) then Error(@SListCountError, NewCount); if NewCount > FCapacity then SetCapacity(NewCount); if NewCount > FCount then FillMemory(@(FList^[FCount]), (NewCount - FCount) * SizeOf(_DATA_TYPE_),0); FCount := NewCount; end; procedure QuickIntSort(ia: PIntList; iLo,iHi : integer); var Lo, Hi : Integer; // индексы Mid, T : _DATA_TYPE_; // значения begin Lo := iLo; Hi := iHi; Mid := ia[(Lo+hi) shr 1]; repeat while ia[Lo] < Mid do Inc(Lo); while ia[Hi] > Mid do Dec(Hi); if Lo Hi; if Hi > iLo then QuickIntSort(ia,iLo,Hi); if Lo < iHi then QuickIntSort(ia,Lo,iHi); end; procedure TemplateList.Sort; begin if (FList <> nil) and (FCount > 0) then QuickIntSort(FList, 0, FCount - 1); end; class procedure TemplateList.Error(const Msg: string; Data: Integer); function ReturnAddr: Pointer; asm MOV EAX,[EBP+4] end; begin raise Exception.CreateFmt(Msg, [Data]) at ReturnAddr; end; class procedure TemplateList.Error(Msg: PResStringRec; Data: Integer); begin TemplateList.Error(LoadResString(Msg), Data); end; function TemplateList.Last: _DATA_TYPE_; begin Result := Get(FCount - 1); end; function TemplateList.First: _DATA_TYPE_; begin Result := Get(0); end; Теперь необходимо создать файл для так называемого "typedef" (Файл указания конкретного типа). На примере типа Currency (ImplCurrencyList.pas), для другого типа создайте еще один файл с другим названием, например (ImplIntegerList.pas)
Итак Currency:
unit ImplCurrencyList; interface uses windows, sysutils; {$H-} // длинные строки недопустимы type _DATA_TYPE_ = Currency; // здесь указывается настоящий тип {$H+} const MaxListSize = Maxint div (4*sizeof(_DATA_TYPE_)); type PIntList = ^TIntList; TIntList = array[0..MaxListSize - 1] of _DATA_TYPE_; {$I InterfaceTemp} // соответственно тип уже обозначен и реален type TCurrencyList = TemplateList; // здесь задается тип реального класса списка implementation uses Consts; {$I ImplementTemp} // соответственно тип уже обозначен и реален end.
Вот собственно и все. Теперь подключате модуль нужного типа uses ImplCurrencyList или ImplIntegerList.
И
var cyr: TCurrencyList или
var intlist: TIntegerList; где то. (если вы создали два или более "typedef" файла для других типов byte, Extended).
Данный пример работает с обычными типами данных (не объектными). Для объектов можно завернуть "перегрузку операторов"
Например: TBase = class // это пример для дальнейших обсуждений function doPlus(value: TBase): TBase; overload; // для выполнения оператора+ (если конечно договорится, что doPlus подразумеывает оператор +) function doPlus(value: integer): TBase; overload; function doPlus(value: real): TBase; overload; end; Соответсвенно где то в шаблоне (очень примитивный пример) function TemplateClass.Add(Item: _DATA_TYPE_): Integer; // например TemplateClass и _DATA_TYPE_ есть TBase; begin self.doPlus(Item); {для TBase} Result:=self.a; // какое-то внутреннее поле (пример) end; Вот такие дела в Delphi творятся. Любая критика и предложения принимаются.
Скачать пример (6.2K)
