Нужна Помощь

  • Автор темы -
  • Дата начала
Статус
Закрыто для дальнейших ответов.

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

alex77755

Well-Known Member
15.02.2009
128
0
62
Украина Павлоград
#2
Сам медик. Хочу усовершенствовать одну методу по исправлению заикания, но знаний по программированию
не хватает. Прошу помочь если есть возможность.
Нужна программа на vb 6. Представляет собой форму с двумя кнопкамии и текстовым полем(счётчик).
Одна кнопка посредством мышки включает счетчик другая выключает. Включение и выключение
сопровождается звуковым сигналом beep.Первая кнопка в момент включения счётчика обнуляет
предыдущие показания счётчика.Включение и выключение происходят в момент нажатия кнопок, а не
в момент отжатия.
вот так, примерно?
 

Вложения

alex77755

Well-Known Member
15.02.2009
128
0
62
Украина Павлоград
#4
Форма
Код:
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
 
Статус
Закрыто для дальнейших ответов.