Form running in a different thread react to Application

[Weitentaaal]

Hello,

some time ago i wrote this Post: https://forum.lazarus.freepascal.org/index.php/topic,67450.msg519055.html#msg519055

i have a form which will show an animated GIF. It's in a different thread to prevent it from freezing. Now when my Main form does lose Focus (for example ALT+TAB out) and wont be visible anymore, then the Form in the Second thread will still be there. How do i react to Changes from the Application in the Second thread form.

I want both Forms to behave the same way if that is possible.

This is the Code of The Thread-Form:

Code: Pascal  [Select][+][-]

1. unit uGIF;
2.  
3. {$mode objfpc}{$H+}
4.  
5. interface
6.  
7. uses
8.    Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ExtCtrls, Windows,
9.    BGRAAnimatedGif;
10.  
11. type
12.    { TGifView }
13.    TGifView = class(TForm)
14.       Image: TImage;
15.       procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
16.       procedure FormCreate(Sender: TObject);
17.       procedure FormShow(Sender: TObject);
18.    public
19.       PathToGIF: string;
20.    end;
21. var
22.    GifView: TGifView;
23. implementation
24. const
25.   //LWA_COLORKEY = 1;
26.   //LWA_ALPHA = 2;
27.   //LWA_BOTH = 3;
28.   WS_EX_LAYERED = $80000;
29.   GWL_EXSTYLE = -20;
30.  
31. {$R *.lfm}
32.  
33. function SetLayeredWindowAttributes(hWnd: longint; Color: longint;
34.    X: byte; alpha: longint): bool stdcall; external 'USER32';
35.  
36. function SetWindowLongA(hWnd: longint; nIndex: longint;
37.    dwNewLong: longint): longint stdcall; external 'USER32';
38.  
39. function GetWindowLongA(hWnd: longint; nIndex: longint): longint stdcall;
40.    external 'user32';
41.  
42. procedure SetTranslucent(ThehWnd: longint; Color: longint; nTrans: integer);
43. var
44.    Attrib: longint;
45. begin
46.    {SetWindowLong and SetLayeredWindowAttributes = API functions}
47.    Attrib := GetWindowLongA(ThehWnd, GWL_EXSTYLE);
48.    SetWindowLongA(ThehWnd, GWL_EXSTYLE, attrib or WS_EX_LAYERED);
49.    {anything with color value color will completely disappear if flag = 1 or flag = 3  }
50.    SetLayeredWindowAttributes(ThehWnd, Color, nTrans, 1);
51. end;
52.  
53. { TGifView }
54.  
55. procedure TGifView.FormShow(Sender: TObject);
56. begin
57.    //SetWindowPos(Handle, HWND_TOPMOST, 0, 0, 0, 0, SWP_NoMove or SWP_NoSize);
58.    SetWindowPos(Handle, HWND_TOPMOST, 0, 0, 0, 0, SWP_NoMove or SWP_NoSize);
59.  
60.    Image.Picture.LoadFromFile(PathToGIF);
61.  
62.    self.Top:= Application.MainForm.Top + Application.MainForm.Height - Self.Height - 10;
63.    self.Left:= Application.MainForm.Left + Application.MainForm.Width - Self.Width - 10;
64. end;
65.  
66. procedure TGifView.FormCreate(Sender: TObject);
67. var
68.    Transparency: longint;
69. begin
70.    Self.Color := clRed;
71.    Transparency := Self.Color;
72.    SetTranslucent(Self.Handle, Transparency, 0);
73.  
74.    PathToGIF:= '';
75. end;
76.  
77. procedure TGifView.FormClose(Sender: TObject; var CloseAction: TCloseAction);
78. begin
79.    //SetWindowPos(Handle, HWND_NOTOPMOST, 0, 0, 0, 0, SWP_NoMove or SWP_NoSize);
80.    SetWindowPos(Handle, HWND_NOTOPMOST, 0, 0, 0, 0, SWP_NoMove or SWP_NoSize);
81. end;
82.  
83. end.
84.  

and this would be the Function to call it:

Code: Pascal  [Select][+][-]

