Вопрос 1) - встроенный таймер, который в палитре стандартных контролов - хорошо его использовать или нет? Использует ли он DoEvents?
Использование связки Sleep + Doevents в цикле (или заменяя Doevents на PeekMessage + TranslateMessage + DispatchMessage) имеет недостаток - если схватить мышью форму за заголовок - таймер приостановится. На этом форуме Хакер в писал (viewtopic.php?f=1&t=37142), что эту задачу нельзя решить в общем случае. По поводу фиберов - есть статья tyomitch-а, однако ссылки на примеры мертвые...
Можно попробовать использовать потоки, но они работают только в скомпилированном виде и использование очень ограничено. Хочу в цикле потока работать с формой (в качестве примера - что-то напечатать на форме или сменить заголовок) - переделанный пример от Кривоус Анатолия не работает корректно (зависает при попытке выгрузить все потоки процедурой UnloadAll), потому что я могу чего-то не знать. И API в цикле потока просто так нельзя использовать, приходится юзать TLB.
Вопрос 2) - что у меня не правильно в переделанном примере многопоточности от Кривоус Анатолия?
Код формы (на форме 2 кнопки cmdNewThread и cmdUnload):
- Код: Выделить всё
Option Explicit
' Пример многопоточности VB6
' © Кривоус Анатолий Анатольевич (The trick), 2013
' Работает только в скомпилированном виде
Private Declare Function WaitForSingleObject Lib "kernel32" (ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long
Private Declare Function CreateThread Lib "kernel32" (lpThreadAttributes As Any, ByVal dwStackSize As Long, ByVal lpStartAddress As Long, lpParameter As Any, ByVal dwCreationFlags As Long, lpThreadId As Long) As Long
Private Declare Function SetThreadPriority Lib "kernel32" (ByVal hThread As Long, ByVal nPriority As Long) As Long
Private Declare Function GetThreadPriority Lib "kernel32" (ByVal hThread As Long) As Long
Private Declare Function GetExitCodeThread Lib "kernel32" (ByVal hThread As Long, lpExitCode As Long) As Long
'Private Const DC_PEN As Long = 19
Private Const INFINITE = &HFFFFFFFF
Private Const MAX = 255
Dim Threads As Collection
Dim Thread(MAX - 1) As Point
Private Sub cmdNewThread_Click()
Dim hThread As Long, IDThread As Long, Pt As Point
Pt.Status = True
Thread(Threads.Count) = Pt
hThread = CreateThread(ByVal 0, 0, AddressOf MoveProc, Thread(Threads.Count), 0, IDThread)
If hThread Then Threads.Add hThread Else MsgBox ("Неудалось создать поток"): Exit Sub
SetThreadPriority hThread, 0
Print hThread & " " & IDThread
cmdNewThread.Enabled = False
End Sub
Private Sub cmdUnload_Click()
UnloadAll
End Sub
Private Sub Form_Load()
Set Threads = New Collection
End Sub
Private Sub UnloadAll()
Dim i As Variant, l As Long
For Each i In Threads
Thread(l).Status = False
Dim Ret As Long
GetExitCodeThread CLng(i), Ret
If Ret = &H103& Then
WaitForSingleObject CLng(i), INFINITE
End If
'WaitForSingleObject CLng(i), INFINITE
Print CLng(i)
l = l + 1
Next
End Sub
Private Sub Form_Unload(Cancel As Integer)
UnloadAll
End Sub
Код модуля:
- Код: Выделить всё
Option Explicit
' Пример многопоточности VB6
' © Кривоус Анатолий Анатольевич (The trick), 2013
' Работает только в скомпилированном виде
Public Type Vector
X As Double
Y As Double
End Type
Public Type Point
Pos As Vector
Spd1 As Single
Spd2 As Single
Color As Long
Status As Boolean
End Type
Public Play As Boolean
Private Const Pi2 = 6.28318530717959
'Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Public Function MoveProc(Pt As Point) As Long
Dim Ph1 As Single, Ph2 As Single, Scl As Single
Do
Ph1 = Ph1 + Pt.Spd1: Ph2 = Ph2 + Pt.Spd2
If Ph1 > Pi2 Then Ph1 = Ph1 - Pi2
If Ph2 > Pi2 Then Ph2 = Ph2 - Pi2
Scl = Sin(Ph2)
Pt.Pos.X = Cos(Ph1) * Scl * 100 + 100
Pt.Pos.Y = Sin(Ph1) * Scl * 100 + 100
'Sleep 500
abc1 CStr(Pt.Pos.Y) 'frmTest.Caption = CStr(Scl)
' Т.к. VB анализирует код, то в VB "думает" что
' никто не может обратится к локальной переменной этой процедуры извне
' в реальности к элементам массива Thread, модуля frmTest.
' Поэтому если не обрабатывать переменную Pt.Status, то VB "решит" (если стоит оптимизации кода)
' что значение ее всегда равно в теле цикла, и проверит значение до цикла
' Получится что цикл будет крутиться бесконечно.
' Чтобы такого не было вставляем вот эту строчку
Pt.Status = Not Not Pt.Status
Loop While Pt.Status
End Function
Public Sub abc1(f As String)
'frmTest.Print f 'Caption = f
frmTest.Caption = f
End Sub
Есть еще вариант использовать API SetTimer/KillTimer, либо CreateTimerQueueTimer. Они работают нормально, то есть если схватить форму, таймер будет продолжать работать.
Вопрос 3) - SetTimer как работает изнутри? Он лучше чем стандартный контрол таймера VB в плане производительности и "тяжелизны"? И там нету никакого Doevents?
Вопрос 4) - Верно ли, что CreateTimerQueueTimer еще лучше использовать, чем SetTimer? SetTimer - обертка ли над CreateTimerQueueTimer?
Вопрос 5) - есть ли что-то, что еще "ниже" чем CreateTimerQueueTimer?
Вопрос 6) - как можно на лету поменять интервал таймера при использовании CreateTimerQueueTimer, не прибегая к уничтожению и тут же созданию нового? Примеров на эту тему практически нет.
Спасибо за внимание к моему вопросу.
