盒子论坛 v2.1

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...
.
.
.

此帖子包含附件:

大小: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

信息

登陆以后才能回复