vb.net и реальные справки

[Invader]

Где!!!
где нормальный msdn по vb.net? Уточню где описание деклараций API функций ....
PInvoke.net половину показывает на C а иных вообще нет, почему в vb6 легко можно было отыскать декларацию почти любой API с реальными, простыми, рабочими примерами???
API Guide очень хорош но нет примеров для .NET!
почему такой гем..ой в vb.net! За что не возьмись: запись звука,взлом(пордоньте, подключение к сторонним EXE), эффекты с формой, потом где русские ресурсы, Варианты типа английский надо знать, это конечно Зер Гуд, но во первых я больше документации нахожу на китайском (скоро наверно мировой язык ),
а во вторых я не готовлюсь к дипломной и не пишу работы для NASA!!!
не исключаю что не нашел такого, коим все давно пользуются, если кто знает подскажите ресурс.
и умаляю, не глумитесь. Просто реально учусь Сам.

[FireFenix]

где нормальный msdn по vb.net? Уточню где описание деклараций API функций ....

Почему оно должно быть? и зачем оно надо если можно сделать руками, если только понимать типы данных и что вообще происходит?
Базовая комплектация FW даёт 98% требуемых возможностей.

[Invader]

каким боком мне использовать функции которые работали vb6
а vb.net мне сообщают
Вызов функции PInvoke "WindowsApplication1!WindowsApplication1.slushatel::waveInOpen" разбалансировал стек. Вероятно, это вызвано тем, что управляемая сигнатура PInvoke не совпадает с неуправляемой целевой сигнатурой. Убедитесь, что соглашение о вызовах и параметры сигнатуры PInvoke совпадают с неуправляемой целевой сигнатурой.
есть у меня набор деклараций в модуле VB6
я модуль оформил в VB.NET

Код: Выделить всё

Declare Function GlobalAlloc Lib "kernel32" (ByVal wFlags As Long, ByVal dwBytes As Long) As Long
Declare Function GlobalLock Lib "kernel32" (ByVal hmem As Long) As Long
Declare Function GlobalFree Lib "kernel32" (ByVal hmem As Long) As Long
Declare Sub CopyStructFromPtr Lib "kernel32" Alias "RtlMoveMemory" (struct As Any, ByVal ptr As Long, ByVal cb As Long)
Declare Function waveInOpen Lib "winmm.dll" (lphWaveIn As Long, ByVal uDeviceID As Long, lpFormat As WAVEFORMAT, ByVal dwCallback As Long, ByVal dwInstance As Long, ByVal dwFlags As Long) As Long
Declare Function waveInStart Lib "winmm.dll" (ByVal hWaveIn As Long) As Long
Declare Function waveInStop Lib "winmm.dll" (ByVal hWaveIn As Long) As Long
Declare Function waveInAddBuffer Lib "winmm.dll" (ByVal hWaveIn As Long, lpWaveInHdr As WAVEHDR, ByVal uSize As Long) As Long
Declare Function waveInReset Lib "winmm.dll" (ByVal hWaveIn As Long) As Long
Declare Function waveInPrepareHeader Lib "winmm.dll" (ByVal hWaveIn As Long, lpWaveInHdr As WAVEHDR, ByVal uSize As Long) As Long
Declare Function waveInGetErrorText Lib "winmm.dll" Alias "waveInGetErrorTextA" (ByVal err As Long, ByVal lpText As String, ByVal uSize As Long) As Long
Declare Function waveInClose Lib "winmm.dll" (ByVal hWaveIn As Long) As Long
Declare Function waveInUnprepareHeader Lib "winmm.dll" (ByVal hWaveIn As Long, lpWaveInHdr As WAVEHDR, ByVal uSize As Long) As Long


оно vb.net сначало ругалось на GlobalAlloc Lib "kernel32" я заменил

Код: Выделить всё

<DllImport("kernel32.dll", CharSet:=CharSet.Auto, ExactSpelling:=True)> _
    Public Function GlobalLock(ByVal handle As IntPtr) As IntPtr
    End Function


оно тогда перешло на следующую функцию (ошибка описана выше)
как мне все их расписать, а ведь не секретные и примеров на каждую в msdn на vb.net далжно было быть море, но нет

[Invader]

эти моменты

Код: Выделить всё

CharSet:=CharSet.Auto, ExactSpelling:=True

я вообще не понимаю, как то раньше без них замечательно писал и всё работало

[Qwertiy]

1. Надо не забывать менять Long на Integer.
2. В VB6 по умолчанию ByRef, которое может не стоять в описании (по крайней мере, API Text Viewer не ставит). Надо скопировать в блокнотик, там подписать ByRef, где надо, затем вставить в VS и выполнить пункут 1.
Собственно, всё. После этого функции должны стать рабочими Если конечно в описании нет As Any... В последнем случае надо смотреть по ситуации.

[Invader]

