Остановка таймера API при открытии CommonDialog

[danilasv]

Остановка таймера при открытии диалогового окна CommonDialog (OpenFile) и Меню
Для создания точного таймера я использую следующий код:

Option Explicit
Private Declare Function timeGetTime Lib "winmm.dll" () As Long
Dim i As Long
Dim PlayingSong As Boolean

Private Sub cmdPlay_Click()
Dim start_time As Long
Dim next_time As Long
PlayingSong = True
i = 0
Do While PlayingSong = True
Text1.Text = i
start_time = timeGetTime
next_time = start_time + 100
Do While (timeGetTime < next_time)
DoEvents
Loop
i = i + 1
Loop
End Sub

Private Sub cmdStop_Click()
PlayingSong = False
Text1.Text = 0
End Sub

На форму устанавливаю CommonDialog или использую API
Private Declare Function GetOpenFileName Lib "comdlg32.dll" Alias "GetOpenFileNameA" (pOpenfilename As OpenFileName) As Long

Private Sub Command1_Click()
CommonDialog1.ShowOpen
End Sub

При открытии диалогового окна CommonDialog таймер останавливается. Закрываю окно CommonDialog1 - таймер работает.
В чём причина? Как сделать, чтобы таймер не останавливался при открытии диалогового окна CommonDialog?

[tyomitch]

Сделай обычный таймер.
Что за нужда в сверхточности?

[danilasv]

Спасибо за ответ.
Таймер нужен высокоточный (для миди плейера)
1 - 10 миллисекунд (регулировка темпа)
Обычный таймер не годится.

[tyomitch]

Сделай обычный таймер с крупным интервалом, а внутри него регулируй темп точно.

Если бы приложил проект, который можно погонять, -- советовать было бы проще.

[danilasv]

Нет, вставил в обычный таймер. Всё равно таймер API приостанавливается при открытии CommonDialog
Происходит какое - то прерывание выполнения Do While - Loop. Открывается диалоговое окно CommonDialog (модальное) с фокусом и идёт прерывание Do While - Loop на форме.
А может сделать компонент OCX или класс как обычный таймер? Почему обычный таймер не останавливается?
Полный проект для прогонки не нужен. Нужно найти решение этого казалось бы элементарного кода.

[tyomitch]

Нет, вставил в обычный таймер. Всё равно таймер API приостанавливается при открытии CommonDialog
Происходит какое - то прерывание выполнения Do While - Loop. Открывается диалоговое окно CommonDialog (модальное) с фокусом и идёт прерывание Do While - Loop на форме.

Это само собой. DoEvents из середины цикла убери, не будет прерываться.

[danilasv]

DoEvents убирать нельзя. Иначе цикл не работает. Дело не в DoEvents
Я похоже разобрался в чём дело - Форма CommonDialog - модальная. При её открытии невозможен доступ к основной форме, поэтому цикл прерывается, как только открывается вторая модальная форма.
Я это проверил. Добавил вторую форму Form2 в проект. Сделал её модальной. (Удалил CommonDialog, чтобы не смущала. ) Открываю Form2

Private Sub Command1_Click()
Form2.Show 1 'Form2 модальная
End Sub

Таймер останавливается. Делаю Form2 как обычную - таймер работает.
Вопрос:
Можно сделать CommonDialog как обычную форму?
Можно имитировать CommonDialog функцией API
Private Declare Function GetOpenFileName Lib "comdlg32.dll" Alias "GetOpenFileNameA" (pOpenfilename As OpenFileName) As Long
Но в ней тоже получается модальная форма диалога открытия файла.
Как в ней задать диалоговое окно открытия файла как немодальную?
Может есть другие варианты открытия файла где окно открытия файла немодальное?

[arthur2]

по GetOpenFileName диалог откроется модальным по отношению к тому окну, которое ты сам укажешь. Укажешь 0 - будет совсем не модальный диалог, и даже со своим персональным поплавком в панели задач

А дело, кстати, таки в дуэвенте. Если сам вызов диалога происходит во время одного из твоих дуэвентов, то ты не вернёшься из дуэвента в цикл, пока не закроется диалог. То есть, цикл приостановится.

Попробуй разорвать действие, вызывающее диалог и сам вызов диалога: Скажем, диалог у тебя вызывается по клику на кнопке. И ты не выйдешь из клика, пока диалог не закроется Попробуй по клику на кнопке запускай стандартный таймер (тогда из клика выйдешь сразу), а уже по таймеру - открывай диалог.

[tyomitch]

Попробуй разорвать действие, вызывающее диалог и сам вызов диалога: Скажем, диалог у тебя вызывается по клику на кнопке. И ты не выйдешь из клика, пока диалог не закроется Попробуй по клику на кнопке запускай стандартный таймер (тогда из клика выйдешь сразу), а уже по таймеру - открывай диалог.

