VBNet - Форум - проблема с переводом вб6

Вопрос: проблема с переводом вб6 Добавлено: 03.11.07 20:04

Автор вопроса: Skywalker | Web-сайт: iSkywalker.ru | ICQ: 300-70-6пятьЪ

есть исходник который ловит с звуковухи сигнал и рисует график, вроде бы даже с этого сайта, Spectrum Analizer.
Не могу перевести его на вб нет, помогите пжл. Вот начальный вб6 (комментарии были в исходнике, их сильно много, чтобы удалять):

'Модуль:

Option Explicit 'Yoi e ?aeieeo ynii :)

Public hWaveIn& 'Eiioaeia? o?iaiy aoiaa
Private bBufferFull As Boolean 'Eiioaeia? noaoona aooa?a (iaiyoe); Ei?/Enoeia
Private WaveData(255) As Byte 'Caoeiaua aaiiua

Type WAVEFORMATEX 'Oi?iao e eioi?iaoey caoeiauo aaiiuo
     wFormatTag As Integer 'Oaa oeia oi?iaoa (caoea)
     nChannels As Integer 'Eiee?anoai eaiaeia
     nSamplesPerSec As Long 'Eaa?ia a naeoiao (eaa?/nae)
     nAvgBytesPerSec As Long 'Ia?a?inooua aaeou ca nae.
     nBlockAlign As Integer 'Aeiee?iaaou iai?aaeaiea
     wBitsPerSample As Integer 'Aeo/eaa?
     cbSize As Integer '?acia? aaou
End Type

Type WAVEHDR 'Eiioaeia? iieo?aiiiai caoea (oaeea/aeoia)
     lpData As Long 'Aaiiua (eiioaeia?)
     dwBufferLength As Long 'Aeeia aooa?a (iaiyoe)
     dwBytesRecorded As Long 'Aaeoia caienaii
     dwUser As Long 'Aeie iieuciaaoaeuneie iaiyoe
     dwFlags As Long 'Ie?a iienaiiua oeaoee (oeiu)
     dwLoops As Long 'Iiaoi?
     lpNext As Long 'Neaao?uee aeo
     Reserved As Long 'Ia?aoiia auaaeaiea
End Type

Type WAVEINCAPS 'Aaiiua a eieia?ea
     wMid As Integer 'Na?aaeia
     wPid As Integer 'Ieee (Peak)
     vDriverVersion As Long 'Aa?ney a?aeaa?a (nenoaiiiai)
     szPname As String * 32 'Eiy ii?oa (Eaiaea/A?aeaa?a)
     dwFormats As Long 'Ie?aiienaiiua oi?iaou
     wChannels As Integer 'Eiee?anoai eaiaeia
End Type

Declare Function waveInAddBuffer Lib "winmm.dll" (ByVal hWaveIn As Long, lpWaveInHdr As WAVEHDR, ByVal uSize As

Long) As Long
'Iieo?eaia eiee?anoaa caoeiauo ono?ienoa (0 i?e ionoonaee)
Declare Function waveInGetNumDevs Lib "winmm.dll" () As Long
'Ioe?uou caoeiaie aoia
Declare Function waveInOpen Lib "winmm.dll" (lphWaveIn As Long, ByVal uDeviceID As Long, lpFormat As WAVEFORMATEX,

ByVal dwCallback As Long, ByVal dwInstance As Long, ByVal dwFlags As Long) As Long
'Iieo?eou caaieiaie (eaiaea)
Declare Function waveInPrepareHeader Lib "winmm.dll" (ByVal hWaveIn As Long, lpWaveInHdr As WAVEHDR, ByVal uSize As

Long) As Long
'Na?in aaiiuo aoiaa
Declare Function waveInReset Lib "winmm.dll" (ByVal hWaveIn As Long) As Long
'Ioe?uoe i?e?iiiai eaiaea
Declare Function waveInStart Lib "winmm.dll" (ByVal hWaveIn As Long) As Long
'Ionaiiaea i?e?ia aaeoia aoiaiiai eaiaea
Declare Function waveInStop Lib "winmm.dll" (ByVal hWaveIn As Long) As Long
'Cae?uoea caoeiaiai eaiaea
Declare Function waveInClose Lib "winmm.dll" (ByVal hWaveIn As Long) As Long
'Iaaoiaua (iaia?aaioaiiua) caaieiaee
Declare Function waveInUnprepareHeader Lib "winmm.dll" (ByVal hWaveIn As Long, lpWaveInHdr As WAVEHDR, ByVal uSize

As Long) As Long

