unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Buttons, ExtCtrls;
type
TMyThread = class(TThread)
private
protected
procedure DoWork;
procedure Execute; override;
end;
type
TForm1 = class(TForm)
Image1: TImage;
Label1: TLabel;
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
Image1WinProcOld:TWndMethod; // "Старая" оконная процедура для Image1
procedure Image1WinProcNew(var Message: TMessage); // "Новая" оконная процедура для Image1
public
{ Public declarations }
end;
var
Form1: TForm1;
Tr: TMyThread;
implementation
{$R *.dfm}
procedure TForm1.FormCreate(Sender: TObject);
begin
// Переназначаем оконную процедуру для Image1
Image1WinProcOld := Image1.WindowProc;
Image1.WindowProc := Image1WinProcNew;
end;
procedure TForm1.Image1WinProcNew(var Message: TMessage);
begin
// Ловим "моменты" :-)
with Message do
begin
case Msg of // Момент когда курсор мыши "вошел в Image"
CM_MOUSEENTER: begin
// Рождаем нить
Tr := TMyThread.Create(True);
Tr.Resume;
end;
// Момент когда курсор мыши "вышел из Image"
CM_MOUSELEAVE: begin
// Убиваем нить
Tr.Terminate;
// Обязательно нужно подождать пока Tr закончит очередную итерацию цикла while
while not Tr.Terminated do
Sleep(10);
end;
end;
end;
// Передаем управление "старой" оконной процедуре
Image1WinProcOld(Message);
end;
{ TMyThread }
// выполняется в основной нити (потоке) программы
procedure TMyThread.DoWork;
begin
Form1.Label1.Caption := IntToStr(Random(1000));
//... bla bla Ваш код
Sleep(10);
Application.ProcessMessages;
end;
// выполняется в параллельной нити (потоке) Tr
procedure TMyThread.Execute;
begin
while not Terminated do
begin
//... bla bla Ваш код
Sleep(10);
Synchronize(DoWork);
end;
end;
end.