pascal语言泛型和模板,适用于FPC和delphi。
泛型是一种编程思想,模板是实现这种思想的具体工具。
泛型编程的目标是写出与类型无关的代码,而模板提供了这种能力。
模板不是真正的代码,而是生成代码的规则。
编译器在编译期根据具体类型实例化模板,对每个不同类型都会生成一份独立的代码。
1)定义泛型模板
//cxg 2025-2-6 //池的泛型模板 fit lazarus+delphi unit sys.pool; {$ifdef fpc} {$mode delphi}{$H+} {$endif} interface uses //system-------- Generics.Collections, Classes, SysUtils; type TPool<T> = class private //池中的对象 FList: TthreadList<T>; //池大小 FPoolSize: Integer; public constructor Create(poolSize: Integer); virtual; destructor Destroy; override; public //初始化,往池中一次性创建poolsize数量的对象 procedure Init; //新建一个对象 function NewObj(owner: TComponent = nil): T; virtual; abstract; //从池中取一个对象 function Lock: T; virtual; //对象归还池中 procedure Unlock(Value: T); virtual; end; implementation constructor TPool<T>.Create(poolSize: Integer); begin FList := TThreadList<T>.Create; Self.FPoolSize := poolSize; //根据实际情况,合理设置 end; destructor TPool<T>.Destroy; begin FList.Clear; FreeAndNil(FList); inherited Destroy; end; procedure TPool<T>.Init; var list: TList<T>; begin list := FList.LockList; try while list.Count < Self.FPoolSize do List.Add(NewObj); finally FList.UnlockList; end; end; function TPool<T>.Lock: T; var list: TList<T>; begin list := FList.LockList; try if list.Count > 0 then begin Result := list.First; List.Remove(Result); end else begin //池中已无可用对象,池容量+1 List.Add(NewObj); Result := list.First; List.Remove(Result); end; finally FList.UnlockList; end; end; procedure TPool<T>.Unlock(Value: T); begin FList.Add(Value); end; end.
2)具体类型实例化模板一
unit sys.threadpool; //cxg 2025-2-6 //线程池 fit lazarus+delphi {$ifdef fpc} {$mode delphi}{$H+} {$endif}interface uses //my---------- sys.pool, //system-------- classes, SysUtils, SyncObjs; type Tproc1 = TThreadMethod; //procedure of object {$ifndef fpc} Tproc2 = TThreadProcedure; //reference to procedure fpc3.3.1才支持 {$endif} Ttread1 = class(TThread) private Fproc1: Tproc1; {$ifndef fpc} Fproc2: Tproc2; {$endif} Fevent: TEvent; FtaskFinished: Boolean; //任务执行完成否 public constructor Create; overload; procedure execute; override; //恢复线程 procedure start; //挂起线程 procedure stop; public //线程要执行的方法 procedure of object property proc1: Tproc1 read Fproc1 write Fproc1; //线程要执行的方法 reference to procedure {$ifndef fpc} property proc2: Tproc2 read Fproc2 write Fproc2; {$endif} //任务执行完成否 property taskFinished: Boolean read FtaskFinished; end; type Tthreadpool = class(TPool<Ttread1>) public function NewObj(owner: TComponent = nil): Ttread1; override; procedure Unlock(Value: Ttread1); override; end; implementation { Tthreadpool } function Tthreadpool.NewObj(owner: TComponent): Ttread1; begin Result := Ttread1.Create; end; procedure Tthreadpool.Unlock(Value: Ttread1); begin //必须等待线程的任务执行完成,才能归还池中 while not Value.taskFinished do Sleep(1); inherited; end; { Ttread1 } constructor Ttread1.Create; begin inherited Create(False); Fevent := TEvent.Create(nil, False, False, ''); end; procedure Ttread1.execute; begin while not Terminated do begin Fevent.Acquire; FtaskFinished := False; //任务正在执行 if Assigned(Fproc1) then Fproc1; {$ifndef fpc} if Assigned(Fproc2) then Fproc2; {$endif} FtaskFinished := True; //任务执行完成 end; end; procedure Ttread1.start; begin Fevent.SetEvent; end; procedure Ttread1.stop; begin Fevent.ResetEvent; end; end.
3)具体类型实例化模板二
unit db.datasetpool; //cxg 2025-2-6 //数据集池 fit lazarus+delphi {$ifdef fpc} {$mode delphi}{$H+} {$endif} interface uses //my------- sys.pool, //system----- {$IFDEF fpc} fpjsondataset, {$ELSE} firedac.comp.Client, {$ENDIF} classes, DB, SysUtils; type TdatasetPool = class(TPool<Tdataset>) public function NewObj(owner: TComponent = nil): Tdataset; override; procedure unlock(value: Tdataset); override; end; implementation { TdatasetPool } function TdatasetPool.NewObj(owner: TComponent): Tdataset; begin {$IFDEF fpc} Result := Tjsondataset.create(nil); {$ELSE} Result := TFDMemTable.Create(nil); {$ENDIF} end; procedure TdatasetPool.unlock(value: Tdataset); begin value.close; inherited; end; end.