Нужна Помощь

[Guest]

Сам медик. Хочу усовершенствовать одну методу по исправлению заикания, но знаний по программированию
не хватает. Прошу помочь если есть возможность.
Нужна программа на vb 6. Представляет собой форму с двумя кнопкамии и текстовым полем(счётчик).
Одна кнопка посредством мышки включает счетчик другая выключает. Включение и выключение
сопровождается звуковым сигналом beep.Первая кнопка в момент включения счётчика обнуляет
предыдущие показания счётчика.Включение и выключение происходят в момент нажатия кнопок, а не
в момент отжатия.

 

[alex77755]

Сам медик. Хочу усовершенствовать одну методу по исправлению заикания, но знаний по программированию
не хватает. Прошу помочь если есть возможность.
Нужна программа на vb 6. Представляет собой форму с двумя кнопкамии и текстовым полем(счётчик).
Одна кнопка посредством мышки включает счетчик другая выключает. Включение и выключение
сопровождается звуковым сигналом beep.Первая кнопка в момент включения счётчика обнуляет
предыдущие показания счётчика.Включение и выключение происходят в момент нажатия кнопок, а не
в момент отжатия.

вот так, примерно?

 

[Guest]

вот так, примерно?
Спасибо большое но нельзя ли эту прогу прислать в открытом коде, я его вставлю в свою прогу.

 

[alex77755]

Форма

Option Explicit

Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Private Declare Function waveOutGetNumDevs Lib "winmm.dll" () As Long
Private Declare Function sndPlaySound Lib "winmm.dll" Alias "sndPlaySoundA" _
(ByVal lpszSoundName As String, ByVal uFlags As Long) As Long
Dim N
Dim ZVUK
Dim lngSound
Dim strWaveFile As String
Dim ST
Dim DVIG As Boolean

Sub QWERT()
Dim S
Do
Sleep 100
If Not DVIG Then Exit Sub
S = QTime
Доли = (S - ST) * 1000 Mod 10
Секунды = (QTime - ST) \ 1 Mod 60
Минуты = (QTime - ST) \ 60 Mod 60
DoEvents
Loop
End Sub

Private Sub Form_Load()
ZVUK = Dir(App.Path & "\*.wav")
If ZVUK = "" Then
MsgBox " Рядом с программой должен быть файл сигнала в формате " & """" & "wav" & """""", vbCritical, ""
Unload Me
End If
strWaveFile = App.Path & "\" & Dir(App.Path & "\*.wav")
End Sub

Private Sub Включить_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
lngSound = sndPlaySound(strWaveFile, 1)
QTime_Init
ST = Int(QTime)
DVIG = True
QWERT

End Sub


Private Sub Выключить_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
lngSound = sndPlaySound(strWaveFile, 1)
DVIG = False
End Sub

модуль:

Option Explicit
Private Type int64
dw1 As Long
dw2 As Long
End Type
Private Declare Function QueryPerformanceCounter Lib "kernel32" (lpPerformanceCount As int64) As Long
Private Declare Function QueryPerformanceFrequency Lib "kernel32" (lpFrequency As int64) As Long
Dim QSpeed As Double

Public Function QTime() As Double
Dim QD As int64, t As Double
QueryPerformanceCounter QD
If QD.dw1 < 0& Then t = QD.dw1 + 4294967296# Else t = QD.dw1
If QD.dw2 < 0& Then t = t + (QD.dw2 + 4294967296#) * 4294967296# Else t = t + QD.dw2 * 4294967296#
QTime = t * QSpeed
End Function

Public Sub QTime_Init()
Dim QD As int64
QueryPerformanceFrequency QD
If QD.dw1 < 0& Then QSpeed = QD.dw1 + 4294967296# Else QSpeed = QD.dw1
If QD.dw2 < 0& Then QSpeed = QSpeed + (QD.dw2 + 4294967296#) * 4294967296# Else QSpeed = QSpeed + QD.dw2 * 4294967296#
QSpeed = 1# / QSpeed
End Sub