摘要: 咏南FPC(FREE PASCAL)中间件 阅读全文
posted @ 2021-08-22 11:45 delphi中间件 阅读(739) 评论(0) 推荐(0) 编辑
摘要: 购买咏南中间件 阅读全文
posted @ 2018-03-03 08:57 delphi中间件 阅读(8868) 评论(0) 推荐(0) 编辑
摘要: BS开发框架 阅读全文
posted @ 2017-06-14 22:19 delphi中间件 阅读(4401) 评论(0) 推荐(0) 编辑
摘要: CS开发框架 阅读全文
posted @ 2017-06-14 15:44 delphi中间件 阅读(4156) 评论(2) 推荐(0) 编辑
摘要: 咏南DELPHI7中间件+开发框架 演示下载:链接: https://pan.baidu.com/s/1bulGBIZ6A1nkeErxIrGsGA 密码: 22dk 解压后运行ynmain.exe 这套开发框架的目的:方便地将DELPHI7老的二层CS程序升级为三层。 中间件技术:INDY9通信, 阅读全文
posted @ 2017-03-23 11:27 delphi中间件 阅读(5477) 评论(0) 推荐(0) 编辑
摘要: 专门为ADO二层升三层的咏南中间件(特种用途) 阅读全文
posted @ 2017-03-21 16:25 delphi中间件 阅读(2868) 评论(0) 推荐(0) 编辑
摘要: 咏南手机开发框架 阅读全文
posted @ 2017-03-09 12:41 delphi中间件 阅读(2487) 评论(0) 推荐(0) 编辑
摘要: REST中间件 阅读全文
posted @ 2016-12-14 15:31 delphi中间件 阅读(1788) 评论(0) 推荐(0) 编辑
摘要: 中间件 集群 海量并发 阅读全文
posted @ 2016-11-10 10:39 delphi中间件 阅读(2384) 评论(0) 推荐(0) 编辑
摘要: 中间件 iocp datasnap delphi 阅读全文
posted @ 2016-10-21 11:12 delphi中间件 阅读(1588) 评论(0) 推荐(0) 编辑
摘要: 快餐触摸收银软件 阅读全文
posted @ 2016-03-24 13:37 delphi中间件 阅读(1729) 评论(0) 推荐(0) 编辑
摘要: 快餐触摸屏收银系统 阅读全文
posted @ 2014-09-17 14:55 delphi中间件 阅读(3870) 评论(2) 推荐(2) 编辑

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.

 

posted @ 2025-02-06 09:43 delphi中间件 阅读(152) 评论(0) 推荐(1) 编辑
摘要: sys.zlib.pas 阅读全文
posted @ 2025-01-10 16:04 delphi中间件 阅读(21) 评论(0) 推荐(0) 编辑
摘要: sys.base64.pas 阅读全文
posted @ 2025-01-09 20:07 delphi中间件 阅读(13) 评论(0) 推荐(0) 编辑
摘要: lazarus utf8string乱码 阅读全文
posted @ 2025-01-08 12:38 delphi中间件 阅读(25) 评论(0) 推荐(0) 编辑
摘要: json.help.pas 阅读全文
posted @ 2025-01-05 20:35 delphi中间件 阅读(16) 评论(0) 推荐(0) 编辑
摘要: sys.data.pas 阅读全文
posted @ 2025-01-04 17:00 delphi中间件 阅读(25) 评论(0) 推荐(0) 编辑
摘要: mormot2 json 阅读全文
posted @ 2024-12-29 11:37 delphi中间件 阅读(28) 评论(0) 推荐(0) 编辑
摘要: db.msgpack.pas 阅读全文
posted @ 2024-12-19 11:52 delphi中间件 阅读(30) 评论(0) 推荐(0) 编辑
摘要: key.val.pas 阅读全文
posted @ 2024-12-19 10:28 delphi中间件 阅读(16) 评论(0) 推荐(0) 编辑
摘要: delphi安卓http访问 阅读全文
posted @ 2024-12-14 14:10 delphi中间件 阅读(30) 评论(0) 推荐(0) 编辑
点击右上角即可分享
微信分享提示