DELPHI盒子
!实时搜索: 盒子论坛 | 注册用户 | 修改信息 | 退出
检举帖 | 全文检索 | 关闭广告 | 捐赠
技术论坛
 用户名
 密  码
自动登陆(30天有效)
忘了密码
≡技术区≡
DELPHI技术
lazarus/fpc/Free Pascal
移动应用开发
Web应用开发
数据库专区
报表专区
网络通讯
开源项目
论坛精华贴
≡发布区≡
发布代码
发布控件
文档资料
经典工具
≡事务区≡
网站意见
盒子之家
招聘应聘
信息交换
论坛信息
最新加入: cuiqingbo
今日帖子: 2
在线用户: 5
导航: 论坛 -> DELPHI技术 斑竹:liumazi,sephil  
作者:
男 emailx45 (emailx45) ▲▲▲▲△ -
普通会员
2023/3/25 8:50:16
标题:
my sample for VCL/FMX forms: How run your threads in a secondary forms? by Emailx45 浏览:570
加入我的收藏
楼主: my sample for VCL/FMX forms: How run your threads in a secondary forms? by Emailx45


Here, just an idea how run your thread using a secondary form...

I'm using a "global var" only for show my idea... of course, this is not recommend in real app!!!

You can click many time in the Button1 ( Threads )... 1x, 2x, 3x, etc...
.
.
.
此帖子包含附件:
GIF 图像
大小:3.23M
----------------------------------------------
The higher the degree, the greater the respect given to the humblest!RAD 11.3
作者:
男 emailx45 (emailx45) ▲▲▲▲△ -
普通会员
2023/3/25 8:51:01
1楼: ---- Main form


var
  MainForm          : TMainForm;
  LHowManyThreadRunning: integer = 0; // Global vars was just for my test... do use it, at all!!!

implementation

{$R *.dfm}

uses
  uFormWithThread;

var
  LArrForms: TArray<TForm>;
  LTop     : integer = 0;
  LLeft    : integer = 0;

procedure MyDestroyForms;
begin
  for var F in LArrForms do
    if (F <> nil) then
      FreeAndNil(F);
end;

procedure TMainForm.Bnt_Call_Form_ThreadClick(Sender: TObject);
var
  i: integer;
begin
  i          := Length(LArrForms);
  LArrForms         := LArrForms + [TFormWithThread.Create(nil)];
  LArrForms[i].Top  := LTop;
  LArrForms[i].Left := LLeft;
  LArrForms[i].Show;
  //
  LTop  := LTop;
  LLeft := LLeft + LArrForms[i].Width;
end;

procedure TMainForm.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
  CanClose := LHowManyThreadRunning = 0;
end;

procedure TMainForm.FormDestroy(Sender: TObject);
begin
  MyDestroyForms;
end;

procedure TMainForm.Btn_Try_Close_All_Form_ShowingClick(Sender: TObject);
begin
  for var F in LArrForms do
    if (F <> nil) then
      F.Close;
  //
  LTop  := 0;
  LLeft := 0;
end;

initialization

ReportMemoryLeaksOnShutdown := true;

end.
----------------------------------------------
The higher the degree, the greater the respect given to the humblest!RAD 11.3
作者:
男 emailx45 (emailx45) ▲▲▲▲△ -
普通会员
2023/3/25 8:51:20
2楼: --- Second Forms