Public Const CALLBACK_FUNCTION = &H30000 'Ooieoey aica?aoa
Public Const MM_WIM_DATA = &H3C0 'Eiioaeia? ia?aia?aciaaiea aaiiuo
Public Const WAVE_FORMAT_PCM = 1 'Oi?iao aaiiuo (1 ii oiie?.)
Public Const WAVE_MAPPER = -1& 'Wave Mapper nenoaiiia ono?ienoai iaae?aaiey ca caoeii

Public Const WAVE_FORMAT_1M08 = &H1   ' 11025 Ao, 8 Aeo, Iiii.
Public Const WAVE_FORMAT_2M08 = &H10  ' 22050 Ao, 8 Aeo, Iiii.
Public Const WAVE_FORMAT_4M08 = &H100 ' 44100 Ao, 8 Aeo, Iiiio.

Private Function WaveInPresent() As Boolean
If waveInGetNumDevs() > 0 Then 'Anee i?enonoaoao iaii eee aieaa ono?ienoai
    WaveInPresent = True 'Oi Ono?ienoai aoiaa nooanoaoao
Else 'A i?ioeaiii neo?aa
    'Niiaoei iieuciaaae? ia ioeaea
    MsgBox "Iaaicii?ii ii?aaaeeou ieiaii ono?ienoai aaica caoea." & _
    vbCrLf & "Aicii?ii a nenoaia iaou caoeaaie ea?ou eee iia iaeni?aaia." _
    , vbCritical, "Ioeaea a " & App.Title
    WaveInPresent = False 'Eae ieeae, ii ea?ou iaoo (eee iaiiiyoiay)
End If
End Function
Public Sub waveInProc(ByVal hwi&, ByVal uMsg&, ByVal dwInstance&, ByVal dwParam1&, ByVal dwParam2&)
If uMsg = MM_WIM_DATA Then bBufferFull = True
End Sub
Private Sub DrawSpect()
Dim X%, c%, i%, j%
frmMain.pctSpec.Cls 'I?enoa? an? ?oi auei ia?eniaaii a yoeea ?enoiea
For X% = 0 To 254 'Ia?i?i e?oa e aici?i ana 254 (ca?ai ia 255?)
c% = WaveData(X%) 'Eae e iienuaae, yoi eiioaeia? caoeiauo aaiiuo
frmMain.pctSpec.Line -(X%, c%), Col(c%)
Next X%
End Sub
Public Function Col(CV) As ColorConstants
        If CV > 0 And CV <= 24 Then Col = vbRed 'E?aniue
        If CV > 24 And CV <= 64 Then Col = vbYellow '??eoue
        If CV > 64 And CV <= 192 Then Col = vbGreen 'Cae?iiue
        If CV > 192 And CV <= 232 Then Col = vbYellow '?aeoue
        If CV > 232 And CV <= 256 Then Col = vbRed 'E?aniue
        If CV > 256 Then MsgBox "Oa oa! Aeo aieuoa " & CV 'Ii?ao e oaeia auou! :)
End Function
Public Sub MonitorAudio()
Dim WH As WAVEHDR 'Ii?aaaeei WH eae caienaiiue aooa? ec iaiyoe

waveInStart hWaveIn 'Ioeoaa e eae ia?aou

