powered by simpleCommunicator - 2.0.53     © 2025 Programmizd 02
Форумы / Visual Basic [игнор отключен] [закрыт для гостей] / Перехват потока Звука
12 сообщений из 12, страница 1 из 1
Перехват потока Звука
    #35134248
Фотография Maks_mDavem
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Добрые люди помогите сообразить чайнику!!

Задача: необхоодимо построить эквлайзер на форме, не зависимо какой плеер играет, вобщем перехватить поток!
...
Рейтинг: 0 / 0
Перехват потока Звука
    #35134258
Фотография Maks_mDavem
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Вот нашол чтото подобное но не знаю с какой стороны подойти!

Audio-sampling Prerelease 4. Небольшая библиотека для C Builder 3/4/5, а именно набор из трех компонент, которые умеют захватывать звук с какого-либо источника, производить БПФ, и выводить на экран спектры 3-х различных типов. Описание: readme.html
...
Рейтинг: 0 / 0
Период между сообщениями больше года.
Перехват потока Звука
    #36624972
Фотография Андрей159
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
с bass.dll там все просто
...
Рейтинг: 0 / 0
Перехват потока Звука
    #36625458
Фотография Андрей159
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Вот лекарство к этой библиотеке
Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
39.
40.
41.
42.
43.
44.
45.
46.
47.
48.
49.
50.
51.
52.
53.
54.
55.
56.
57.
58.
59.
60.
61.
62.
63.
64.
65.
66.
67.
68.
69.
70.
71.
72.
73.
74.
75.
76.
77.
78.
79.
80.
81.
82.
83.
84.
85.
86.
87.
88.
89.
90.
91.
92.
93.
94.
95.
96.
97.
98.
99.
100.
101.
102.
103.
104.
105.
106.
107.
108.
109.
110.
111.
112.
113.
114.
115.
116.
117.
118.
119.
120.
121.
122.
123.
124.
125.
126.
127.
128.
129.
130.
131.
132.
133.
134.
135.
136.
137.
138.
139.
140.
141.
142.
143.
144.
145.
146.
147.
148.
149.
150.
151.
152.
153.
154.
155.
156.
157.
158.
159.
160.
161.
162.
163.
164.
165.
166.
167.
168.
169.
170.
171.
172.
173.
174.
175.
176.
177.
178.
179.
180.
181.
182.
183.
184.
185.
186.
187.
188.
189.
190.
191.
192.
193.
194.
195.
196.
197.
198.
199.
200.
201.
202.
203.
204.
205.
206.
207.
208.
209.
210.
211.
212.
213.
214.
215.
216.
217.
218.
219.
220.
221.
222.
223.
224.
225.
226.
227.
228.
229.
230.
231.
232.
233.
234.
235.
236.
237.
238.
239.
240.
241.
242.
243.
244.
245.
246.
247.
248.
249.
250.
251.
252.
253.
254.
255.
256.
257.
258.
259.
260.
261.
262.
263.
264.
265.
266.
267.
268.
269.
270.
271.
272.
273.
274.
275.
276.
277.
278.
279.
280.
281.
282.
283.
284.
285.
286.
287.
288.
289.
290.
291.
292.
293.
294.
295.
296.
297.
298.
299.
300.
301.
302.
303.
304.
305.
306.
307.
308.
309.
310.
311.
312.
313.
314.
315.
316.
317.
318.
319.
320.
321.
322.
323.
324.
325.
326.
327.
328.
329.
330.
331.
332.
333.
334.
335.
336.
337.
338.
339.
340.
341.
342.
343.
344.
345.
346.
347.
348.
349.
350.
351.
352.
353.
354.
355.
356.
357.
358.
359.
360.
361.
362.
363.
364.
365.
366.
367.
368.
369.
370.
371.
372.
373.
374.
375.
376.
377.
378.
379.
380.
381.
382.
383.
384.
385.
386.
387.
388.
389.
390.
391.
392.
393.
394.
395.
396.
397.
398.
399.
400.
401.
402.
403.
404.
405.
406.
407.
408.
409.
410.
411.
412.
413.
414.
415.
416.
417.
418.
419.
420.
421.
422.
423.
424.
425.
426.
427.
428.
429.
430.
431.
432.
433.
434.
435.
436.
437.
438.
439.
440.
441.
442.
443.
444.
445.
446.
447.
448.
449.
450.
451.
452.
453.
454.
455.
456.
457.
458.
459.
460.
461.
462.
463.
464.
465.
466.
467.
468.
469.
470.
471.
472.
473.
474.
475.
476.
477.
478.
479.
480.
481.
482.
483.
484.
485.
486.
487.
488.
489.
490.
491.
492.
493.
494.
495.
496.
497.
498.
499.
500.
501.
502.
503.
504.
505.
506.
507.
508.
509.
510.
511.
512.
513.
514.
515.
516.
517.
518.
519.
520.
521.
522.
523.
524.
525.
526.
527.
528.
529.
530.
531.
532.
533.
534.
535.
536.
537.
538.
539.
540.
541.
542.
543.
544.
545.
546.
547.
548.
549.
550.
551.
552.
553.
554.
555.
556.
557.
558.
559.
560.
561.
562.
563.
564.
565.
566.
567.
568.
569.
570.
571.
572.
573.
574.
575.
576.
577.
578.
579.
580.
581.
582.
583.
584.
585.
586.
587.
588.
589.
590.
591.
592.
593.
594.
595.
596.
597.
598.
599.
600.
601.
602.
603.
604.
605.
606.
607.
608.
609.
610.
611.
612.
613.
614.
615.
616.
617.
618.
619.
620.
621.
622.
623.
624.
625.
626.
627.
628.
629.
630.
631.
632.
633.
634.
635.
636.
637.
638.
639.
640.
641.
642.
643.
644.
645.
646.
647.
648.
649.
650.
651.
652.
653.
654.
655.
656.
657.
658.
659.
660.
661.
662.
663.
664.
665.
666.
667.
668.
669.
670.
671.
672.
673.
674.
675.
676.
677.
678.
679.
680.
681.
682.
683.
684.
685.
686.
687.
688.
689.
690.
691.
692.
693.
694.
695.
696.
697.
698.
699.
700.
701.
702.
703.
704.
705.
706.
707.
708.
709.
710.
711.
712.
713.
714.
715.
716.
717.
718.
719.
720.
721.
722.
723.
724.
725.
726.
727.
728.
729.
730.
731.
732.
733.
734.
735.
736.
737.
738.
739.
740.
741.
742.
743.
744.
745.
746.
747.
748.
749.
750.
751.
752.
753.
754.
755.
756.
757.
758.
759.
760.
761.
762.
763.
764.
765.
766.
767.
768.
769.
770.
771.
772.
773.
774.
775.
776.
777.
778.
779.
780.
781.
782.
783.
784.
785.
786.
787.
788.
789.
790.
791.
792.
793.
794.
795.
796.
797.
798.
799.
800.
801.
802.
803.
804.
805.
806.
807.
808.
809.
810.
811.
812.
813.
814.
815.
816.
817.
818.
819.
820.
821.
822.
823.
824.
825.
826.
827.
828.
829.
830.
831.
832.
833.
834.
835.
836.
837.
838.
839.
840.
841.
842.
843.
844.
845.
846.
847.
848.
849.
850.
851.
852.
853.
854.
855.
856.
857.
858.
859.
860.
861.
862.
863.
864.
865.
866.
867.
868.
869.
870.
871.
872.
873.
874.
875.
876.
877.
878.
879.
880.
881.
882.
883.
884.
885.
886.
887.
888.
889.
890.
891.
892.
893.
894.
895.
896.
897.
898.
899.
900.
901.
902.
903.
904.
905.
906.
907.
908.
909.
910.
911.
912.
913.
914.
915.
916.
917.
918.
919.
920.
921.
922.
923.
924.
925.
926.
927.
928.
929.
930.
931.
932.
933.
934.
935.
936.
937.
938.
939.
940.
941.
942.
943.
944.
945.
946.
947.
948.
949.
950.
951.
952.
953.
954.
955.
956.
957.
958.
959.
960.
961.
962.
963.
964.
965.
966.
967.
968.
969.
970.
971.
972.
'BASS 2.3 Visual Basic API, (c) 1999-2006 Ian Luck.
'Please report bugs/suggestions/etc... to bass@un4seen.com

'See the BASS.CHM file for detailed documentation

'NOTE: VB does not support 64-bit integers, so VB users only have access
'      to the low 32-bits of 64-bit return values. 64-bit parameters can
'      be specified though, using the "64" version of the function.

'NOTE: Use the VBStrFromAnsiPtr function to convert "char *" to VB "String".

Global Const BASSVERSION = &H203    'API version

Global Const BASSTRUE As Long =  1    'Use this instead of VB Booleans
Global Const BASSFALSE As Long =  0   'Use this instead of VB Booleans

'***********************************************
'* Error codes returned by BASS_ErrorGetCode() *
'***********************************************
Global Const BASS_OK =  0                'all is OK
Global Const BASS_ERROR_MEM =  1         'memory error
Global Const BASS_ERROR_FILEOPEN =  2    'can't open the file
Global Const BASS_ERROR_DRIVER =  3      'can't find a free sound driver
Global Const BASS_ERROR_BUFLOST =  4     'the sample buffer was lost
Global Const BASS_ERROR_HANDLE =  5      'invalid handle
Global Const BASS_ERROR_FORMAT =  6      'unsupported sample format
Global Const BASS_ERROR_POSITION =  7    'invalid playback position
Global Const BASS_ERROR_INIT =  8        'BASS_Init has not been successfully called
Global Const BASS_ERROR_START =  9       'BASS_Start has not been successfully called
Global Const BASS_ERROR_ALREADY =  14    'already initialized/paused/whatever
Global Const BASS_ERROR_NOPAUSE =  16    'not paused
Global Const BASS_ERROR_NOCHAN =  18     'can't get a free channel
Global Const BASS_ERROR_ILLTYPE =  19    'an illegal type was specified
Global Const BASS_ERROR_ILLPARAM =  20   'an illegal parameter was specified
Global Const BASS_ERROR_NO3D =  21       'no 3D support
Global Const BASS_ERROR_NOEAX =  22      'no EAX support
Global Const BASS_ERROR_DEVICE =  23     'illegal device number
Global Const BASS_ERROR_NOPLAY =  24     'not playing
Global Const BASS_ERROR_FREQ =  25       'illegal sample rate
Global Const BASS_ERROR_NOTFILE =  27    'the stream is not a file stream
Global Const BASS_ERROR_NOHW =  29       'no hardware voices available
Global Const BASS_ERROR_EMPTY =  31      'the MOD music has no sequence data
Global Const BASS_ERROR_NONET =  32      'no internet connection could be opened
Global Const BASS_ERROR_CREATE =  33     'couldn't create the file
Global Const BASS_ERROR_NOFX =  34       'effects are not available
Global Const BASS_ERROR_PLAYING =  35    'the channel is playing
Global Const BASS_ERROR_NOTAVAIL =  37   'requested data is not available
Global Const BASS_ERROR_DECODE =  38     'the channel is a "decoding channel"
Global Const BASS_ERROR_DX =  39         'a sufficient DirectX version is not installed
Global Const BASS_ERROR_TIMEOUT =  40    'connection timedout
Global Const BASS_ERROR_FILEFORM =  41   'unsupported file format
Global Const BASS_ERROR_SPEAKER =  42    'unavailable speaker
Global Const BASS_ERROR_VERSION =  43    'invalid BASS version (used by add-ons)
Global Const BASS_ERROR_CODEC =  44      'codec is not available/supported
Global Const BASS_ERROR_UNKNOWN = - 1    'some other mystery error

'************************
'* Initialization flags *
'************************
Global Const BASS_DEVICE_8BITS =  1      'use 8 bit resolution, else 16 bit
Global Const BASS_DEVICE_MONO =  2       'use mono, else stereo
Global Const BASS_DEVICE_3D =  4         'enable 3D functionality
' If the BASS_DEVICE_3D flag is not specified when initilizing BASS,
' then the 3D flags (BASS_SAMPLE_3D and BASS_MUSIC_3D) are ignored when
' loading/creating a sample/stream/music.
Global Const BASS_DEVICE_LATENCY =  256  'calculate device latency (BASS_INFO struct)
Global Const BASS_DEVICE_SPEAKERS =  2048  'force enabling of speaker assignment
Global Const BASS_DEVICE_NOSPEAKER =  4096  'ignore speaker arrangement

'***********************************
'* BASS_INFO flags (from DSOUND.H) *
'***********************************
Global Const DSCAPS_CONTINUOUSRATE =  16 
' supports all sample rates between min/maxrate
Global Const DSCAPS_EMULDRIVER =  32 
' device does NOT have hardware DirectSound support
Global Const DSCAPS_CERTIFIED =  64 
' device driver has been certified by Microsoft
' The following flags tell what type of samples are supported by HARDWARE
' mixing, all these formats are supported by SOFTWARE mixing
Global Const DSCAPS_SECONDARYMONO =  256     ' mono
Global Const DSCAPS_SECONDARYSTEREO =  512   ' stereo
Global Const DSCAPS_SECONDARY8BIT =  1024    ' 8 bit
Global Const DSCAPS_SECONDARY16BIT =  2048   ' 16 bit

