Статьи Королевства Дельфи

         

Реализация шаблонов в 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)



Содержание  Назад  Вперед