1. Надо не забывать менять Long на Integer.
2. В VB6 по умолчанию ByRef, которое может не стоять в описании (по крайней мере, API Text Viewer не ставит). Надо скопировать в блокнотик, там подписать ByRef, где надо, затем вставить в VS и выполнить пункут 1.
Собственно, всё. После этого функции должны стать рабочими Если конечно в описании нет As Any... В последнем случае надо смотреть по ситуации.

спасибо
as Any есть

и ещё "1. Надо не забывать менять Long на Integer." это по всему коду

Надо скопировать в блокнотик, там подписать ByRef, где надо -Непонятно уточните

[Invader]

в vb6 в текстбокс передавало значение 1 если уровень выше порога и ноль если ниже
а vb.net ошибок не выдает, но вместо передачи в текстбокс при запуске появляется второе окошко с названием проекта и с кнопкой окей
может не так задекларирована Declare Sub CopyStructFromPtr Lib "kernel32" Alias "RtlMoveMemory" (struct As Any, ByVal ptr As Long, ByVal cb As Long)
я записал как

Код: Выделить всё

Declare Sub CopyStructFromPtr Lib "kernel32" Alias "RtlMoveMemory" (ByRef struct As IntPtr, ByVal ptr As Integer, ByVal cb As Integer)


и в коде на форме выдает в цикле ошибку:
Предупреждение 2 Тип переменной "curSample" не будет определен, так как она связана с полем во внешней области видимости. Нужно изменить имя "curSample" или использовать полное имя (например, "Me.curSample" or "MyBase.curSample")
на форме цикл

Код: Выделить всё

Sub DrawSpectrum()

        'Dim Volume As Double
        'Dim curSample As Long
        Dim curSample As integer,
        Dim f, kk
        N = 2048


        For curSample = 0 To 2047
            GetMono16Sample(curSample, Volume)
            REX(curSample) = Volume
            'TextBox1.Text = Volume
            IMX(curSample) = 0
        Next
.........


и в модуле есть код

Код: Выделить всё

Sub GetMono16Sample(ByVal sample As Integer, ByRef leftVol As Double)
        Dim sample16 As Integer
        Dim ptr As Integer

        ptr = sample * format.nBlockAlign + inHdr.lpData
        CopyStructFromPtr(sample16, ptr, 2)
        leftVol = sample16 / 32768

    End Sub


[FireFenix]

эти моменты

Код: Выделить всё

CharSet:=CharSet.Auto, ExactSpelling:=True

я вообще не понимаю, как то раньше без них замечательно писал и всё работало

Тебя никто не заставляет указывать параметры, не нужно - не указывай

я записал как

Код: Выделить всё

Declare Sub CopyStructFromPtr Lib "kernel32" Alias "RtlMoveMemory" (ByRef struct As IntPtr, ByVal ptr As Integer, ByVal cb As Integer)

Как я говорил - во фреймворке 98% функционала уже реализовано, если умeть их использовать, то тянуть АПИ не обязательно.
Для работы с неуправляемой памятью, есть класс Mrashal

P.S. И по моему если указать ByRef Strucutre, то вернётся структура по переданному указателю, без ручного транслирования адреса. Но может я не прав

[Invader]

я уже записывал

Код: Выделить всё

Declare Sub CopyStructFromPtr Lib "kernel32" Alias "RtlMoveMemory" ( <MarshalAs(UnmanagedType.AsAny)> ByRef struct as Object, ByVal ptr As Integer, ByVal cb As Integer)



один вариант, - выдаёт окошко?!
я писал выше: "при запуске появляется второе окошко с названием проекта и с кнопкой окей

и в коде на форме выдает в цикле ошибку:
Предупреждение 2 Тип переменной "curSample" не будет определен, так как она связана с полем во внешней области видимости. Нужно изменить имя "curSample" или использовать полное имя (например, "Me.curSample" or "MyBase.curSample")"
может struct не Object
и может из формы в отличии от vb6 надо в vb.net как то по другому передавать значение переменной в модуль,
я могу сбросить рабочий пример в vb6, и не рабочий vb.net

[Qwertiy]

Надо скопировать в блокнотик, там подписать ByRef, где надо -Непонятно уточните

API Text Viewer делает описания функций с указанием ByVal и без указания ByRef (в VB6 по умолчанию использовалось ByRef). Но в VB.NET по умолчанию используется ByVal, поэтому сгенерированные таким образом объявления работать не будут. Первым приходит в голову вставить эти объявления в VS и там его править. Так вот, это тоже работать не будет, т. к. после нажатия Ctrl+V умная VS вставит перед аргументами, для которых не указано ни ByVal, ни ByRef метку ByVal, что вызовет трудности с расстановкой ByRef в нужных местах. Именно поэтому надо вставить в блокнот (я предпочитаю NPP), там дописать все необходимые ByRef, после чего, скопировать код оттуда, и уже этот код вставить в VS.

