Ttimer

Тема в разделе "Delphi - Компоненты", создана пользователем Dock1100, 30 мар 2010.

  1. Dock1100

    Dock1100 :-]

    Регистрация:
    9 ноя 2009
    Сообщения:
    678
    Симпатии:
    0
    Как ускорить TTimer, к примеру если естm много (>5)and(<100) TTimer, то они работоют медленее, чем 1-3 отдельно.
    Или может использовать что то другое(другой компонент или цикл(только главное что бы прога не зависала)).
     
  2. vital

    vital Больной Компом Детектед
    Команда форума Web Team

    Регистрация:
    29 янв 2006
    Сообщения:
    2.474
    Симпатии:
    27
    Либо разбивать на потоки, как написано выше. Либо в RxLib есть такой компонент, как TTimerList - там он расчитан на работу туевой кучи таймеров одновременно. Реализовано по-другому не много..
     
  3. Dock1100

    Dock1100 :-]

    Регистрация:
    9 ноя 2009
    Сообщения:
    678
    Симпатии:
    0
    Недавно решил вернутся к этой проблеме, всё вродебы нечего, но как сделать что бы наводиш на рисунок и поток срабатывает не 1 раз а длится пока курсор над рисунком?
    У меня получается что срабатывает 1 раз или прога виснет(ниче нажать нельза, но рисунок отрисовуется).
     
  4. Dock1100

    Dock1100 :-]

    Регистрация:
    9 ноя 2009
    Сообщения:
    678
    Симпатии:
    0
    Пробовал так :
    Код (Text):
    while ind do
    begin
    ...
    end;
    вечный цикл
    И так:
    Код (Text):
    if ind then
    begin
    ...
    end;
    срабатывает 1 раз.


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

    sinkopa Well-Known Member

    Регистрация:
    17 июн 2009
    Сообщения:
    344
    Симпатии:
    9
    Вот... :please:
    Код (Delphi):
    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.
     
  6. Dock1100

    Dock1100 :-]

    Регистрация:
    9 ноя 2009
    Сообщения:
    678
    Симпатии:
    0
    Спосибо, правда пришлось код немного переделать, а репутацию подниму через 6 дней(ограничение стоит).
     

Поделиться этой страницей