Модераторы: Poseidon, Snowy, bems, MetalFan

Поиск:

Ответ в темуСоздание новой темы Создание опроса
> Как запустить процедуру таймера в отдельном потоке, Чтобы таймер "тикал в потоке" 
:(
    Опции темы
mr_smit
  Дата 13.3.2010, 15:05 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Опытный
**


Профиль
Группа: Участник
Сообщений: 254
Регистрация: 27.2.2008
Где: Самара

Репутация: нет
Всего: 4
По событию таймера, раз в 5 сек, происходит запись данных в СОМ порт, что подвешивает программу. Как запустить процедуру таймера в отдельном потоке?

Код

procedure TForm1.Timer1Timer(Sender: TObject);
var BMP: TBitmap;
    PColor: TColor;
    r1,g1,b1:integer;
    i,j:integer;
    Data: Byte;
    Sensors: TStringList;
begin
 Sensors:=TStringList.Create;
 ReadSensors(Sensors);

 BMP:=TBitmap.Create;
  ...
 BMP.Canvas.TextOut(9,70,Sensors[0]);
 BMP.Canvas.TextOut(71,70,Sensors[1]);
 BMP.Canvas.TextOut(129,70,Sensors[2]);
  
 Image1.Picture.Assign(BMP);
 Image1.Repaint;
 Send_Data;
 for i:=0 to BMP.Height-1 do
    begin
      for j:=0 to BMP.Width-1 do
        begin
          PColor:= BMP.Canvas.Pixels[j,BMP.Height-1-i];
          r1:=GetRValue(PColor) shr 3;
          g1:=GetGValue(PColor) shr 2;
          b1:=GetBValue(PColor) shr 3;
          PColor:= (r1 shl 11) + (g1 shl 5) + b1;

          Data := Hi(PColor);
          BComPort1.Write(Data, SizeOf(Data));
          Data := Lo(PColor);
          BComPort1.Write(Data, SizeOf(Data));
       end;
    end;
 BMP.Free;
 Sensors.Free;
end;
PM MAIL   Вверх
samsamich
Дата 13.3.2010, 16:22 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Новичок



Профиль
Группа: Участник
Сообщений: 13
Регистрация: 3.3.2010

Репутация: нет
Всего: нет
Надо не процедуру таймера запускать в отдельном потоке, а создавать отдельный поток в процедуре таймера..
PM MAIL   Вверх
Dom
Дата 13.3.2010, 18:27 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Шустрый
*


Профиль
Группа: Участник
Сообщений: 121
Регистрация: 7.8.2005

Репутация: 1
Всего: 4
Цитата(samsamich @  13.3.2010,  16:22 Найти цитируемый пост)
Надо не процедуру таймера запускать в отдельном потоке, а создавать отдельный поток в процедуре таймера.. 
Мне кажется, что это может быть не эффективным, если каждые 5 секунд создавать, запускать и уничтожать поток. Много времени будет уходить. Как вариант, можно приостанавливать поток и возобновлять его каждые 5 секунд.
PM MAIL   Вверх
mr_smit
  Дата 13.3.2010, 19:31 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Опытный
**


Профиль
Группа: Участник
Сообщений: 254
Регистрация: 27.2.2008
Где: Самара

Репутация: нет
Всего: 4
Цитата(Dom @ 13.3.2010,  18:27)
Мне кажется, что это может быть не эффективным, если каждые 5 секунд создавать, запускать и уничтожать поток.

Во во...

Может конечно глупо, но попробовал так:
Код

TNewThread = class(TThread)
  procedure Timer1Timer(Sender: TObject);
  private
    { Private declarations }
  protected
    procedure Execute; override;
  end;


Ругается на классы... типа не может один класс быть внутри другого. Т.к. у меня есть процедура ReadSensors "внутри таймера".
Код

procedure TForm1.ReadSensors(Spisok:TStringList);

Можно конечно убрать привязку к TForm1, но тогда "поплывет" весь код...

Не работал с потоками раньше. Неужели нельзя создать поток и выполнять процедуру в нем???
PM MAIL   Вверх
Dom
Дата 13.3.2010, 23:17 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Шустрый
*


Профиль
Группа: Участник
Сообщений: 121
Регистрация: 7.8.2005

Репутация: 1
Всего: 4
Если нет опыта работы с потоками, то обязательно к прочтению http://forum.vingrad.ru/forum/topic-60076.html
Мне еще MSDN помог в освоении потоков.
Так просто с наскоку маловероятно, что получится что-то работающее.
PM MAIL   Вверх
mr_smit
Дата 15.3.2010, 10:11 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Опытный
**


Профиль
Группа: Участник
Сообщений: 254
Регистрация: 27.2.2008
Где: Самара

Репутация: нет
Всего: 4
Спасибо, почитаю. Тем не менее вопрос в силе:

Цитата(mr_smit @ 13.3.2010,  19:31)
Неужели нельзя создать поток и выполнять процедуру в нем???


Добавлено через 1 минуту и 23 секунды
В двух словах, по простому, с примером, может кто объяснит, пожалуйста.
PM MAIL   Вверх
samsamich
Дата 15.3.2010, 11:28 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Новичок



Профиль
Группа: Участник
Сообщений: 13
Регистрация: 3.3.2010

Репутация: нет
Всего: нет
Цитата(mr_smit @  13.3.2010,  19:31 Найти цитируемый пост)
Цитата(Dom @ 13.3.2010,  18:27)
Мне кажется, что это может быть не эффективным, если каждые 5 секунд создавать, запускать и уничтожать поток.

Во во...
 Непонятно, в каком смысле не эффективно? И зачем каждые 5 секунд поток уничтожать если он не закончил работу? Лучше уж каждые пять секунд его не запускать


Цитата(mr_smit @  15.3.2010,  10:11 Найти цитируемый пост)
В двух словах, по простому, с примером, может кто объяснит, пожалуйста. 
 В справке и на форумах работа с потоками разобрана дальше некуда..


Код

type
  TR=class(TThread)
    procedure Execute;override;
    constructor Create;

end;

  TfmMain = class(TForm)
    Timer1: TTimer;
    procedure Timer1Timer(Sender: TObject);
  private
    { Private declarations }
     InProc:boolean;
-----------------

procedure TR.Execute;
var i,j,k:integer;
const a=2000;
begin
  inherited;

  for i:=1 to a do
  for j:=1 to a do
  for k:=1 to a do;

end;


procedure TfmMain.Timer1Timer(Sender: TObject);
var trr:TR;
begin
if InProc then exit;
trr:=TR.Create(true);
trr.OnTerminate:=OnTrrTerminate;
trr.FreeOnTerminate:=true;
InProc:=true;
trr.Resume;
end;

procedure TfmMain.OnTrrTerminate(Sender:TObject);
begin
  ShowMessage('kaput');
  InProc:=false;
end;
PM MAIL   Вверх
Snowy
Дата 15.3.2010, 12:39 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
****


Профиль
Группа: Модератор
Сообщений: 11363
Регистрация: 13.10.2004
Где: Питер

Репутация: 192
Всего: 484
ИМХО, таймер тут вообще не нужен.
Создай поток, выполняй в нём запись в порт.
После записи засыпай поток на время, оставшееся до следующего момента срабатывания.
Например:
0 секунда - пишем данные, это заняло, например, 0.5 секунд
0.5 секунд - интервал 5 секунд, прошлое срабатывание в 0 секунд, сейчас 0.5 секунд. Значит засыпаем на 4.5 секунды - Sleep(4500).
5 секунд - пишем данные......
PM MAIL   Вверх
Matematik
Дата 15.3.2010, 14:21 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
***


Профиль
Группа: Завсегдатай
Сообщений: 1027
Регистрация: 11.3.2006

Репутация: 17
Всего: 50
Цитата(Snowy @  15.3.2010,  12:39 Найти цитируемый пост)
Создай поток, выполняй в нём запись в порт.
После записи засыпай поток на время, оставшееся до следующего момента срабатывания.


+1

Примерно так

Код

unit Unit2;

interface

uses SysUtils, Classes, Windows, Forms, DateUtils;

type
  TTheadSomething = class(TThread)
  private
    FEventTerminate: THandle;
    //---
    procedure DoSomething;
    procedure _Sleep(AMilliSeconds: Cardinal);
  public
    constructor Create;
    destructor Destroy; override;
    procedure Terminate;
    procedure Execute; override;
  end;

implementation

{ TTheadFM }

constructor TTheadSomething.Create;
begin
  inherited Create(True);
  FreeOnTerminate := True;
  FEventTerminate := CreateEvent(nil, False, False, nil);
end;

destructor TTheadSomething.Destroy;
begin
  CloseHandle(FEventTerminate);
  inherited;
end;

procedure TTheadSomething.DoSomething;
begin
  Application.MessageBox('text', 'cap', MB_OK)
end;

procedure TTheadSomething.Execute;
var
  t: TDateTime;
  k: Int64;
begin
  while (not Terminated) and (not Application.Terminated) do
  begin
    t := Now();
    DoSomething;
    k := 5000 - Round(MilliSecondSpan(Now(), t));
    if k>0 then
      _Sleep(k);
  end;
end;

procedure TTheadSomething.Terminate;
begin
  SetEvent(FEventTerminate);
  inherited Terminate;
end;

procedure TTheadSomething._Sleep(AMilliSeconds: Cardinal);
begin
  WaitForSingleObject(FEventTerminate, AMilliSeconds);
end;

end.
PM MAIL WWW ICQ   Вверх
mr_smit
  Дата 28.3.2010, 18:10 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Опытный
**


Профиль
Группа: Участник
Сообщений: 254
Регистрация: 27.2.2008
Где: Самара

Репутация: нет
Всего: 4
Создал отдельный unit2 для потока: 
Код

unit Unit2;

interface

uses
  Classes,Windows,unit1;

type
  TLCD = class(TThread)
  private
    { Private declarations }
  protected
    procedure Execute; override;
  end;

implementation

procedure TLCD.Execute;
var r1,g1,b1:integer;
    i,j:integer;
    Data: Byte;
begin
FreeOnTerminate:=true;
   for i:=0 to BMP.Height-1 do
    begin
      for j:=0 to BMP.Width-1 do
        begin
          PColor:= BMP.Canvas.Pixels[j,BMP.Height-1-i];
          r1:=GetRValue(PColor) shr 3;
          g1:=GetGValue(PColor) shr 2;
          b1:=GetBValue(PColor) shr 3;
          PColor:= (r1 shl 11) + (g1 shl 5) + b1;

          Data := Hi(PColor);
          Form1.BComPort1.Write(Data, SizeOf(Data));
          Data := Lo(PColor);
          Form1.BComPort1.Write(Data, SizeOf(Data));
       end;
    end;
 BMP.Free;
 Sensors.Free;
end;

end.


А в unit1 написал:
Код

var LCDThead: TLCD;
...
LCDThead.Create(false);


Получаю ошибку при создании потока. BMP, PColor и т.д. сделал глобальными в unit1

Добавлено через 2 минуты и 16 секунд
EAccessViolation
PM MAIL   Вверх
Alexeis
Дата 28.3.2010, 18:24 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Амеба
Group Icon


Профиль
Группа: Админ
Сообщений: 11743
Регистрация: 12.10.2005
Где: Зеленоград

Репутация: 109
Всего: 459
Цитата(mr_smit @  28.3.2010,  17:10 Найти цитируемый пост)
EAccessViolation 

  Это говорит лишь о том, что ошибка работы с памятью. Наверняка не синхронизировал доступ к глобальному объекту из разных потоков. Еще варианты дважды удалил или не создал, а пользуешься.


--------------------
Vit вечная память.

Обсуждение действий администрации форума производятся только в этом форуме

гениальность идеи состоит в том, что ее невозможно придумать
PM ICQ Skype   Вверх
Dom
Дата 29.3.2010, 09:31 (ссылка) | (голосов:2) Загрузка ... Загрузка ... Быстрая цитата Цитата


Шустрый
*


Профиль
Группа: Участник
Сообщений: 121
Регистрация: 7.8.2005

Репутация: 1
Всего: 4
А может так создавать объект? 
Код

LCDThead := TLCD.Create(false)
PM MAIL   Вверх
mr_smit
Дата 29.3.2010, 12:33 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Опытный
**


Профиль
Группа: Участник
Сообщений: 254
Регистрация: 27.2.2008
Где: Самара

Репутация: нет
Всего: 4
Цитата(Alexeis @ 28.3.2010,  18:24)
Это говорит лишь о том, что ошибка работы с памятью. Наверняка не синхронизировал доступ к глобальному объекту из разных потоков. Еще варианты дважды удалил или не создал, а пользуешься.

Я код привел, какая там может быть синхронизация??? Одна процедура Execute. Переменные объявлены в unit1. Ошибка возникает каждый раз при создании. Если бы дело было в синхронизации, то ошибка не всегда бы возникала.

Добавлено через 1 минуту и 13 секунд
Цитата(Dom @ 29.3.2010,  09:31)
А может так создавать объект? 
Код

LCDThead := TLCD.Create(false)

Не думаю что это поможет.

Просто не пойму что тут может быть не правильно, 10 строк кода.
PM MAIL   Вверх
Alexeis
Дата 29.3.2010, 12:48 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Амеба
Group Icon


Профиль
Группа: Админ
Сообщений: 11743
Регистрация: 12.10.2005
Где: Зеленоград

Репутация: 109
Всего: 459
Цитата(mr_smit @  29.3.2010,  11:33 Найти цитируемый пост)
Просто не пойму что тут может быть не правильно, 10 строк кода. 

Например обращаешься к BMP из 2х потоков одновременно. Вообще, посмотри точку вылета в Call Stack.


--------------------
Vit вечная память.

Обсуждение действий администрации форума производятся только в этом форуме

гениальность идеи состоит в том, что ее невозможно придумать
PM ICQ Skype   Вверх
Gwire
Дата 29.3.2010, 13:39 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Бывалый
*


Профиль
Группа: Участник
Сообщений: 216
Регистрация: 7.8.2007
Где: Николаев

Репутация: 1
Всего: 4

Потоковый таймер с использованием CreateWaitableTimer;
Код

uses Windows, Classes;
type
  TThreadTimer = class(TThread)
  private
    FInterval: Integer;     
    FWaitEvent: THandle;
    procedure set_Interval(Value: Integer);
    procedure set_Enabled(Value: Boolean);
    function get_Enabled: Boolean;
    procedure Run; // В ней твой код по работе с портом
  protected
    procedure Execute; override;
  public
    constructor Create;
    destructor Destroy; override;
    property Interval: Integer read FInterval write set_Interval;
    property Enabled: Boolean read get_Enabled write set_Enabled;
  end;

Код

constructor TThreadTimer.Create;
begin
    inherited Create(True);
    FWaitEvent:= CreateWaitableTimer(nil, False, nil);
    Interval:= 1000;
end;

destructor TThreadTimer.Destroy;
begin
    Terminate;
    Interval:= 0;
    Enabled:= True;
    CloseHandle( FWaitEvent );
    inherited Destroy;
end;

procedure TThreadTimer.Execute;
begin
    while not Terminated do
    begin
        if WaitForSingleObject( FWaitEvent, Cardinal(-1) ) = WAIT_OBJECT_0
          then Synchronize( Run );
    end;
end;

procedure TThreadTimer.Run;
begin
    // Твой код 
    Writeln( 'Your code' );
end;

procedure TThreadTimer.set_Interval(Value: Integer);
var Due: Int64;
begin
    Due:= Value * -10000;
    SetWaitableTimer( FWaitEvent, Due, Value, nil, nil, False );
end;

procedure TThreadTimer.set_Enabled(Value: Boolean);
begin
    Suspended:= not Value;
end;

function TThreadTimer.get_Enabled: Boolean;
begin
    Result:= not Suspended;
end;

FWaitEvent это объект Event-подобный, стой разницей что он устанавливается сам со строго заданным интервалом.
Если процедура Run выполняется дольше установленного времени, то при возврате в Execute FWaitEvent уже будет установлен и следуюций цикл выполнится не замедлительно.
Чтобы дождаться следующего сраватывания таймера перед выходом из Run вставить "ResetEvent( FWaitEvent );"
Если нужно подождать заданое время, то нужно вместо ResetEvent переустоновить интервал - Interval:= FInterval;
Удачи.

PS: Dom прав - создавать нужно "от имени" класса а не объекта. То что ты объявишь переменную (указатель на объект), var LCDThead: TLCD, 
она не станет объектом, это только определит её поведение для компилятора. А любой вызов метода не существуещего объекта даст "EAccessViolation" в том числе и Create
Сперва необходимо поместить в переменную значение: LCDThead := TLCD.Create(false). Здесь Create метод класса а не объекта.
Тоже самое и в при обащении в свойству объекта BMP.Canvas. Нет BMP:= TBitmap.Create;


Это сообщение отредактировал(а) Gwire - 29.3.2010, 15:10
PM MAIL   Вверх
Ответ в темуСоздание новой темы Создание опроса
Правила форума "Delphi: Общие вопросы"
SnowyMetalFan
bemsPoseidon
Rrader

Запрещается!

1. Публиковать ссылки на вскрытые компоненты

2. Обсуждать взлом компонентов и делиться вскрытыми компонентами

  • Литературу по Дельфи обсуждаем здесь
  • Действия модераторов можно обсудить здесь
  • С просьбами о написании курсовой, реферата и т.п. обращаться сюда
  • Вопросы по реализации алгоритмов рассматриваются здесь
  • 90% ответов на свои вопросы можно найти в DRKB (Delphi Russian Knowledge Base) - крупнейшем в рунете сборнике материалов по Дельфи

Если Вам понравилась атмосфера форума, заходите к нам чаще! С уважением, Snowy, MetalFan, bems, Poseidon, Rrader.
 
0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема | Delphi: Общие вопросы | Следующая тема »

Подписаться на тему | Подписка на этот форум | Скачать/Распечатать тему


 




[ Время генерации скрипта: 0.1497 ]   [ Использовано запросов: 22 ]   [ GZIP включён ]


Реклама на сайте     Информационное спонсорство

 
 По вопросам размещения рекламы пишите на vladimir(sobaka)vingrad.ru
Отказ от ответственности     Powered by Invision Power Board(R) 1.3 © 2003  IPS, Inc.