Не сканает.
Пока управление не выйдет из обработчика, DoEvents не завершится и цикл не продолжится.
Пока диалог не закроется, обработчик не закончится.


Настойчиво советую автору собрать проект из его хитрого таймера и коммон-диалога, и выложить.
Таймер по-любому придётся переделывать без DoEvents, но непонятно как, пока непонятно, что же он делает.

[danilasv]

1 Возможно вы правы по DoEvents
2 GetOpenFileName - Укажешь 0 - будет совсем не модальный диалог
Не могу найти этот 0 ни в структуре Private Type OpenFileName, ни в Function DlgOpenFile
Может укажите на действующий пример?
3 Наверное самое лучшее создать отдельный контролл OCX? Чтобы в нём генерировались события Timer,
а в форме в событии Timer указывать только интервал? Есть желающие за отдельную плату создать точный таймер?
А кто знает Timer OCX с разрешением 100 микросекунд? Много различных контроллов, а хорошего таймера 100 микросекунд найти не могу. Вернее есть таймеры, которые очень точно (единицы микросекунд) измеряют время от начала события до конца. Мне же нужно генерировать события.
Всем спасибо за советы

[arthur2]

"Точный" таймер:

Код: Выделить всё

Public Declare Function timeKillEvent Lib "winmm.dll" (ByVal uID As Long) As Long
Public Declare Function timeSetEvent Lib "winmm.dll" (ByVal uDelay As Long _
                , ByVal uResolution As Long, ByVal lpFunction As Long _
                , ByVal dwUser As Long, ByVal uFlags As Long) As Long

Если у стандартного точность где-то 50 миллисекунд (по другим сведениям, 10), то этот натикивает, вроде как, с точностью до 1


А поле для хендла окна в OPENFILENAME.Owner (но здесь это не поможет - если передать 0, окно будет хоть и не модальное, но вызывающую процедуру, а с ней и твой цикл, всё равно приостановит). Можно попробовать вместе с диалогом запускать резервный цикл, в котором продолжать нужные действия, а после закрытия диалога выставлять флаг, чтобы резервный цикл завершился - тогда вернёшься в цикл основной.

[danilasv]

Артур
Попробую исследовать этот таймер.
Я разработал свой таймер (генератор) с точностью 100 микросекунд, но у него та же беда при открытии модального окна.
В нём нет DoEvents, а остановка идёт. Есть цикл Do While - Loop, но без DoEvents.
Наверное нужно убрать этот цикл из формы в отдельный класс.

Посмотрите пример таймера с разрешением 1 миллисекунда на базе API timeGetTime
http://webfile.ru/
Номер файла для скачивания 2636975
Сергей

[arthur2]

А чего ты не выкладываешь файлы прямо здесь?

Вот тебе пример с мультимедийным таймером. По msgbox обычный таймер, естественно, замирает. А этот продолжает тикать Точность - одна миллисекунда.

[tyomitch]

Посмотрите пример таймера с разрешением 1 миллисекунда на базе API timeGetTime
http://webfile.ru/
Номер файла для скачивания 2636975
Сергей

Вот, я имел в виду примерно такой код.

[tyomitch]

Мысль вслух: а вообще это классное применение для фиберов
Поэкспериментирую чуть позже.

[danilasv]

Артур, cпасибо за ваш пример таймера M_Timer2
У меня к нему есть замечания. Я подготовил по этому таймеру свой пример M_Timer2
Спасибо tyomitch
Решение с добавлением обычного Timer не помогает. TimeGetTime останавливается.
Как мне выложить свой пример на Форум? Где Опция вложения файла?
Сергей

[tyomitch]

Спасибо tyomitch
Решение с добавлением обычного Timer не помогает. TimeGetTime останавливается.

Контролом -- да, останавливается; апишкой -- нет, не останавливается.

Не важно.

Зацени лучше мою особую, фиберную магию
Если понравится, пойду писать для Гайдара ещё одну статью в фиберный цикл

[danilasv]

tyomitch
УРА!!! ЗАРАБОТАЛО!!!
Большое спасибо.
Теперь перехожу к исследованию таймера с более высоким разрешением (микросекунды), т.к. мне нужно изменять Темп плавно с шагом 0.1 миллисекунда (100 микросекунд)
TimeGetTime имеет разрешение 1 миллисекунда
А я могу свои примеры выкладывать на Форум?
С Уважением, Сергей

[danilasv]

Нет. Ещё рано переходить к более точному таймеру.
С CommonDialog задача решена очень хорошо.
Теперь проблема с Меню.
Та же беда - остановка таймера происходит при открытии Меню
Посмотрите Пример http://webfile.ru/
Номер Файла 2676445
А у стандартного VB Меню есть аналог API ?
Возможно аналогично VB CommonDialog также решить проблему остановки таймера и с VB Menu с помощью API функций ?