После этого надо поменять Long на Integer или IntPtr (в зависимости от ситуации). По сути, от выбранного типа ничего не изменится (по крайней мере, если речь не идёт об x64 - там гарантировать не могу).

Если встречается As Any, то надо вместо него подставить то, с чем реально будет работать функция. Это может быть тип или делегат. Возможно, придётся сделать несколько объявлений с различными параметрами на одну и ту же api-функцию. Насколько я помню, при объявлении в классе имена могут совпадать, а при объявлении в модуле - нет, хотя, возможно, что это не так.

[FireFenix]

Для работы с неуправляемой памятью, есть класс Mrashal

я уже записывал

Код: Выделить всё

Declare Sub CopyStructFromPtr Lib "kernel32" Alias "RtlMoveMemory" ( <MarshalAs(UnmanagedType.AsAny)> ByRef struct as Object, ByVal ptr As Integer, ByVal cb As Integer)


Ну... включи уже голову!

Как ты думаешь есть ли разница между Параметром MarshalAs и Классом Marshal?
В этом же классе есть метод Marshal.PtrToStructure, ни на что не намекает?

[Viper]

Порекламирую свою статью очередной раз. Здесь в том числе и о работе с классом Marshal, и про атрибуты MarshalAs и еще много полезного.

[Invader]

Порекламирую свою статью очередной раз. Здесь в том числе и о работе с классом Marshal, и про атрибуты MarshalAs и еще много полезного.

Очень полезная статья, с Вашего позволения скопировал (для себя) но уж всё так сложно, так и не могу понять что не так .
если у кого будет время взгляните на код, пример на vb6
в проекте при запуске на форме надо плавно увеличивать ползунок слайдер где то (у меня на значении 20) на кнопке начинает при постукиванию по микрофону, в качестве caption срабатывать счетчик, ну так мне было удобнее тестить.
Планировалось при большом сигнале запускать нажатие кнопки а при сигнале - шум, делать кнопку не активной

spectrum audio.zip

(6.29 Кб) Скачиваний: 203

[Qwertiy]

У меня VB6 падает при попытке открыть проект...

[Invader]

У меня VB6 падает при попытке открыть проект...

Страно, я запустил проект из распакованного зипа, всё работает
но есть один баг, если я микрофон не подключаю к микрофонному входу, выдает сообщение что указан код устройства не используемого в системе,
но при подключении всё гуд.
Может из за того что я из виндовс 7 захожу? проверю в хр
visual basic 6(sp5), его ещё на русском трекере назвали visual basic 6.5
остальных вылетов не наблюдал.

[Qwertiy]

Падает сама среда при открытии проекта. Не при запуске.
Вообще, у меня есть с ней некоторые проблемы, но мои проекты открываются.

[Invader]

я просто не знаю, уже что и делать, код формы и код модуля минимум кода - перепроектировать не могу для vb.net
Qwertiy может просто блокнотом открыть, может посмотришь что к чему, так или иначе спасибо за найденное время.

[Qwertiy]

К ранее приведённым рекомендациям добавляется заменить Integer на Short в структурах.

[Qwertiy]

Я без понятия, что этот код делает и разбираться не хочу.

Попробуй что-нибудь типа:

Код: Выделить всё

Option Explicit On


Module Module1

Public Const WHDR_DONE = &H1         '  done bit

Structure WAVEHDR
   Dim lpData As Integer
   Dim dwBufferLength As Integer
   Dim dwBytesRecorded As Integer
   Dim dwUser As Integer
   Dim dwFlags As Integer
   Dim dwLoops As Integer
   Dim lpNext As Integer
   Dim Reserved As Integer
End Structure

Structure WAVEFORMAT
   Dim wFormatTag As Short
   Dim nChannels As Short
   Dim nSamplesPerSec As Integer
   Dim nAvgBytesPerSec As Integer
   Dim nBlockAlign As Short
   Dim wBitsPerSample As Short
   Dim cbSize As Short
End Structure

