Ttimer

  • Автор темы Dock1100
  • Дата начала
D

Dock1100

Как ускорить TTimer, к примеру если естm много (>5)and(<100) TTimer, то они работоют медленее, чем 1-3 отдельно.
Или может использовать что то другое(другой компонент или цикл(только главное что бы прога не зависала)).
 
V

vital

Либо разбивать на потоки, как написано выше. Либо в RxLib есть такой компонент, как TTimerList - там он расчитан на работу туевой кучи таймеров одновременно. Реализовано по-другому не много..
 
D

Dock1100

Недавно решил вернутся к этой проблеме, всё вродебы нечего, но как сделать что бы наводиш на рисунок и поток срабатывает не 1 раз а длится пока курсор над рисунком?
У меня получается что срабатывает 1 раз или прога виснет(ниче нажать нельза, но рисунок отрисовуется).
 
D

Dock1100

Пробовал так :
Код:
while ind do 
begin
...
end;
вечный цикл
И так:
Код:
if ind then
begin
...
end;
срабатывает 1 раз.


Добавлено: где ind:boolean меняется при наведении/отведении курсора с рисунка.
При наведении на рисунок произвожу запуск потока.
 
S

sinkopa

Пробовал так :
Код:
while ind do 
...
срабатывает 1 раз.

Вот... :please:
Код:
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.
 
D

Dock1100

Спосибо, правда пришлось код немного переделать, а репутацию подниму через 6 дней(ограничение стоит).
 
Мы в соцсетях:

Обучение наступательной кибербезопасности в игровой форме. Начать игру!