'*****************************************
'* BASS_RECORDINFO flags (from DSOUND.H) *
'*****************************************
Global Const DSCCAPS_EMULDRIVER = DSCAPS_EMULDRIVER
' device does NOT have hardware DirectSound recording support
Global Const DSCCAPS_CERTIFIED = DSCAPS_CERTIFIED
' device driver has been certified by Microsoft

'******************************************************************
'* defines for formats field of BASS_RECORDINFO (from MMSYSTEM.H) *
'******************************************************************
Global Const WAVE_FORMAT_1M08 = &H1          ' 11.025 kHz, Mono,   8-bit
Global Const WAVE_FORMAT_1S08 = &H2          ' 11.025 kHz, Stereo, 8-bit
Global Const WAVE_FORMAT_1M16 = &H4          ' 11.025 kHz, Mono,   16-bit
Global Const WAVE_FORMAT_1S16 = &H8          ' 11.025 kHz, Stereo, 16-bit
Global Const WAVE_FORMAT_2M08 = &H10         ' 22.05  kHz, Mono,   8-bit
Global Const WAVE_FORMAT_2S08 = &H20         ' 22.05  kHz, Stereo, 8-bit
Global Const WAVE_FORMAT_2M16 = &H40         ' 22.05  kHz, Mono,   16-bit
Global Const WAVE_FORMAT_2S16 = &H80         ' 22.05  kHz, Stereo, 16-bit
Global Const WAVE_FORMAT_4M08 = &H100        ' 44.1   kHz, Mono,   8-bit
Global Const WAVE_FORMAT_4S08 = &H200        ' 44.1   kHz, Stereo, 8-bit
Global Const WAVE_FORMAT_4M16 = &H400        ' 44.1   kHz, Mono,   16-bit
Global Const WAVE_FORMAT_4S16 = &H800        ' 44.1   kHz, Stereo, 16-bit

'*********************
'* Sample info flags *
'*********************
Global Const BASS_SAMPLE_8BITS =  1           ' 8 bit
Global Const BASS_SAMPLE_FLOAT =  256         ' 32-bit floating-point
Global Const BASS_SAMPLE_MONO =  2            ' mono, else stereo
Global Const BASS_SAMPLE_LOOP =  4            ' looped
Global Const BASS_SAMPLE_3D =  8              ' 3D functionality enabled
Global Const BASS_SAMPLE_SOFTWARE =  16       ' it's NOT using hardware mixing
Global Const BASS_SAMPLE_MUTEMAX =  32        ' muted at max distance (3D only)
Global Const BASS_SAMPLE_VAM =  64            ' uses the DX7 voice allocation & management
Global Const BASS_SAMPLE_FX =  128            ' old implementation of DX8 effects are enabled
Global Const BASS_SAMPLE_OVER_VOL = &H10000 ' override lowest volume
Global Const BASS_SAMPLE_OVER_POS = &H20000 ' override longest playing
Global Const BASS_SAMPLE_OVER_DIST = &H30000 ' override furthest from listener (3D only)

Global Const BASS_STREAM_PRESCAN = &H20000   ' enable pin-point seeking (MP3/MP2/MP1)
Global Const BASS_MP3_SETPOS = BASS_STREAM_PRESCAN
Global Const BASS_STREAM_AUTOFREE = &H40000 ' automatically free the stream when it stop/ends
Global Const BASS_STREAM_RESTRATE = &H80000 ' restrict the download rate of internet file streams
Global Const BASS_STREAM_BLOCK = &H100000   ' download/play internet file stream in small blocks
Global Const BASS_STREAM_DECODE = &H200000  ' don't play the stream, only decode (BASS_ChannelGetData)
Global Const BASS_STREAM_STATUS = &H800000  ' give server status info (HTTP/ICY tags) in DOWNLOADPROC

Global Const BASS_MUSIC_FLOAT = BASS_SAMPLE_FLOAT ' 32-bit floating-point
Global Const BASS_MUSIC_MONO = BASS_SAMPLE_MONO ' force mono mixing (less CPU usage)
Global Const BASS_MUSIC_LOOP = BASS_SAMPLE_LOOP ' loop music
Global Const BASS_MUSIC_3D = BASS_SAMPLE_3D ' enable 3D functionality
Global Const BASS_MUSIC_FX = BASS_SAMPLE_FX ' enable old implementation of DX8 effects
Global Const BASS_MUSIC_AUTOFREE = BASS_STREAM_AUTOFREE ' automatically free the music when it stop/ends
Global Const BASS_MUSIC_DECODE = BASS_STREAM_DECODE ' don't play the music, only decode (BASS_ChannelGetData)
Global Const BASS_MUSIC_PRESCAN = BASS_STREAM_PRESCAN ' calculate playback length
Global Const BASS_MUSIC_CALCLEN = BASS_MUSIC_PRESCAN
Global Const BASS_MUSIC_RAMP = &H200        ' normal ramping
Global Const BASS_MUSIC_RAMPS = &H400       ' sensitive ramping
Global Const BASS_MUSIC_SURROUND = &H800    ' surround sound
Global Const BASS_MUSIC_SURROUND2 = &H1000  ' surround sound (mode 2)
Global Const BASS_MUSIC_FT2MOD = &H2000     ' play .MOD as FastTracker 2 does
Global Const BASS_MUSIC_PT1MOD = &H4000     ' play .MOD as ProTracker 1 does
Global Const BASS_MUSIC_NONINTER = &H10000  ' non-interpolated mixing
Global Const BASS_MUSIC_POSRESET =  32768   ' stop all notes when moving position
Global Const BASS_MUSIC_POSRESETEX = &H400000 ' stop all notes and reset bmp/etc when moving position
Global Const BASS_MUSIC_STOPBACK = &H80000  ' stop the music on a backwards jump effect
Global Const BASS_MUSIC_NOSAMPLE = &H100000 ' don't load the samples

' Speaker assignment flags
Global Const BASS_SPEAKER_FRONT = &H1000000 ' front speakers
Global Const BASS_SPEAKER_REAR = &H2000000  ' rear/side speakers
Global Const BASS_SPEAKER_CENLFE = &H3000000 ' center & LFE speakers (5.1)
Global Const BASS_SPEAKER_REAR2 = &H4000000 ' rear center speakers (7.1)
Global Const BASS_SPEAKER_LEFT = &H10000000 ' modifier: left
Global Const BASS_SPEAKER_RIGHT = &H20000000 ' modifier: right
Global Const BASS_SPEAKER_FRONTLEFT = BASS_SPEAKER_FRONT Or BASS_SPEAKER_LEFT
Global Const BASS_SPEAKER_FRONTRIGHT = BASS_SPEAKER_FRONT Or BASS_SPEAKER_RIGHT
Global Const BASS_SPEAKER_REARLEFT = BASS_SPEAKER_REAR Or BASS_SPEAKER_LEFT
Global Const BASS_SPEAKER_REARRIGHT = BASS_SPEAKER_REAR Or BASS_SPEAKER_RIGHT
Global Const BASS_SPEAKER_CENTER = BASS_SPEAKER_CENLFE Or BASS_SPEAKER_LEFT
Global Const BASS_SPEAKER_LFE = BASS_SPEAKER_CENLFE Or BASS_SPEAKER_RIGHT
Global Const BASS_SPEAKER_REAR2LEFT = BASS_SPEAKER_REAR2 Or BASS_SPEAKER_LEFT
Global Const BASS_SPEAKER_REAR2RIGHT = BASS_SPEAKER_REAR2 Or BASS_SPEAKER_RIGHT

Global Const BASS_UNICODE = &H80000000

Global Const BASS_RECORD_PAUSE =  32768  ' start recording paused

'***********************************************
'* BASS_ChannelGetTags types : what's returned *
'***********************************************
Global Const BASS_TAG_ID3 =  0    'ID3v1 tags : 128 byte block
Global Const BASS_TAG_ID3V2 =  1  'ID3v2 tags : variable length block
Global Const BASS_TAG_OGG =  2    'OGG comments : array of null-terminated UTF-8 strings
Global Const BASS_TAG_HTTP =  3   'HTTP headers : array of null-terminated ANSI strings
Global Const BASS_TAG_ICY =  4    'ICY headers : array of null-terminated ANSI strings
Global Const BASS_TAG_META =  5   'ICY metadata : ANSI string
Global Const BASS_TAG_VENDOR =  9  ' OGG encoder : UTF-8 string
Global Const BASS_TAG_RIFF_INFO = &H100 'RIFF/WAVE tags : array of null-terminated ANSI strings
Global Const BASS_TAG_MUSIC_NAME = &H10000    'MOD music name : ANSI string
Global Const BASS_TAG_MUSIC_MESSAGE = &H10001     'MOD message : ANSI string
Global Const BASS_TAG_MUSIC_INST = &H10100    '+ instrument #, MOD instrument name : ANSI string
Global Const BASS_TAG_MUSIC_SAMPLE = &H10300  '+ sample #, MOD sample name : ANSI string

'********************
'* 3D channel modes *
'********************
Global Const BASS_3DMODE_NORMAL =  0 
' normal 3D processing
Global Const BASS_3DMODE_RELATIVE =  1 
' The channel's 3D position (position/velocity/orientation) are relative to
' the listener. When the listener's position/velocity/orientation is changed
' with BASS_Set3DPosition, the channel's position relative to the listener does
' not change.
Global Const BASS_3DMODE_OFF =  2 
' Turn off 3D processing on the channel, the sound will be played
' in the center.

'****************************************************
'* EAX environments, use with BASS_SetEAXParameters *
'****************************************************
Global Const EAX_ENVIRONMENT_GENERIC =  0 
Global Const EAX_ENVIRONMENT_PADDEDCELL =  1 
Global Const EAX_ENVIRONMENT_ROOM =  2 
Global Const EAX_ENVIRONMENT_BATHROOM =  3 
Global Const EAX_ENVIRONMENT_LIVINGROOM =  4 
Global Const EAX_ENVIRONMENT_STONEROOM =  5 
Global Const EAX_ENVIRONMENT_AUDITORIUM =  6 
Global Const EAX_ENVIRONMENT_CONCERTHALL =  7 
Global Const EAX_ENVIRONMENT_CAVE =  8 
Global Const EAX_ENVIRONMENT_ARENA =  9 
Global Const EAX_ENVIRONMENT_HANGAR =  10 
Global Const EAX_ENVIRONMENT_CARPETEDHALLWAY =  11 
Global Const EAX_ENVIRONMENT_HALLWAY =  12 
Global Const EAX_ENVIRONMENT_STONECORRIDOR =  13 
Global Const EAX_ENVIRONMENT_ALLEY =  14 
Global Const EAX_ENVIRONMENT_FOREST =  15 
Global Const EAX_ENVIRONMENT_CITY =  16 
Global Const EAX_ENVIRONMENT_MOUNTAINS =  17 
Global Const EAX_ENVIRONMENT_QUARRY =  18 
Global Const EAX_ENVIRONMENT_PLAIN =  19 
Global Const EAX_ENVIRONMENT_PARKINGLOT =  20 
Global Const EAX_ENVIRONMENT_SEWERPIPE =  21 
Global Const EAX_ENVIRONMENT_UNDERWATER =  22 
Global Const EAX_ENVIRONMENT_DRUGGED =  23 
Global Const EAX_ENVIRONMENT_DIZZY =  24 
Global Const EAX_ENVIRONMENT_PSYCHOTIC =  25 
' total number of environments
Global Const EAX_ENVIRONMENT_COUNT =  26 