Declare Function GlobalAlloc Lib "kernel32" (ByVal wFlags As Integer, ByVal dwBytes As Integer) As Integer
Declare Function GlobalLock Lib "kernel32" (ByVal hmem As Integer) As Integer
Declare Function GlobalFree Lib "kernel32" (ByVal hmem As Integer) As Integer
'Declare Sub CopyStructFromPtr Lib "kernel32" Alias "RtlMoveMemory" (ByRef struct As Any, ByVal ptr As Integer, ByVal cb As Integer)
Declare Sub CopyStructFromPtr Lib "kernel32" Alias "RtlMoveMemory" (ByRef struct As Short, ByVal ptr As Integer, ByVal cb As Integer)
Declare Function waveInOpen Lib "winmm.dll" (ByRef lphWaveIn As Integer, ByVal uDeviceID As Integer, ByRef lpFormat As WAVEFORMAT, ByVal dwCallback As Integer, ByVal dwInstance As Integer, ByVal dwFlags As Integer) As Integer
Declare Function waveInStart Lib "winmm.dll" (ByVal hWaveIn As Integer) As Integer
Declare Function waveInStop Lib "winmm.dll" (ByVal hWaveIn As Integer) As Integer
Declare Function waveInAddBuffer Lib "winmm.dll" (ByVal hWaveIn As Integer, ByRef lpWaveInHdr As WAVEHDR, ByVal uSize As Integer) As Integer
Declare Function waveInReset Lib "winmm.dll" (ByVal hWaveIn As Integer) As Integer
Declare Function waveInPrepareHeader Lib "winmm.dll" (ByVal hWaveIn As Integer, ByRef lpWaveInHdr As WAVEHDR, ByVal uSize As Integer) As Integer
Declare Function waveInGetErrorText Lib "winmm.dll" Alias "waveInGetErrorTextA" (ByVal err As Integer, ByVal lpText As String, ByVal uSize As Integer) As Integer
Declare Function waveInClose Lib "winmm.dll" (ByVal hWaveIn As Integer) As Integer
Declare Function waveInUnprepareHeader Lib "winmm.dll" (ByVal hWaveIn As Integer, ByRef lpWaveInHdr As WAVEHDR, ByVal uSize As Integer) As Integer

Public i As Short, j As Short, rc As Integer, msg As String = Space$(200), hWaveIn As Integer
Public format As WAVEFORMAT
Public hmem As Integer
Public inHdr As WAVEHDR
Public Const DEVICEID = 0
Public fRecording As Boolean
Public BUFFER_SIZE As Short

'When the number of FFT points is < 512 and samplerates
'are < 22050 are used the program has to wait for input.
'A circular buffer of sufficient size may be of value
'but I don't know how to implement it.

Function StartInput() As Boolean

    If fRecording Then
        StartInput = True
        Exit Function
    End If

    format.wFormatTag = 1
    format.nChannels = 1
    format.wBitsPerSample = 16
    format.nSamplesPerSec = 48000    'Gets the sample rate from the main form
    format.nBlockAlign = format.nChannels * format.wBitsPerSample / 8
    format.nAvgBytesPerSec = format.nSamplesPerSec * format.nBlockAlign
    format.cbSize = 0

    hmem = GlobalAlloc(&H40, BUFFER_SIZE)
    inHdr.lpData = GlobalLock(hmem)
    inHdr.dwBufferLength = BUFFER_SIZE
    inHdr.dwFlags = 0
    inHdr.dwLoops = 0

    rc = waveInOpen(hWaveIn, DEVICEID, format, 0, 0, 0)
    If rc <> 0 Then
      waveInGetErrorText(rc, msg, Len(msg))
      MsgBox(msg)
      StartInput = False
      Exit Function
    End If

    rc = waveInPrepareHeader(hWaveIn, inHdr, Len(inHdr))
    If (rc <> 0) Then
       waveInGetErrorText(rc, msg, Len(msg))
       MsgBox(msg)
    End If

    rc = waveInAddBuffer(hWaveIn, inHdr, Len(inHdr))
    If (rc <> 0) Then
       waveInGetErrorText(rc, msg, Len(msg))
       MsgBox(msg)
    End If

    fRecording = True
    rc = waveInStart(hWaveIn)
    StartInput = True

End Function

' Stop receiving audio input on the soundcard
Sub StopInput()
    fRecording = False
    waveInReset(hWaveIn)
    waveInStop(hWaveIn)
    waveInUnprepareHeader(hWaveIn, inHdr, Len(inHdr))
    GlobalFree(hmem)
    waveInClose(hWaveIn)
End Sub

Sub GetMono16Sample(ByVal sample As Integer, ByRef leftVol As Double)
   Dim sample16 As Short
   Dim ptr As Integer

   ptr = sample * format.nBlockAlign + inHdr.lpData
   CopyStructFromPtr(sample16, ptr, 2)
   leftVol = sample16 / 32768

End Sub

'The following code may be from the original program author
'but it appears to be a relatively generic adaptation.
'This routine imposes a speed bottleneck when the number
'of FFT points is > 512.

'THE FAST FOURIER TRANSFORM
'Upon entry, N% contains the number of points in the DFT,
'REX[ ] and IMX[ ] contain the real and imaginary parts of the input.
'Upon return, REX[ ] and IMX[ ] contain the DFT output.
'All signals run from 0 to N-1.

Sub FFT(ByVal N As Short, ByVal REX() As Double, ByVal IMX() As Double)

    Const Pi = 3.14159
    Dim NM1 As Short
    Dim ND2 As Short
    Dim M As Short
    Dim j As Short
    Dim K As Short
    Dim L As Short
    Dim LE As Short
    Dim LE2 As Short
    Dim JM1 As Short
    Dim i As Short
    Dim IP As Short
    Dim TR As Double
    Dim TI As Double
    Dim UR As Double
    Dim UI As Double
    Dim SR As Double
    Dim SI As Double

    NM1 = N - 1
    ND2 = N / 2
    M = CInt(Math.Log(N) / Math.Log(2))
    j = ND2

    For i = 1 To N - 2                    'Bit reversal sorting
      If i >= j Then GoTo S1
      TR = REX(j)
      TI = IMX(j)
      REX(j) = REX(i)
      IMX(j) = IMX(i)
      REX(i) = TR
      IMX(i) = TI
