threads and sendmessage to tlabel

[tr_escape]

Hello,

I have got a problem about sendmessage to TLabel component from threads.

I can execute same codes in windows correctly but in Linux I got a lot of SEG message.

I tried some fail safe but now worked , I also tried synchronize command it working.

What I am doing wrong? Is the threads in Linux working more aggressively than windows?

If I remove the

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

1.           TLabel(Message.wParam).Caption := buf;
2.  

line I don't catch any problem.

I attached my software but I also pasted as code:

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

1. unit main;
2.  
3. {$mode objfpc}{$H+}
4.  
5. interface
6.  
7. uses
8.   Classes, LclIntf, Messages,LMessages, LclType, LResources,
9.   SysUtils, FileUtil, uPSComponent, Forms, Controls, Graphics, Dialogs,
10.   StdCtrls, ExtCtrls,
11.  
12.   uPSRuntime,uPSCompiler
13.  
14.   ;
15.  
16. const
17.   WM_SET_CAPTION = WM_USER + $01;
18.  
19. type
20.  
21.   { TScriptThread }
22.  
23.   TScriptThread = class (TThread)
24.     fScript:TPSScript;
25.     procedure PSScriptExecute(Sender: TPSScript);
26.     procedure PSScriptCompImport(Sender: TObject; x: TPSPascalCompiler);
27.     procedure PSScriptExecImport(Sender: TObject;
28.                                  se: TPSExec; x: TPSRuntimeClassImporter);
29.     procedure PSScriptCompile(Sender: TPSScript);
30.  
31.     procedure AppProcMes;
32.     procedure ScrSleep(const ms: Integer);
33.  
34.   protected
35.     procedure Execute; override;
36.   public
37.     constructor Create(aText:String);overload;
38.     destructor Destroy; override;
39.   end;
40.  
41.  
42. type
43.  
44.   { TForm1 }
45.  
46.   TForm1 = class(TForm)
47.     Button4: TButton;
48.     Label1: TLabel;
49.     Label2: TLabel;
50.     Label3: TLabel;
51.     lblCallBack: TLabel;
52.     Memo1: TMemo;
53.     Memo2: TMemo;
54.     Memo3: TMemo;
55.     procedure Button4Click(Sender: TObject);
56.   private
57.     { private declarations }
58.   public
59.     { public declarations }
60.     procedure MyCallBack;
61.   protected
62.      procedure WMSetCaption(var Message: TLMessage); message WM_SET_CAPTION;
63.   end;
64.  
65. var
66.   Form1: TForm1;
67.   thr1,thr2,thr3 : TScriptThread;
68.   Cnt:Integer;
69.   Busy:Boolean=False;
70.  
71. implementation
72. uses
73.       uPSR_std,
74.       uPSC_std,
75.       uPSR_stdctrls,
76.       uPSC_stdctrls,
77.       uPSR_forms,
78.       uPSC_forms,
79.       uPSC_graphics,
80.       uPSC_controls,
81.       uPSC_classes,
82.       uPSR_graphics,
83.       uPSR_controls,
84.       uPSR_classes;
85.  
86.  
87. {$R *.lfm}
88.  
89. { TForm1 }
90.  
91. procedure TScriptThread.ScrSleep(const ms:Integer);
92. begin
93.   Sleep(ms);
94. end;
95.  
96.  
97. procedure SetLabelCaption(const aName, aCaption:string);
98. var
99.   buf: PChar;
100.   len: integer;
101.   cmp : TComponent;
102. begin
103.   if (aName='') or (aCaption='') then
104.     Exit;
105.  
106.   if Busy then
107.     Exit;
108.  
109.   Busy:=True;
110.  
111.   len := (Length(aCaption) + 1) * SizeOf(Char);
112.   GetMem(buf, len);
113.   Move(aCaption[1], buf^, len);
114.   cmp := Form1.FindComponent(aName);
115.   if Assigned(cmp) then
116.     LclIntf.SendMessage(Form1.Handle,
117.                         WM_SET_CAPTION,
118.                         Integer(cmp),
119.                         Integer(buf));
120. end;
121.  
122.  
123.  
124. constructor TScriptThread.Create(aText:String);
125. begin
126.   inherited Create(True);
127.   FreeOnTerminate := True;
128.   fScript:=TPSScript.Create(nil);
129.   fScript.Script.Text := aText;
130.   fScript.OnCompile := @PSScriptCompile;
131.   fScript.OnExecute := @PSScriptExecute;
132.   fScript.OnCompImport := @PSScriptCompImport;
133.   fScript.OnExecImport := @PSScriptExecImport;
134.   // Execute;
135. end;
136.  
137. destructor TScriptThread.Destroy;
138. begin
139.   FreeAndNil(fScript);
140.   inherited;
141. end;
142.  
143. procedure TScriptThread.Execute;
144. begin
145.   if fScript.Compile then
146.     fScript.Execute;
147. end;
148.  
149. procedure TScriptThread.PSScriptCompImport(Sender: TObject;
150.   x: TPSPascalCompiler);
151. begin
152.   SIRegister_Std(x);
153.   SIRegister_Classes(x, true);
154.   SIRegister_Graphics(x, true);
155.   SIRegister_Controls(x);
156.   SIRegister_stdctrls(x);
157.   SIRegister_Forms(x);
158. end;
159.  
160. procedure TScriptThread.PSScriptExecImport(Sender: TObject; se: TPSExec;
161.   x: TPSRuntimeClassImporter);
162. begin
163.   RIRegister_Std(x);
164.   RIRegister_Classes(x, True);
165.   RIRegister_Graphics(x, True);
166.   RIRegister_Controls(x);
167.   RIRegister_stdctrls(x);
168.   RIRegister_Forms(x);
169. end;
170.  
171. procedure TScriptThread.PSScriptExecute(Sender: TPSScript);
172. begin
173.   Sender.SetVarToInstance('Application', Application);
174.   Sender.SetVarToInstance('Form1', Self);
175. end;
176.  
177. procedure TScriptThread.PSScriptCompile(Sender: TPSScript);
178. begin
179.   Sender.AddRegisteredVariable('Application', 'TApplication');
180.   Sender.AddRegisteredVariable('Form1', 'TForm');
181.   Sender.AddFunction(@TScriptThread.ScrSleep,
182.                    'procedure ScrSleep(const ms:Integer);');
183.   Sender.AddFunction(@SetLabelCaption,
184.                    'procedure SetLabelCaption(const aName, aCaption:string);');
185.   Sender.AddFunction(@TScriptThread.AppProcMes,
186.                     'procedure AppProcMes;');
187. end;
188.  
189. procedure TScriptThread.AppProcMes;
190. begin
191.   Synchronize(@Form1.MyCallBack);
192.   Synchronize(@Application.ProcessMessages);
193. end;
194.  
195. procedure TForm1.Button4Click(Sender: TObject);
196. begin
197.   Cnt:=0;
198.  
199.   thr1:=TScriptThread.Create(Memo1.Text);
200.   thr1.Start;
201.  
202.   thr2:=TScriptThread.Create(Memo2.Text);
203.   thr2.Start;
204.  
205.   thr3:=TScriptThread.Create(Memo3.Text);
206.   thr3.Start;
207.  
208. end;
209.  
210. procedure TForm1.MyCallBack;
211. begin
212.   Cnt+=1;
213.   lblCallBack.Caption:=IntToStr(Cnt);
214. end;
215.  
216. var
217.   // timeout:TDateTime;
218.   OldCmp : TComponent=nil;
219. procedure TForm1.WMSetCaption(var Message: TLMessage);
220. var
221.   buf: PChar;
222. begin
223.   if (Message.lParam <> 0) and (Message.WParam<>0) then
224.     try
225.       buf := PChar(Message.lParam);
226.       if // (now>timeout) and
227.          (OldCmp<>TComponent(Message.wParam)) then
228.         begin
229.           // timeout:=Now+(1/24/60/60/1000);
230.           OldCmp:=TComponent(Message.wParam);
231.           TLabel(Message.wParam).Caption := buf;
232.         end;
233.     finally
234.       FreeMem(buf);
235.       Busy:=False;
236.     end;
237. end;
238.  
239. end.
240.  
241.  

 