Do 'Ia?aou aanu i?ioann (oio ca?ai i?iaa nicaaia)
    With WH '?oia iiaoi?ii ia ienaou WH (WAVEHDR) e ?oia ia iooae eaiaeu
        .lpData = VarPtr(WaveData(0)) 'Aaa acyou aaiiua
        .dwBufferLength = 256 'Aeeia aooa?a (Ii oiie?. 256, ii ii?ii e 128)
        .dwFlags = 0 'Ieeaeeo oea?eia, ?oia i?inoi ?aaioaei
    End With

    waveInPrepareHeader hWaveIn, WH, Len(WH) 'Eoaa iai?aaeou, e ioeoaa
    bBufferFull = False 'I?enuai aooa?, ii e eiioaeia? oi?a
    waveInAddBuffer hWaveIn, WH, Len(WH) 'Aiaaaeou caoe a aooa?

    Do 'Ia?aou oeee
        DoEvents '?oia ia aenei...
    Loop Until bBufferFull Or hWaveIn = 0 'Iiea aooa? ia ia?aiieiai eee aoia ?aaai ioe?

    waveInUnprepareHeader hWaveIn, WH, Len(WH) 'Ia?aaa?i iaia?aaioaiiua aaiiua
    DrawSpect '?eniaaiea niaeo?ia

    DoEvents '?oia ia aenei e ieeiai ia ?aaei
Loop Until hWaveIn = 0 'I?iai?eou ai iionoaoaiey
End Sub

'Форма:
Private m As Integer

Private Sub cmdExit_Click()
    Unload frmMain 'Ia?aaaou an? a ioieo aua?ocee
End Sub
Private Sub cmdStart_Click() 'Caione anyai :)
Dim Rv&
Dim WF As WAVEFORMATEX

cmbStyle.SetFocus

With WF 'Oeacuaaai ioeoaa e eae ?eoaou aaiiua
    .wFormatTag = WAVE_FORMAT_PCM 'Oi?iao oaeea
    .nChannels = 1 'Eaiaeu
    .nBlockAlign = 1
    .nSamplesPerSec = 11025 'Oi?iao 11/22/44 Ao
    .wBitsPerSample = 8 'Naiie (8 ii oiie?. ii ii?iie 16, ii nia?aea iaai oeacaou ii?aaaaiea a SpecAnalyzer)
    .nAvgBytesPerSec = (.nSamplesPerSec * .nBlockAlign) \ 8
    .cbSize = 0 '?acia? aooa?a (ia oiai i ?ai au iiaoiaee ;)
End With

'Ioe?uou eaiae?ee e ienoau
Rv = waveInOpen(hWaveIn, WAVE_MAPPER, WF, AddressOf waveInProc, 0, CALLBACK_FUNCTION)
If Rv <> 0 Then 'Anee iao neaiaea
    MsgBox "Iaaicii?ii ioe?uou ono?ienoai aaiaa caoea." & vbCrLf & _
    "Aicii?ii ii caiyo eee eniieucoaony a?oaei i?eei?aieai.", vbCritical, "Ioeaea a " & App.Title
    Exit Sub 'I?inoi aueaai
End If

DoEvents '?oia ia aenei

MonitorAudio

End Sub
Private Sub cmdStop_Click()

cmbStyle.SetFocus 'Ia?aaa?a oieona

waveInReset hWaveIn 'Io?oaeo
waveInStop hWaveIn 'Inoaiiaeou
waveInClose hWaveIn 'Cae?uo
hWaveIn = 0 'I?enoeou

If chkStopCLS.Value = vbChecked Then pctSpec.Cls

DoEvents '?oia ia aenei e i?iaie?aei ?aaioo nenoaiu
End Sub
Private Sub Form_Load()
m = 0
cmbStyle.ListIndex = 0
cmbColor.ListIndex = 3
'Aa?i caaaeiaie ec naienoaa caaaeiaie
frmMain.Caption = App.Title & Space(1) & App.Major & "." & App.Minor
chkOnTop.Value = vbChecked '?oia i?e caionea aue iiaa?o anao (ia iaai aoaao eeeeaou)
End Sub
Private Sub Form_QueryUnload(Cancel%, UnloadMode%)
'Ioee??ou iiieoi? e caaa?oeou ?aaioo i?ia?aiiu
'Anee inoaiiaeo aicii?ii (o.a. ?aaioaao), oi inoaiiaeou (aucaaou eeee ia eiiieo noii)
If cmdStop.Enabled Then cmdStop_Click
Unload frmMain 'Aua?oceou oi?io n iaiyoe
Set frmMain = Nothing 'I?eonoeou ianoi caaieiaaiia a ICO
End 'Caaa?oeo ?aaioo
End Sub