[tyomitch]

Кнопка "Добавить вложения" находится под формой ответа.

Заменить меню на апишное можно, но это дикость.
И всё равно ты так каждый модальный цикл не переделаешь.
Например, если таскать твою прогу за заголовок, то твой "таймер" тоже остановится.
Что там переписывать на апи? Заголовок окна??

[danilasv]

С заголовком окна я проблему давно решил.
Properties Form
Form1.BorderStyle = 0 - None

Код: Выделить всё

Option Explicit

Private Declare Function SendMessage Lib "User32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Sub ReleaseCapture Lib "User32" ()
Private Const WM_NCLBUTTONDOWN = &HA1
Private Const HTCAPTION = 2

Private Sub Form_MouseDown(Button As Integer, Shift As Integer, x As Single, Y As Single)
Dim ReturnValue As Long
If Button = 1 Then
Call ReleaseCapture
ReturnValue = SendMessage(Me.hwnd, WM_NCLBUTTONDOWN, HTCAPTION, 0&)
End If
End Sub

[Viper] :: Пользуйтесь тэгом CODE!!!! Настоятельно рекомендую!

[tyomitch]

Герой!
Теперь реши проблему с перетаскиванием открытого коммондиалога за заголовок, и со всплывающим из текстбокса стандартным контекстным меню.

[danilasv]

Это уже не нужно для меня.
Пусть таймер останавливается при щелчке мыши по заголовку любого диалогового окна.
Что главное, чтобы таймер не останавливался:
1 Перетаскивание формы без заголовка - Задача решена
2 Открытие файла - Задача решена
3 Меню - пока не решена

PS
Кнопку Добавить вложения нашёл.

[tyomitch]

Схематично:
1) делаешь заглавное меню невидимым
2) кладёшь лейбл с названием заглавного меню
3) по клику на лейбле, вызываешь PopupMenu с содержимым меню
4) оборачиваешь вызов PopupMenu в фиберную магию, как в моём примере. Просто вместо DlgOpenFile подставь PopupMenu.

[arthur2]

Как всегда, очень бы хотелось понять принцип магии Расскажи в двух словах, а? А то пока статьи дождёшься...

И кстати, насчёт ассемблерной вставки: а не нужно ли как-то помечать массив байтов, что это именно исполняемый код? А то мне тут как-то говорили, что без этого такие вставки не заработают в висте.

[tyomitch]

Нужно, но добрый бейсик всё помечает за нас сам.
Приведённый код я и сочинял, и дебагал именно под Вистой.
Хотя конкретно эту вставку взял неизменную из своей первой статьи, которая была ещё задолго до. И мне просто повезло, что с наступлением Висты в ней ничего не пришлось менять.

[awl100Alex]

...
Я разработал свой таймер (генератор) с точностью 100 микросекунд...
...
Посмотрите пример таймера с разрешением 1 миллисекунда на базе API timeGetTime...

А как это у тебя получилось сделать таймер на 100 МИКРОсекунд функцией TimeGetTime, которая возвращает значения только в МИЛЛИсекундах?

...
Теперь перехожу к исследованию таймера с более высоким разрешением (микросекунды), т.к. мне нужно изменять Темп плавно с шагом 0.1 миллисекунда (100 микросекунд)
TimeGetTime имеет разрешение 1 миллисекунда

danilasv
Не хочу тебя огорчать, но любая ОС - среда многозадачная и высокая точность таймеров тем более в таких малых величинах будет «плавающей». Добиться реальной сверхточности можно разве что только на уровне драйвера.

«Золотой» серединой разве что можно использовать API – QueryPerformanceCounter и QueryPerformaceFrequency.

QueryPerformanceCounter - возвращает время в тактах.
QueryPerformaceFrequency - количество тактов в секунду.

Таким образом можно действительно в ОС что-либо более-менее высокоточно измерять. Да и то, все равно точность будет с погрешностью и зависеть от переключения потоков, которые могут происходить в любое время.

[arthur2]

Нужно, но добрый бейсик всё помечает за нас сам.

Значит, меня зря пугали DEP-unsafe вот здесь viewtopic.php?p=6694815#p6694815 и здесь http://forum.sources.ru/index.php?showtopic=196997#
Тады -ура!

[Penumbra]

tyomitch а как эту особую, фиберную магию приатачить к моему случаю:
моя програмка юзает дллку FTD2XX.DLL (для обмена данными с FTDI контролером через usb)
в модуле:

Код: Выделить всё

