* * *    
Главная » Статьи » Код PB

Просмотров: 6150 | Дата: 29.03.2024 | Коментарии (0)

Bass.dll библиотека (2)

Несколько рабочих примеров:





Нашел, не помню где, рабочий пример для PB4.00 - тест работы библиотеки на Bass.dll
Переделал в PB4.41
Проигрывает весь звук на компьютере.
Вывод графика звука в OpenWindowedScreen().



Вариант кода для PB4.41:

Enumeration
 #Window_0
 #file
EndEnumeration

IncludeFile "bass.pbi"

ExamineDesktops()
XRES =DesktopWidth(0)/2
YRES =255

Dim fft.f(1028)


Procedure Dummy(Handle,*buf,*len,user)
 Delay(1)
 ProcedureReturn #True; // continue recording
EndProcedure

InitMouse()
InitKeyboard()
InitSprite()


OpenWindow(#Window_0, 0, 0, XRES-10, YRES, "Bass_dll-Test", #PB_Window_SystemMenu | #PB_Window_MinimizeGadget |#PB_Window_SizeGadget|#PB_Window_MaximizeGadget| #PB_Window_TitleBar)
OpenWindowedScreen(WindowID(#Window_0),0,0,XRES/2,YRES,1,0,0)
SetFrameRate(100)


BASS_Init(-1, 44100, 0, WindowID(#Window_0), #Null)
BASS_RecordInit(#True)
Handle = BASS_RecordStart(44100, 2, 0, @Dummy(),0) 

CreateImage(0,XRES/2,YRES)

Repeat
Event=WindowEvent()
ExamineKeyboard() 
FlipBuffers()
 
BASS_ChannelGetData(Handle,@fft.f(),#BASS_DATA_FFT2048)

ClearScreen(0)
 StartDrawing(ImageOutput(0))
 Box(0,0,XRES*2,YRES*2,RGB(0, 0, 0))
 NextPoint=0 : frun=1
 For x=1 To XRES-1 Step 2
 If NextPoint=2
 If frun= 1 Or x=XRES/2-1
 LineXY(X1,yres-60,x,(yres-60)-Abs((fft(x)*8000))/2,$FFFFFF)
 frun=0
 Else
 LineXY(X1,Y1,x,(yres-60)-Abs((fft(x)*8000))/2,$FFFFFF)
 EndIf
 X1 = x
 Y1 = (yres-60)-Abs((fft(x)*8000))/2 
 NextPoint=0
 ElseIf NextPoint=0
 X1 = x
 Y1 = (yres-60)-Abs((fft(x)*8000))/2
 EndIf
 NextPoint = NextPoint + 1
 Next 
 X1=0 : Y1=0
 StopDrawing()
 
 
 StartDrawing(ScreenOutput())
 DrawImage(ImageID(0),0,0,Xres/2,Yres)
 StopDrawing()

Delay(20)
Until Event = #PB_Event_CloseWindow
;


Все нужные файлы на странице...



Пример 2



IncludeFile "bass.pbi"

CompilerIf #PB_Compiler_Unicode
 #UNICODE=#BASS_Unicode
CompilerElse
 #UNICODE=0
CompilerEndIf

Global Handle
Global Event

#SPECWIDTH = 368
#SPECHEIGHT = 127
#TIME_PERIODIC = 1
#MainWin=0

Structure BITMAPINFO256
 bmiHeader.BITMAPINFOHEADER
 bmiColors.RGBQUAD[256]
EndStructure

Global specpos = 0, specmode = 1
Global bh.BITMAPINFO256
Global Dim specbuf.b(#SPECWIDTH*(#SPECHEIGHT+1))

;' create bitmap to draw spectrum in - 8 bit for easy updating :)
With bh\bmiHeader
 \biBitCount = 8
 \biPlanes = 1
 \biSize = SizeOf(BITMAPINFOHEADER)
 \biWidth = #SPECWIDTH
 \biHeight = #SPECHEIGHT
 \biClrUsed = 256
 \biClrImportant = 256
EndWith

;' setup palette
For a = 1 To 127
 bh\bmiColors[a]\rgbGreen = 256 - 2 * a
 bh\bmiColors[a]\rgbRed = 2 * a
Next a
For a = 0 To 31
 bh\bmiColors[128 + a]\rgbBlue = 8 * a
 bh\bmiColors[128 + 32 + a]\rgbBlue = 255
 bh\bmiColors[128 + 32 + a]\rgbRed = 8 * a
 bh\bmiColors[128 + 64 + a]\rgbRed = 255
 bh\bmiColors[128 + 64 + a]\rgbBlue = 8 * (31 - a)
 bh\bmiColors[128 + 64 + a]\rgbGreen = 8 * a
 bh\bmiColors[128 + 96 + a]\rgbRed = 255
 bh\bmiColors[128 + 96 + a]\rgbGreen = 255
 bh\bmiColors[128 + 96 + a]\rgbBlue = 8 * a
Next a

Enumeration 
 ;PLAY GADGETS 
 #BG_Play 
 #BG_Pause 
 #BG_Stop 
 #BG_Load
 #BG_Next
EndEnumeration 

Procedure IIF(expr,y,n)
If expr
 ProcedureReturn y
Else
 ProcedureReturn n
EndIf
EndProcedure

Procedure UpdateSpectrum()

 Define x.l, y.l, y1.l

 Dim FFT.f(1024) 

 BASS_ChannelGetData(Handle,@FFT(),#BASS_DATA_FFT2048)

 Select specmode
 Case 0
 Dim specbuf(#SPECWIDTH * (#SPECHEIGHT + 1)) ;' clear display
 For x = 0 To (#SPECWIDTH/2)-1
 Y = Sqr(fft(X + 1)) * 3 * #SPECHEIGHT - 4 ; scale it (sqrt to make low values more visible)
 ; Y = fft(X + 1) * 10 * #SPECHEIGHT ; scale it (linearly)
 
 If Y>#SPECHEIGHT : Y=#SPECHEIGHT : EndIf
 If X
 y1 = (Y + y1) / 2
 y1 = y1 - 1
 While (y1 >= 0)
 ind=y1 * #SPECWIDTH + X * 2 - 1
 specbuf(ind) = y1 + 1
 y1 = y1 - 1
 Wend
 EndIf
 y1 = Y
 Y = Y - 1
 While (Y >= 0)
 ind=Y * #SPECWIDTH + X * 2
 specbuf(ind) = Y + 1
 Y = Y - 1
 Wend
 Next X
 Case 1
 Dim specbuf(#SPECWIDTH * (#SPECHEIGHT + 1)) ; clear display
 Define b0.l, BANDS.i
 b0 = 0
 BANDS = 21
 Define sc.l, b1.l, sum.f
 For X = 0 To BANDS
 sum = 0
 b1 = Pow(2, X * 10.0 / BANDS )
 If (b1 > 1023) : b1 = 1023 : EndIf
 If (b1 <= b0) : b1 = b0 + 1 : EndIf; make sure it uses at least 1 FFT bin
 sc = 10 + b1 - b0
 Repeat
 sum = sum + fft(1 + b0)
 b0 = b0 + 1
 Until b0 >= b1
 Y = (Sqr(sum / Log10(sc)) * 1.7 * #SPECHEIGHT) - 4 ;' scale it
 If Y > #SPECHEIGHT : Y = #SPECHEIGHT : EndIf;' cap it
 Y = Y - 1
 While Y >= 0
 FillMemory(@specbuf(Y * #SPECWIDTH + X * Int(#SPECWIDTH / BANDS)), #SPECWIDTH / BANDS - 2, Y + 1)
 Y = Y - 1
 Wend
 Next X
 Case 2
 For X = 0 To #SPECHEIGHT - 1
 Y = Sqr(fft(X + 1)) * 3 * 127 ;' scale it (sqrt to make low values more visible)
 If (Y > 127) : Y = 127 : EndIf;' cap it
 specbuf(X * #SPECWIDTH + specpos) = 128 + Y ;' plot it
 Next X
 ;' move marker onto next position
 specpos = (specpos + 1) % #SPECWIDTH
 For X = 0 To #SPECHEIGHT - 1
 specbuf(X * #SPECWIDTH + specpos) = 255
 Next X
 Case 3
 Dim buf.f(0)
 Define c.l, ci.BASS_CHANNELINFO
 Dim specbuf(#SPECWIDTH * (#SPECHEIGHT + 1))
 
 BASS_ChannelGetInfo(Handle, @ci)
 Dim buf(ci\chans * #SPECWIDTH * 4)
 
 BASS_ChannelGetData(Handle, @buf(0), (ci\chans * #SPECWIDTH * 4) | #BASS_DATA_FLOAT)
 For c = 0 To ci\chans - 1
 For X = 0 To #SPECWIDTH - 1
 v.l = (1 - buf(X * ci\chans + c)) * #SPECHEIGHT / 2
 If (v < 0)
 v = 0
 ElseIf (v >= #SPECHEIGHT) 
 v = #SPECHEIGHT - 1
 EndIf
 If (X = 0) : Y = v : EndIf
 Repeat
 If (Y < v)
 Y = Y + 1
 ElseIf (Y > v)
 Y = Y - 1
 EndIf
 specbuf(Y * #SPECWIDTH + X) = IIf(c And 1, 127, 1)
 Until (Y = v)
 Next X
 Next c
 
 EndSelect

 SetDIBitsToDevice_(GetDC_(WindowID(0)), 0, 0, #SPECWIDTH, #SPECHEIGHT, 0, 0, 0, #SPECHEIGHT, @specbuf(0), @bh, 0)
EndProcedure

Procedure Loadfile()
 FileName.s = OpenFileRequester("","","*.*|*.*",0) 
 If FileName 
 Handle=BASS_StreamCreateFile(0, @FileName, 0, 0, #UNICODE) 
 BASS_SetVolume(100) 
 BASS_ChannelPlay(Handle,0) 
 EndIf 
EndProcedure

#T_Update = 1
;- START
If OpenWindow(0,50,50,#SPECWIDTH,#SPECHEIGHT+35,"BASS Spectrum example")

 ButtonGadget(#BG_Load,50,#SPECHEIGHT+5,50,25,"Load")
 ButtonGadget(#BG_Stop,100,#SPECHEIGHT+5,50,25,"Stop")
 ButtonGadget(#BG_Play,150,#SPECHEIGHT+5,50,25,"Play")
 ButtonGadget(#BG_Pause,200,#SPECHEIGHT+5,50,25,"Pause")
 ButtonGadget(#BG_Next,250,#SPECHEIGHT+5,70,25,"Spectrum")

 AddWindowTimer(#MainWin, #T_Update, 25)
 BASS_Init(-1, 44100, 0, WindowID(#MainWin), #Null)

 loadfile()

 Repeat
 Event=WaitWindowEvent(10)
 Select Event
 Case #PB_Event_Gadget 
 Select EventGadget() 
 Case #BG_Load 
 BASS_StreamFree(Handle)
 Loadfile()
 Case #BG_Play 
 BASS_ChannelPlay(Handle,0) 
 Case #BG_Pause 
 BASS_ChannelPause(Handle) 
 Case #BG_Stop 
 BASS_ChannelStop(Handle) 
 BASS_ChannelSetPosition(Handle,0,#BASS_POS_BYTE) 
 Case #BG_Next 
 specmode=(specmode+1)%4
 EndSelect 
 Case #PB_Event_Timer
 Select EventTimer()
 Case #T_Update
 UpdateSpectrum()
 EndSelect
 EndSelect
 Until Event=#PB_Event_CloseWindow 
EndIf
BASS_Free()
End
;












Сайт посвящён языку программирования PureBasic — коммерческий компилятор языка программирования, использующего синтаксис BASIC. Предназначен для создания кроссплатформенных приложений для AmigaOS, Linux, Microsoft Windows, Windows NT и Mac OS X. Разработан компанией Fantaisie Software.