VPF::SetDIBitsToDevice - Форум программистов

Vano-K

Дата 3.2.2009, 22:42 (ссылка)

(нет голосов)

Загрузка ...

Шустрый

Профиль
Группа: Участник
Сообщений: 58
Регистрация: 4.4.2003
Где: Украина, Днепропе тровск

Репутация: нет
Всего: нет

Подскажите пожалуйста есть такая вот строка

Код


Call SetDIBitsToDevice(Picture1.hdc, 0, 0, 512, 127, 0, 0, 0, 127, specbuf(0), bh, 0)

В результате рисуется спектр звука в Picture1, но мне надо получить значения а не рисунок(нарисовать тот же самый спектр но, допустим, вот таким вот образом Picture1.Line (i * 15, 0)-(i * 15, spectrum(i))), подскажите как.

specbuf(0) ето массив, но в нем хранятся 0 и 1, каким образом рисуется спектр я не могу понять... bh - это что то с цветовой палитрой связанно, как я понял.

На всякий случай вот весь модуль:

Код


Option Explicit

Public Const BI_RGB = 0&
Public Const DIB_RGB_COLORS = 0&    'color table in RGBs

Public Type BITMAPINFOHEADER
        biSize As Long
        biWidth As Long
        biHeight As Long
        biPlanes As Integer
        biBitCount As Integer
        biCompression As Long
        biSizeImage As Long
        biXPelsPerMeter As Long
        biYPelsPerMeter As Long
        biClrUsed As Long
        biClrImportant As Long
End Type

Public Type RGBQUAD
        rgbBlue As Byte
        rgbGreen As Byte
        rgbRed As Byte
        rgbReserved As Byte
End Type

Public Type BITMAPINFO
        bmiHeader As BITMAPINFOHEADER
        bmiColors(512) As RGBQUAD
End Type

Declare Sub FillMemory Lib "kernel32.dll" Alias "RtlFillMemory" (Destination As Any, ByVal length As Long, ByVal Fill As Byte)
Public Declare Function SetDIBitsToDevice Lib "gdi32" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long, _
   ByVal dx As Long, ByVal dy As Long, ByVal SrcX As Long, ByVal SrcY As Long, ByVal Scan As Long, _
   ByVal NumScans As Long, Bits As Any, BitsInfo As BITMAPINFO, ByVal wUsage As Long) As Long

Public Const SPECWIDTH As Long = 512  ' display width
Public Const SPECHEIGHT As Long = 127 ' height (changing requires palette adjustments too)
Public specmode As Integer, specpos As Integer  ' spectrum mode (and marker pos for 2nd mode)
Public specbuf() As Byte    ' a pointer

Public chan As Long         ' recording channel

Public bh As BITMAPINFO     ' bitmap header

' MATH Functions
Public Function Sqrt(ByVal num As Double) As Double
    Sqrt = num ^ 0.5
End Function


' update the spectrum display - the interesting bit :)
Public Sub UpdateSpectrum()
    Static quietcount As Integer
    Dim X As Long, Y As Long, Y1 As Long

        Dim fft(1024) As Single     ' get the FFT data
        Call BASS_ChannelGetData(chan, fft(0), BASS_DATA_FFT2048)
        
        If (specmode = 0) Then   ' "normal" FFT
            ReDim specbuf(SPECWIDTH * (SPECHEIGHT + 1)) As Byte  ' clear display

            For X = 0 To (SPECWIDTH / 2) - 1
#If 1 Then
                Y = Sqrt(fft(X + 1)) * 3 * SPECHEIGHT - 4 ' scale it (sqrt to make low values more visible)
#Else
                Y = fft(X + 1) * 10 * SPECHEIGHT ' scale it (linearly)
#End If
                If (Y > SPECHEIGHT) Then Y = SPECHEIGHT 'cap it
                If (X) Then  ' interpolate from previous to make the display smoother
                    Y1 = (Y + Y1) / 2
                    Y1 = Y1 - 1
                    While (Y1 >= 0)
                        specbuf(Y1 * SPECWIDTH + X * 2 - 1) = Y1 + 1
                        Y1 = Y1 - 1

                    Wend
                End If
                Y1 = Y
                Y = Y - 1
                While (Y >= 0)
                    specbuf(Y * SPECWIDTH + X * 2) = Y + 1 ' draw level
                    Y = Y - 1
                Wend
            Next X
            frmLiveSpec.Text1.Text = ""
        End If
Dim i As Integer

    ' update the display
    ' to display in a PictureBox, simply change the .hDC to Picture1.hDC :)
    Call SetDIBitsToDevice(frmLiveSpec.Picture1.hdc, 0, 0, 512, 127, 0, 0, 0, 127, specbuf(0), bh, 0)

frmLiveSpec.Picture2.Cls
For i = 0 To SPECWIDTH
    frmLiveSpec.Picture2.Line (i, 0)-(i, specbuf(i) * 150)
    frmLiveSpec.Label1(i).Caption = bh
Next i

    If (LoWord(BASS_ChannelGetLevel(chan)) < 500) Then ' check if it's quiet
        quietcount = quietcount + 1
        If (quietcount > 40 And (quietcount And 16)) Then ' it's been quiet for over a second
                frmLiveSpec.Text1.Text = "тишина"
        End If
    Else
        quietcount = 0 ' not quiet
    End If
End Sub

Это сообщение отредактировал(а) Akina - 3.2.2009, 22:55

Akina

Дата 3.2.2009, 22:54 (ссылка)

(нет голосов)

Загрузка ...

Советчик

Профиль
Группа: Модератор
Сообщений: 20581
Регистрация: 8.4.2004
Где: Зеленоград

Репутация: 34
Всего: 454

Цитата(Vano-K @ 3.2.2009, 23:42

)

specbuf(0) ето массив, но в нем хранятся 0 и 1, каким образом рисуется спектр я не могу понять...

Заполнение массива спектра выполняется в строках 63-85. Вот и разбирайтесь, что там вычисляется.

--------------------

О(б)суждение моих действий - в соответствующей теме, пожалуйста. Или в РМ. И высшая инстанция - Администрация форума.

Vano-K

Дата 3.2.2009, 23:06 (ссылка)

(нет голосов)

Загрузка ...

Шустрый

Америку мне конечно не открыли, это я и сам понял, что все происходит в цикле, но всеравно спасибо

Akina

Дата 3.2.2009, 23:20 (ссылка)

(нет голосов)

Загрузка ...

Советчик

Профиль
Группа: Модератор
Сообщений: 20581
Регистрация: 8.4.2004
Где: Зеленоград

Репутация: 34
Всего: 454

А за открытием Америк следует обращаться в специализированные форумы по работе со звуком. Мультимедиа, алгоритмы, форматы и так далее.

--------------------

0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема \| VB6 \| Следующая тема »