Allora, ho un progetto che ha più icone nel form principale.
Quando l'utente clicca su una di queste icone dovrei:
1 - aspettare 5 secondi per dar tempo all'utente di cliccare su un'altra delle icone nel form, far partire un'animazione che "dissolve il form" fino a farlo sparire
2 - mentre fa quello che c'è scritto nel punto 1, deve lanciare un eseguibile
All'inizio, avevo messo quello che c'è nel punto 1 in un Timer, ma il punto 2 veniva eseguito solo dopo la fine del punto 1.
Ho così pensato di mettere il punto 1 sotto thread, ma così ho 2 problemi: il primo è che non riesco a dire al thread di aspettare 5 secondi. Il secondo è che il "dissolve il form" lo faccio modificando il valore di "AlphaBlendValue" ogni 100 millisecondi, ed anche qui sarei fregato non potendo usare lo sleep.
Grazie, Mario
forse potresti creare il nuovo thread con (come parametro) un timestamp avanti di 5 secondi rispetto al momento della creazione
poniamo che nel metodo create del thread metti un parametro: ExecuteAfterDatetime: TDatetime;
poi nel metodo execute qualcosa tipo
begin
while now() < ExecuteAfterDatetime do
sleep(250);
// le istruzioni vere e proprie da eseguire
end;
penso che potrebbe andare
Il problema è proprio l'istruzione "Sleep".
Supponiamo che il codice del thread sia questo:
procedure TMyThread.Execute;
const CstMinLivTrasp=1;
CstMaxLivTrasp=255;
var Idx:Integer;
begin
Idx:=1;
Sleep(100);
Idx:=2;
Idx:=3;
end;
Dopo aver eseguito l'istruzione "Sleep(100);", non esegue l'istruzione "Idx:=2;", ma torna al thread principale.
Al momento ho fatto questo (che però non mi piace molto):
procedure TMyThread.MyDelay(WrkMsAtt: dword);
var OraIni, OraFin:TTime;
begin
OraIni:=Now();
repeat
OraFin:=Now();
until (MilliSecondsBetween(OraIni, OraFin) >= WrkMsAtt);
end;
Invece di chiamare Sleep all'interno del thread, chiamo "MyDelay".
Ora il programma fa quello che voglio, ma la soluzione che ho trovato non mi piace molto.
Anche perché, ora chiamo MyDelay con un massimo di 5 secondi di attesa, se mai lo dovessi usare con periodi più lunghi, probabilmente mi occuperebbe la CPU per niente !
Ciao, Mario
Ritengo che il problema che hai sia legato alla ottimizzazione intrinseca che viene generata dal compilatore.
Essendo IDX locale e assumendo come ultimo valore 3 senza essere usato da alcuna funzione esterna, il compilatore pone probabilmente tale valore all'inizio ed esegue lo sleep, terminando immediatamente il thread.
E' una ipotesi.
Lo sleep deve comunque funzionare. Tieni presente che le assegnazioni interne vengono ottimizzate se non ci sono chiamate esterne a tale procedura. Ciò viene fatto anche nei normali metodi. L'unico modo per evitare ciò è eliminare completamente l'ottimizzazione (normalmente posta a O1) o usare variabili definite nella classe, esterne o globali.
Fai una prova così:
va IDX: Integer; //VARIABILE GLOBALE NELLA SEZIONE INTERFACE
procedure TMyThread.Execute;
const CstMinLivTrasp=1;
CstMaxLivTrasp=255;
begin
Idx:=1;
Sleep(5000);
Idx:=2;
end;
Così dovrebbe funzionare.
Ciao
Ho usato diverse volte sleep all'interno dei thread e non ricordo questo tipo di problema. Tra l'altro è anche un medodo interno alla classe quindi ancora più strano.
Se si escludono eventuali eccezioni che possono interrompere il thread rimane poco da ipotizzare.
Ho provato a simulare più o meno quello che vuoi fare e su linux mi sembra funzionare come aspettato.
Ciao
qk
unit Unit1;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls, Buttons;
type
{ TForm1 }
TForm1 = class(TForm)
Button1: TButton;
procedure Button1Click(Sender: TObject);
procedure DoTerminate1(Sender: TObject);
procedure DoTerminate2(Sender: TObject);
private
public
end;
TMyThread1 = class(TThread)
constructor Create;
procedure Execute; override;
end;
TMyThread2 = class(TThread)
constructor Create;
procedure Execute; override;
end;
var
Form1: TForm1;
MyThread1: TMyThread1 = nil;
MyThread2: TMyThread2 = nil;
implementation
{$R *.lfm}
constructor TMyThread1.Create;
begin
FreeOnTerminate := True;
Inherited Create(True);
end;
procedure TMyThread1.Execute;
begin
Form1.AlphaBlend := True;
while Form1.AlphaBlendValue > 0 do
begin
Sleep(10);
Form1.AlphaBlendValue := Form1.AlphaBlendValue -1;
Form1.Refresh;
end;
end;
constructor TMyTHread2.Create;
begin
FreeOnTerminate := True;
Inherited Create(True);
end;
procedure TMyThread2.Execute;
begin
Sleep(5000);
// eseguo altro codice ...
end;
{ TForm1 }
procedure TForm1.Button1Click(Sender: TObject);
begin
if MyThread1 = nil then
begin
MyThread1 := TMyThread1.Create;
MyThread1.OnTerminate := @DoTerminate1;
MyThread1.Start;
end;
if MyThread2= nil then
begin
MyThread2 := TMyThread2.Create;
MyThread2.OnTerminate := @DoTerminate2;
MyThread2.Start;
end;
end;
procedure TForm1.DoTerminate1(Sender: TObject);
begin
ShowMessage('Terminate thread 1');
Form1.AlphaBlendValue := 255;
MyThread1 := nil;
end;
procedure TForm1.DoTerminate2(Sender: TObject);
begin
ShowMessage('Terminate thread 2');
MyThread2 := nil;
end;
end.
unit Unit1;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls, Buttons;
type
{ TForm1 }
TForm1 = class(TForm)
Button1: TButton;
procedure Button1Click(Sender: TObject);
procedure DoTerminate1(Sender: TObject);
procedure DoTerminate2(Sender: TObject);
private
public
end;
TMyThread1 = class(TThread)
constructor Create;
procedure Execute; override;
end;
TMyThread2 = class(TThread)
constructor Create;
procedure Execute; override;
end;
var
Form1: TForm1;
MyThread1: TMyThread1 = nil;
MyThread2: TMyThread2 = nil;
implementation
{$R *.lfm}
constructor TMyThread1.Create;
begin
FreeOnTerminate := True;
Inherited Create(True);
end;
procedure TMyThread1.Execute;
begin
Form1.Caption := IntToStr(5) + ' sec'; Sleep(1000);
Form1.Caption := IntToStr(4) + ' sec'; Sleep(1000);
Form1.Caption := IntToStr(3) + ' sec'; Sleep(1000);
Form1.Caption := IntToStr(2) + ' sec'; Sleep(1000);
Form1.Caption := IntToStr(1) + ' sec'; Sleep(1000);
Form1.Caption := '';
Form1.AlphaBlend := True;
while Form1.AlphaBlendValue > 0 do
begin
Sleep(10);
Form1.AlphaBlendValue := Form1.AlphaBlendValue -1;
Form1.Refresh;
end;
end;
constructor TMyTHread2.Create;
begin
FreeOnTerminate := True;
Inherited Create(True);
end;
procedure TMyThread2.Execute;
begin
Sleep(1000);
end;
{ TForm1 }
procedure TForm1.Button1Click(Sender: TObject);
begin
if MyThread1 = nil then
begin
MyThread1 := TMyThread1.Create;
MyThread1.OnTerminate := @DoTerminate1;
MyThread1.Start;
end;
if MyThread2 = nil then
begin
MyThread2 := TMyThread2.Create;
MyThread2.OnTerminate := @DoTerminate2;
MyThread2.Start;
end;
end;
procedure TForm1.DoTerminate1(Sender: TObject);
begin
ShowMessage('Fine dissolvenza');
Form1.AlphaBlendValue := 255;
Form1.Caption := 'Form1';
MyThread1 := nil;
end;
procedure TForm1.DoTerminate2(Sender: TObject);
begin
ShowMessage('Lancio l''eseguibile');
MyThread2 := nil;
end;
end.
Accedere alle proprietà della form direttamente dal thread è maledettamente comodo ma SBAGLIATO.
Diciamo che ne ero conscio e l'ho dato per scontato.
Domani sistemo meglio il post nell'eventualità di futuri lettori.
Ciao
qk
EDIT: versione aggiornata che usa synchronize per aggiornare le proprietà della form.
Riassumendo:
- primo thread gestisce il countdown e la dissolvenza della form;
- secondo thread lancia eseguibile un secondo dopo il suo avvio.
Saluti
qk
unit Unit1;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls, Buttons;
type
{ TForm1 }
TForm1 = class(TForm)
Button1: TButton;
Label1: TLabel;
procedure Button1Click(Sender: TObject);
procedure DoTerminate1(Sender: TObject);
procedure DoTerminate2(Sender: TObject);
procedure DoUpdateForm;
private
public
end;
TMyThread1 = class(TThread)
NewCaption: string;
NewAlphaBlendValue: longint;
OnUpdateForm: TThreadMethod;
procedure DoUpdateForm;
constructor Create;
procedure Execute; override;
end;
TMyThread2 = class(TThread)
constructor Create;
procedure Execute; override;
end;
var
Form1: TForm1;
MyThread1: TMyThread1 = nil;
MyThread2: TMyThread2 = nil;
implementation
{$R *.lfm}
constructor TMyThread1.Create;
begin
FreeOnTerminate := True;
Inherited Create(True);
end;
procedure TMyThread1.DoUpdateForm;
begin
if Assigned(OnUpdateForm) then
Synchronize(OnUpdateForm);
end;
procedure TMyThread1.Execute;
var
i: longint;
begin
NewAlphaBlendValue := 255;
for i := 5 downto 1 do
begin
NewCaption := i.ToString + ' sec';
DoUpdateForm;
Sleep(1000);
end;
NewCaption := 'Form1';
DoUpdateForm;
while NewAlphaBlendValue > 0 do
begin
Dec(NewAlphaBlendValue);
DoUpdateForm;
Sleep(10);
end;
end;
constructor TMyThread2.Create;
begin
FreeOnTerminate := True;
Inherited Create(True);
end;
procedure TMyThread2.Execute;
begin
Sleep(1000);
end;
{ TForm1 }
procedure TForm1.Button1Click(Sender: TObject);
begin
AlphaBlend := True;
if (MyThread1 = nil) and
(MyThread2 = nil) then
begin
MyThread1 := TMyThread1.Create;
MyThread1.OnTerminate := @DoTerminate1;
MyThread1.OnUpdateForm := @DoUpdateForm;
MyThread1.Start;
MyThread2 := TMyThread2.Create;
MyThread2.OnTerminate := @DoTerminate2;
MyThread2.Start;
end;
end;
procedure TForm1.DoUpdateForm;
begin
Caption := MyThread1.NewCaption;
AlphaBlendValue := MyThread1.NewAlphaBlendValue;
end;
procedure TForm1.DoTerminate1(Sender: TObject);
begin
AlphaBlendValue := 255;
Label1.Caption :='Dissolvenza terminata';
MyThread1 := nil;
end;
procedure TForm1.DoTerminate2(Sender: TObject);
begin
Label1.Caption := 'Eseguibile lanciato';
MyThread2 := nil;
end;
end.
vedo però che scrivono questo:
In difference with TThread.SpinWait, a thread switch may occur during the sleep.
Quindi può anche essere un caso che nel test che ho fatto prima funzionasse correttamente.
Domani faccio qualche prova in più, e verifico anche il funzionamento di TThread.SpinWait, che potrebbe essere quello che fa al caso mio.
Grazie ancora, Mario