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;
Как запустить процедуру таймера в отдельном потоке?
По событию таймера, раз в 5 сек, происходит запись данных в СОМ порт, что подвешивает программу. Как запустить процедуру таймера в отдельном потоке?
Код:
Можно и не делать отдельный поток для таймера. С помощью функции SetTimer создаете таймер:
В эту функцию передаете адрес процедуры TimerProc, которую Windows будет вызывать по истечении 5 сек.
После работы таймера не забудьте уничтожить его:
Код:
var idTemir:WORD;
.................
idTemir := SetTimer(0, 0, 5000, @TimerProc);
.................
idTemir := SetTimer(0, 0, 5000, @TimerProc);
В эту функцию передаете адрес процедуры TimerProc, которую Windows будет вызывать по истечении 5 сек.
Код:
procedure TimerProc;
begin
MessageBox(0, 'Hello', 'Inf', MB_OK);
end;
begin
MessageBox(0, 'Hello', 'Inf', MB_OK);
end;
После работы таймера не забудьте уничтожить его:
Код:
KillTimer(0, idTemir);
SetTimer выполняется в отдельном потоке?
Не работал с потоками раньше. Неужели нельзя создать поток и выполнять процедуру в нем???
Не работал с потоками раньше. Неужели нельзя создать поток и выполнять процедуру в нем???
вроде дельфовый таймер и использует SetTimer, а та в свою очередь привязывается к очереди сообщений и не работает в отдельном потоке. скорее всего из-за этого зависон.
я рекомендую использовать это. система сама создает потоки
у меня старая делфя и там нету этих фунок. в вложении модуль, чтобы сразу подключить если в новых делфях они тоже не определены
только учтите, что если за отведенное время ваш запрос не успеет выполниться, то с флагом WT_EXECUTELONGFUNCTION система вызовет callback еще раз, пока предыдущее выполнение не завершилось, но в то же время WT_EXECUTELONGFUNCTION необходим, покуда время запроса может быть длинное. Возможное решение - синхронизация или если точно известно что время выполнения невелико - использование другого флага. Вроде WT_EXECUTEINTIMERTHREAD заставляет ждать пока выполнится предыдущий callback. Уже забыл.
я рекомендую использовать это. система сама создает потоки
Код:
const
Timeout = 200;
var
newTimer: THandle;
procedure TimerProc(lpParameter: Pointer; TimerOrWaitFired: BOOL); stdcall;
begin
//...
end;
// создание
CreateTimerQueueTimer(
newTimer, 0, @TimerProc, nil, 0, Timeout, WT_EXECUTELONGFUNCTION);
// уничтожение
DeleteTimerQueueTimer(0, newTimer, INVALID_HANDLE_VALUE);
Timeout = 200;
var
newTimer: THandle;
procedure TimerProc(lpParameter: Pointer; TimerOrWaitFired: BOOL); stdcall;
begin
//...
end;
// создание
CreateTimerQueueTimer(
newTimer, 0, @TimerProc, nil, 0, Timeout, WT_EXECUTELONGFUNCTION);
// уничтожение
DeleteTimerQueueTimer(0, newTimer, INVALID_HANDLE_VALUE);
у меня старая делфя и там нету этих фунок. в вложении модуль, чтобы сразу подключить если в новых делфях они тоже не определены
только учтите, что если за отведенное время ваш запрос не успеет выполниться, то с флагом WT_EXECUTELONGFUNCTION система вызовет callback еще раз, пока предыдущее выполнение не завершилось, но в то же время WT_EXECUTELONGFUNCTION необходим, покуда время запроса может быть длинное. Возможное решение - синхронизация или если точно известно что время выполнения невелико - использование другого флага. Вроде WT_EXECUTEINTIMERTHREAD заставляет ждать пока выполнится предыдущий callback. Уже забыл.
Цитата: mr_smit
По событию таймера, раз в 5 сек, происходит запись данных в СОМ порт, что подвешивает программу
А что именно ее подвешивает?
Код:
BComPort1.Write(Data, SizeOf(Data));
Всего отправляется 46464 байта на скорости 115200 бит/сек. Примерно 3-4 секунды всё это занимает.
115200/8=14400 байт/сек
46464/14400=~3,23 сек
Цитата: mr_smit
SetTimer выполняется в отдельном потоке?
Не работал с потоками раньше. Неужели нельзя создать поток и выполнять процедуру в нем???
Не работал с потоками раньше. Неужели нельзя создать поток и выполнять процедуру в нем???
Насколько я понимаю, таймер всегда вызывается в отдельном потоке. Не может же ОС просто прервать прогу на середине инструкции и вызвать функцию таймера.
Проще всего, по-моему, это проверить экспериментально. Можно юзать SetTimer, как уже посоветовали выше, либо timeSetEvent. Здесь же CreateThread.
Событие SetTimer всегда возникает в текущем потоке. Использование timeSetEvent в данном случае неоправданно, ибо использование мультимедиа таймера для задержки в 5 сек. это как микроскопом гвозди забивать.
Проще всего не изобретать велосипед, а использовать "стандартный многопоточный набор" TThread + WaitFor[Single/Multiple]Object и его параметр dwMilliseconds.
Проще всего не изобретать велосипед, а использовать "стандартный многопоточный набор" TThread + WaitFor[Single/Multiple]Object
Цитата:
timeSetEvent Function
Note This function is obsolete. New applications should use CreateTimerQueueTimer to create a timer-queue timer.
Note This function is obsolete. New applications should use CreateTimerQueueTimer to create a timer-queue timer.
Поэтому либо CreateTimerQueueTimer (удобнее всего) либо CreateWaitableTimer либо возможно,
Цитата:
"стандартный многопоточный набор"
хотя последнее я не очень понял чем хорошо.
Вообще есть интересная статья: Эффективная многопоточность
Цитата:
SetTimer работает в том же потоке что создавался и использует очередь сообщений.
Точно, про очередь сообщений я забыл.
Цитата:
Поэтому либо CreateTimerQueueTimer (удобнее всего) либо CreateWaitableTimer либо возможно,
Ого, не знал, что функция уже устарела. Спасибо.
Цитата: bagie2
хотя последнее я не очень понял чем хорошо.
Тем, что ТС необходимо еще и данные для посылки периодически передавать. А явным образом реализованный поток намного нагляднее, чем просто callback - функция.
Цитата: mr_smit
Код:
BComPort1.Write(Data, SizeOf(Data));
Всего отправляется 46464 байта на скорости 115200 бит/сек. Примерно 3-4 секунды всё это занимает.
Забавно. И вам никогда в голову не приходило завести в поток именно то что вешает программу, а не таймер? :)
Создал отдельный unit2 для потока:
А в unit1 написал:
Получаю ошибку EAccessViolation при создании потока. BMP, PColor и т.д. сделал глобальными в unit1
Код:
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.
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);
...
LCDThead.Create(false);
Получаю ошибку EAccessViolation при создании потока. BMP, PColor и т.д. сделал глобальными в unit1
Цитата: mr_smit
Получаю ошибку EAccessViolation при создании потока. BMP, PColor и т.д. сделал глобальными в unit1
Проверь, что у тебя с глобальными переменными (в первую очередь BMP). Может, они не созданы, либо уже разрушены (BMP.Free в потоке, и если ты его запускаешь второй раз, то...).
mr_smit, покури документацию по компоненту. BComPort поддерживает асинхронную посылку в данных. Нечего изобретать велосипед.
Смысл в том что без потока всё работает. Всё прекрасно отсылается. Только подвешивает программу.
Я уже писал:
Я уже писал:
Цитата:
Всего отправляется 46464 байта на скорости 115200 бит/сек. Примерно 3-4 секунды всё это занимает.
115200/8=14400 байт/сек
46464/14400=~3,23 сек
115200/8=14400 байт/сек
46464/14400=~3,23 сек
1. Я решил избавиться от этого с помощью потока;
2. BMP создается в процедуре таймера, заполняется необходимой информацией;
3. Потом его нужно отправить в СОМ порт (в этой же процедуре таймера);
4. Процедуру отправки попытался вынести в поток;
5. FreeOnTerminate:=true; - чтобы поток выполнился один раз;
6. BMP.Free; именно в потоке для того чтобы не уничтожить BMP до завершения потока;
7. Документация на BComPort тут не причем вообще. Да, он поддерживает асинхронную посылку в данных. И синхронную. Я "шлю синхронно". Или для потока это имеет значение?
Тут фишка в том, что неизвестно, как себя ведет компонент в отдельном потоке. Кроме того, и TBitmap не потокобезопасен. Понять, из-за чего ошибка невозможно - не хватает данных. Поэтому я и предлагаю использовать возможность компонента асинхронно посылать данные (по сути - в отдельном потоке, реализованном "внутри" компонента).
Сделал асинхронную отправку. Всё работает. Не зависает. Но каждый раз в момент отправки загрузка процессора прыгает до 50-55%. Потом падает до 0%. При синхронной загрузка поднималась до 10-12%.
Нажал закрыть (форму). Рухнул комп. Перезагрузился. Видно надо ждать завершение передачи.
Всё таки наверное создам массив, заполню его байтами цвета, и попробую в потоке синхронно отправить.
Прикладываю справку к компоненту.
Кстати вот что у меня получается на данный момент (видео):
http://www.youtube.com/watch?v=5EcmFPGZLvc
Нажал закрыть (форму). Рухнул комп. Перезагрузился. Видно надо ждать завершение передачи.
Всё таки наверное создам массив, заполню его байтами цвета, и попробую в потоке синхронно отправить.
Прикладываю справку к компоненту.
Кстати вот что у меня получается на данный момент (видео):
http://www.youtube.com/watch?v=5EcmFPGZLvc