S1:   K = ND2
S2:   If K > j Then GoTo s3
      j = j - K
      K = K / 2
      GoTo S2
s3:   j = j + K
    Next

    For L = 1 To M                          'Loop for each stage
        LE = CInt(2 ^ L)
        LE2 = LE / 2
        UR = 1
        UI = 0
        SR = Math.Cos(Pi / LE2)                 'Calculate sine & cosine values
        SI = -Math.Sin(Pi / LE2)

        For j = 1 To LE2                    'Loop for each sub DFT
             JM1 = j - 1
             For i = JM1 To NM1 Step LE     'Loop for each butterfly
                   IP = i + LE2
                   TR = REX(IP) * UR - IMX(IP) * UI   'Butterfly calculation
                   TI = REX(IP) * UI + IMX(IP) * UR
                   REX(IP) = REX(i) - TR
                   IMX(IP) = IMX(i) - TI
                   REX(i) = REX(i) + TR
                   IMX(i) = IMX(i) + TI
             Next
             TR = UR
             UR = TR * SR - UI * SI
             UI = TR * SI + UI * SR
        Next
    Next

End Sub

End Module

Код: Выделить всё

Option Explicit On

Public Class Form1


Const contrast = 6
Const gain = 6
Const SampleRate = 48000
Const bins = 2048

Dim N As Short        'Number of points in the DFT,
Dim REX() As Double     'Real part of input
Dim IMX() As Double     'Imaginary part of input
Dim ln As Single        'Vertical line # in Waterfall
Dim Volume As Double
Dim curSample As Integer

Dim brightness As Short

Dim scet As Integer


Dim fError As Boolean






Private Sub Command1_Click() Handles Command1.Click
Command1.Enabled = True
   Command2.Enabled = False
End Sub

Private Sub Command2_Click() Handles Command2.Click
Command1.Enabled = False
Command2.Enabled = True
End Sub

Private Sub Form_Activate() Handles MyBase.Activated

    N = 2048   'Number of samples must be  2^k  where k = integer > 1
    BUFFER_SIZE = 4096      'Must be at least 2 * max number of bins

    ReDim REX(N - 1)
    ReDim IMX(N - 1)

    CmdSwitch.Text = "Start"

    lblBrightness.Text = "Brightness " + Str(scrBrightness.Value)
    brightness = scrBrightness.Value

    ln = 0  'Waterfall must start at line 0

    Timer1.Interval = 1
    Timer1.Enabled = True



End Sub


Private Sub CmdSwitch_Click() Handles CmdSwitch.Click
    If CmdSwitch.Text = "Start" Then
        CmdSwitch.Text = "Freeze"
        StartInput()
    Else
        CmdSwitch.Text = "Start"
        StopInput()
    End If

End Sub



Private Sub scrBrightness_Change() Handles scrBrightness.ValueChanged
    lblBrightness.Text = "Brightness " + Str(scrBrightness.Value)
    brightness = scrBrightness.Value
End Sub

Private Sub Timer1_Timer() Handles Timer1.Tick  ' Process sound buffer if recording

    If (fRecording) Then
        If inHdr.dwFlags And WHDR_DONE Then
            rc = waveInAddBuffer(hWaveIn, inHdr, Len(inHdr))
            DrawSpectrum()
        End If

    End If

End Sub

Private Sub Form_QueryUnload() Handles MyBase.FormClosing
    If (fRecording) Then
        StopInput()
    End If
End Sub

Sub DrawSpectrum()

    'Dim Volume As Double
    'Dim curSample As Long
    Dim f As Integer, kk As Integer
    N = 2048


    For curSample = 0 To 2047
        GetMono16Sample(curSample, Volume)
        REX(curSample) = Volume

        IMX(curSample) = 0
    Next

    FFT(N, REX, IMX)


    For f = 0 To 1024
        kk = Math.Sqrt(REX(f) ^ 2) * Int((brightness * 100))
        If kk < 1 Then
            kk = 1
        End If
        kk = gain * Math.Log(kk)
         Text1.Text = CStr(kk)

    Next
    If kk > 16 Then 'StopInput

           scet = scet + 1
          Command1_Click()
          Command1.Text = CStr(scet)
          'Else
          'Command2_Click

          End If
End Sub
End Class


Оно компилируется и запускается И даже не падает, у меня

[Invader]