а вот код вб нет, ошибок компиляции нет, но не работает, т. е. ничего не рисует, видимо буфер неправильно определяется или еще что-то не так сделал:

Public Class Form1
    Private hWaveIn As Integer 'Контейнер уровня входа
    Private bBufferFull As Boolean 'Контейнер статуса буфера (памяти); Лож/Истина
    Private WaveData(255) As Byte 'Звуковые данные
    Private Structure WAVEFORMATEX 'Формат и информация звуковых данных
        Public wFormatTag As Int16 'Тег типа формата (звука)
        Public nChannels As Int16 'Количество каналов
        Public nSamplesPerSec As Int32 'Кадров в секунду (кадр/сек)
        Public nAvgBytesPerSec As Int32 'Переростшые байты за сек.
        Public nBlockAlign As Int16 'Блокировать направление
        Public wBitsPerSample As Int16 'Бит/кадр
        Public cbSize As Int16 'Размер даты
    End Structure
    Private Structure WAVEHDR 'Контейнер полученного звука (файла/битов)
        Public lpData As Int32 'Данные (контейнер)
        Public dwBufferLength As Int32 'Длина буфера (памяти)
        Public dwBytesRecorded As Int32 'Байтов записано
        Public dwUser As Int32 'Блок пользовательской памяти
        Public dwFlags As Int32 'Ниже описанные флашки (типы)
        Public dwLoops As Int32 'Повтор
        Public lpNext As Int32 'Следующий бит
        Public Reserved As Int32 'Обратное выделение
    End Structure
    Private Structure WAVEINCAPS 'Данные в колпачке
        Public wMid As Int16 'Середина
        Public wPid As Int16 'Пики (Peak)
        Public vDriverVersion As Int64 'Версия драйвера (системного)
        'Public szPname As String 'Имя порта (Канала/Драйвера)
        <System.Runtime.InteropServices.MarshalAs(Runtime.InteropServices.UnmanagedType.ByValArray, SizeConst:=32)> Public szPname() As Char
        Public dwFormats As Int32 'Нижеописанные форматы
        Public wChannels As Int16 'Количество каналов
    End Structure
    Private Declare Function waveInAddBuffer Lib "winmm.dll" (ByVal hWaveIn As Int32, ByRef lpWaveInHdr As WAVEHDR, ByVal uSize As UInt32) As Int32
    Private Declare Function waveInGetNumDevs Lib "winmm.dll" () As Integer
    Private Declare Function waveInOpen Lib "winmm.dll" (ByRef lphWaveIn As Int32, ByVal uDeviceID As Int32, ByRef lpFormat As WAVEFORMATEX, ByVal dwCallback As waveCallbackProc, ByVal dwInstance As UInt32, ByVal dwFlags As Int32) As Int32
    Private Declare Function waveInPrepareHeader Lib "winmm.dll" (ByVal hWaveIn As Int32, ByRef lpWaveInHdr As WAVEHDR, ByVal uSize As UInt32) As Int32
    Private Declare Function waveInReset Lib "winmm.dll" (ByVal hWaveIn As Int32) As Int32
    Private Declare Function waveInStart Lib "winmm.dll" (ByVal hWaveIn As Int32) As Int32
    Private Declare Function waveInStop Lib "winmm.dll" (ByVal hWaveIn As Int32) As Int32
    Private Declare Function waveInClose Lib "winmm.dll" (ByVal hWaveIn As Int32) As Int32
    Private Declare Function waveInUnprepareHeader Lib "winmm.dll" (ByVal hWaveIn As Int32, ByRef lpWaveInHdr As WAVEHDR, ByVal uSize As UInt32) As Int32
    Private Delegate Sub waveCallbackProc(ByVal hwi As Int32, ByVal uMsg As UInt32, ByVal dwInstance As Int32, ByRef dwParam1 As WAVEHDR, ByVal dwparam2 As Int32)
    Private Const CALLBACK_FUNCTION = &H30000 'Функция возврата
    Private Const MM_WIM_DATA = &H3C0 'Контейнер переобразование данных
    Private Const WAVE_FORMAT_PCM = 1 'Формат данных (1 по умолч.)
    Private Const WAVE_MAPPER = -1& 'Wave Mapper системное устройство наблюдения за звуком
    Private Const WAVE_FORMAT_1M08 = &H1   ' 11025 Гц, 8 Бит, Моно.
    Private Const WAVE_FORMAT_2M08 = &H10  ' 22050 Гц, 8 Бит, Моно.
    Private Const WAVE_FORMAT_4M08 = &H100 ' 44100 Гц, 8 Бит, Моноo.
    Private Function WaveInPresent() As Boolean
        'Получение количества звуковых устройств
        If waveInGetNumDevs() > 0 Then 'Если присуствует одно или более устройство
            WaveInPresent = True 'То Устройство входа сушествует
        Else 'В противном случае
            'Сообшим пользоваелю об ошибке
            MsgBox("Невозможно определить ниодно устройство ввоза звука." & _
            vbCrLf & "Возможно в системе неть звукавой карты или она неисправна." _
            , vbCritical, "Ошибка")
            WaveInPresent = False 'Как никак, но карты нету (или непонятная)
        End If
    End Function
    Private Sub waveInProc(ByVal hwi As Int32, ByVal uMsg As UInt32, ByVal dwInstance As Int32, ByRef dwParam1 As WAVEHDR, ByVal dwParam2 As Int32)
        'ВНИМАНИЕ!
        'Не вызывайте ниодной системной функции из етой рутины.
        'Вызов других звуковых функций можеть вызвать зависание.

        'Состояние буфера: заполнен (занят) или нет
        If uMsg = MM_WIM_DATA Then bBufferFull = True

    End Sub
    Private Sub DrawSpect()
        Dim X%, c%, i%, j%
        For X% = 0 To 254 'Начнём круг и возмём все 254 (зачем не 255?)
            c% = WaveData(X%) 'Как и описывал, это контейнер звуковых данных
            Dim pen As New Drawing.Pen(Col(c%))
            Dim q As Drawing.Graphics = Me.CreateGraphics()
            q.DrawLine(pen, 0, 0, X%, c%)
            Application.DoEvents()
        Next X%
    End Sub
    Private Function Col(ByVal CV As Integer) As Color
        If CV > 0 And CV <= 24 Then Col = Color.Red 'Красный
        If CV > 24 And CV <= 64 Then Col = Color.Yellow 'Жёлтый
        If CV > 64 And CV <= 192 Then Col = Color.Green 'Зелённый
        If CV > 192 And CV <= 232 Then Col = Color.Yellow 'Желтый
        If CV > 232 And CV <= 256 Then Col = Color.Red 'Красный
        If CV > 256 Then MsgBox("Хе хе! Бит больше " & CV) 'Может и такое быть! :)
    End Function
    Public Sub MonitorAudio()
        'Мониторинг (наблюдение) за звуком в входном канале
        Dim WH As WAVEHDR 'Определим WH как записанный буфер из памяти

        waveInStart(hWaveIn) 'Откуда и как начать

        Do 'Начать весь процесс (тот зачем прога создана)
            With WH 'Чтоб повторно не писать WH (WAVEHDR) и чтоб не путал каналы
                .lpData = VarPtr(WaveData(0)) 'Где взять данные
                .dwBufferLength = 256 'Длина буфера (По умолч. 256, но можно и 128)
                .dwFlags = 0 'Никаких флажков, чтоб просто работало
            End With

            waveInPrepareHeader(hWaveIn, WH, System.Runtime.InteropServices.Marshal.SizeOf(WH)) 'Куда направить, и откуда
            bBufferFull = False 'Очисщен буфер, но и контейнер тоже
            waveInAddBuffer(hWaveIn, WH, System.Runtime.InteropServices.Marshal.SizeOf(WH)) 'Добавить звук в буфер

            Do 'Начать цикл
                Application.DoEvents() 'Чтоб не висло...
            Loop Until bBufferFull Or hWaveIn = 0 'Пока буфер не переполнен или вход равен нулю

            waveInUnprepareHeader(hWaveIn, WH, System.Runtime.InteropServices.Marshal.SizeOf(WH)) 'Передаём необработанные данные
            DrawSpect() 'Рисование спектров

            Application.DoEvents() 'Чтоб не висло и никого не ждало
        Loop Until hWaveIn = 0 'Продожить до опусташения
    End Sub
    Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
        Dim Rv As UInt32
        Dim WF As WAVEFORMATEX
        With WF 'Указываем откуда и как читать данные
            .wFormatTag = WAVE_FORMAT_PCM 'Формат файла
            .nChannels = 1 'Каналы
            .nBlockAlign = 1
            .nSamplesPerSec = 11025 'Формат 11/22/44 Гц
            .wBitsPerSample = 8 'Семпл (8 по умолч. но можнои 16, но сначала надо указать опредеение в SpecAnalyzer)
            .nAvgBytesPerSec = (.nSamplesPerSec * .nBlockAlign) \ 8
            .cbSize = 0 'Размер буфера (не того о чем вы подумали ;)
        End With

        Dim pCallback As waveCallbackProc = AddressOf waveInProc
        'Открыть каналчик и пистаь
        Rv = waveInOpen(hWaveIn, WAVE_MAPPER, WF, pCallback, 0, CALLBACK_FUNCTION)
        If Rv <> 0 Then 'Если нет сигнала
            MsgBox("Невозможно открыть устройство ввода звука." & vbCrLf & _
            "Возможно он занят или используется другим приложением.", vbCritical, "Ошибка")
            Exit Sub 'Просто выйдем
        End If

        Application.DoEvents() 'Чтоб не висло

        'Вызваем то зачем всё это создали,
        'т.е. модуль чтения и рисования спектрума
        MonitorAudio()
    End Sub
    Private Function VarPtr(ByVal o As Object) As Integer
        Dim GC As System.Runtime.InteropServices.GCHandle = System.Runtime.InteropServices.GCHandle.Alloc(o, System.Runtime.InteropServices.GCHandleType.Pinned)
        Dim ret As Integer = GC.AddrOfPinnedObject.ToInt32
        GC.Free()
        Return ret
    End Function