type
  TFormWithThread = class(TForm)
    Btn_RunThread: TButton;
    MyAnimation: TActivityIndicator;
    Memo1: TMemo;
    Label1: TLabel;
    procedure Btn_RunThreadClick(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
  private
    LArrThreads: TArray<TMyThread>;
    //
    procedure MyUpdateButtonCaption(const AValue: string);
    function MyCanClose: Boolean;
  public
    { Public declarations }
  end;

var
  FormWithThread: TFormWithThread;

implementation

{$R *.dfm}

uses
  uFormMain;

function TFormWithThread.MyCanClose: Boolean;
begin
  result := false;
  //
  try
    while (Length(LArrThreads) > 0) do
      begin
        // trying kill the thread...
        LArrThreads[0].Terminate;
        LArrThreads[0].WaitFor;
        LArrThreads[0].Free;
        //
        // if ok, remove it from list
        delete(LArrThreads, 0, 1);
      end;
  except
    on E: Exception do
      Memo1.Lines.Add('ERROR: ' + E.Message);
  end;
  //
  LHowManyThreadRunning := Length(LArrThreads);
  result          := LHowManyThreadRunning = 0;
end;

procedure TFormWithThread.Btn_RunThreadClick(Sender: TObject);
var
  i: integer;
begin
  i          := Length(LArrThreads);
  LArrThreads := LArrThreads + [TMyThread.Create(MyUpdateButtonCaption)];
  //
  Memo1.Lines.Add(TimeToStr(now) + ' CurrentThread: ' + TThread.CurrentThread.ThreadID.ToString + ' ... App');
  //
  LArrThreads[i].Start;
  //
  LHowManyThreadRunning := i + 1;
  Label1.Caption        := (i + 1).ToString;
  //
  MyAnimation.StartAnimation;
end;

procedure TFormWithThread.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
  LHowManyThreadRunning := Length(LArrThreads);
  CanClose          := LHowManyThreadRunning = 0;
  //
  if not CanClose then
    CanClose := MyCanClose;
end;

procedure TFormWithThread.MyUpdateButtonCaption(const AValue: string);
begin
  Memo1.Lines.Add(TimeToStr(now) + ' CurrentThread: ' + TThread.CurrentThread.ThreadID.ToString + ' ' + AValue);
end;

end.
----------------------------------------------
The higher the degree, the greater the respect given to the humblest!RAD 11.3
作者:
男 emailx45 (emailx45) ▲▲▲▲△ -
普通会员
2023/3/25 8:51:35
3楼: --- MyThread

unit uMyThread;

interface

uses
  System.SysUtils,
  System.Classes,
  System.Threading;

type
  TMyProcReference = reference to procedure(const AValue: string);

  TMyThread = class(TThread)
  strict private
    FProc     : TMyProcReference;
    FLCounter : integer;
    FLThreadID: string;
  protected
    procedure Execute; override;
    procedure DoTerminate; override;
  public
    constructor Create(const AProc: TMyProcReference = nil); overload;
  end;

implementation

{ TMyThread }

constructor TMyThread.Create(const AProc: TMyProcReference = nil);
begin
  inherited Create(true);
  //
  FProc      := AProc;
  FLThreadID := ThreadID.ToString;
  FLCounter  := 0;
end;

procedure TMyThread.DoTerminate;
begin
  FLThreadID := ThreadID.ToString;
  //
  if Assigned(FProc) then
    TThread.Queue(nil,
      procedure
      begin
        FProc('This is the end! FLThreadID: ' + FLThreadID + '    LCounter: ' + FLCounter.ToString);
      end);
end;

procedure TMyThread.Execute;
begin
  while not Terminated do
    begin
      FLThreadID := ThreadID.ToString;
      //
      if (FLCounter = 100) then
        break;
      //
      if Assigned(FProc) then
        TThread.Queue(nil,
          procedure
          begin
          FProc('FLThreadID: ' + FLThreadID + '    LCounter: ' + FLCounter.ToString);
          end);
      //
      // simulating a process... "LCounter just for test n process"
      FLCounter := FLCounter + 1;
      sleep(500);
    end;
end;

end.
----------------------------------------------
The higher the degree, the greater the respect given to the humblest!RAD 11.3
作者:
男 emailx45 (emailx45) ▲▲▲▲△ -
普通会员
2023/3/25 9:02:17
4楼: the big problem it's here:

...  LHowManyThreadRunning := Length(LArrThreads);  <--- not safe!!!
----------------------------------------------
The higher the degree, the greater the respect given to the humblest!RAD 11.3
信息
登陆以后才能回复
Copyright © 2CCC.Com 盒子论坛 v3.0.1 版权所有 页面执行85.9375毫秒 RSS