код повторяю рабочий.
Да я по быстрому убрал многое из полного примера, в котором в частности, было два пикчербокса и многое рассчитывалось из переменых rgb и прочего...
многие перемеренные по умолчанию имели значения, которые я и подставил в формулы, убрав сами переменные
вот ссылка на полный примерhttp://www.planet-source-code.com/vb/scripts/ShowCode.asp?txtCodeId=56425&lngWId=1
а здесь сам проект в zipе

Spectrum.zip

(7.66 Кб) Скачиваний: 190

меня интересовало только изменяемое значение переменой kk. Я выставил условие kk>16, значит не шум а голос.

[Qwertiy]

Я не понимаю, что ты хочешь. Я думал, переделать VB6 на VB.NET.

[Invader]

Я не понимаю, что ты хочешь. Я думал, переделать VB6 на VB.NET.

ну да, мне нуна код на vb по оценки уровня громкости с микрофона
в моей готовой программе с помощью платной библиотеки, было реализовано запись с последующей конвертацией и сохранением звукового файла.
запись начинается с момента нажатия кнопки старт, и прекращается при нажатие кнопки стоп.
В программе есть уровень шума если задержка 0,4 секунды - стоп нажата
следующую запись надо начинать с очередного нажатия старт.
на vb.net по работе с потоком данных из микрофона ни чего в сети нет, есть на С# но не выгружается и ошибки с памятью, да и конвертируется с проблемами.
нашёл на vb6, программа производит: БПФурье, рисует спектр, лишнее убрал, то что осталось меня устраивает, но не могу правильно сконвертировать в VB.NET

[Qwertiy]

Ты мой код смотрел?

[Invader]

Ты мой код смотрел?

где ты отобразил код на vb6?
вставив его vb.net всё теже проблемы
Тип переменной "curSample" не будет определен, так как она связана с полем во внешней области видимости. Нужно изменить имя "curSample" или использовать полное имя (например, "Me.curSample" or "MyBase.curSample")

[Qwertiy]

Ты мой код смотрел?

где ты отобразил код на vb6?

Он был на vb6, я сделал на vb.net. Он компилируется запускается и не падает при условии, что звук всегда 0. Но скорее всего, он считает, что нет микрофона.

[Invader]

Я без понятия, что этот код делает и разбираться не хочу.

Попробуй что-нибудь типа:

Код: Выделить всё

Option Explicit On


Module Module1

Public Const WHDR_DONE = &H1         '  done bit

Structure WAVEHDR
   Dim lpData As Integer
   Dim dwBufferLength As Integer
   Dim dwBytesRecorded As Integer
   Dim dwUser As Integer
   Dim dwFlags As Integer
   Dim dwLoops As Integer
   Dim lpNext As Integer
   Dim Reserved As Integer
End Structure

Structure WAVEFORMAT
   Dim wFormatTag As Short
   Dim nChannels As Short
   Dim nSamplesPerSec As Integer
   Dim nAvgBytesPerSec As Integer
   Dim nBlockAlign As Short
   Dim wBitsPerSample As Short
   Dim cbSize As Short
End Structure

Declare Function GlobalAlloc Lib "kernel32" (ByVal wFlags As Integer, ByVal dwBytes As Integer) As Integer
Declare Function GlobalLock Lib "kernel32" (ByVal hmem As Integer) As Integer
Declare Function GlobalFree Lib "kernel32" (ByVal hmem As Integer) As Integer
'Declare Sub CopyStructFromPtr Lib "kernel32" Alias "RtlMoveMemory" (ByRef struct As Any, ByVal ptr As Integer, ByVal cb As Integer)
Declare Sub CopyStructFromPtr Lib "kernel32" Alias "RtlMoveMemory" (ByRef struct As Short, ByVal ptr As Integer, ByVal cb As Integer)
Declare Function waveInOpen Lib "winmm.dll" (ByRef lphWaveIn As Integer, ByVal uDeviceID As Integer, ByRef lpFormat As WAVEFORMAT, ByVal dwCallback As Integer, ByVal dwInstance As Integer, ByVal dwFlags As Integer) As Integer
Declare Function waveInStart Lib "winmm.dll" (ByVal hWaveIn As Integer) As Integer
Declare Function waveInStop Lib "winmm.dll" (ByVal hWaveIn As Integer) As Integer
Declare Function waveInAddBuffer Lib "winmm.dll" (ByVal hWaveIn As Integer, ByRef lpWaveInHdr As WAVEHDR, ByVal uSize As Integer) As Integer
Declare Function waveInReset Lib "winmm.dll" (ByVal hWaveIn As Integer) As Integer
Declare Function waveInPrepareHeader Lib "winmm.dll" (ByVal hWaveIn As Integer, ByRef lpWaveInHdr As WAVEHDR, ByVal uSize As Integer) As Integer
Declare Function waveInGetErrorText Lib "winmm.dll" Alias "waveInGetErrorTextA" (ByVal err As Integer, ByVal lpText As String, ByVal uSize As Integer) As Integer
Declare Function waveInClose Lib "winmm.dll" (ByVal hWaveIn As Integer) As Integer
Declare Function waveInUnprepareHeader Lib "winmm.dll" (ByVal hWaveIn As Integer, ByRef lpWaveInHdr As WAVEHDR, ByVal uSize As Integer) As Integer