End Class

Ответить

Ответы Всего ответов: 4

Номер ответа: 1 Автор ответа: gvozd Разработчик Offline Client Вопросов: 164 Ответов: 1317	Web-сайт: www.gvozdsoft.com Профиль \| \| #1	Добавлено: 03.11.07 20:17
	Ниасилил. Много букафф. Ответить

Номер ответа: 2 Автор ответа: Skywalker ICQ: 300-70-6пятьЪ Вопросов: 62 Ответов: 545	Web-сайт: iSkywalker.ru Профиль \| \| #2	Добавлено: 03.11.07 23:01
	для людей, которым лень прочитать, что написано выше, скажу по-другому: как получить звуковой буфер, для дальнейшей отрисовки. допускается реализация на DirectSound Ответить

Номер ответа: 3 Автор ответа: Ra$cal ICQ: 8068014 Вопросов: 18 Ответов: 817	Web-сайт: www.rascalspb.narod.ru Профиль \| \| #3	Добавлено: 03.11.07 23:11
	codeproject.com там полно примеров. на разных языках - хоть на с++, хоть на точке. на с++ вроде почаще такой тематики статьи, так что нада в нем уметь плавать немногим лучше топора. может и на вб.нет найдешь. Ответить

Номер ответа: 4 Автор ответа: Skywalker ICQ: 300-70-6пятьЪ Вопросов: 62 Ответов: 545	Web-сайт: iSkywalker.ru Профиль \| \| #4	Добавлено: 03.11.07 23:32
	да на с++ я давно уж этот код перевел и он норм работает, мне надо на вб.нет. причем все уже написано, нужно только что-то где-то сверху исправить пару строчек и все(( Ответить

Страница: 1 |