Нужна Помощь

Тема в разделе "Visual Basic", создана пользователем -, 16 дек 2012.

Статус темы:
Закрыта.
  1. Гость

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

    alex77755 Well-Known Member

    Регистрация:
    15 фев 2009
    Сообщения:
    128
    Симпатии:
    0
    вот так, примерно?
     

    Вложения:

  3. Гость

     
  4. alex77755

    alex77755 Well-Known Member

    Регистрация:
    15 фев 2009
    Сообщения:
    128
    Симпатии:
    0
    Форма
    Код (LotusScript):
    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
    модуль:
    Код (LotusScript):
    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
     
Загрузка...
Статус темы:
Закрыта.

Поделиться этой страницей