Public i As Short, j As Short, rc As Integer, msg As String = Space$(200), hWaveIn As Integer
Public format As WAVEFORMAT
Public hmem As Integer
Public inHdr As WAVEHDR
Public Const DEVICEID = 0
Public fRecording As Boolean
Public BUFFER_SIZE As Short

'When the number of FFT points is < 512 and samplerates
'are < 22050 are used the program has to wait for input.
'A circular buffer of sufficient size may be of value
'but I don't know how to implement it.

Function StartInput() As Boolean

    If fRecording Then
        StartInput = True
        Exit Function
    End If

    format.wFormatTag = 1
    format.nChannels = 1
    format.wBitsPerSample = 16
    format.nSamplesPerSec = 48000    'Gets the sample rate from the main form
    format.nBlockAlign = format.nChannels * format.wBitsPerSample / 8
    format.nAvgBytesPerSec = format.nSamplesPerSec * format.nBlockAlign
    format.cbSize = 0

    hmem = GlobalAlloc(&H40, BUFFER_SIZE)
    inHdr.lpData = GlobalLock(hmem)
    inHdr.dwBufferLength = BUFFER_SIZE
    inHdr.dwFlags = 0
    inHdr.dwLoops = 0

    rc = waveInOpen(hWaveIn, DEVICEID, format, 0, 0, 0)
    If rc <> 0 Then
      waveInGetErrorText(rc, msg, Len(msg))
      MsgBox(msg)
      StartInput = False
      Exit Function
    End If

    rc = waveInPrepareHeader(hWaveIn, inHdr, Len(inHdr))
    If (rc <> 0) Then
       waveInGetErrorText(rc, msg, Len(msg))
       MsgBox(msg)
    End If

    rc = waveInAddBuffer(hWaveIn, inHdr, Len(inHdr))
    If (rc <> 0) Then
       waveInGetErrorText(rc, msg, Len(msg))
       MsgBox(msg)
    End If

    fRecording = True
    rc = waveInStart(hWaveIn)
    StartInput = True

End Function

' Stop receiving audio input on the soundcard
Sub StopInput()
    fRecording = False
    waveInReset(hWaveIn)
    waveInStop(hWaveIn)
    waveInUnprepareHeader(hWaveIn, inHdr, Len(inHdr))
    GlobalFree(hmem)
    waveInClose(hWaveIn)
End Sub

Sub GetMono16Sample(ByVal sample As Integer, ByRef leftVol As Double)
   Dim sample16 As Short
   Dim ptr As Integer

   ptr = sample * format.nBlockAlign + inHdr.lpData
   CopyStructFromPtr(sample16, ptr, 2)
   leftVol = sample16 / 32768

End Sub

'The following code may be from the original program author
'but it appears to be a relatively generic adaptation.
'This routine imposes a speed bottleneck when the number
'of FFT points is > 512.

'THE FAST FOURIER TRANSFORM
'Upon entry, N% contains the number of points in the DFT,
'REX[ ] and IMX[ ] contain the real and imaginary parts of the input.
'Upon return, REX[ ] and IMX[ ] contain the DFT output.
'All signals run from 0 to N-1.

Sub FFT(ByVal N As Short, ByVal REX() As Double, ByVal IMX() As Double)

    Const Pi = 3.14159
    Dim NM1 As Short
    Dim ND2 As Short
    Dim M As Short
    Dim j As Short
    Dim K As Short
    Dim L As Short
    Dim LE As Short
    Dim LE2 As Short
    Dim JM1 As Short
    Dim i As Short
    Dim IP As Short
    Dim TR As Double
    Dim TI As Double
    Dim UR As Double
    Dim UI As Double
    Dim SR As Double
    Dim SI As Double

    NM1 = N - 1
    ND2 = N / 2
    M = CInt(Math.Log(N) / Math.Log(2))
    j = ND2

    For i = 1 To N - 2                    'Bit reversal sorting
      If i >= j Then GoTo S1
      TR = REX(j)
      TI = IMX(j)
      REX(j) = REX(i)
      IMX(j) = IMX(i)
      REX(i) = TR
      IMX(i) = TI
S1:   K = ND2
S2:   If K > j Then GoTo s3
      j = j - K
      K = K / 2
      GoTo S2
