FreeBasic
Главная
Вход
Регистрация
Четверг, 28.03.2024, 20:26Приветствую Вас Гость | RSS
[ Новые сообщения · Участники · Правила форума · Поиск · RSS ]
  • Страница 1 из 1
  • 1
Форум » Freebasic » Вопросы по языку FreeBasic » Таймер (Прерывание по таймеру)
Таймер
vizitДата: Среда, 28.11.2018, 19:52 | Сообщение # 1
Рядовой
Группа: Пользователи
Сообщений: 11
Репутация: 0
Статус: 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
Полковник
Группа: Друзья
Сообщений: 188
Репутация: -2
Статус: Offline
Цитата vizit ()
Как на FB можно организовать событие по таймеру без загрузки процессора?

Цикл со SLEEP 1, 1 в потоке, значение таймера при этом вычислять через QueryPerformanceCounter.
 
WQДата: Четверг, 29.11.2018, 12:26 | Сообщение # 3
Полковник
Группа: Проверенные
Сообщений: 215
Репутация: 7
Статус: 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
Репутация: 0
Статус: 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
Репутация: 7
Статус: 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
Репутация: 0
Статус: Offline
Спасибо. Я не правильно объявил переменную, по привычке Public.
 
Форум » Freebasic » Вопросы по языку FreeBasic » Таймер (Прерывание по таймеру)
  • Страница 1 из 1
  • 1
Поиск: