pascal语言泛型和模板

pascal语言泛型和模板，适用于FPC和delphi。

泛型是一种编程思想，模板是实现这种思想的具体工具。

泛型编程的目标是写出与类型无关的代码，而模板提供了这种能力。

模板不是真正的代码，而是生成代码的规则。

编译器在编译期根据具体类型实例化模板，对每个不同类型都会生成一份独立的代码。

1）定义泛型模板

//cxg 2025-2-6
//池的泛型模板  fit lazarus+delphi
unit sys.pool;
{$ifdef fpc}{$mode delphi}{$H+}
{$endif}interfaceuses//system--------
  Generics.Collections, Classes, SysUtils;typeTPool<T> = classprivate//池中的对象FList: TthreadList<T>;//池大小
    FPoolSize: Integer;publicconstructor 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;implementationconstructor TPool<T>.Create(poolSize: Integer);
beginFList := TThreadList<T>.Create;Self.FPoolSize := poolSize;    //根据实际情况，合理设置
end;destructor TPool<T>.Destroy;
beginFList.Clear;FreeAndNil(FList);inherited Destroy;
end;procedure TPool<T>.Init;
varlist: TList<T>;
beginlist := FList.LockList;trywhile list.Count < Self.FPoolSize doList.Add(NewObj);finallyFList.UnlockList;end;
end;function TPool<T>.Lock: T;
varlist: TList<T>;
beginlist := FList.LockList;tryif list.Count > 0 thenbeginResult := list.First;List.Remove(Result);endelsebegin //池中已无可用对象，池容量+1
      List.Add(NewObj);Result := list.First;List.Remove(Result);end;finallyFList.UnlockList;end;
end;procedure TPool<T>.Unlock(Value: T);
beginFList.Add(Value);
end;end.

2）具体类型实例化模板一

unit sys.threadpool;
//cxg 2025-2-6
//线程池  fit lazarus+delphi
{$ifdef fpc}{$mode delphi}{$H+}
{$endif}interfaceuses//my----------
  sys.pool, //system--------
  classes, SysUtils, SyncObjs;typeTproc1 = TThreadMethod;   //procedure of object
  {$ifndef fpc}Tproc2 = TThreadProcedure; //reference to procedure fpc3.3.1才支持
  {$endif}Ttread1 = class(TThread)privateFproc1: Tproc1;{$ifndef fpc}Fproc2: Tproc2;{$endif}Fevent: TEvent;FtaskFinished: Boolean; //任务执行完成否publicconstructor 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;typeTthreadpool = class(TPool<Ttread1>)publicfunction NewObj(owner: TComponent = nil): Ttread1; override;procedure Unlock(Value: Ttread1); override;end;implementation{ Tthreadpool }function Tthreadpool.NewObj(owner: TComponent): Ttread1;
beginResult := Ttread1.Create;
end;procedure Tthreadpool.Unlock(Value: Ttread1);
begin//必须等待线程的任务执行完成，才能归还池中while not Value.taskFinished doSleep(1);inherited;
end;{ Ttread1 }constructor Ttread1.Create;
begininherited Create(False);Fevent := TEvent.Create(nil, False, False, '');
end;procedure Ttread1.execute;
beginwhile not Terminated dobeginFevent.Acquire;FtaskFinished := False;         //任务正在执行if Assigned(Fproc1) thenFproc1;{$ifndef fpc}if Assigned(Fproc2) thenFproc2;{$endif}FtaskFinished := True;          //任务执行完成
  end;
end;procedure Ttread1.start;
beginFevent.SetEvent;
end;procedure Ttread1.stop;
beginFevent.ResetEvent;
end;end.

3）具体类型实例化模板二

unit db.datasetpool;
//cxg 2025-2-6
//数据集池 fit lazarus+delphi
{$ifdef fpc}{$mode delphi}{$H+}
{$endif}
interfaceuses//my-------
  sys.pool,//system-----
  {$IFDEF fpc}fpjsondataset,{$ELSE}firedac.comp.Client,{$ENDIF}classes, DB, SysUtils;typeTdatasetPool = class(TPool<Tdataset>)publicfunction 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);
beginvalue.close;inherited;
end;end.