Форум программистов [Powered by Invision Power Board]

Версия для печати темы
Нажмите сюда для просмотра этой темы в оригинальном формате

Форум программистов > Delphi: Общие вопросы > Как запустить процедуру таймера в отдельном потоке

Автор: mr_smit 13.3.2010, 15:05

По событию таймера, раз в 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;

Автор: samsamich 13.3.2010, 16:22

Надо не процедуру таймера запускать в отдельном потоке, а создавать отдельный поток в процедуре таймера..

Автор: Dom 13.3.2010, 18:27

Цитата(samsamich @ 13.3.2010, 16:22

)

Надо не процедуру таймера запускать в отдельном потоке, а создавать отдельный поток в процедуре таймера..

Мне кажется, что это может быть не эффективным, если каждые 5 секунд создавать, запускать и уничтожать поток. Много времени будет уходить. Как вариант, можно приостанавливать поток и возобновлять его каждые 5 секунд.

Автор: mr_smit 13.3.2010, 19:31

Цитата(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, но тогда "поплывет" весь код...

Не работал с потоками раньше. Неужели нельзя создать поток и выполнять процедуру в нем???

Автор: Dom 13.3.2010, 23:17

Если нет опыта работы с потоками, то обязательно к прочтению http://forum.vingrad.ru/forum/topic-60076.html
Мне еще MSDN помог в освоении потоков.
Так просто с наскоку маловероятно, что получится что-то работающее.

Автор: mr_smit 15.3.2010, 10:11

Спасибо, почитаю. Тем не менее вопрос в силе:

Цитата(mr_smit @ 13.3.2010, 19:31)

Неужели нельзя создать поток и выполнять процедуру в нем???

Добавлено через 1 минуту и 23 секунды
В двух словах, по простому, с примером, может кто объяснит, пожалуйста.

Автор: samsamich 15.3.2010, 11:28

Цитата(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;

Автор: Snowy 15.3.2010, 12:39

ИМХО, таймер тут вообще не нужен.
Создай поток, выполняй в нём запись в порт.
После записи засыпай поток на время, оставшееся до следующего момента срабатывания.
Например:
0 секунда - пишем данные, это заняло, например, 0.5 секунд
0.5 секунд - интервал 5 секунд, прошлое срабатывание в 0 секунд, сейчас 0.5 секунд. Значит засыпаем на 4.5 секунды - Sleep(4500).
5 секунд - пишем данные......

Автор: Matematik 15.3.2010, 14:21

Цитата(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.

Автор: mr_smit 28.3.2010, 18:10

Создал отдельный 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

Автор: Alexeis 28.3.2010, 18:24

Цитата(mr_smit @ 28.3.2010, 17:10

)

EAccessViolation

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

Автор: Dom 29.3.2010, 09:31

А может так создавать объект?

Код


LCDThead := TLCD.Create(false)

Автор: mr_smit 29.3.2010, 12:33

Цитата(Alexeis @ 28.3.2010, 18:24)

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

Добавлено через 1 минуту и 13 секунд

Цитата(Dom @ 29.3.2010, 09:31)

А может так создавать объект?

Код


LCDThead := TLCD.Create(false)

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

Просто не пойму что тут может быть не правильно, 10 строк кода.

Автор: Alexeis 29.3.2010, 12:48

Цитата(mr_smit @ 29.3.2010, 11:33

)

Просто не пойму что тут может быть не правильно, 10 строк кода.

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

Автор: Gwire 29.3.2010, 13:39

Потоковый таймер с использованием 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;

Автор: mr_smit 29.3.2010, 22:32

Код


LCDThead := TLCD.Create(false)

Помогло. Работает. Только если перемещать форму данные куда то деваются...
Если при отправлении начать таскать форму то (например с середины картинки) идет заполнение белым цветом.

В процедуре таймера:

Код


 BMP:=TBitmap.Create;
 BMP.Width:=176;
 BMP.Height:=132;
 BMP.PixelFormat:=pf16bit;
 BMP.Canvas.Brush.Color:=clwhite; // - БЕЛЫЙ!!!
...
 BMP.Assign(Global_BackGround); // Global_BackGround - загружаемая из файла картинка

и в этой же процедуре в потоке отправка в порт. Т.е. как будто Assign куда то пропадает smile

Вот что у меня получается на данный момент (видео работы моего USB дисплея):

http://www.youtube.com/watch?v=5EcmFPGZLvc