s3:   j = j + K
    Next

    For L = 1 To M                          'Loop for each stage
        LE = CInt(2 ^ L)
        LE2 = LE / 2
        UR = 1
        UI = 0
        SR = Math.Cos(Pi / LE2)                 'Calculate sine & cosine values
        SI = -Math.Sin(Pi / LE2)

        For j = 1 To LE2                    'Loop for each sub DFT
             JM1 = j - 1
             For i = JM1 To NM1 Step LE     'Loop for each butterfly
                   IP = i + LE2
                   TR = REX(IP) * UR - IMX(IP) * UI   'Butterfly calculation
                   TI = REX(IP) * UI + IMX(IP) * UR
                   REX(IP) = REX(i) - TR
                   IMX(IP) = IMX(i) - TI
                   REX(i) = REX(i) + TR
                   IMX(i) = IMX(i) + TI
             Next
             TR = UR
             UR = TR * SR - UI * SI
             UI = TR * SI + UI * SR
        Next
    Next

End Sub

End Module

Код: Выделить всё

Option Explicit On

Public Class Form1


Const contrast = 6
Const gain = 6
Const SampleRate = 48000
Const bins = 2048

Dim N As Short        'Number of points in the DFT,
Dim REX() As Double     'Real part of input
Dim IMX() As Double     'Imaginary part of input
Dim ln As Single        'Vertical line # in Waterfall
Dim Volume As Double
Dim curSample As Integer

Dim brightness As Short

Dim scet As Integer


Dim fError As Boolean






Private Sub Command1_Click() Handles Command1.Click
Command1.Enabled = True
   Command2.Enabled = False
End Sub

Private Sub Command2_Click() Handles Command2.Click
Command1.Enabled = False
Command2.Enabled = True
End Sub

Private Sub Form_Activate() Handles MyBase.Activated

    N = 2048   'Number of samples must be  2^k  where k = integer > 1
    BUFFER_SIZE = 4096      'Must be at least 2 * max number of bins

    ReDim REX(N - 1)
    ReDim IMX(N - 1)

    CmdSwitch.Text = "Start"

    lblBrightness.Text = "Brightness " + Str(scrBrightness.Value)
    brightness = scrBrightness.Value

    ln = 0  'Waterfall must start at line 0

    Timer1.Interval = 1
    Timer1.Enabled = True



End Sub


Private Sub CmdSwitch_Click() Handles CmdSwitch.Click
    If CmdSwitch.Text = "Start" Then
        CmdSwitch.Text = "Freeze"
        StartInput()
    Else
        CmdSwitch.Text = "Start"
        StopInput()
    End If

End Sub



Private Sub scrBrightness_Change() Handles scrBrightness.ValueChanged
    lblBrightness.Text = "Brightness " + Str(scrBrightness.Value)
    brightness = scrBrightness.Value
End Sub

Private Sub Timer1_Timer() Handles Timer1.Tick  ' Process sound buffer if recording

    If (fRecording) Then
        If inHdr.dwFlags And WHDR_DONE Then
            rc = waveInAddBuffer(hWaveIn, inHdr, Len(inHdr))
            DrawSpectrum()
        End If

    End If

End Sub

Private Sub Form_QueryUnload() Handles MyBase.FormClosing
    If (fRecording) Then
        StopInput()
    End If
End Sub

Sub DrawSpectrum()

    'Dim Volume As Double
    'Dim curSample As Long
    Dim f As Integer, kk As Integer
    N = 2048


    For curSample = 0 To 2047
        GetMono16Sample(curSample, Volume)
        REX(curSample) = Volume

        IMX(curSample) = 0
    Next

    FFT(N, REX, IMX)


    For f = 0 To 1024
        kk = Math.Sqrt(REX(f) ^ 2) * Int((brightness * 100))
        If kk < 1 Then
            kk = 1
        End If
        kk = gain * Math.Log(kk)
         Text1.Text = CStr(kk)

    Next
    If kk > 16 Then 'StopInput

           scet = scet + 1
          Command1_Click()
          Command1.Text = CStr(scet)
          'Else
          'Command2_Click

          End If
End Sub
End Class


Оно компилируется и запускается И даже не падает, у меня

а у меня конвертируется в VB.NET с ошибками

[Qwertiy]

Тип переменной "curSample" не будет определен, так как она связана с полем во внешней области видимости. Нужно изменить имя "curSample" или использовать полное имя (например, "Me.curSample" or "MyBase.curSample")

У меня предупреждение

The type for variable 'curSample' will not be inferred because it is bound to a field in an enclosing scope. Either change the name of 'curSample', or use the fully qualified name (for example, 'Me.curSample' or 'MyBase.curSample').

Оно связано с тем, что у тебя в качестве переменной цикла используется переменная, объявленная в классе.

а у меня конвертируется в VB.NET с ошибками

Это уже vb.net!

[Qwertiy]

Если ты используешь не VS2010, то возможно (уже не помню), что обработчики событий требуют наличия соответствующих аргументов (сам присобачишь).

[Invader]

у меня VS2010
если сконвертировал, покажи на VS2010 проектом, т.к. в среде VS2010 сразу у меня много ошибок

[Qwertiy]

Invader - spectrum audio.7z

Вот :)

(39.62 Кб) Скачиваний: 205