Public Declare Function FT_Open Lib "FTD2XX.DLL" (ByVal intDeviceNumber As Integer, ByRef lngHandle As Long) As Long
Public Declare Function FT_Close Lib "FTD2XX.DLL" (ByVal lngHandle As Long) As Long
Public Declare Function FT_Read Lib "FTD2XX.DLL" (ByVal lngHandle As Long, ByVal lpszBuffer As String, ByVal lngBufferSize As Long, ByRef lngBytesReturned As Long) As Long
Public Declare Function FT_Write Lib "FTD2XX.DLL" (ByVal lngHandle As Long, ByVal lpszBuffer As String, ByVal lngBufferSize As Long, ByRef lngBytesWritten As Long) As Long
Public Declare Function FT_SetBaudRate Lib "FTD2XX.DLL" (ByVal lngHandle As Long, ByVal lngBaudRate As Long) As Long
Public Declare Function FT_SetDataCharacteristics Lib "FTD2XX.DLL" (ByVal lngHandle As Long, ByVal byWordLength As Byte, ByVal byStopBits As Byte, ByVal byParity As Byte) As Long
Public Declare Function FT_SetFlowControl Lib "FTD2XX.DLL" (ByVal lngHandle As Long, ByVal intFlowControl As Integer, ByVal byXonChar As Byte, ByVal byXoffChar As Byte) As Long
Public Declare Function FT_SetTimeouts Lib "FTD2XX.DLL" (ByVal lngHandle As Long, ByVal lngReadTimeout As Long, ByVal lngWriteTimeout As Long) As Long
Public Declare Function FT_SetBreakOn Lib "FTD2XX.DLL" (ByVal lngHandle As Long) As Long
Public Declare Function FT_SetBreakOff Lib "FTD2XX.DLL" (ByVal lngHandle As Long) As Long
Public Declare Function FT_SetLatencyTimer Lib "FTD2XX.DLL" (ByVal lngHandle As Long, ByVal LatencyTimer As Long) As Long
Public Declare Function FT_GetLatencyTimer Lib "FTD2XX.DLL" (ByVal lngHandle As Long, ByRef LatencyTimer As Long) As Long
Public Declare Function FT_SetUSBParameters Lib "FTD2XX.DLL" (ByVal lngHandle As Long, ByVal InTransferSize As Long, ByVal outTransferSize As Long) As Long
....
Public Function WriteRead(outB As String, inCount As Long, P As Byte) As String
Dim strWriteBuffer As String * 256
Dim lngBytesWritten As Long
Dim strReadBuffer As String * 256
Dim lngBytesRead As Long
Dim lngTotalBytesRead As Long
Dim strLoggerBuffer As String
Dim flFailed As Boolean
Dim flTimedout As Boolean
Dim flFatalError As Boolean
Dim ftStatus As Long

  flFailed = True
  flTimedout = False
  flFatalError = False
  lngTotalBytesRead = 0
  lngBytesWritten = 0
 
 
  If FT_SetDataCharacteristics(lngHandle, FT_BITS_8, FT_STOP_BITS_1, P) <> FT_OK Then
    Exit Function
  End If
  If FT_SetTimeouts(lngHandle, MDIForm1.WaitComm * (inCount + Len(outB)), MDIForm1.WaitComm * Len(outB)) <> FT_OK Then
    Exit Function
  End If
  If FT_Write(lngHandle, outB, Len(outB), lngBytesWritten) <> FT_OK Then
    If FT_Purge(lngHandle, FT_PURGE_TX) <> FT_OK Then
      Exit Function
    End If
    Exit Function
  End If
  lngBytesRead = 0
 
    ftStatus = FT_Read(lngHandle, strReadBuffer, inCount, lngBytesRead)
    If (ftStatus = FT_OK) Or (ftStatus = FT_IO_ERROR) Then
      If lngBytesRead = 0 Then flTimedout = True
      'lngTotalBytesRead = Len(strReadBuffer)
    Else
        flFatalError = True
    End If

  strLoggerBuffer = Left(strReadBuffer, lngBytesRead)
  If (flTimedout = False) Or (flFatalError = False) Then
    WriteRead = strLoggerBuffer
    flFailed = False
    Else
      WriteRead = ""
  End If
 
End Function

так вот на строке ftStatus = FT_Read(lngHandle, strReadBuffer, inCount, lngBytesRead)(прием данных)
программа засыпает на 0,3 секундды причем настолько что при загрузке проца 1% я немогу двигать даже главное окно своей проги
получается я могу управлять программой только в паузы между посылкой пакета данных
0,3 тормоза -0,1-работаю-0,3 тормоза -0,1-работаю- и тд и тп

[tyomitch]

У тебя же дело не в модальности, так что магия ни при чём.

Судя по беглому взгляду на доку, перед FT_Read стоит вставить цикл с DoEvents и в нём через FT_GetQueueStatus проверять, готовы ли данные для приёма.
Вот тогда, когда у тебя будет цикл с DoEvents, -- тогда у тебя будут все те же самые проблемы, как у автора топика