[Débutant] Thread non bloquant
Bonjour,
J'essaye de mettre en place un thread pour lancer des calculs très longs tout en gardant une interface "responsive" (?) mais j'avoue que je n'y connais rien ! Voilà ce que j'ai fait pour l'instant, problème: ça bloque complètement l'interface :(
Code:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
| unit Unit2;
interface
uses
Windows, Messages, SysUtils, Classes, Forms;
const
WM_MYPROGRESS_MESSAGE = WM_USER + 1;
type
TCalculsLongs = class(TThread)
private
procedure DoUpdateProgress(const ProgressValue: Integer);
public
FNotifyHandle: Hwnd;
procedure Execute; override;
end;
implementation
{ TCalculsLongs }
{======================================================================================================================}
procedure TCalculsLongs.DoUpdateProgress(const ProgressValue: Integer);
begin
if FNotifyHandle <> 0 then begin
SendMessage(FNotifyHandle, WM_MYPROGRESS_MESSAGE, ProgressValue, 0);
// PostMessage(FNotifyHandle, WM_MYPROGRESS_MESSAGE, ProgressValue, 0);
end;
end;
{======================================================================================================================}
procedure TCalculsLongs.Execute;
var
i1, i2, i3, i4: Integer;
begin
inherited;
for i1 := 0 to 100 do begin // Calculs longs
for i2 := 0 to 10000 do begin
for i3 := 0 to 10000 do begin
Inc(i4);
end;
end;
DoUpdateProgress(i1);
end;
end;
{======================================================================================================================}
end. |
et dans ma fiche pricipale:
Code:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
| unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Controls, Forms, StdCtrls, ExtCtrls, ComCtrls, Unit2, ...;
type
TForm1 = class(TForm)
Button1: TButton;
ProgressBar1: TProgressBar;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
procedure MyThreadProgressEvent(var Msg: TMessage); message WM_MYPROGRESS_MESSAGE;
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
var
CalculsLongs: TCalculsLongs;
procedure TForm1.Button1Click(Sender: TObject);
begin
CalculsLongs := TCalculsLongs.Create(True);
CalculsLongs.FNotifyHandle := Form1.Handle;
try
CalculsLongs.Execute;
finally
CalculsLongs.Free;
end;
end;
{======================================================================================================================}
procedure TForm1.MyThreadProgressEvent(var Msg: TMessage);
begin
ProgressBar1.Position := Msg.WParam;
end;
{======================================================================================================================}
end. |
Je pensais que je pourrai au moins déplacer la fiche pendant que les calculs ont lieu mais tout reste figé tant que les calculs ne sont pas finis.
Est-ce que vous pourriez me dire où je fais erreur ?
Merci d'avance !:oops:
