VCL or FMX: My sample using Thread running in another forms for some tasks...

[programmerdelphi2k 235]

My sample using Thread running in another forms some tasks...

• not 100% perfect or SAFE... but works if you take a care about my "little code"
• of course, needs to know "what going on..."  and to do some changes for a specific usage... then, dont blame me, this it's just a simple sample. ok?
• take the idea and do better!!!  maybe a "container using Observer Pattern" would help here, but "arrays" was good for me in this time!
• try close all forms, or simply the mainform  🙂
• you CAN click many time on Button and raise yourS threadS... 1x, 2x, 3x, etc... dont abuse :)))

// ---- FormMain -----
var
  MainForm             : TMainForm;
  LHowManyThreadRunning: integer = 0; // Global vars was just for my test... dont 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;
end;

initialization

ReportMemoryLeaksOnShutdown := true;

end.

 

// --- Secondary Forms...
var
  FormWithThread: TFormWithThread;

implementation

{$R *.dfm}

uses
  uMyThread,
  uFormMain;

var
  LArrThreads: TArray<TMyThread>;

function MyCanClose: Boolean;
begin
  result := false;
  //
  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;
  //
  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 := LHowManyThreadRunning + 1;
  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.

 

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.

 

 

Edited March 25, 2023 by programmerdelphi2k

[programmerdelphi2k 235]

Ops!!!! exists a little error in my code using "global things" :)>.. 

•   LHowManyThreadRunning := Length(LArrThreads);   // cause stop the other forms....  then, dont use "global vars" all time... 
• of course, you can do at "OnTerminate()" from thread... but it's "global var" yet 😠

Edited March 25, 2023 by programmerdelphi2k

[David Heffernan 2300]

UI code must run on the main thread.

 

Although I have no clue what the point of this code us, I can see that it breaks that rule. 

 

Sad to see a thread be created suspended only to be immediately started. 

[programmerdelphi2k 235]

I beg a billion apologies, "oh universal wisdom and Master of all Mages"   🤧, for forgetting to use "Synchronism" in the "Execute" procedure...

You forgive me please, I won't know how to live without your forgiveness....   😁

 

NOTE: The "Start procedure" exists for a reason, doesn't it? (I like him)

Edited March 25, 2023 by programmerdelphi2k

[David Heffernan 2300]

Start exists for a reason. It doesn't exist to create a thread and start it immediately. 

 

I still don't know the point of this code. What is the high level overview of what you are trying to do here? 

[programmerdelphi2k 235]

1 hour ago, David Heffernan said:

I still don't know the point of this code.

Neither did I, regarding your insistence! After all, you must have something much more important to do, right? Or are you not sure about that either (too)? 😂

Edited March 26, 2023 by programmerdelphi2k

[David Heffernan 2300]

I'm so confused. 

[Lars Fosdal 1732]

It seems someone lost their thread... 

[Fr0sT.Brutal 897]

Some forums I lived at red color was only allowed for moderators. That was very good rule.

[Lars Fosdal 1732]

It is nice to have the ability to embellish with color and font size, but I agree - it sucks when people abuse that ability.