pascal语言泛型和模板

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.