1. function GetHTTP_ThreadFunc(AsyncData: Pointer): PtrInt;
2. var
3.    Data: PAsyncData absolute AsyncData;
4.    Client: THTTPSend = Nil;
5.    Buffer: TStringList;
6. begin
7.    Data^.Response:= 'Error';
8.    Buffer:= TStringList.Create();
9.    try
10.       Client:= THTTPSend.Create();
11.       if Client.HTTPMethod('GET', Data^.Request) then begin
12.          Buffer.LoadFromStream(Client.Document);
13.          Data^.Response := Buffer.Text.Trim();
14.       end;
15.    finally
16.       Client.Free();
17.    end;
18.    InterlockedExchange(Data^.Ready, 1);
19.    Buffer.Free();
20.    Result:= 0;
21.    EndThread;
22. end;
23.  
24. function GetHTTP(const Request: string): String;
25. var
26.   Data: TAsyncData;
27. begin
28.   Data:= Default(TAsyncData);
29.   Data.Request:= Request;
30.   BeginThread(@GetHTTP_ThreadFunc, @Data);
31.   while InterlockedCompareExchange(Data.Ready, 0, 0) <> 1 do begin
32.     Application.ProcessMessages();
33.     Sleep(16);
34.   end;
35.   Result:= Data.Response;
36. end;
37.  

[440bx]

How do i react to Changes from the Application in the Second thread form.