'**********************************************************************
'* Sync types (with BASS_ChannelSetSync() "param" and SYNCPROC "data" *
'* definitions) & flags.                                              *
'**********************************************************************
Global Const BASS_SYNC_POS =  0 
' Sync when a channel reaches a position.
' param: position in bytes
' data : not used
Global Const BASS_SYNC_END =  2 
' Sync when a channel reaches the end.
' param: not used
' data : not used
Global Const BASS_SYNC_META =  4 
' Sync when metadata is received in a stream.
' param: not used
' data : pointer to the metadata
Global Const BASS_SYNC_SLIDE =  5 
' Sync when an attribute slide is completed.
' param: not used
' data : the type of slide completed (one of the BASS_SLIDE_xxx values)
Global Const BASS_SYNC_STALL =  6 
' Sync when playback has stalled.
' param: not used
' data : 0=stalled, 1=resumed
Global Const BASS_SYNC_DOWNLOAD =  7 
' Sync when downloading of an internet (or "buffered" user file) stream has ended.
' param: not used
' data : not used
Global Const BASS_SYNC_FREE =  8 
' Sync when a channel is freed.
' param: not used
' data : not used
Global Const BASS_SYNC_MUSICPOS =  10 
' Sync when a MOD music reaches an order:row position.
' param: LOWORD=order (0=first, -1=all) HIWORD=row (0=first, -1=all)
' data : LOWORD=order HIWORD=row
Global Const BASS_SYNC_MUSICINST =  1 
' Sync when an instrument (sample for the non-instrument based formats)
' is played in a MOD music (not including retrigs).
' param: LOWORD=instrument (1=first) HIWORD=note (0=c0...119=b9, -1=all)
' data : LOWORD=note HIWORD=volume (0-64)
Global Const BASS_SYNC_MUSICFX =  3 
' Sync when the "sync" effect (XM/MTM/MOD: E8x/Wxx, IT/S3M: S2x) is used.
' param: 0:data=pos, 1:data="x" value
' data : param=0: LOWORD=order HIWORD=row, param=1: "x" value
Global Const BASS_SYNC_MESSAGE = &H20000000 ' FLAG: post a Windows message (instead of callback)
' When using a window message "callback", the message to post is given in the "proc"
' parameter of BASS_ChannelSetSync, and is posted to the window specified in the BASS_Init
' call. The message parameters are: WPARAM = data, LPARAM = user.
Global Const BASS_SYNC_MIXTIME = &H40000000 ' FLAG: sync at mixtime, else at playtime
Global Const BASS_SYNC_ONETIME = &H80000000 ' FLAG: sync only once, else continuously

' BASS_ChannelIsActive return values
Global Const BASS_ACTIVE_STOPPED =  0 
Global Const BASS_ACTIVE_PLAYING =  1 
Global Const BASS_ACTIVE_STALLED =  2 
Global Const BASS_ACTIVE_PAUSED =  3 

' BASS_ChannelIsSliding return flags
Global Const BASS_SLIDE_FREQ =  1 
Global Const BASS_SLIDE_VOL =  2 
Global Const BASS_SLIDE_PAN =  4 

' BASS_ChannelGetData flags
Global Const BASS_DATA_AVAILABLE =  0          ' query how much data is buffered
Global Const BASS_DATA_FLOAT = &H40000000    ' flag: return floating-point sample data
Global Const BASS_DATA_FFT512 = &H80000000   ' 512 sample FFT
Global Const BASS_DATA_FFT1024 = &H80000001  ' 1024 FFT
Global Const BASS_DATA_FFT2048 = &H80000002  ' 2048 FFT
Global Const BASS_DATA_FFT4096 = &H80000003  ' 4096 FFT
Global Const BASS_DATA_FFT_INDIVIDUAL = &H10 ' FFT flag: FFT for each channel, else all combined
Global Const BASS_DATA_FFT_NOWINDOW = &H20   ' FFT flag: no Hanning window

' BASS_RecordSetInput flags
Global Const BASS_INPUT_OFF = &H10000
Global Const BASS_INPUT_ON = &H20000
Global Const BASS_INPUT_LEVEL = &H40000

Global Const BASS_INPUT_TYPE_MASK = &HFF000000
Global Const BASS_INPUT_TYPE_UNDEF = &H0
Global Const BASS_INPUT_TYPE_DIGITAL = &H1000000
Global Const BASS_INPUT_TYPE_LINE = &H2000000
Global Const BASS_INPUT_TYPE_MIC = &H3000000
Global Const BASS_INPUT_TYPE_SYNTH = &H4000000
Global Const BASS_INPUT_TYPE_CD = &H5000000
Global Const BASS_INPUT_TYPE_PHONE = &H6000000
Global Const BASS_INPUT_TYPE_SPEAKER = &H7000000
Global Const BASS_INPUT_TYPE_WAVE = &H8000000
Global Const BASS_INPUT_TYPE_AUX = &H9000000
Global Const BASS_INPUT_TYPE_ANALOG = &HA000000

' BASS_MusicSet/GetAttribute options
Global Const BASS_MUSIC_ATTRIB_AMPLIFY =  0 
Global Const BASS_MUSIC_ATTRIB_PANSEP =  1 
Global Const BASS_MUSIC_ATTRIB_PSCALER =  2 
Global Const BASS_MUSIC_ATTRIB_BPM =  3 
Global Const BASS_MUSIC_ATTRIB_SPEED =  4 
Global Const BASS_MUSIC_ATTRIB_VOL_GLOBAL =  5 
Global Const BASS_MUSIC_ATTRIB_VOL_CHAN = &H100 ' + channel #
Global Const BASS_MUSIC_ATTRIB_VOL_INST = &H200 ' + instrument #

' BASS_Set/GetConfig options
Global Const BASS_CONFIG_BUFFER =  0 
Global Const BASS_CONFIG_UPDATEPERIOD =  1 
Global Const BASS_CONFIG_MAXVOL =  3 
Global Const BASS_CONFIG_GVOL_SAMPLE =  4 
Global Const BASS_CONFIG_GVOL_STREAM =  5 
Global Const BASS_CONFIG_GVOL_MUSIC =  6 
Global Const BASS_CONFIG_CURVE_VOL =  7 
Global Const BASS_CONFIG_CURVE_PAN =  8 
Global Const BASS_CONFIG_FLOATDSP =  9 
Global Const BASS_CONFIG_3DALGORITHM =  10 
Global Const BASS_CONFIG_NET_TIMEOUT =  11 
Global Const BASS_CONFIG_NET_BUFFER =  12 
Global Const BASS_CONFIG_PAUSE_NOPLAY =  13 
Global Const BASS_CONFIG_NET_PREBUF =  15 
Global Const BASS_CONFIG_NET_AGENT =  16 
Global Const BASS_CONFIG_NET_PROXY =  17 
Global Const BASS_CONFIG_NET_PASSIVE =  18 
Global Const BASS_CONFIG_MP3_CODEC =  19 

' BASS_StreamGetFilePosition modes
Global Const BASS_FILEPOS_CURRENT =  0 
Global Const BASS_FILEPOS_DECODE = BASS_FILEPOS_CURRENT
Global Const BASS_FILEPOS_DOWNLOAD =  1 
Global Const BASS_FILEPOS_END =  2 
Global Const BASS_FILEPOS_START =  3 

' STREAMFILEPROC actions
Global Const BASS_FILE_CLOSE =  0 
Global Const BASS_FILE_READ =  1 
Global Const BASS_FILE_LEN =  3 
Global Const BASS_FILE_SEEK =  4 

Global Const BASS_STREAMPROC_END = &H80000000 ' end of user stream flag

'**************************************************************
'* DirectSound interfaces (for use with BASS_GetDSoundObject) *
'**************************************************************
Global Const BASS_OBJECT_DS =  1                      ' DirectSound
Global Const BASS_OBJECT_DS3DL =  2                   'IDirectSound3DListener

'******************************
'* DX7 voice allocation flags *
'******************************
' Play the sample in hardware. If no hardware voices are available then
' the "play" call will fail
Global Const BASS_VAM_HARDWARE =  1 
' Play the sample in software (ie. non-accelerated). No other VAM flags
'may be used together with this flag.
Global Const BASS_VAM_SOFTWARE =  2 

'******************************
'* DX7 voice management flags *
'******************************
' These flags enable hardware resource stealing... if the hardware has no
' available voices, a currently playing buffer will be stopped to make room for
' the new buffer. NOTE: only samples loaded/created with the BASS_SAMPLE_VAM
' flag are considered for termination by the DX7 voice management.

' If there are no free hardware voices, the buffer to be terminated will be
' the one with the least time left to play.
Global Const BASS_VAM_TERM_TIME =  4 
' If there are no free hardware voices, the buffer to be terminated will be
' one that was loaded/created with the BASS_SAMPLE_MUTEMAX flag and is beyond
' it 's max distance. If there are no buffers that match this criteria, then the
' "play" call will fail.
Global Const BASS_VAM_TERM_DIST =  8 
' If there are no free hardware voices, the buffer to be terminated will be
' the one with the lowest priority.
Global Const BASS_VAM_TERM_PRIO =  16 

'**********************************************************************
'* software 3D mixing algorithm modes (used with BASS_Set3DAlgorithm) *
'**********************************************************************
' default algorithm (currently translates to BASS_3DALG_OFF)
Global Const BASS_3DALG_DEFAULT =  0 
' Uses normal left and right panning. The vertical axis is ignored except for
'scaling of volume due to distance. Doppler shift and volume scaling are still
'applied, but the 3D filtering is not performed. This is the most CPU efficient
'software implementation, but provides no virtual 3D audio effect. Head Related
'Transfer Function processing will not be done. Since only normal stereo panning
'is used, a channel using this algorithm may be accelerated by a 2D hardware
'voice if no free 3D hardware voices are available.
Global Const BASS_3DALG_OFF =  1 
' This algorithm gives the highest quality 3D audio effect, but uses more CPU.
' Requires Windows 98 2nd Edition or Windows 2000 that uses WDM drivers, if this
' mode is not available then BASS_3DALG_OFF will be used instead.
Global Const BASS_3DALG_FULL =  2 
' This algorithm gives a good 3D audio effect, and uses less CPU than the FULL
' mode. Requires Windows 98 2nd Edition or Windows 2000 that uses WDM drivers, if
' this mode is not available then BASS_3DALG_OFF will be used instead.
Global Const BASS_3DALG_LIGHT =  3 

Type BASS_INFO
    flags As Long         ' device capabilities (DSCAPS_xxx flags)
    hwsize As Long        ' size of total device hardware memory
    hwfree As Long        ' size of free device hardware memory
    freesam As Long       ' number of free sample slots in the hardware
    free3d As Long        ' number of free 3D sample slots in the hardware
    minrate As Long       ' min sample rate supported by the hardware
    maxrate As Long       ' max sample rate supported by the hardware
    eax As Long           ' device supports EAX? (always BASSFALSE if BASS_DEVICE_3D was not used)
    minbuf As Long        ' recommended minimum buffer length in ms (requires BASS_DEVICE_LATENCY)
    dsver As Long         ' DirectSound version
    latency As Long       ' delay (in ms) before start of playback (requires BASS_DEVICE_LATENCY)
    initflags As Long     ' "flags" parameter of BASS_Init call
    speakers As Long      ' number of speakers available
    driver As Long        ' driver
    freq As Long          ' current output rate (OSX only)
End Type

Type BASS_RECORDINFO
    flags As Long         ' device capabilities (DSCCAPS_xxx flags)
    formats As Long       ' supported standard formats (WAVE_FORMAT_xxx flags)
    inputs As Long        ' number of inputs
    singlein As Long      ' BASSTRUE = only 1 input can be set at a time
    driver As Long        ' driver
    freq As Long          ' current input rate (OSX only)
End Type