[avra]

I did not have time to debug your code, but here is a working alternative using QueueAsyncCall() if you would like to take a look. I use it for thread safe logging messages to Memo control, which is close enough to your use case.

There is a MemoChannel unit where I have something like this:

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

1. ...
2. type
3.   TLogMsgData = record
4.     Text: string;
5.   end;
6.   PLogMsgData = ^TLogMsgData;
7. ...
8. procedure TMemoChannel.Write(const AMsg: string);
9. var
10.   LogMsgToSend: PLogMsgData;
11. begin
12.   New(LogMsgToSend);
13.   LogMsgToSend^.Text:= AMsg;
14.   Application.QueueAsyncCall(@WriteAsyncQueue, NativeUInt(LogMsgToSend)); // put log msg into queue that will be processed from the main thread after all other messages
15. end;
16. ...
17. procedure TMemoChannel.WriteAsyncQueue(Data: PtrInt);
18. var // called from main thread after all other messages have been processed to allow thread safe TMemo access
19.   ReceivedLogMsg: TLogMsgData;
20. begin
21.   ReceivedLogMsg := PLogMsgData(Data)^;
22.   try
23.     if (FMemo <> nil) and (not Application.Terminated) then
24.     begin
25.       ...
26.       FMemo.Append(ReceivedLogMsg.Text) // <<< fully thread safe
27.     end;
28.   finally
29.     Dispose(PLogMsgData(Data));
30.   end;
31. end;
32.  

All you have to do is call Write('Your text') from the thread and Memo will be safely updated because all writing to gui will be done after main gui loop finished one full cycle, and additionaly all calls are serialized so there is no fight for gui access at all. Also there is no thread locking, which brings significant speed improvements in some thread use cases.

Funny thing is that so far I have used this approach only on Windows, and you need it to work also on Linux. I do not see why it shouldn't work on both, but if you want to play with it then testing is up to you.

EDIT: After comments from Thaddy and totya in https://forum.lazarus.freepascal.org/index.php/topic,45924.msg325307.html#msg325307, PtrInt was replaced with NativeUInt.

[tr_escape]

Thank a lot I changed as your mentioned QueueAsyncCall it is worked as well as.

https://github.com/mehmetulukaya/laz-projects/blob/master/Laz_PascalScript_Multi/main.pas

[avra]

Thank a lot I changed as your mentioned QueueAsyncCall it is worked as well as.

You are most welcome. I am glad it worked for you. 

[Mike.Cornflake]

Wild guess for a possible problem with the initial code

Code: [Select]

    LclIntf.SendMessage(Form1.Handle,
                        WM_SET_CAPTION,
                        Integer(cmp),
                        Integer(buf));
Maybe should be?  (pointers was never my thing....)

Code: [Select]

    LclIntf.SendMessage(Form1.Handle,
                        WM_SET_CAPTION,
                        Pointer(cmp),
                        Pointer(buf));