Disclaimer: I know nothing about "Forms" and other OOP gizmos and what follows is Windows only (you have "windows" in the uses clause so that part looks like isn't a problem.)

That said, the problem you describe sounds like it is the result of one thread not getting messages it wants/should get.  That problem can be solved using AttachThreadInput.  That would allow the other thread to see the messages received by the first thread and react to them as well (and as appropriate.)

All of the above said, I know how this stuff works when programming to the API (real windows) when it comes to "forms", the above is as far as I can go.  Someone else will have to fill in the details as to how that API fits in the framework.  (this is why I normally don't answer these kinds of questions, i.e, I cannot give a "full" answer.)

HTH.

[MarkMLl]

It's in a different thread to prevent it from freezing.

Don't.

GUIs are not thread-safe, and you are exposing yourself to nothing bur grief.

There might be a way round it by using e.g. OpenGL in a different thread context, but apart from that the only guaranteed-safe way of passing state from a thread to the foreground is by using TThread.Synchronize.

MarkMLl

[Weitentaaal]

i did use a thread beacuse the GIF Animation froze when waiting for server Response. Is there a better way of doing so ?

Edit: the goal would be to show a Loading animation while waiting for a response. i thought using a GIF would be the easy way.

[MarkMLl]

Either put the server interaction in a thread, or use a library for that which either supports asynchronous operations or gives you an idle callback while it's busy.

MarkMLl

[Weitentaaal]

I put the whole Server <-> Client Communication in a thread. Now i need to keep the Application responsive while waiting for the thread to finish, how do i do that ?. i want to show the gif (simple form with TImage on it) while waiting. I added a boolean to the thread class which gives me the info if the thread is finished or not.

i use this simple example (which i got from here: https://forum.lazarus.freepascal.org/index.php?topic=44274.0) to test it:

Code: Pascal  [Select][+][-]

1. unit Unit1;
2.  
3. {$mode objfpc}{$H+}
4.  
5. interface
6.  
7. uses
8.    Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls;
9.  
10. type
11.   TMyArray    = array[0..999] of smallint;
12.  
13.   TMsgEvent  = procedure(const aMsg : string) of object;
14.  
15.   { TMyThread }
16.  
17.   TMyThread = class(TThread)
18.     fMySubArray : TMyArray;
19.     fFileNumber : integer;
20.     fFileName   : string;
21.     fIsFinished : boolean;
22.   private
23.     FOnProgress: TMsgEvent;
24.     procedure DoProgress;
25.   protected
26.     procedure Execute; override;
27.   public
28.     property OnProgress: TMsgEvent read FOnProgress write FOnProgress;
29.   end;
30.  
31.   { TForm1 }
32.  
33.   TForm1 = class(TForm)
34.     Button1: TButton;
35.     Memo1: TMemo;
36.     procedure Button1Click(Sender: TObject);
37.     procedure FormCreate(Sender: TObject);
38.   private
39.      fFilenumber : integer;
40.      procedure DoMyProgress(const aMsg : string);
41.      procedure fill;
42.   end;
43.  
44. var
45.   Form1: TForm1;
46.  
47. implementation
48. uses uGIF;
49. {$R *.lfm}
50.  
51. { TForm1 }
52.  
53. procedure TForm1.Button1Click(Sender: TObject);
54. begin
55.   fill;
56.   memo1.lines.add('ok');
57. end;
58.  
59. procedure TForm1.fill;
60. var FMyArray  : TMyArray;
61.     subindex  : smallint;
62.     MyThread  : TMyThread;
63. begin
64.     GifView.Show;
65.     for subindex := low(fMyArray) to high(fMyArray) do
66.       fMyArray[subindex] := subindex;
67.     fFilenumber := fFilenumber + 1;
68.     MyThread  := TMyThread.create(true);
69.     MyThread.fFileNumber := fFilenumber;
70.     MyThread.fIsFinished:= false;
71.     MyThread.fMySubArray := fMyArray;
72.     MyThread.FreeOnTerminate := true;
73.     MyThread.OnProgress := @DoMyProgress;
74.     MyThread.Start;
75.  
76.     Application.ProcessMessages;
77.     repeat
78.       //??
79.     until MyThread.fIsFinished;
80.     //MyThread.Terminate;
81. end;
82.  
83. procedure TForm1.FormCreate(Sender: TObject);
84. begin
85.   fFilenumber := 0;
86. end;
87.  
88. procedure TForm1.DoMyProgress(const aMsg : string);
89. begin
90.   memo1.lines.add(aMsg);
91.   GifView.Close;
92. end;
93.  
94. { TMyThread }
95.  
96. procedure TMyThread.Execute;
97. var MyFile   : TextFile;
98.     index    : integer;
99. begin
100.   ffilename := format('myfile_%.5d.txt',[fFilenumber]);
101.   try
102.     Assignfile(MyFile,ffilename);
103.     rewrite(MyFile);
104.     writeln(MyFile,fFilename);
105.     for index := 0 to length(fMySubArray) - 1 do
106.       system.Write(MyFile,fMySubArray[index]);
107.     Sleep(1000);
108.   finally
109.     fIsFinished:= true;
110.     system.close(MyFile);
111.     synchronize(@doProgress)
112.   end;
113. end;
114.  
115. procedure TMyThread.DoProgress;
116. begin
117.   if Assigned(FOnProgress) then
118.     FOnProgress(fFilename);
119. end;
120.  
121. end.
122.  

what is the correct way of waiting for the thread to finish ? Its the main thread that is waiting, so i should not use "WaitFor".

[Thaddy]

In principle you should not run whole forms in a thread, but just the data it needs to display.

[Remy Lebeau]

I put the whole Server <-> Client Communication in a thread. Now i need to keep the Application responsive while waiting for the thread to finish, how do i do that ? i want to show the gif (simple form with TImage on it) while waiting.

The best option is to simply start the thread and then have the caller return flow back to the main message loop, and then have the thread notify the main thread when it is finished.  Never block the main thread.

I added a boolean to the thread class which gives me the info if the thread is finished or not.

You don't need that.  TThread has a Finished property for that purpose.  Or you can use the TThread.OnTerminate event.

i use this simple example (which i got from here: https://forum.lazarus.freepascal.org/index.php?topic=44274.0) to test it

Try something more like this instead:

Code: Pascal  [Select][+][-]

1. unit Unit1;
2.  
3. {$mode objfpc}{$H+}
4.  
5. interface
6.  
7. uses
8.    Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls;
9.  
10. type
11.   TMyArray    = array[0..999] of SmallInt;
12.  
13.   TMsgEvent  = procedure(const aMsg : string) of object;
14.  
15.   { TMyThread }
16.  
17.   TMyThread = class(TThread)
18.     fMySubArray : TMyArray;
19.     fFileNumber : Integer;
20.     fFileName   : string;
21.   private
22.     FOnProgress: TMsgEvent;
23.     procedure DoProgress;
24.   protected
25.     procedure Execute; override;
26.   public
27.     property OnProgress: TMsgEvent read FOnProgress write FOnProgress;
28.   end;
29.  
30.   { TForm1 }
31.  
32.   TForm1 = class(TForm)
33.     Button1: TButton;
34.     Memo1: TMemo;
35.     procedure Button1Click(Sender: TObject);
36.     procedure FormCreate(Sender: TObject);
37.   private
38.      fFileNumber : Integer;
39.      fMyThread  : TMyThread;
40.      procedure DoMyProgress(const aMsg : string);
41.      procedure DoMyTerminate(Sender: TObject);
42.      procedure StartFill;
43.   end;
44.  
45. var
46.   Form1: TForm1;
47.  
48. implementation
49.  
50. uses
51.   uGIF;
52.  
53. {$R *.lfm}
54.  
55. { TForm1 }
56.  
57. procedure TForm1.FormCreate(Sender: TObject);
58. begin
59.   fFileNumber := 0;
60. end;
61.  
62. procedure TForm1.Button1Click(Sender: TObject);
63. begin
64.   if fMyThread <> nil then Exit;
65.   Button1.Enabled := False;
66.   StartFill;
67. end;
68.  
69. procedure TForm1.StartFill;
70. var
71.   MyArray  : TMyArray;
72.   SubIndex  : SmallInt;
73. begin
74.     GifView.Show;
75.     for SubIndex := Low(MyArray) to High(MyArray) do
76.       MyArray[SubIndex] := SubIndex;
77.     Inc(fFileNumber);
78.     fMyThread  := TMyThread.Create(True);
79.     fMyThread.fFileNumber := fFileNumber;
80.     fMyThread.fMySubArray := MyArray;
81.     fMyThread.FreeOnTerminate := True;
82.     fMyThread.OnProgress := @DoMyProgress;
83.     fMyThread.OnTerminate := @DoMyTerminate;
84.     fMyThread.Start;
85. end;
86.  
87. procedure TForm1.DoMyProgress(const aMsg : string);
88. begin
89.   Memo1.Lines.Add(aMsg);
90. end;
91.  
92. procedure TForm1.DoMyTerminate(Sender: TObject);
93. begin
94.   fMyThread := nil;
95.   GifView.Close;
96.   Memo1.Lines.Add('ok');
97.   Button1.Enabled := True;
98. end;
99.  
100. { TMyThread }
101.  
102. procedure TMyThread.Execute;
103. var
104.   MyFile   : TextFile;
105.   index    : Integer;
106. begin
107.   fFileName := Format('myfile_%.5d.txt', [fFileNumber]);
108.   try
109.     AssignFile(MyFile, fFileName);
110.     Rewrite(MyFile);
111.     WriteLn(MyFile, fFileName);
112.     for index := 0 to Length(fMySubArray) - 1 do
113.       System.Write(MyFile, fMySubArray[index]);
114.     Sleep(1000);
115.   finally
116.     System.Close(MyFile);
117.     if Assigned(FOnProgress) then
118.       Synchronize(@DoProgress);
119.   end;
120. end;
121.  
122. procedure TMyThread.DoProgress;
123. begin
124.   if Assigned(FOnProgress) then
125.     FOnProgress(fFileName);
126. end;
127.  
128. end.
129.  

[Weitentaaal]

Ok i see the dangers when working with threads so i made sure to terminate the thread after some time if i don't get a Server result (due to connection issues or whatever). I will keep the main form idle and just Lock certain controls/functions while waiting for thread to finish.

The "OnTerminate" was what i was looking for, don't ask me how i missed that.

I will do some further reading about "synchronize", but other than that i think i got it now well understood. Thank you all.

[MarkMLl]

Ok i see the dangers when working with threads so i made sure to terminate the thread after some time if i don't get a Server result (due to connection issues or whatever). I will keep the main form idle and just Lock certain controls/functions while waiting for thread to finish.

The "OnTerminate" was what i was looking for, don't ask me how i missed that.

I will do some further reading about "synchronize", but other than that i think i got it now well understood. Thank you all.

Don't worry, we've all been there. However this is a /very/ common restriction: Delphi in Windows had it, and Lazarus on unix (i.e. Linux et al.) has it in spades because threads were introduced into that family of OSes relatively late.

MarkMLl

[Thaddy]

because threads were introduced into that family of OSes relatively late.

MarkMLl

??? Unix - at least since SystemV - had from the beginning means of asynchronous execution. It is designed like that. Unlike DOS or CP/M
(Call it threads, forks or processes)
The main difference between high level Windows and High level UNIX is that Windows uses "messages" and UNIX relies on synchronization primitives like events, semaphores and the like. (Actually, deep under the hood, Windows does the same...Well hidden from the user)
I am aware that asynchronous execution need not be the same as parallel execution, which is a specialization of the former.

[MarkMLl]

??? Unix - at least since SystemV - had from the beginning means of asynchronous execution. It is designed like that. Unlike DOS or CP/M
(Call it threads, forks or processes)

unix threads and processes are very different: threads explicitly share memory while processes explicitly do not (typically but not always with COW on a fork()).

And because processes do not share memory or other resources, it is at least non-trivial to have multiple processes interact in the context of the same X11 etc. window.

Threads were more of a Windows NT thing, brought over from OS/2 and various things before that: the unix community was aggressively dismissive of them at least until GUI-oriented programs and workstation-level SMP began to be significant.

As I'm sure you are aware, GUI with a message-handling queue has a common heritage reaching back to Xerox Parc, with various forgotten offshoots including a Logitech product. I do not know what level of process/thread architecture the Xerox OSes had, but from the hardware descriptions I've seen I suspect it was fairly rudimentary.

Somewhat later: I think it fair to add that at one time Linux supported two different thread architectures: NPTL and LinuxThreads. What is more, at one time the same version of Debian implemented different thread architectures on different hardware platforms, e.g. x86 vs ARM. Hence

Code: Pascal  [Select][+][-]

1. (* If running Win-32 then GetProcessID equals masterThreadProcessId. If *)
2. (* running Linux (or possibly other unix implementations) then there    *)
3. (* are two cases: LinuxThreads where they are different and NPTL where  *)
4. (* they are the same. The program instance that is sending the TFTP     *)
5. (* ping request will be using the result to determine whether it is the *)
6. (* same program instance, so in all cases we need to use the PID which  *)
7. (* represents the main process, not one which represents a LinuxThreads *)
8. (* thread.                                                              *)
9.  
10.       IF GetProcessId = masterThreadProcessID THEN
11.         debug('NPTL')
12.       ELSE
13.         debug('LinuxThreads');
14.  
15. ...
16.  
17. INITIALIZATION
18.   xClipBook:= NIL;
19.   SetSockOptBroadcast:= '';
20.  
21. (* Saving the original PID is essential if LinuxThreads is being used   *)
22. (* since the thread handling TFTP ping requests can't get it on the fly.*)
23.  
24.   masterThreadProcessId:= GetProcessID
25. FINALIZATION
26.   xClipBook.Free
27. end.
28.  

After a while things settled down with well-nigh universal adoption of POSIX threads. Then got worse with process groups and so on.

MarkMLl

[Weitentaaal]

how would it look like if i use the "Finished" Property instead of the "OnTerminate" function. i tried to use it but i guess i did use it wrong because i will never be true.

Maybe i could avoid haveing the input and output in 2 different procedures ? and have it in a function instead ?

For example if i send data and retrieve data from the server then i would need to feed the thread and wait for the thread to finish to use the data. That would be easier in a Single function instead of  2 seperate procedures.

It does not make much of a diference but i need to call the server multiple times in different Classes so i would need to create a "OnTerminate" procedure for every call i make.

[Remy Lebeau]

how would it look like if i use the "Finished" Property instead of the "OnTerminate" function. i tried to use it but i guess i did use it wrong because i will never be true.

You would simply replace MyThread.fIsFinished with MyThread.Finished.  But, if you have to launch a thread and then wait on it, you should be using TThread.WaitFor() instead.  Though, you usually shouldn't be launching a thread at all in this case.

Maybe i could avoid haveing the input and output in 2 different procedures ? and have it in a function instead ?

For example if i send data and retrieve data from the server then i would need to feed the thread and wait for the thread to finish to use the data. That would be easier in a Single function instead of  2 seperate procedures.

I would not have the function use a thread in that situation. However, doing the send and read in a single function would require blocking the caller of the function, in which case you should not call the function in the main UI thread at all.

It does not make much of a diference but i need to call the server multiple times in different Classes so i would need to create a "OnTerminate" procedure for every call i make.

If you use a new thread per call, then yes.

Otherwise, consider using a single thread connected to the server, and then put the calls into a queue that the thread pulls from regularly, where each queue item indicates how to notify when the call finishes, whether that be to send a window/thread message, or signal an event object that the queuer is waiting on, etc.