Type BASS_SAMPLE
    freq As Long          ' default playback rate
    volume As Long        ' default volume (0-100)
    pan As Long           ' default pan (-100=left, 0=middle, 100=right)
    flags As Long         ' BASS_SAMPLE_xxx flags
    length As Long        ' length (in samples, not bytes)
    max As Long           ' maximum simultaneous playbacks
    origres As Long       ' original resolution
    chans As Long         ' number of channels
        mingap As Long        ' minimum gap (ms) between creating channels
    ' The following are the sample's default 3D attributes (if the sample
    ' is 3D, BASS_SAMPLE_3D is in flags) see BASS_ChannelSet3DAttributes
    mode3d As Long        ' BASS_3DMODE_xxx mode
    mindist As Single     ' minimum distance
    MAXDIST As Single     ' maximum distance
    iangle As Long        ' angle of inside projection cone
    oangle As Long        ' angle of outside projection cone
    outvol As Long        ' delta-volume outside the projection cone
    ' The following are the defaults used if the sample uses the DirectX 7
    ' voice allocation/management features.
    vam As Long           ' voice allocation/management flags (BASS_VAM_xxx)
    priority As Long      ' priority (0=lowest, &Hffffffff=highest)
End Type

Type BASS_CHANNELINFO
    freq As Long          ' default playback rate
    chans As Long         ' channels
    flags As Long         ' BASS_SAMPLE/STREAM/MUSIC/SPEAKER flags
    ctype As Long         ' type of channel
    origres As Long       ' original resolution
        plugin As Long        ' plugin
End Type

' BASS_CHANNELINFO types
Global Const BASS_CTYPE_SAMPLE =  1 
Global Const BASS_CTYPE_RECORD =  2 
Global Const BASS_CTYPE_STREAM = &H10000
Global Const BASS_CTYPE_STREAM_OGG = &H10002
Global Const BASS_CTYPE_STREAM_MP1 = &H10003
Global Const BASS_CTYPE_STREAM_MP2 = &H10004
Global Const BASS_CTYPE_STREAM_MP3 = &H10005
Global Const BASS_CTYPE_STREAM_AIFF = &H10006
Global Const BASS_CTYPE_STREAM_WAV = &H40000 ' WAVE flag, LOWORD=codec
Global Const BASS_CTYPE_STREAM_WAV_PCM = &H50001
Global Const BASS_CTYPE_STREAM_WAV_FLOAT = &H50003
Global Const BASS_CTYPE_MUSIC_MOD = &H20000
Global Const BASS_CTYPE_MUSIC_MTM = &H20001
Global Const BASS_CTYPE_MUSIC_S3M = &H20002
Global Const BASS_CTYPE_MUSIC_XM = &H20003
Global Const BASS_CTYPE_MUSIC_IT = &H20004
Global Const BASS_CTYPE_MUSIC_MO3 = &H100    ' MO3 flag

Type BASS_PLUGINFORM
        ctype As Long         ' channel type
        name As Long          ' format description
        exts As Long          ' file extension filter (*.ext1;*.ext2;etc...)
End Type

Type BASS_PLUGININFO
        version As Long       ' version (same form as BASS_GetVersion)
        formatc As Long       ' number of formats
        formats As Long       ' the array of formats
End Type

'********************************************************
'* 3D vector (for 3D positions/velocities/orientations) *
'********************************************************
Type BASS_3DVECTOR
    X As Single           ' +=right, -=left
    Y As Single           ' +=up, -=down
    z As Single           ' +=front, -=behind
End Type

' DX8 effect types, use with BASS_ChannelSetFX
Global Const BASS_FX_CHORUS =  0          ' GUID_DSFX_STANDARD_CHORUS
Global Const BASS_FX_COMPRESSOR =  1      ' GUID_DSFX_STANDARD_COMPRESSOR
Global Const BASS_FX_DISTORTION =  2      ' GUID_DSFX_STANDARD_DISTORTION
Global Const BASS_FX_ECHO =  3            ' GUID_DSFX_STANDARD_ECHO
Global Const BASS_FX_FLANGER =  4         ' GUID_DSFX_STANDARD_FLANGER
Global Const BASS_FX_GARGLE =  5          ' GUID_DSFX_STANDARD_GARGLE
Global Const BASS_FX_I3DL2REVERB =  6     ' GUID_DSFX_STANDARD_I3DL2REVERB
Global Const BASS_FX_PARAMEQ =  7         ' GUID_DSFX_STANDARD_PARAMEQ
Global Const BASS_FX_REVERB =  8          ' GUID_DSFX_WAVES_REVERB

Type BASS_FXCHORUS              ' DSFXChorus
    fWetDryMix As Single
    fDepth As Single
    fFeedback As Single
    fFrequency As Single
    lWaveform As Long   ' 0=triangle, 1=sine
    fDelay As Single
    lPhase As Long              ' BASS_FX_PHASE_xxx
End Type

Type BASS_FXCOMPRESSOR  ' DSFXCompressor
    fGain As Single
    fAttack As Single
    fRelease As Single
    fThreshold As Single
    fRatio As Single
    fPredelay As Single
End Type

Type BASS_FXDISTORTION  ' DSFXDistortion
    fGain As Single
    fEdge As Single
    fPostEQCenterFrequency As Single
    fPostEQBandwidth As Single
    fPreLowpassCutoff As Single
End Type

Type BASS_FXECHO                ' DSFXEcho
    fWetDryMix As Single
    fFeedback As Single
    fLeftDelay As Single
    fRightDelay As Single
    lPanDelay As Long
End Type

Type BASS_FXFLANGER             ' DSFXFlanger
    fWetDryMix As Single
    fDepth As Single
    fFeedback As Single
    fFrequency As Single
    lWaveform As Long   ' 0=triangle, 1=sine
    fDelay As Single
    lPhase As Long              ' BASS_FX_PHASE_xxx
End Type

Type BASS_FXGARGLE              ' DSFXGargle
    dwRateHz As Long               ' Rate of modulation in hz
    dwWaveShape As Long            ' 0=triangle, 1=square
End Type

Type BASS_FXI3DL2REVERB ' DSFXI3DL2Reverb
    lRoom As Long                    ' [-10000, 0]      default: -1000 mB
    lRoomHF As Long                  ' [-10000, 0]      default: 0 mB
    flRoomRolloffFactor As Single    ' [0.0, 10.0]      default: 0.0
    flDecayTime As Single            ' [0.1, 20.0]      default: 1.49s
    flDecayHFRatio As Single         ' [0.1, 2.0]       default: 0.83
    lReflections As Long             ' [-10000, 1000]   default: -2602 mB
    flReflectionsDelay As Single     ' [0.0, 0.3]       default: 0.007 s
    lReverb As Long                  ' [-10000, 2000]   default: 200 mB
    flReverbDelay As Single          ' [0.0, 0.1]       default: 0.011 s
    flDiffusion As Single            ' [0.0, 100.0]     default: 100.0 %
    flDensity As Single              ' [0.0, 100.0]     default: 100.0 %
    flHFReference As Single          ' [20.0, 20000.0]  default: 5000.0 Hz
End Type

Type BASS_FXPARAMEQ             ' DSFXParamEq
    fCenter As Single
    fBandwidth As Single
    fGain As Single
End Type

Type BASS_FXREVERB              ' DSFXWavesReverb
    fInGain As Single                ' [-96.0,0.0]            default: 0.0 dB
    fReverbMix As Single             ' [-96.0,0.0]            default: 0.0 db
    fReverbTime As Single            ' [0.001,3000.0]         default: 1000.0 ms
    fHighFreqRTRatio As Single       ' [0.001,0.999]          default: 0.001
End Type

Global Const BASS_FX_PHASE_NEG_180 =  0 
Global Const BASS_FX_PHASE_NEG_90 =  1 
Global Const BASS_FX_PHASE_ZERO =  2 
Global Const BASS_FX_PHASE_90 =  3 
Global Const BASS_FX_PHASE_180 =  4 

Type GUID       ' used with BASS_Init - use VarPtr(guid) in clsid parameter
    Data1 As Long
    Data2 As Integer
    Data3 As Integer
    Data4( 7 ) As Byte
End Type


Declare Function BASS_SetConfig Lib "bass.dll" (ByVal opt As Long, ByVal value As Long) As Long
Declare Function BASS_GetConfig Lib "bass.dll" (ByVal opt As Long) As Long
Declare Function BASS_GetVersion Lib "bass.dll" () As Long
Declare Function BASS_GetDeviceDescription Lib "bass.dll" (ByVal device As Long) As Long
Declare Function BASS_ErrorGetCode Lib "bass.dll" () As Long
Declare Function BASS_Init Lib "bass.dll" (ByVal device As Long, ByVal freq As Long, ByVal flags As Long, ByVal win As Long, ByVal clsid As Long) As Long
Declare Function BASS_SetDevice Lib "bass.dll" (ByVal device As Long) As Long
Declare Function BASS_GetDevice Lib "bass.dll" () As Long
Declare Function BASS_Free Lib "bass.dll" () As Long
Declare Function BASS_GetDSoundObject Lib "bass.dll" (ByVal object As Long) As Long
Declare Function BASS_GetInfo Lib "bass.dll" (ByRef info As BASS_INFO) As Long
Declare Function BASS_Update Lib "bass.dll" () As Long
Declare Function BASS_GetCPU Lib "bass.dll" () As Single
Declare Function BASS_Start Lib "bass.dll" () As Long
Declare Function BASS_Stop Lib "bass.dll" () As Long
Declare Function BASS_Pause Lib "bass.dll" () As Long
Declare Function BASS_SetVolume Lib "bass.dll" (ByVal volume As Long) As Long
Declare Function BASS_GetVolume Lib "bass.dll" () As Long

Declare Function BASS_PluginLoad Lib "bass.dll" (ByVal filename As String, ByVal flags As Long) As Long
Declare Function BASS_PluginFree Lib "bass.dll" (ByVal handle As Long) As Long
Private Declare Function BASS_PluginGetInfo_ Lib "bass.dll" Alias "BASS_PluginGetInfo" (ByVal handle As Long) As Long

Declare Function BASS_Set3DFactors Lib "bass.dll" (ByVal distf As Single, ByVal rollf As Single, ByVal doppf As Single) As Long
Declare Function BASS_Get3DFactors Lib "bass.dll" (ByRef distf As Single, ByRef rollf As Single, ByRef doppf As Single) As Long
Declare Function BASS_Set3DPosition Lib "bass.dll" (ByRef pos As Any, ByRef vel As Any, ByRef front As Any, ByRef top As Any) As Long
Declare Function BASS_Get3DPosition Lib "bass.dll" (ByRef pos As Any, ByRef vel As Any, ByRef front As Any, ByRef top As Any) As Long
Declare Function BASS_Apply3D Lib "bass.dll" () As Long
Declare Function BASS_SetEAXParameters Lib "bass.dll" (ByVal env As Long, ByVal vol As Single, ByVal decay As Single, ByVal damp As Single) As Long
Declare Function BASS_GetEAXParameters Lib "bass.dll" (ByRef env As Long, ByRef vol As Single, ByRef decay As Single, ByRef damp As Single) As Long

Declare Function BASS_MusicLoad Lib "bass.dll" (ByVal mem As Long, ByVal f As Any, ByVal offset As Long, ByVal length As Long, ByVal flags As Long, ByVal freq As Long) As Long
Declare Function BASS_MusicFree Lib "bass.dll" (ByVal handle As Long) As Long
Declare Function BASS_MusicSetAttribute Lib "bass.dll" (ByVal handle As Long, ByVal attrib As Long, ByVal value As Long) As Long
Declare Function BASS_MusicGetAttribute Lib "bass.dll" (ByVal handle As Long, ByVal attrib As Long) As Long
Declare Function BASS_MusicGetOrders Lib "bass.dll" (ByVal handle As Long) As Long
Declare Function BASS_MusicGetOrderPosition Lib "bass.dll" (ByVal handle As Long) As Long

Declare Function BASS_SampleLoad Lib "bass.dll" (ByVal mem As Long, ByVal f As Any, ByVal offset As Long, ByVal length As Long, ByVal max As Long, ByVal flags As Long) As Long
Declare Function BASS_SampleCreate Lib "bass.dll" (ByVal length As Long, ByVal freq As Long, ByVal chans As Long, ByVal max As Long, ByVal flags As Long) As Long
Declare Function BASS_SampleCreateDone Lib "bass.dll" () As Long
Declare Function BASS_SampleFree Lib "bass.dll" (ByVal handle As Long) As Long
Declare Function BASS_SampleGetInfo Lib "bass.dll" (ByVal handle As Long, ByRef info As BASS_SAMPLE) As Long
Declare Function BASS_SampleSetInfo Lib "bass.dll" (ByVal handle As Long, ByRef info As BASS_SAMPLE) As Long
Declare Function BASS_SampleGetChannel Lib "bass.dll" (ByVal handle As Long, ByVal onlynew As Long) As Long
Declare Function BASS_SampleStop Lib "bass.dll" (ByVal handle As Long) As Long

Declare Function BASS_StreamCreate Lib "bass.dll" (ByVal freq As Long, ByVal chans As Long, ByVal flags As Long, ByVal proc As Long, ByVal user As Long) As Long
Declare Function BASS_StreamCreateFile Lib "bass.dll" (ByVal mem As Long, ByVal f As Any, ByVal offset As Long, ByVal length As Long, ByVal flags As Long) As Long
Declare Function BASS_StreamCreateURL Lib "bass.dll" (ByVal url As String, ByVal offset As Long, ByVal flags As Long, ByVal proc As Long, ByVal user As Long) As Long
Declare Function BASS_StreamCreateFileUser Lib "bass.dll" (ByVal buffered As Long, ByVal flags As Long, ByVal proc As Long, ByVal user As Long) As Long
Declare Function BASS_StreamFree Lib "bass.dll" (ByVal handle As Long) As Long
Declare Function BASS_StreamGetFilePosition Lib "bass.dll" (ByVal handle As Long, ByVal mode As Long) As Long

Declare Function BASS_RecordGetDeviceDescription Lib "bass.dll" (ByVal device As Long) As Long
Declare Function BASS_RecordInit Lib "bass.dll" (ByVal device As Long) As Long
Declare Function BASS_RecordSetDevice Lib "bass.dll" (ByVal device As Long) As Long
Declare Function BASS_RecordGetDevice Lib "bass.dll" () As Long
Declare Function BASS_RecordFree Lib "bass.dll" () As Long
Declare Function BASS_RecordGetInfo Lib "bass.dll" (ByRef info As BASS_RECORDINFO) As Long
Declare Function BASS_RecordGetInputName Lib "bass.dll" (ByVal inputn As Long) As Long
Declare Function BASS_RecordSetInput Lib "bass.dll" (ByVal inputn As Long, ByVal setting As Long) As Long
Declare Function BASS_RecordGetInput Lib "bass.dll" (ByVal inputn As Long) As Long
Declare Function BASS_RecordStart Lib "bass.dll" (ByVal freq As Long, ByVal chans As Long, ByVal flags As Long, ByVal proc As Long, ByVal user As Long) As Long

Private Declare Function BASS_ChannelBytes2Seconds64 Lib "bass.dll" Alias "BASS_ChannelBytes2Seconds" (ByVal handle As Long, ByVal pos As Long, ByVal poshigh As Long) As Single
Declare Function BASS_ChannelSeconds2Bytes Lib "bass.dll" (ByVal handle As Long, ByVal pos As Single) As Long
Declare Function BASS_ChannelGetDevice Lib "bass.dll" (ByVal handle As Long) As Long
Declare Function BASS_ChannelSetDevice Lib "bass.dll" (ByVal handle As Long, ByVal device As Long) As Long
Declare Function BASS_ChannelIsActive Lib "bass.dll" (ByVal handle As Long) As Long
Declare Function BASS_ChannelGetInfo Lib "bass.dll" (ByVal handle As Long, ByRef info As BASS_CHANNELINFO) As Long
Declare Function BASS_ChannelGetTags Lib "bass.dll" (ByVal handle As Long, ByVal tags As Long) As Long
Declare Function BASS_ChannelSetFlags Lib "bass.dll" (ByVal handle As Long, ByVal flags As Long) As Long
Declare Function BASS_ChannelPreBuf Lib "bass.dll" (ByVal handle As Long, ByVal length As Long) As Long
Declare Function BASS_ChannelPlay Lib "bass.dll" (ByVal handle As Long, ByVal restart As Long) As Long
Declare Function BASS_ChannelStop Lib "bass.dll" (ByVal handle As Long) As Long
Declare Function BASS_ChannelPause Lib "bass.dll" (ByVal handle As Long) As Long
Declare Function BASS_ChannelSetAttributes Lib "bass.dll" (ByVal handle As Long, ByVal freq As Long, ByVal volume As Long, ByVal pan As Long) As Long
Declare Function BASS_ChannelGetAttributes Lib "bass.dll" (ByVal handle As Long, ByRef freq As Long, ByRef volume As Long, ByRef pan As Long) As Long
Declare Function BASS_ChannelSlideAttributes Lib "bass.dll" (ByVal handle As Long, ByVal freq As Long, ByVal volume As Long, ByVal pan As Long, ByVal time As Long) As Long
Declare Function BASS_ChannelIsSliding Lib "bass.dll" (ByVal handle As Long) As Long
Declare Function BASS_ChannelSet3DAttributes Lib "bass.dll" (ByVal handle As Long, ByVal mode As Long, ByVal min As Single, ByVal max As Single, ByVal iangle As Long, ByVal oangle As Long, ByVal outvol As Long) As Long
Declare Function BASS_ChannelGet3DAttributes Lib "bass.dll" (ByVal handle As Long, ByRef mode As Long, ByRef min As Single, ByRef max As Single, ByRef iangle As Long, ByRef oangle As Long, ByRef outvol As Long) As Long
Declare Function BASS_ChannelSet3DPosition Lib "bass.dll" (ByVal handle As Long, ByRef pos As Any, ByRef orient As Any, ByRef vel As Any) As Long
Declare Function BASS_ChannelGet3DPosition Lib "bass.dll" (ByVal handle As Long, ByRef pos As Any, ByRef orient As Any, ByRef vel As Any) As Long
Declare Function BASS_ChannelGetLength Lib "bass.dll" (ByVal handle As Long) As Long
Private Declare Function BASS_ChannelSetPosition64 Lib "bass.dll" Alias "BASS_ChannelSetPosition" (ByVal handle As Long, ByVal pos As Long, ByVal poshigh As Long) As Long
Declare Function BASS_ChannelGetPosition Lib "bass.dll" (ByVal handle As Long) As Long
Declare Function BASS_ChannelGetLevel Lib "bass.dll" (ByVal handle As Long) As Long
Declare Function BASS_ChannelGetData Lib "bass.dll" (ByVal handle As Long, ByRef buffer As Any, ByVal length As Long) As Long
Private Declare Function BASS_ChannelSetSync64 Lib "bass.dll" Alias "BASS_ChannelSetSync" (ByVal handle As Long, ByVal atype As Long, ByVal param As Long, ByVal paramhigh As Long, ByVal proc As Long, ByVal user As Long) As Long
Declare Function BASS_ChannelRemoveSync Lib "bass.dll" (ByVal handle As Long, ByVal sync As Long) As Long
Declare Function BASS_ChannelSetDSP Lib "bass.dll" (ByVal handle As Long, ByVal proc As Long, ByVal user As Long, ByVal priority As Long) As Long
Declare Function BASS_ChannelRemoveDSP Lib "bass.dll" (ByVal handle As Long, ByVal dsp As Long) As Long
Declare Function BASS_ChannelSetEAXMix Lib "bass.dll" (ByVal handle As Long, ByVal mix As Single) As Long
Declare Function BASS_ChannelGetEAXMix Lib "bass.dll" (ByVal handle As Long, ByRef mix As Single) As Long
Declare Function BASS_ChannelSetLink Lib "bass.dll" (ByVal handle As Long, ByVal chan As Long) As Long
Declare Function BASS_ChannelRemoveLink Lib "bass.dll" (ByVal handle As Long, ByVal chan As Long) As Long
Declare Function BASS_ChannelSetFX Lib "bass.dll" (ByVal handle As Long, ByVal atype As Long, ByVal priority As Long) As Long
Declare Function BASS_ChannelRemoveFX Lib "bass.dll" (ByVal handle As Long, ByVal fx As Long) As Long
Declare Function BASS_FXSetParameters Lib "bass.dll" (ByVal handle As Long, ByRef par As Any) As Long
Declare Function BASS_FXGetParameters Lib "bass.dll" (ByVal handle As Long, ByRef par As Any) As Long

Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (ByRef Destination As Any, ByRef Source As Any, ByVal length As Long)
Private Declare Function lstrlen Lib "kernel32" Alias "lstrlenA" (ByVal lpString As Long) As Long

Public Function BASS_SPEAKER_N(ByVal n As Long) As Long
BASS_SPEAKER_N = n * ( 2  ^  24 )
End Function

Public Function MAKEMUSICPOS(ByVal order As Long, ByVal row As Long) As Long
MAKEMUSICPOS = &H80000000 Or MakeLong(order, row)
End Function

'*******************************************
' 32-bit wrappers for 64-bit BASS functions
'*******************************************
Function BASS_ChannelBytes2Seconds(ByVal handle As Long, ByVal pos As Long) As Single
BASS_ChannelBytes2Seconds = BASS_ChannelBytes2Seconds64(handle, pos,  0 )
End Function

Function BASS_ChannelSetPosition(ByVal handle As Long, ByVal pos As Long) As Long
BASS_ChannelSetPosition = BASS_ChannelSetPosition64(handle, pos,  0 )
End Function

Function BASS_ChannelSetSync(ByVal handle As Long, ByVal atype As Long, ByVal param As Long, ByVal proc As Long, ByVal user As Long) As Long
BASS_ChannelSetSync = BASS_ChannelSetSync64(handle, atype, param,  0 , proc, user)
End Function

'****************************
' BASS_PluginGetInfo wrappers
'****************************
Function BASS_PluginGetInfo(ByVal handle As Long) As BASS_PLUGININFO
Dim pinfo As BASS_PLUGININFO, plug As Long
plug = BASS_PluginGetInfo_(handle)
If plug Then
    Call CopyMemory(pinfo, ByVal plug, LenB(pinfo))
End If
BASS_PluginGetInfo = pinfo
End Function

Function BASS_PluginGetInfoFormat(ByVal handle As Long, ByVal Index As Long) As BASS_PLUGINFORM
Dim pform As BASS_PLUGINFORM, plug As Long
plug = BASS_PluginGetInfo(handle).formats
If plug Then
    plug = plug + (Index * LenB(pform))
    Call CopyMemory(pform, ByVal plug, LenB(pform))
End If
BASS_PluginGetInfoFormat = pform
End Function

'*******************
' callback functions
'*******************
Function STREAMPROC(ByVal handle As Long, ByVal buffer As Long, ByVal length As Long, ByVal user As Long) As Long
    
    'CALLBACK FUNCTION !!!
    
    ' User stream callback function
    ' NOTE: A stream function should obviously be as quick
    ' as possible, other streams (and MOD musics) can't be mixed until it's finished.
    ' handle : The stream that needs writing
    ' buffer : Buffer to write the samples in
    ' length : Number of bytes to write
    ' user   : The 'user' parameter value given when calling BASS_StreamCreate
    ' RETURN : Number of bytes written. Set the BASS_STREAMPROC_END flag to end
    '          the stream.
    
End Function

Function STREAMFILEPROC(ByVal action As Long, ByVal param1 As Long, ByVal param2 As Long, ByVal user As Long) As Long
    
    'CALLBACK FUNCTION !!!
    
    ' User file stream callback function.
    ' action : The action to perform, one of BASS_FILE_xxx values.
    ' param1 : Depends on "action"
    ' param2 : Depends on "action"
    ' user   : The 'user' parameter value given when calling BASS_StreamCreate
    ' RETURN : Depends on "action"
    
End Function

Sub DOWNLOADPROC(ByVal buffer As Long, ByVal length As Long, ByVal user As Long)
    
    'CALLBACK FUNCTION !!!

    ' Internet stream download callback function.
    ' buffer : Buffer containing the downloaded data... NULL=end of download
    ' length : Number of bytes in the buffer
    ' user   : The 'user' parameter given when calling BASS_StreamCreateURL
    
End Sub

Sub SYNCPROC(ByVal handle As Long, ByVal channel As Long, ByVal data As Long, ByVal user As Long)
    
    'CALLBACK FUNCTION !!!
    
    'Similarly in here, write what to do when sync function
    'is called, i.e screen flash etc.
    
    ' NOTE: a sync callback function should be very quick as other
    ' syncs cannot be processed until it has finished.
    ' handle : The sync that has occured
    ' channel: Channel that the sync occured in
    ' data   : Additional data associated with the sync's occurance
    ' user   : The 'user' parameter given when calling BASS_ChannelSetSync */
    
End Sub

Sub DSPPROC(ByVal handle As Long, ByVal channel As Long, ByVal buffer As Long, ByVal length As Long, ByVal user As Long)

    'CALLBACK FUNCTION !!!

    ' VB doesn't support pointers, so you should copy the buffer into an array,
    ' process it, and then copy it back into the buffer.

    ' DSP callback function. NOTE: A DSP function should obviously be as quick as
    ' possible... other DSP functions, streams and MOD musics can not be processed
    ' until it's finished.
    ' handle : The DSP handle
    ' channel: Channel that the DSP is being applied to
    ' buffer : Buffer to apply the DSP to
    ' length : Number of bytes in the buffer
    ' user   : The 'user' parameter given when calling BASS_ChannelSetDSP
    
End Sub

Function RECORDPROC(ByVal handle As Long, ByVal buffer As Long, ByVal length As Long, ByVal user As Long) As Long

    'CALLBACK FUNCTION !!!

    ' Recording callback function.
    ' handle : The recording handle
    ' buffer : Buffer containing the recorded samples
    ' length : Number of bytes
    ' user   : The 'user' parameter value given when calling BASS_RecordStart
    ' RETURN : BASSTRUE = continue recording, BASSFALSE = stop

End Function


Function BASS_GetDeviceDescriptionString(ByVal device As Long) As String
Dim pstring As Long
Dim sstring As String
On Error Resume Next
pstring = BASS_GetDeviceDescription(device)
If pstring Then
    sstring = VBStrFromAnsiPtr(pstring)
End If
BASS_GetDeviceDescriptionString = sstring
End Function

Function BASS_SetEAXPreset(Preset) As Long
' This function is a workaround, because VB doesn't support multiple comma seperated
' paramaters for each Global Const, simply pass the EAX_ENVIRONMENT_xxx value to this function
' instead of BASS_SetEAXParameters as you would do in C++
Select Case Preset
    Case EAX_ENVIRONMENT_GENERIC
        BASS_SetEAXPreset = BASS_SetEAXParameters(EAX_ENVIRONMENT_GENERIC,  0 . 5 ,  1 . 493 ,  0 . 5 )
    Case EAX_ENVIRONMENT_PADDEDCELL
        BASS_SetEAXPreset = BASS_SetEAXParameters(EAX_ENVIRONMENT_PADDEDCELL,  0 . 25 ,  0 . 1 ,  0 )
    Case EAX_ENVIRONMENT_ROOM
        BASS_SetEAXPreset = BASS_SetEAXParameters(EAX_ENVIRONMENT_ROOM,  0 . 417 ,  0 . 4 ,  0 . 666 )
    Case EAX_ENVIRONMENT_BATHROOM
        BASS_SetEAXPreset = BASS_SetEAXParameters(EAX_ENVIRONMENT_BATHROOM,  0 . 653 ,  1 . 499 ,  0 . 166 )
    Case EAX_ENVIRONMENT_LIVINGROOM
        BASS_SetEAXPreset = BASS_SetEAXParameters(EAX_ENVIRONMENT_LIVINGROOM,  0 . 208 ,  0 . 478 ,  0 )
    Case EAX_ENVIRONMENT_STONEROOM
        BASS_SetEAXPreset = BASS_SetEAXParameters(EAX_ENVIRONMENT_STONEROOM,  0 . 5 ,  2 . 309 ,  0 . 888 )
    Case EAX_ENVIRONMENT_AUDITORIUM
        BASS_SetEAXPreset = BASS_SetEAXParameters(EAX_ENVIRONMENT_AUDITORIUM,  0 . 403 ,  4 . 279 ,  0 . 5 )
    Case EAX_ENVIRONMENT_CONCERTHALL
        BASS_SetEAXPreset = BASS_SetEAXParameters(EAX_ENVIRONMENT_CONCERTHALL,  0 . 5 ,  3 . 961 ,  0 . 5 )
    Case EAX_ENVIRONMENT_CAVE
        BASS_SetEAXPreset = BASS_SetEAXParameters(EAX_ENVIRONMENT_CAVE,  0 . 5 ,  2 . 886 ,  1 . 304 )
    Case EAX_ENVIRONMENT_ARENA
        BASS_SetEAXPreset = BASS_SetEAXParameters(EAX_ENVIRONMENT_ARENA,  0 . 361 ,  7 . 284 ,  0 . 332 )
    Case EAX_ENVIRONMENT_HANGAR
        BASS_SetEAXPreset = BASS_SetEAXParameters(EAX_ENVIRONMENT_HANGAR,  0 . 5 ,  10 ,  0 . 3 )
    Case EAX_ENVIRONMENT_CARPETEDHALLWAY
        BASS_SetEAXPreset = BASS_SetEAXParameters(EAX_ENVIRONMENT_CARPETEDHALLWAY,  0 . 153 ,  0 . 259 ,  2 )
    Case EAX_ENVIRONMENT_HALLWAY
        BASS_SetEAXPreset = BASS_SetEAXParameters(EAX_ENVIRONMENT_HALLWAY,  0 . 361 ,  1 . 493 ,  0 )
    Case EAX_ENVIRONMENT_STONECORRIDOR
        BASS_SetEAXPreset = BASS_SetEAXParameters(EAX_ENVIRONMENT_STONECORRIDOR,  0 . 444 ,  2 . 697 ,  0 . 638 )
    Case EAX_ENVIRONMENT_ALLEY
        BASS_SetEAXPreset = BASS_SetEAXParameters(EAX_ENVIRONMENT_ALLEY,  0 . 25 ,  1 . 752 ,  0 . 776 )
    Case EAX_ENVIRONMENT_FOREST
        BASS_SetEAXPreset = BASS_SetEAXParameters(EAX_ENVIRONMENT_FOREST,  0 . 111 ,  3 . 145 ,  0 . 472 )
    Case EAX_ENVIRONMENT_CITY
        BASS_SetEAXPreset = BASS_SetEAXParameters(EAX_ENVIRONMENT_CITY,  0 . 111 ,  2 . 767 ,  0 . 224 )
    Case EAX_ENVIRONMENT_MOUNTAINS
        BASS_SetEAXPreset = BASS_SetEAXParameters(EAX_ENVIRONMENT_MOUNTAINS,  0 . 194 ,  7 . 841 ,  0 . 472 )
    Case EAX_ENVIRONMENT_QUARRY
        BASS_SetEAXPreset = BASS_SetEAXParameters(EAX_ENVIRONMENT_QUARRY,  1 ,  1 . 499 ,  0 . 5 )
    Case EAX_ENVIRONMENT_PLAIN
        BASS_SetEAXPreset = BASS_SetEAXParameters(EAX_ENVIRONMENT_PLAIN,  0 . 097 ,  2 . 767 ,  0 . 224 )
    Case EAX_ENVIRONMENT_PARKINGLOT
        BASS_SetEAXPreset = BASS_SetEAXParameters(EAX_ENVIRONMENT_PARKINGLOT,  0 . 208 ,  1 . 652 ,  1 . 5 )
    Case EAX_ENVIRONMENT_SEWERPIPE
        BASS_SetEAXPreset = BASS_SetEAXParameters(EAX_ENVIRONMENT_SEWERPIPE,  0 . 652 ,  2 . 886 ,  0 . 25 )
    Case EAX_ENVIRONMENT_UNDERWATER
        BASS_SetEAXPreset = BASS_SetEAXParameters(EAX_ENVIRONMENT_UNDERWATER,  1 ,  1 . 499 ,  0 )
    Case EAX_ENVIRONMENT_DRUGGED
        BASS_SetEAXPreset = BASS_SetEAXParameters(EAX_ENVIRONMENT_DRUGGED,  0 . 875 ,  8 . 392 ,  1 . 388 )
    Case EAX_ENVIRONMENT_DIZZY
        BASS_SetEAXPreset = BASS_SetEAXParameters(EAX_ENVIRONMENT_DIZZY,  0 . 139 ,  17 . 234 ,  0 . 666 )
    Case EAX_ENVIRONMENT_PSYCHOTIC
        BASS_SetEAXPreset = BASS_SetEAXParameters(EAX_ENVIRONMENT_PSYCHOTIC,  0 . 486 ,  7 . 563 ,  0 . 806 )
End Select
End Function

Public Function HiWord(lparam As Long) As Long
' This is the HIWORD of the lParam:
HiWord = lparam \ &H10000 And &HFFFF&
End Function
Public Function LoWord(lparam As Long) As Long
' This is the LOWORD of the lParam:
LoWord = lparam And &HFFFF&
End Function
Function MakeLong(LoWord As Long, HiWord As Long) As Long
'Replacement for the c++ Function MAKELONG
MakeLong = (LoWord And &HFFFF&) Or (HiWord * &H10000)
End Function

Public Function VBStrFromAnsiPtr(ByVal lpStr As Long) As String
Dim bStr() As Byte
Dim cChars As Long
On Error Resume Next
' Get the number of characters in the buffer
cChars = lstrlen(lpStr)
' Resize the byte array
ReDim bStr( 0  To cChars -  1 ) As Byte
' Grab the ANSI buffer
Call CopyMemory(bStr( 0 ), ByVal lpStr, cChars)
' Now convert to a VB Unicode string
VBStrFromAnsiPtr = StrConv(bStr, vbUnicode)
End Function

должно находится в модуле
...
Рейтинг: 0 / 0
Перехват потока Звука
    #36625475
Фотография Андрей159
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
И вот еще один модуль. Это уже готовый код аквалайзера. Поскольку ты так и не разберешся сам что делать с данными звука. Там совсем другое представление. В даном коде я немножко своего добра добавил. Я доработал светомузыку на 5 лампочек под ритм. Опрашивать процедуру нужно через таймер.interval = 10

Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
39.
40.
41.
42.
43.
44.
45.
46.
47.
48.
49.
50.
51.
52.
53.
54.
55.
56.
57.
58.
59.
60.
61.
62.
63.
64.
65.
66.
67.
68.
69.
70.
71.
72.
73.
74.
75.
76.
77.
78.
79.
80.
81.
82.
83.
84.
85.
86.
87.
88.
89.
90.
91.
92.
93.
94.
95.
96.
97.
98.
99.
100.
101.
102.
103.
104.
105.
106.
107.
108.
109.
110.
111.
112.
113.
114.
115.
116.
117.
118.
119.
120.
121.
122.
123.
124.
125.
126.
127.
128.
129.
130.
131.
132.
133.
134.
135.
136.
137.
138.
139.
140.
141.
142.
143.
144.
145.
146.
147.
148.
149.
150.
151.
152.
153.
154.
155.
156.
157.
158.
159.
160.
161.
162.
163.
164.
165.
166.
167.
168.
169.
170.
171.
172.
173.
174.
175.
176.
177.
178.
179.
180.
181.
182.
183.
184.
185.
186.
187.
188.
189.
190.
191.
192.
193.
194.
195.
196.
197.
198.
199.
200.
201.
202.
203.
204.
205.
206.
207.
208.
209.
210.
211.
212.
213.
214.
215.
216.
217.
218.
219.
220.
221.
222.
223.
224.
225.
226.
227.
228.
229.
230.
231.
232.
233.
234.
235.
236.
237.
238.
239.
240.
241.
242.
243.
244.
245.
246.
247.
248.
249.
250.
251.
252.
253.
254.
255.
256.
257.
258.
259.
260.
261.
262.
263.
264.
265.
266.
267.
268.
269.
270.
271.
272.
273.
274.
275.
276.
277.
278.
279.
280.
281.
282.
283.
284.
285.
286.
287.
288.
289.
290.
291.
292.
293.
294.
295.
296.
297.
298.
299.
300.
301.
302.
303.
304.
305.
306.
307.
308.
309.
310.
311.
312.
313.
314.
315.
316.
317.
318.
319.
320.
321.
322.
323.
324.
325.
326.
327.
328.
329.
330.
331.
332.
333.
334.
335.
336.
337.
338.
339.
340.
341.
342.
343.
344.
345.
346.
347.
348.
349.
350.
351.
352.
353.
354.
355.
356.
357.
358.
359.
360.
361.
362.
363.
364.
365.
366.
367.
368.
369.
370.
371.
372.
373.
374.
375.
376.
377.
378.
379.
380.
381.
382.
383.
384.
385.
386.
387.
388.
389.
390.
391.
392.
393.
394.
395.
396.
397.
398.
399.
400.
401.
402.
403.
404.
405.
406.
407.
408.
409.
410.
411.
412.
413.
414.
415.
416.
417.
418.
419.
420.
421.
422.
423.
424.
425.
426.
427.
428.
429.
430.
431.
432.
433.
434.
435.
436.
437.
438.
439.
440.
441.
442.
443.
444.
445.
446.
447.
448.
449.
450.
451.
452.
453.
454.
455.
456.
457.
458.
459.
460.
461.
462.
463.
464.
465.
466.
467.
468.
469.
470.
471.
472.
473.
474.
475.
476.
477.
478.
479.
480.
481.
482.
483.
484.
485.
486.
487.
488.
489.
490.
491.
492.
493.
494.
495.
496.
497.
498.
499.
500.
501.
502.
503.
504.
505.
506.
507.
508.
509.
510.
511.
512.
513.
514.
515.
516.
517.
518.
519.
520.
521.
522.
523.
524.
525.
526.
527.
528.
529.
530.
531.
532.
533.
534.
535.
536.
537.
538.
539.
540.
541.
542.
543.
544.
545.
546.
547.
548.
549.
550.
551.
552.
553.
554.
555.
556.
557.
558.
559.
560.
561.
562.
563.
564.
565.
566.
567.
568.
569.
570.
571.
572.
573.
574.
575.
576.
577.
578.
579.
580.
581.
582.
583.
584.
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( 255 ) As RGBQUAD
End Type

Declare Sub FillMemory Lib "kernel32.dll" Alias "RtlFillMemory" (Destination As Any, ByVal length As Long, ByVal Fill As Long) 'byte було для fill
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

' NOTE: Using an API MM timer (may sometimes Crash your app in an IDE mode)
Public Const TIME_PERIODIC =  1   '  program for continuous periodic event
Public Declare Function timeSetEvent Lib "winmm.dll" (ByVal uDelay As Long, ByVal uResolution As Long, ByVal lpFunction As Long, ByVal dwUser As Long, ByVal uFlags As Long) As Long
Public Declare Function timeKillEvent Lib "winmm.dll" (ByVal uID As Long) As Long
Public timing As Long       ' an API timer Handle

Public Const SPECWIDTH As Long =  412  ' display width
Public Const SPECHEIGHT As Long =  295  '127 height (changing requires palette adjustments too)

Public chan As Long         ' stream/music handle

Public specmode As Long, specpos As Long  ' spectrum mode (and marker pos for 2nd mode)
Public specbuf() As Byte    ' a pointer

Public perenos1 As Boolean
Public perenos2 As Boolean
Public perenos3 As Boolean
Public perenos4 As Boolean
Public perenos5 As Boolean
Public perenos6 As Boolean
Public perenos7 As Boolean
Public perenos8 As Boolean
Public MinimBass As Byte
Public MaximBass As Byte
Public PotochBass As Byte
Public StBits As Byte

Public bh As BITMAPINFO     ' bitmap header

' MATH Functions
Public Function Sqrt(ByVal num As Double) As Double
    Sqrt = num ^  0 . 5 
End Function

Function Log10(ByVal X As Double) As Double
    Log10 = Log(X) / Log( 10 #)
End Function

' update the spectrum display - the interesting bit :)
Public Sub UpdateSpectrum(ByVal uTimerID As Long, ByVal uMsg As Long, ByVal dwUser As Long, ByVal dw1 As Long, ByVal dw2 As Long)
    chan = IDNomerPlayer1 Or IDNomerPlayer2
    
    specmode =  1 
    Dim X As Long, Y As Long, y1 As Long
    
    If (specmode =  3 ) Then ' waveform
        Dim c As Long, buf() As Single, ci As BASS_CHANNELINFO
        ReDim specbuf(SPECWIDTH * (SPECHEIGHT +  1 )) As Byte ' clear display

        Call BASS_ChannelGetInfo(chan, ci) ' get number of channels
        ReDim buf(ci.chans * SPECWIDTH * LenB(buf( 0 ))) As Single  ' allocate buffer for data

        Call BASS_ChannelGetData(chan, buf( 0 ), (ci.chans * SPECWIDTH * LenB(buf( 0 ))) Or BASS_DATA_FLOAT)  ' get the sample data (floating-point to avoid 8 & 16 bit processing)
        For c =  0  To ci.chans -  1 
            For X =  0  To SPECWIDTH -  1 
                Dim v As Long
                v = ( 1  - buf(X * ci.chans + c)) * SPECHEIGHT /  2  ' invert and scale to fit display
                If (v <  0 ) Then
                    v =  0 
                ElseIf (v >= SPECHEIGHT) Then
                    v = SPECHEIGHT -  1 
                End If
                If (X =  0 ) Then Y = v
                Do  ' draw line from previous sample...
                    If (Y < v) Then
                        Y = Y +  1 
                    ElseIf (Y > v) Then
                        Y = Y -  1 
                    End If
                    specbuf(Y * SPECWIDTH + X) = IIf(c And  1 ,  127 ,  1 ) ' left=green, right=red (could add more colours to palette for more chans)
                Loop While (Y <> v)
            Next X
        Next c
    Else
        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
        ElseIf (specmode =  1 ) Then  ' logarithmic, acumulate & average bins
            ReDim specbuf(SPECWIDTH * (SPECHEIGHT +  1 )) As Byte ' clear display
            Dim b0 As Long, BANDS As Integer
            b0 =  0 
            BANDS =  28  ' 16'я поміняв було 28
            Dim sc As Long, b1 As Long
            Dim sum As Single
            For X =  0  To BANDS -  1 
                sum =  0 
                b1 =  2  ^ (X *  10 # / (BANDS -  1 ))
                If (b1 >  1023 ) Then b1 =  1023 
                
                If (b1 <= b0) Then b1 = b0 +  1  ' make sure it uses at least 1 FFT bin
                sc =  10  + b1 - b0
                Do
                    sum = sum + fft( 1  + b0)
                    b0 = b0 +  1 
                Loop While b0 < b1
                Y = (Sqrt(sum / Log10(sc)) *  1 . 7  * SPECHEIGHT) -  4  ' scale it 1.7
                If (Y > SPECHEIGHT) Then Y = SPECHEIGHT ' cap it
                
                
    'Dim Col_XBlu As Integer
    'Dim Col_XRed As Integer
    'Dim Col_XGrn As Integer
                
                'If X = 1 Then Col_XRed = Y + 4
                'If X = 3 Then Col_XGrn = Y + 4
                'If X = 4 Then Col_XBlu = Y + 4
                'If X = 5 Then
                  'frmBassTest.Shape11.BackColor = RGB(Col_XRed, Col_XGrn, Col_XBlu)
                  'frmBassTest.Shape33.BackColor = RGB(Col_XRed, Col_XGrn, Col_XBlu)
                'End If
                
                
                'If X = 40 Then Col_XRed = Y + 4
                'If X = 43 Then Col_XGrn = Y + 4
                'If X = 45 Then Col_XBlu = Y + 4
                'If X = 46 Then
                '  If chan = IDNomerPlayer1 Then frmBassTest.Shape11.BackColor = RGB(Col_XRed, Col_XGrn, Col_XBlu)
                '  If chan = IDNomerPlayer2 Then frmBassTest.Shape33.BackColor = RGB(Col_XRed, Col_XGrn, Col_XBlu)
                'End If
                
                
                
'frmBassTest.TVicLPT1.DataPort = X 'Int(Rnd(1) * 255)
                If X = PotochBass Then
                
                  Call SvitloMuzika(Y)
                
                   'bh.bmiColors(0).rgbBlue = Abs(Sin(Y / 1000) * 254)
                   'bh.bmiColors(0).rgbRed = 0
                   
                   'bh.bmiColors(0).rgbRed = Abs(Sin(Y / 1000) * 254)
                   'bh.bmiColors(0).rgbGreen = Abs(Sin(Y / 1000) * 154)
       
                
                
                
                
                
                
                
                'frmBassTest.TVicLPT1.DataPort = ((Y > 20) * (-1)) + ((Y > 30) * (-2)) + ((Y > 40) * (-4)) + ((Y > 50) * (-8)) + ((Y > 55) * (-16)) + ((Y > 60) * (-32)) + ((Y > 65) * (-64)) + ((Y > 70) * (-128))
                End If
                Y = Y -  1 
                While (Y >=  0 )
                    Call FillMemory(specbuf(Y * SPECWIDTH + X * Int(SPECWIDTH / BANDS)), SPECWIDTH / BANDS -  2 , Y +  1 )
                    
                    Y = Y -  1 
                Wend
            Next X
        Else ' "3D"
            For X =  0  To SPECHEIGHT -  1 
                
                Y = Sqrt(fft(X +  1 )) *  3  *  127  ' scale it (sqrt to make low values more visible)
                
                If (Y >  127 ) Then Y =  127  ' cap it
                specbuf(X * SPECWIDTH + specpos) =  128  + Y ' plot it
            Next X
            ' move marker onto next position
            specpos = (specpos +  1 ) Mod SPECWIDTH
            For X =  0  To SPECHEIGHT -  1 
                specbuf(X * SPECWIDTH + specpos) =  255 
            Next X
        End If
    End If

    ' update the display
    ' to display in a PictureBox, simply change the .hDC to Picture1.hDC :)
    Call SetDIBitsToDevice(frmSpectrum.hDC,  0 ,  0 , SPECWIDTH, SPECHEIGHT,  0 ,  0 ,  0 , SPECHEIGHT, specbuf( 0 ), bh,  0 )
End Sub
Private Sub SvitloMuzika(Y As Long)
Static StartRejim As Boolean
Static LichilnikRegimu As Integer

Const UprKanalLPT1 =  1 
Const UprKanalLPT2 =  4 
Const UprKanalLPT3 =  2 
Const UprKanalLPT4 =  16 
Const UprKanalLPT5 =  8 
Const UprKanalLPT6 =  32 
Const UprKanalLPT7 =  64 
Const UprKanalLPT8 =  128 
Static PerevirkaY As Long

Static ZagRegVibSvMusic As Byte

If Int(Rnd( 1 ) *  200 ) =  50  Then
  ZagRegVibSvMusic = Int(Rnd( 1 ) *  6 )
End If

If Oplata.Visible = True Then
   Static GrivenDali As Byte
   GrivenDali = GrivenDali +  1 : If GrivenDali >  8  Then GrivenDali =  0 
   'If FrmViknoFile.Dir1.ListCount = 0 Then
   If YeValuta >= TrebaValuta Then
     If GrivenDali >  4  Then perenos5 = True Else perenos5 = False
   Else
     perenos5 = False
   End If
   
   
   If PerehidDoMp3 = False Then
     If PotVibranaPapka +  1  >= PB_Papki_ListCount Then
       perenos4 = False
     Else
       perenos4 = True
     End If
     If PotVibranaPapka =  0  Then
       perenos2 = False
     Else
       perenos2 = True
     End If
     If FrmViknoPapok.Dir1.Path = MusicPath Then
       perenos1 = False
     Else
       perenos1 = True
     End If
     If FrmViknoFile.Dir1.ListCount <>  0  Then
       perenos3 = True
     Else
       If perenos3 = False Then perenos3 = True Else perenos3 = False
     End If
   Else
     
     
     perenos1 = True
     perenos3 = False
     If PotVibranaPapkaMP3 +  1  >= PB_File_ListCount Then
       perenos4 = False
     Else
       perenos4 = True
     End If
     If PotVibranaPapkaMP3 =  0  Then
       perenos2 = False
     Else
       perenos2 = True
     End If
     
     
     
   End If
   
   
   'If PerehidDoMp3 = True Then perenos1 = True Else perenos1 = False
   
   frmBassTest.TVicLPT1.DataPort = (IIf(perenos1 = True,  1 ,  0 ) * UprKanalLPT1) + (IIf(perenos2 = True,  1 ,  0 ) * UprKanalLPT2) + (IIf(perenos3 = True,  1 ,  0 ) * UprKanalLPT3) + (IIf(perenos4 = True,  1 ,  0 ) * UprKanalLPT4) + (IIf(perenos5 = True,  1 ,  0 ) * UprKanalLPT5) + (IIf(perenos6 = True,  1 ,  0 ) * UprKanalLPT6) + (IIf(perenos7 = True,  1 ,  0 ) * UprKanalLPT7) + (IIf(perenos8 = True,  1 ,  0 ) * UprKanalLPT8)
 Exit Sub
End If

If ZagRegVibSvMusic =  0  Then
  Select Case Y
   Case Is > MaximBass
    perenos1 = True
    perenos2 = True
    perenos3 = True
    perenos4 = True
    perenos5 = True
   Case Is < MinimBass
    perenos1 = False
    perenos2 = False
    perenos3 = False
    perenos4 = False
    perenos5 = False
  End Select
End If


If ZagRegVibSvMusic =  1  Then
 Static PoKolu As Byte
 Static Shvidkist As Byte
 Static TmpShvidkist As Byte
  Shvidkist =  6 
  Select Case Y
   Case Is > MaximBass
    perenos5 = True
   Case Is < MinimBass
    perenos5 = False
  End Select
  Select Case PoKolu
    Case  0 
      perenos1 = True
      perenos2 = False
      perenos3 = False
      perenos4 = False
      If TmpShvidkist >= Shvidkist Then PoKolu =  1 : TmpShvidkist =  0  Else TmpShvidkist = TmpShvidkist +  1 
    Case  1 
      perenos1 = False
      perenos2 = True
      perenos3 = False
      perenos4 = False
      If TmpShvidkist >= Shvidkist Then PoKolu =  2 : TmpShvidkist =  0  Else TmpShvidkist = TmpShvidkist +  1 
    Case  2 
      perenos1 = False
      perenos2 = False
      perenos3 = True
      perenos4 = False
      If TmpShvidkist >= Shvidkist Then PoKolu =  3 : TmpShvidkist =  0  Else TmpShvidkist = TmpShvidkist +  1 
    Case  3 
      perenos1 = False
      perenos2 = False
      perenos3 = False
      perenos4 = True
      If TmpShvidkist >= Shvidkist Then PoKolu =  0 : TmpShvidkist =  0  Else TmpShvidkist = TmpShvidkist +  1 
  End Select
End If

Static UdarS As Boolean
Static UdarDali As Byte
Static UdarPause As Byte
Static DaliReg As Byte

If ZagRegVibSvMusic =  2  Then
  If Y > MaximBass Then perenos5 = True Else perenos5 = False
  Select Case Y
   Case Is > MaximBass
    UdarS = True
   Case Is < MinimBass
    UdarS = False
  End Select
  
  UdarPause = UdarPause +  1 
  If UdarPause >  100  Then UdarPause =  100 
  If UdarPause >  5  And UdarS = True Then UdarPause =  0  Else UdarS = False

  If UdarS = True Then
    Select Case UdarDali
     Case  0 
      perenos1 = True
      perenos2 = False
      perenos3 = False
      perenos4 = False
      UdarDali =  1 
     Case  1 
      perenos1 = False
      perenos2 = True
      perenos3 = False
      perenos4 = False
      UdarDali =  2 
     Case  2 
      perenos1 = False
      perenos2 = False
      perenos3 = True
      perenos4 = False
      UdarDali =  3 
     Case  3 
      perenos1 = False
      perenos2 = False
      perenos3 = False
      perenos4 = True
      UdarDali =  0 
    End Select
        UdarS = False

  End If
End If

If ZagRegVibSvMusic =  3  Then
 Static L41 As Byte
 Static L42 As Byte
 Static L43 As Byte
 Static L44 As Byte
 Static L45 As Byte
  
  perenos4 = False
  perenos3 = False
  perenos2 = False
  perenos1 = False
  L41 = L41 +  1 : If L41 >  100  Then L41 =  100 
  L42 = L42 +  1 : If L42 >  100  Then L42 =  100 
  L43 = L43 +  1 : If L43 >  100  Then L43 =  100 
  L44 = L44 +  1 : If L44 >  100  Then L44 =  100 
  L45 = L45 +  1 : If L45 >  100  Then L45 =  100 
  If Y + (Y *  30  /  100 ) > MaximBass And L44 >  16  Then L44 =  0 
  If Y + (Y *  50  /  100 ) > MaximBass And L41 >  8  Then L41 =  0 
  If Y + (Y *  10  /  100 ) > MaximBass And L43 >  12  Then L43 =  0 
  If Y + (Y *  30  /  100 ) > MaximBass And L42 >  16  Then L42 =  0 
  If Y - (Y *  5  /  100 ) > MaximBass And L45 >  32  Then L45 =  0 
  If L44 <  6  Then perenos4 = True Else perenos4 = False
  If L41 <  4  Then perenos1 = True Else perenos1 = False
  If L43 <  4  Then perenos3 = True Else perenos3 = False
  If L42 <  6  Then perenos2 = True Else perenos2 = False
  If L45 <  10  Then perenos5 = True Else perenos5 = False
End If

If ZagRegVibSvMusic =  4  Then
 Static L55 As Byte
  L55 = L55 +  1 : If L55 >  100  Then L55 =  100 
  If Y > MaximBass And L55 >  5  Then L55 =  0 
  
  If L55 > - 1  And L55 <  8  Then perenos1 = True Else perenos1 = False
  If L55 >  2  And L55 <  9  Then perenos4 = True Else perenos4 = False
  If L55 >  2  And L55 <  9  Then perenos2 = True Else perenos2 = False
  If L55 >  4  And L55 <  10  Then perenos3 = True Else perenos3 = False
  If L55 >  6  And L55 <  12  Then perenos5 = True Else perenos5 = False
End If

If ZagRegVibSvMusic =  5  Then
 Static L65 As Byte
  L65 = L65 +  1 : If L65 >  100  Then L65 =  100 
  If Y > MaximBass And L65 >  5  Then L65 =  0 
  
  If L65 > - 1  And L65 <  8  Then perenos4 = True Else perenos4 = False
  If L65 >  3  And L65 <  9  Then perenos1 = True Else perenos1 = False
  If L65 >  6  And L65 <  10  Then perenos2 = True Else perenos2 = False
  perenos3 = perenos1
  perenos5 = perenos1
End If

If ZagRegVibSvMusic =  6  Then

 If Int(Rnd( 1 ) *  77 ) =  7  Then
  DaliReg = Int(Rnd( 1 ) *  4 )
 End If
  If Y > MaximBass Then perenos5 = True Else perenos5 = False
  Select Case Y
   Case Is > MaximBass
    UdarS = True
   Case Is < MinimBass
    UdarS = False
  End Select
  
  UdarPause = UdarPause +  1 
  If UdarPause >  100  Then UdarPause =  100 
  If UdarPause >  5  And UdarS = True Then UdarPause =  0  Else UdarS = False

If DaliReg =  0  Then
  If UdarS = True Then
    Select Case UdarDali
     Case  0 
      perenos1 = True
      perenos2 = False
      UdarDali =  1 
     Case  1 
      perenos1 = False
      perenos2 = True
      UdarDali =  0 
     Case Is >  1 
      UdarDali =  0 
    End Select
   UdarS = False
  End If
   perenos3 = perenos1
   perenos4 = perenos2
End If
If DaliReg =  1  Then
  If UdarS = True Then
    Select Case UdarDali
     Case  0 
      perenos1 = True
      perenos3 = False
      UdarDali =  1 
     Case  1 
      perenos1 = False
      perenos3 = True
      UdarDali =  0 
    End Select
   UdarS = False
  End If
   perenos2 = perenos1
   perenos4 = perenos3
End If
  
  
If DaliReg =  2  Then
  If UdarS = True Then
    Select Case UdarDali
     Case  0 
      perenos2 = False
      perenos1 = False
      perenos4 = True
      UdarDali =  1 
     Case  1 
      perenos2 = False
      perenos1 = True
      perenos4 = False
      UdarDali =  2 
     Case  2 
      perenos2 = True
      perenos1 = False
      perenos4 = False
      UdarDali =  3 
     Case  3 
      perenos2 = False
      perenos1 = True
      perenos4 = False
      UdarDali =  0 
    End Select
   UdarS = False
   perenos3 = perenos1
  End If
End If

If DaliReg =  3  Then
  If UdarS = True Then
    Select Case UdarDali
     Case  0 
      perenos1 = True
      perenos2 = False
      perenos3 = False
      UdarDali =  1 
     Case  1 
      perenos1 = False
      perenos2 = True
      perenos3 = False
      UdarDali =  2 
     Case  2 
      perenos1 = False
      perenos2 = False
      perenos3 = True
      UdarDali =  3 
     Case  3 
      perenos1 = False
      perenos2 = True
      perenos3 = False
      UdarDali =  0 
    End Select
   UdarS = False
   perenos4 = perenos2
  End If
End If


End If

 frmBassTest.TVicLPT1.DataPort = (IIf(perenos1 = True,  1 ,  0 ) * UprKanalLPT1) + (IIf(perenos2 = True,  1 ,  0 ) * UprKanalLPT2) + (IIf(perenos3 = True,  1 ,  0 ) * UprKanalLPT3) + (IIf(perenos4 = True,  1 ,  0 ) * UprKanalLPT4) + (IIf(perenos5 = True,  1 ,  0 ) * UprKanalLPT5) + (IIf(perenos6 = True,  1 ,  0 ) * UprKanalLPT6) + (IIf(perenos7 = True,  1 ,  0 ) * UprKanalLPT7) + (IIf(perenos8 = True,  1 ,  0 ) * UprKanalLPT8)
End Sub

...
Рейтинг: 0 / 0
Перехват потока Звука
    #36625491
Фотография Андрей159
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Форма еквалайзера frmSpectrum
Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
39.
40.
41.
42.
43.
44.
45.
46.
47.
48.
49.
50.
51.
52.
53.
54.
55.
56.
57.
58.
59.
60.
61.
62.
63.
64.
65.
66.
67.
68.
69.
70.
71.
72.
73.
74.
75.
76.
77.
78.
79.
80.
81.
82.
83.
84.
85.
86.
87.
88.
89.
90.
91.
92.
93.
94.
95.
96.
97.
98.
99.
100.
Option Explicit

' display error messages
Sub Error_(ByVal es As String)
    Call MsgBox(es & vbCrLf & vbCrLf & "error code: " & BASS_ErrorGetCode, vbExclamation, "Error")
End Sub

Private Sub Form_Load()
    specpos =  0 
    specmode =  0 

    ' create bitmap to draw spectrum in - 8 bit for easy updating :)
    With bh.bmiHeader
        .biBitCount =  8 
        .biPlanes =  1 
        .biSize = Len(bh.bmiHeader)
        .biWidth = SPECWIDTH
        .biHeight = SPECHEIGHT  ' upside down (line 0=bottom)
        .biClrUsed =  256 
        .biClrImportant =  256 
    End With

    Dim a As Byte

    ' setup palette
 '   For a = 1 To 127
 '       bh.bmiColors(a).rgbGreen = 256 - 2 * a
 '       bh.bmiColors(a).rgbRed = 2 * a
 '   Next a
    For a =  1  To  254 
     bh.bmiColors(a).rgbBlue = a \  10 
     bh.bmiColors(a).rgbRed = a \  2  +  120 
    Next a

frmSpectrum.top =  110 
frmSpectrum.Left =  9300 
frmSpectrum.Height =  3400  +  1030 
frmSpectrum.Width =  5910 
    
FrmImage.top =  110 
FrmImage.Left =  9300 
FrmImage.Height =  3400  +  1030 
FrmImage.Width =  5910 
    
    
    ' setup update timer (40hz)
#If  1  Then
    tmrSpectrum.Enabled = True
#Else
    timing = timeSetEvent( 25 ,  25 , AddressOf UpdateSpectrum,  0 , TIME_PERIODIC) '  API MM timer
#End If
End Sub


Private Sub Form_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    specmode = (specmode +  1 ) Mod  4   ' swap spectrum mode
    ReDim specbuf(SPECWIDTH * (SPECHEIGHT +  1 )) As Byte ' clear display
End Sub

Private Sub Form_Unload(Cancel As Integer)
    If (timing) Then Call timeKillEvent(timing)
    tmrSpectrum.Enabled = False
    Call BASS_Free
    End
End Sub

Private Sub Timer1_Timer()
    Dim a As Long
    For a =  254  To  1  Step - 1 
        If a <  3  Then
          If bh.bmiColors(a).rgbBlue <  254  Then
           bh.bmiColors(a).rgbBlue = bh.bmiColors(a).rgbBlue +  1 
          Else
           bh.bmiColors(a).rgbBlue =  0 
          End If
          If bh.bmiColors(a).rgbGreen <  253  Then
            bh.bmiColors(a).rgbGreen = bh.bmiColors(a).rgbGreen +  2 
          Else
            bh.bmiColors(a).rgbGreen =  0 
          End If
          If bh.bmiColors(a).rgbRed <  252  Then
            bh.bmiColors(a).rgbRed = bh.bmiColors(a).rgbRed +  3 
          Else
            bh.bmiColors(a).rgbRed =  0 
          End If
        Else
          bh.bmiColors(a).rgbBlue = bh.bmiColors(a -  1 ).rgbBlue
          bh.bmiColors(a).rgbGreen = bh.bmiColors(a -  1 ).rgbGreen
          bh.bmiColors(a).rgbRed = bh.bmiColors(a -  1 ).rgbRed
        End If
    Next a

End Sub

Private Sub tmrSpectrum_Timer()
    tmrSpectrum.Interval =  500 
    Call UpdateSpectrum( 0 ,  0 ,  0 ,  0 ,  0 )  ' the params are if using the API MM timer
End Sub


...
Рейтинг: 0 / 0
Перехват потока Звука
    #36625523
Фотография Игорь Горбонос
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
А можно было это все выложить одним архивчиком с маленьким тестовым примером?
:)

Posted via ActualForum NNTP Server 1.4
...
Рейтинг: 0 / 0
Перехват потока Звука
    #36625603
Фотография Андрей159
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
http://www.youtube.com/v/NJ9yhCXgIKw
...
Рейтинг: 0 / 0
Перехват потока Звука
    #36625630
Фотография Андрей159
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Да. да. Конечно. Я собрал несколько примеров. В самом примере с аквалайзером есть и другие настройки. Просто попробуйте изменить значения (посмотрите в код. все доступно). И Bass.dll бросайте в system32, тогда все заработает. Качаем архив отсюда .
...
Рейтинг: 0 / 0
Период между сообщениями больше года.
Перехват потока Звука
    #38325578
donpauls
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Андрей159,

А можно каким то способом перехватив звук - записать его, скажем в файл wav?
Только интересует не тот звук, что ВХОДИТ в звуковую карту (микрофонный вход), а тот что выходит (линейный выход)
...
Рейтинг: 0 / 0
Перехват потока Звука
    #38337787
Volodbka
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
да вы батенька шпион
...
Рейтинг: 0 / 0
Перехват потока Звука
    #38337891
Фотография Андрей159
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Если сравнивать треки на сходство - моя прога распознает фанеру и оригинал, запись из кассеты (на пленку) и оригинал. На ютубе еще не было такого движка. Сейчас они рванули далеко вперед. Уже есть распознавание речи. Распознавание речи и я реализовал, но ошибки есть при распознавании. Можно научить программу делать только ранее заученные действия. Если будет кто-то другой командовать, иногда могут быть ошибки. Словарь для корректировки не всегда помогает. Главную задачу поставил не распознавание речи, а распознавание тональности, чтобы можно было сравнивать треки на сходство даже если один трек будет немножко замедленно играть. А тут наткнулся на проблему в которой Bass.dll пока что не может ничем помочь своим упрощением. Одна нота дублируется не только на октаву выше, а и в кванту и много непонятного. Только правильная синусоидная волна занимает ровно один диапазон. А если звук открыть типа как эффектом Reso или просто сделать волну треугольную, то все... нота дублируется в 6, 12, 24... дополнительных еле слышных нот, которые человек распознает как одну ноту. Я пробовал на программе Reason 7.0 синтезировать подобное. Наложил простых sinus звуков так как видел на картинке и у меня с просто звука получился острый. Можно представить когда рот закрыт и когда открыт буквой "О" или "А" ... "Е". Мы понимаем одну ноту, а звуков там море. Если слушать трек, то линейный (не аквалайзер а спектральный анализ) показывает такую кашу в которой разобраться очень сложно. Можно отличать где ударные, примерный бас (ноту) и хет тарелки. Для более глубокого изучения нужно более глубокий масштаб проникновения в спектр, которого Bass.dll не дает, а на формулы сейчас нет времени. И так много времени ушло.
...
Рейтинг: 0 / 0
12 сообщений из 12, страница 1 из 1
Форумы / Visual Basic [игнор отключен] [закрыт для гостей] / Перехват потока Звука
Целевая тема:
Создать новую тему:
Автор:
Закрыть
Цитировать
Найденые пользователи ...
Разблокировать пользователей ...
Читали форум (0):
Пользователи онлайн (0):
x
x
Закрыть


Просмотр
0 / 0
Close
Debug Console [Select Text]