|
Таймер
|
|
| vizit | Дата: Среда, 28.11.2018, 19:52 | Сообщение # 1 |
|
Рядовой
Группа: Пользователи
Сообщений: 11
Статус: Offline
| На VBA MS Acces сделал программу которая перегоняет данные из файлов нескольких приборов в базу MS Access, затем контроль, прочая лабуда. Обращение к файлам происходит по событию Timer скрытой формы. Т.к. на MS Access многопоточность проблема, решил эту задачу вынести в FB (службу попробую сделать).
Столкнулся с проблемой 100% загрузки процессора:
#INCLUDE once "vbcompat.bi"
Dim Start As Double
Start = Timer
Do
If (Timer - Start) >= 5 Then
Start = Timer
'Полезный код
End If
Loop
Как на FB можно организовать событие по таймеру без загрузки процессора?
На MS Access загрузка практически не видна.
Конструкция со Sleep довольно экономична, какие ещё возможны варианты?
Код #INCLUDE once "vbcompat.bi"
Nachalo:
Print Format(Now(), "dd.mm.yyyy hh:mm:ss")
Sleep(5000)
GoTo Nachalo
Сообщение отредактировал vizit - Среда, 28.11.2018, 19:59 |
| |
| |
| DarkDemon | Дата: Четверг, 29.11.2018, 07:10 | Сообщение # 2 |
|
Полковник
Группа: Друзья
Сообщений: 200
Статус: Offline
| Цитата vizit (  ) Как на FB можно организовать событие по таймеру без загрузки процессора?
Цикл со SLEEP 1, 1 в потоке, значение таймера при этом вычислять через QueryPerformanceCounter.
|
| |
| |
| WQ | Дата: Четверг, 29.11.2018, 12:26 | Сообщение # 3 |
|
Полковник
Группа: Проверенные
Сообщений: 215
Статус: Offline
| Цитата vizit ( ) Конструкция со Sleep довольно экономична, какие ещё возможны варианты?
Таймер WinApi
Код #Include Once "windows.bi"
Function InetTimer_Proc(hwnd As HWND, msg As UInteger, _ ' функция отслеживания событий в окне
wparam As WPARAM, lparam As LPARAM) As Integer
Select Case As Const msg
Case WM_CREATE '' событие создания окна
SetTimer(hwnd, 1, 1000, 0) '' устанавливаем 1 таймер с периодом 1000 миллисекунд
SetTimer(hwnd, 2, 1500, 0) '' устанавливаем 2 таймер с периодом 1500 миллисекунд
Case WM_TIMER '' событие таймера
Select Case wparam
Case 1
? "Timer 1" '' действие при событии таймера 1
Case 2
? "Timer 2" '' действие при событии таймера 2
End Select
Case WM_CLOSE ''событие закрытия окна
PostQuitMessage(0) '' выход
End Select
Return DefWindowProc(hwnd,msg,wparam,lparam)
End Function
Sub InetTimer(ByVal h As HWND) '' процедура создания окна
Dim msg As MSG
Dim As WNDCLASSEX wc
Dim As String*12 NameClass="TimerClass"
Dim As HINSTANCE Hinst=GetModuleHandle(0)
With wc
.cbSize=SizeOf(WNDCLASSEX)
.style=CS_HREDRAW Or CS_VREDRAW
.lpfnWndProc=@InetTimer_Proc '' ссылка на функцию остлеживания
.hInstance=Hinst
'.hIcon=LoadIcon(GetModuleHandle(0),"1")
.hCursor=LoadCursor(NULL, IDC_ARROW)
.hbrBackground=Cast(HBRUSH,COLOR_WINDOWFRAME)
.lpszClassName=StrPtr(NameClass)
.hIconSm=.hIcon
End With
RegisterClassEx(@wc)
'Var hTimer=CreateWindowEx(0,NameClass,"InetTimer", WS_OVERLAPPEDWINDOW,10,10,10,10,0,0,Hinst,0) '' создание невидимого окна
Var hTimer=CreateWindowEx(0,NameClass,"InetTimer", WS_OVERLAPPEDWINDOW Or WS_VISIBLE,10,10,200,200,0,0,Hinst,0) '' создание видимого окна
While GetMessage(@msg,0,0,0) '' цикл
TranslateMessage(@msg)
DispatchMessage(@msg)
Wend
KillTimer(hTimer,1) '' уничтожение таймера 1
KillTimer(hTimer,2) '' уничтожение таймера 2
End Sub
InetTimer(0) '' запуск процедуры
? " exit"
|
| |
| |
| vizit | Дата: Четверг, 29.11.2018, 16:36 | Сообщение # 4 |
|
Рядовой
Группа: Пользователи
Сообщений: 11
Статус: Offline
| Спасибо. Добавлено (27.07.2019, 17:27)
---------------------------------------------
Цитата WQ ( ) Таймер WinApi
А как реализовать изменяемое значение таймера?
Если я в строку
Цитата WQ ( ) SetTimer(hwnd, 1, 1000, 0)
вместо значения 1000 подставляю переменную, но при компиляции получаю ошибку: Variable not declared, TimerVal.
|
| |
| |
| WQ | Дата: Суббота, 27.07.2019, 19:49 | Сообщение # 5 |
|
Полковник
Группа: Проверенные
Сообщений: 215
Статус: Offline
| Код #Include Once "windows.bi"
Dim Shared As Integer iTimer1, iTimer2
iTimer1=1000
iTimer2=1500
Function InetTimer_Proc(hwnd As HWND, msg As UInteger, _ ' функция отслеживания событий в окне
wparam As WPARAM, lparam As LPARAM) As Integer
Select Case As Const msg
Case WM_CREATE '' событие создания окна
SetTimer(hwnd, 1, iTimer1, 0) '' устанавливаем 1 таймер с периодом 1000 миллисекунд
SetTimer(hwnd, 2, iTimer2, 0) '' устанавливаем 2 таймер с периодом 1500 миллисекунд
Case WM_TIMER '' событие таймера
Select Case wparam
Case 1
? "Timer 1" '' действие при событии таймера 1
Case 2
? "Timer 2" '' действие при событии таймера 2
End Select
Case WM_CLOSE ''событие закрытия окна
PostQuitMessage(0) '' выход
End Select
Return DefWindowProc(hwnd,msg,wparam,lparam)
End Function
Sub InetTimer(ByVal h As HWND) '' процедура создания окна
Dim msg As MSG
Dim As WNDCLASSEX wc
Dim As String*12 NameClass="TimerClass"
Dim As HINSTANCE Hinst=GetModuleHandle(0)
With wc
.cbSize=SizeOf(WNDCLASSEX)
.style=CS_HREDRAW Or CS_VREDRAW
.lpfnWndProc=@InetTimer_Proc '' ссылка на функцию остлеживания
.hInstance=Hinst
'.hIcon=LoadIcon(GetModuleHandle(0),"1")
.hCursor=LoadCursor(NULL, IDC_ARROW)
.hbrBackground=Cast(HBRUSH,COLOR_WINDOWFRAME)
.lpszClassName=StrPtr(NameClass)
.hIconSm=.hIcon
End With
RegisterClassEx(@wc)
'Var hTimer=CreateWindowEx(0,NameClass,"InetTimer", WS_OVERLAPPEDWINDOW,10,10,10,10,0,0,Hinst,0) '' создание невидимого окна
Var hTimer=CreateWindowEx(0,NameClass,"InetTimer", WS_OVERLAPPEDWINDOW Or WS_VISIBLE,10,10,200,200,0,0,Hinst,0) '' создание видимого окна
While GetMessage(@msg,0,0,0) '' цикл
TranslateMessage(@msg)
DispatchMessage(@msg)
Wend
KillTimer(hTimer,1) '' уничтожение таймера 1
KillTimer(hTimer,2) '' уничтожение таймера 2
End Sub
InetTimer(0) '' запуск процедуры
? " exit"
Это если в начале нужно задать значение
А если в процессе работы программы, то сначала нужно удалить таймер с помощью KillTimer, а потом создать снова с помощью SetTimer
|
| |
| |
| vizit | Дата: Суббота, 27.07.2019, 20:01 | Сообщение # 6 |
|
Рядовой
Группа: Пользователи
Сообщений: 11
Статус: Offline
| Спасибо. Я не правильно объявил переменную, по привычке Public.
|
| |
| |
|
