purebasic.info

PureBasic forum
Текущее время: Вс июл 12, 2020 5:59 pm

Часовой пояс: UTC + 3 часа




Начать новую тему Ответить на тему  [ Сообщений: 152 ]  На страницу Пред.  1 ... 5, 6, 7, 8, 9, 10, 11  След.
Автор Сообщение
 Заголовок сообщения:
СообщениеДобавлено: Пн окт 04, 2010 3:32 pm 
Не в сети
профессор
Аватар пользователя

Зарегистрирован: Пн сен 07, 2009 10:00 pm
Сообщений: 1046
Откуда: Николаев
Благодарил (а): 0 раз.
Поблагодарили: 0 раз.
Пункты репутации: 0
Может так ? PB 4.41


Вложения:
Spectr.rar [4.42 KiB]
Скачиваний: 433

_________________
www.mirashic.narod.ru
Первое знакомство с PB
Вернуться наверх
 Профиль  
 
 Заголовок сообщения:
СообщениеДобавлено: Пн окт 04, 2010 3:37 pm 
Не в сети
МОДЕРАТОР
Аватар пользователя

Зарегистрирован: Пн апр 09, 2007 4:53 pm
Сообщений: 11708
Благодарил (а): 4 раз.
Поблагодарили: 512 раз.
radan писал(а):
Изображение
Подскажите, хоть в каком направлении копать?
Это значит что структура WAVEFORMATEX уже объявлена.
Её объявление нужно исключить из текста программы.

_________________
Компьютер позволяет решать все те проблемы, которые до его изобретения не существовали. :) :)


Вернуться наверх
 Профиль  
 
 Заголовок сообщения:
СообщениеДобавлено: Пн окт 04, 2010 3:42 pm 
Не в сети
доцент

Зарегистрирован: Ср янв 02, 2008 10:51 am
Сообщений: 29
Благодарил (а): 0 раз.
Поблагодарили: 0 раз.
Пункты репутации: 0
Большое спасибо!


Вернуться наверх
 Профиль  
 
 Заголовок сообщения:
СообщениеДобавлено: Пн янв 03, 2011 4:53 pm 
Не в сети
профессор
Аватар пользователя

Зарегистрирован: Пн сен 07, 2009 10:00 pm
Сообщений: 1046
Откуда: Николаев
Благодарил (а): 0 раз.
Поблагодарили: 0 раз.
Пункты репутации: 0
Запись на BASS
Методом научного тыка, разобрался как произвести запись онлайн звукового потока на библиотеке Bass.dll
В принципе ничего сложного, реализуется в пару строк...

В функции BASS_StreamCreateURL добавляем адрес процедуры записи, все по справке:

Код:
1
2
3
4
5
6
7
 
CALLBACK DownloadProc(
    void *buffer,
    DWORD length,
    void *user
);
 


Дла PureBasic это выглядит так:

Код:
1
2
3
4
5
6
7
8
 
Global *mem=AllocateMemory(400000) ;Выделяет область памяти указанного размера
 
Procedure Rec(*mem,*length, user) ; процедура записи
 WriteData(#file,*mem, *length)
EndProcedure
BASS_StreamCreateURL(url.s, 0, 0, @Rec(), 0)
 



Вот весь рабочий код:

Код:
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
 
Enumeration
 #Window_0
 #file
 #spektr
 #Hyper
EndEnumeration
IncludeFile "bass.pbi" ; библиотека BASS
Global  Handle, color =RGB(137, 127, 98), rec=0
 
CreateImage(#spektr,1,15)  ; спектр
 
Procedure Tamer()
;----------спектр----------------------
Dim FFT.f(1024)
wer=BASS_ChannelGetData(Handle,@FFT(),#BASS_DATA_FFT2048)
 For f=0 To 85
 Val= Sqr(FFT(f))  * 40            ;получение параметра по частотам
 If wer= -1
  Val=1
 EndIf
 StartDrawing(ImageOutput(#spektr))
   Box(0,0,1,15,RGB(0, 0, 0))
   Box(0,15-Val,1,Val,color)
   ;Box(0,15-Val,1,Val/6,RGB(240, 241, 220)) ;RGB(240, 241, 220)
 StopDrawing()
SetGadgetState(100+f,ImageID(#spektr))
 Next f
 ;------------------------------------------------
EndProcedure
 
Global *mem=AllocateMemory(400000) ;Выделяет область памяти указанного размера
 
Procedure Rec(*mem,*length, user) ; процедура записи
; *mem    указатель на буфер для загружаемых данных ... NULL = завершения загрузки
; *length Длина число байт в буфере ... 0 = HTTP или ICY тегов.
If rec=1
 WriteData(#file,*mem, *length)
EndIf
EndProcedure
 
OpenWindow (#Window_0,0,0,200,100,"Запись Bass", #WS_OVERLAPPEDWINDOW|#PB_Window_ScreenCentered )
SetWindowColor(#Window_0,RGB(0, 0, 0))
  x=10:y=23
  For f=0 To 85
    ImageGadget(100+f,x,y,0,0,ImageID(#spektr))   ; вывод спектра
    x=x+(1+1)
  Next f
 
HyperLinkGadget(#Hyper,15,50,100,15,"Воспроизведение",RGB(137, 127, 98))
   SetGadgetColor(#Hyper, #PB_Gadget_FrontColor, RGB(137, 127, 98))
   SetGadgetColor(#Hyper, #PB_Gadget_BackColor, RGB(0, 0, 0))
 
BASS_Init(-1, 44100, 0, WindowID(#Window_0), #Null) ; инициализация
BASS_ChannelSetAttribute( Handle,#BASS_ATTRIB_VOL,1) ; начальная громкость
Handle=BASS_StreamCreateURL("http://193.46.83.122:8030", 0, 0, @Rec(), 0)
BASS_ChannelPlay(Handle,0)  ;играть
 
SetTimer_(WindowID(#Window_0),Event,50,@Tamer()) ;опрос по таймеру
Repeat
Event =  WaitWindowEvent()
Window = EventWindow()
Gadget = EventGadget()
  Select Event
        Case #PB_Event_Gadget
          Select EventGadget()
             Case #Hyper
              Klik = Klik ! 1
              If Klik=1
               color=RGB(253, 2, 2)
               SetGadgetText(#Hyper, "Идёт звпись!")
               name.s=FormatDate("%hh_%ii_%ss"+".mp3", Date()) ;имя файла
               CreateFile(#file,name)  ;создаём файл для записи
               rec=1
              Else
               color=RGB(137, 127, 98)
               SetGadgetText(#Hyper, "Воспроизведение")
               rec=0
               CloseFile(#file)
              EndIf
          EndSelect
   EndSelect
If Event = #PB_Event_CloseWindow
Break  
EndIf
ForEver
 



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


Вложения:
Rec.rar [109.1 KiB]
Скачиваний: 408

_________________
www.mirashic.narod.ru
Первое знакомство с PB
Вернуться наверх
 Профиль  
 
 Заголовок сообщения:
СообщениеДобавлено: Вт мар 29, 2011 9:30 pm 
Не в сети
профессор
Аватар пользователя

Зарегистрирован: Пн сен 07, 2009 10:00 pm
Сообщений: 1046
Откуда: Николаев
Благодарил (а): 0 раз.
Поблагодарили: 0 раз.
Пункты репутации: 0
В начале темы выкладывал OnLine_TV плеер.
Ссылки на видео потоки быстро устаревают...
По просьбе знакомых, кому раздовал, переписал код.
Сделал парсинг сайта http://ru.2onlinetv.com/,
по мере устаревания ссылок на потоки, они возобновляются..
EXE файл 39КБ
Код:
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
; Последнее изменение:29 Март, 2011 @ 9:14:12 PM
Enumeration
 #Window_0=333
 #List
 #Web
 #Container
EndEnumeration
 
Global Dim URL_ID.s(100)
 
Procedure.s Between_2(string.s, L.s, R.s)  
 Position = FindString(string, L.s, 1)
 string2.s = Right(string, Len(string)+1-Position-Len(L.s))
 Position2 = FindString(string2, R.s, 1)
 string3.s = Left(string2, Position2-1)
 If Position <> 0
  ProcedureReturn string3.s
 EndIf
EndProcedure
 
Procedure Onlinetv(url.s)
URLDownloadToFile_(0,url.s,"2onlinetv.txt",0,0)
 If ReadFile(0,"2onlinetv.txt")
  While Eof(0) = 0  
  string.s=  ReadString(0)
   If FindString(string,"bgcolor='#F3F3F3'",1)
    URL_ID.s(n)="http://ru.2onlinetv.com/"+Between_2(string.s,"href='","'")
    AddGadgetItem(#List,-1,Str(n)+"    "+Between_2(string.s,"title='","'"))
    n=n+1
   EndIf
  Wend
 CloseFile(0)
 EndIf
EndProcedure
 
Procedure HTML2(potok.s)
 HTML.s="<style type='text/css'>.con{position: absolute; left: 0px; top: 0px;}</style>"
 
 HTML= HTML + "<div class='con'><object id='MediaPlayer' CLASSID='CLSID:22D6f312-B0F6-11D0-94AB-0080C74C7E95' "
 HTML= HTML + "CODEBASE='http://activex.microsoft.com/activex/controls/mplayer/en/nsmp2inf.cab#Version=6, 4, 5, 715' "
 HTML= HTML + "width='490' height='370' standby='Loading Microsoft Windows Media Player components...' "
 HTML= HTML + "type='application/x-oleobject'> "
 HTML= HTML + "<param name='FileName' value='"+potok+"'> "
 HTML= HTML + "<param name='TransparentAtStart' value='true'> "
 HTML= HTML + "<param name='wmode' value='transparent'> "
 HTML= HTML + "<param name='AutoStart' value='true'> "
 HTML= HTML + "<param name='AnimationatStart' value='false'> "
 HTML= HTML + "<param name='ShowStatusBar' value='true'> "
 HTML= HTML + "<param value='false' name='enableContextMenu'/> "
 HTML= HTML + "<param name='ShowControls' value='true'> "
 HTML= HTML + "<param name='autoSize' value='false'> "
 HTML= HTML + "<param name='displaySize' value='false'> "
 HTML= HTML + "<param name='ShowAudioControls' value='true'> "
 HTML= HTML + "<param name='ShowPositionControls' value='true'> "
 HTML= HTML + "<param name='windowlessVideo' value='false'></div> "
 
 DeleteFile("TV_onlain.htm")
  If OpenFile(0, "TV_onlain.htm")  
    FileSeek(0, Lof(0))
    WriteString(0,HTML)
    CloseFile(0)
  EndIf
SetGadgetText(#Web,"file://localhost/"+GetPathPart(ProgramFilename())+"TV_onlain.htm")
EndProcedure
 
Procedure TV(url.s)
URLDownloadToFile_(0,url.s,"TV.txt",0,0)
 If ReadFile(0,"TV.txt")
  While Eof(0) = 0  
  string.s=  ReadString(0)
    potok.s= Between_2(string,"value="+Chr(34),Chr(34))
    If potok <> ""
     Break
    EndIf
  Wend
 CloseFile(0)
 EndIf
 HTML2(potok.s)
EndProcedure
 
 
OpenWindow(#Window_0,0,0,505,700,"ru.2onlinetv.com",#PB_Window_MinimizeGadget|#PB_Window_SystemMenu|#PB_Window_ScreenCentered|#PB_Window_Invisible) ;#CRLF$
 ListIconGadget(#List,7,390,490,300,"",0)
 AddGadgetColumn(#List,0, "Список русскоязычных каналов",370)
  ContainerGadget(#Container, 8, 8, 490,370,0)
   WebGadget(#Web,0,0,590,410,"file://localhost/"+GetPathPart(ProgramFilename())+"TV_onlain.htm")
  CloseGadgetList()
 Onlinetv("http://ru.2onlinetv.com/")
 
HideWindow(#Window_0, 0)
Repeat
Event =  WaitWindowEvent()
 
  Select Event
   Case #PB_Event_CloseWindow
    Break  
   Case #PB_Event_Gadget
    Select EventGadget()
     Case #List
      Spisok=GetGadgetState(#List)
      If EventType()=#PB_EventType_LeftDoubleClick And Spisok <>-1
       MessageBeep(#MB_ICONASTERISK) ;  вывод  системного звука
       TV(URL_ID.s(Spisok))
       SetWindowTitle(#Window_0,GetGadgetText(#List))
      EndIf
   EndSelect            
  EndSelect  
 
ForEver
 
 
 


_________________
www.mirashic.narod.ru
Первое знакомство с PB


Вернуться наверх
 Профиль  
 
 Заголовок сообщения:
СообщениеДобавлено: Вт май 24, 2011 1:35 pm 
Не в сети
профессор

Зарегистрирован: Вт мар 24, 2009 11:54 am
Сообщений: 357
Благодарил (а): 15 раз.
Поблагодарили: 18 раз.
Пункты репутации: 19
mirashic

модифицирован код спектрометра, т е используется один гаджет а не несколько

Код:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Dim FFT.f(1024)
 BASS_ChannelGetData(Handle,@FFT(),#BASS_DATA_FFT2048)
For f=0 To 45
   Val= Sqr(FFT(f))  * 80            ;получение параметра по частотам
   StartDrawing(ImageOutput(#spektr))
   Box(f*h,0,3,h_s,global_color)
   Box(f*h,h_s-Val,3,h_s,RGB(130, 213, 87))        
    a=h_s
  For d=0 To 20
    LineXY(0, a-2,  w_s, a-2,  RGB(0, 0, 0))
    a=a-4
  Next d  
   StopDrawing()
   SetGadgetState(#spektr_w,ImageID(#spektr))
 Next f



Вернуться наверх
 Профиль  
 
 Заголовок сообщения:
СообщениеДобавлено: Вт май 24, 2011 3:06 pm 
Не в сети
профессор
Аватар пользователя

Зарегистрирован: Пн сен 07, 2009 10:00 pm
Сообщений: 1046
Откуда: Николаев
Благодарил (а): 0 раз.
Поблагодарили: 0 раз.
Пункты репутации: 0
Тогда весь код, чтоб было понятней:
Код:
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
Enumeration
 #Window_0
 #file
 #spektr
 #Hyper
 #spektr_w
EndEnumeration
IncludeFile "bass.pbi" ; библиотека BASS
Global  Handle, color =RGB(130, 213, 87), rec=0
 
CreateImage(#spektr,230,25)  ; спектр
 
Procedure Tamer()
;----------спектр----------------------
h_s = 25
h   = 4  
w_s = 230
 
Dim FFT.f(1024)
  BASS_ChannelGetData(Handle,@FFT(),#BASS_DATA_FFT2048)
 For f=0 To 57
    Val= Sqr(FFT(f))  * 80            
    StartDrawing(ImageOutput(#spektr))
    Box(f*h,0,3,h_s,RGB(41, 41, 41))
    Box(f*h,h_s-Val,3,h_s,color)
    Box(f*h,h_s-Val,3,Val/15,RGB(195, 14, 37))      
     a=h_s
   For d=0 To 20
     LineXY(0, a-2,  w_s, a-2,  RGB(0, 0, 0))
     a=a-2
   Next d  
    StopDrawing()
    SetGadgetState(#spektr_w,ImageID(#spektr))
  Next f
 ;------------------------------------------------
EndProcedure
 
Global *mem=AllocateMemory(400000) ;Выделяет область памяти указанного размера
 
Procedure Rec(*mem,*length, user) ; процедура записи
; *mem    указатель на буфер для загружаемых данных ... NULL = завершения загрузки
; *length Длина число байт в буфере ... 0 = HTTP или ICY тегов.
If rec=1
 WriteData(#file,*mem, *length)
EndIf
EndProcedure
 
OpenWindow (#Window_0,0,0,250,100,"Запись Bass", #WS_OVERLAPPEDWINDOW|#PB_Window_ScreenCentered )
SetWindowColor(#Window_0,RGB(0, 0, 0))
 
 ImageGadget(#spektr_w,10,20,230,25,ImageID(#spektr))   ; вывод спектра
 
 
HyperLinkGadget(#Hyper,15,50,100,15,"Воспроизведение",RGB(137, 127, 98))
   SetGadgetColor(#Hyper, #PB_Gadget_FrontColor, RGB(137, 127, 98))
   SetGadgetColor(#Hyper, #PB_Gadget_BackColor, RGB(0, 0, 0))
 
BASS_Init(-1, 44100, 0, WindowID(#Window_0), #Null) ; инициализация
BASS_ChannelSetAttribute( Handle,#BASS_ATTRIB_VOL,1) ; начальная громкость
Handle=BASS_StreamCreateURL("http://193.46.83.122:8030", 0, 0, @Rec(), 0)
BASS_ChannelPlay(Handle,0)  ;играть
 
SetTimer_(WindowID(#Window_0),Event,50,@Tamer()) ;опрос по таймеру
Repeat
Event =  WaitWindowEvent()
Window = EventWindow()
Gadget = EventGadget()
  Select Event
        Case #PB_Event_Gadget
          Select EventGadget()
             Case #Hyper
              Klik = Klik ! 1
              If Klik=1
               color=RGB(222, 13, 10)
               SetGadgetText(#Hyper, "Идёт запись!")
               name.s=FormatDate("%hh_%ii_%ss"+".mp3", Date()) ;имя файла
               CreateFile(#file,name)  ;создаём файл для записи
               rec=1
              Else
               color=RGB(130, 213, 87)
               SetGadgetText(#Hyper, "Воспроизведение")
               rec=0
               CloseFile(#file)
              EndIf
          EndSelect
   EndSelect
If Event = #PB_Event_CloseWindow
Break  
EndIf
ForEver
;-----------------------------------
 


_________________
www.mirashic.narod.ru
Первое знакомство с PB


Вернуться наверх
 Профиль  
 
 Заголовок сообщения:
СообщениеДобавлено: Ср май 25, 2011 8:10 am 
Не в сети
профессор

Зарегистрирован: Вт мар 24, 2009 11:54 am
Сообщений: 357
Благодарил (а): 15 раз.
Поблагодарили: 18 раз.
Пункты репутации: 19
Интересная весчь, может это как нибудь решаемо
НО... громкость регулируется общая (по крайне мере в ХР), а не ...внутри плеера
:(


Вернуться наверх
 Профиль  
 
 Заголовок сообщения:
СообщениеДобавлено: Ср май 25, 2011 8:43 am 
Не в сети
профессор
Аватар пользователя

Зарегистрирован: Пн сен 07, 2009 10:00 pm
Сообщений: 1046
Откуда: Николаев
Благодарил (а): 0 раз.
Поблагодарили: 0 раз.
Пункты репутации: 0
Код:
1
BASS_ChannelSetAttribute(Handle,#BASS_ATTRIB_VOL,vol)


vol - меняем от 0 до 1, у меня меняется громкость только в плеере. (XP)

Код:
1
BASS_SetVolume(vol)

- общая громкость...

_________________
www.mirashic.narod.ru
Первое знакомство с PB


Вернуться наверх
 Профиль  
 
 Заголовок сообщения:
СообщениеДобавлено: Ср май 25, 2011 3:22 pm 
Не в сети
профессор

Зарегистрирован: Вт мар 24, 2009 11:54 am
Сообщений: 357
Благодарил (а): 15 раз.
Поблагодарили: 18 раз.
Пункты репутации: 19
Понятно...
а где по плагину документацию почитать можно?


Вернуться наверх
 Профиль  
 
 Заголовок сообщения:
СообщениеДобавлено: Ср май 25, 2011 3:41 pm 
Не в сети
профессор
Аватар пользователя

Зарегистрирован: Пн сен 07, 2009 10:00 pm
Сообщений: 1046
Откуда: Николаев
Благодарил (а): 0 раз.
Поблагодарили: 0 раз.
Пункты репутации: 0
У меня только эта HTML-en справка :


Вложения:
bass.rar [202.75 KiB]
Скачиваний: 370

_________________
www.mirashic.narod.ru
Первое знакомство с PB
Вернуться наверх
 Профиль  
 
 Заголовок сообщения:
СообщениеДобавлено: Пн июн 20, 2011 8:43 am 
Не в сети
профессор

Зарегистрирован: Вт мар 24, 2009 11:54 am
Сообщений: 357
Благодарил (а): 15 раз.
Поблагодарили: 18 раз.
Пункты репутации: 19
Вот моя версия плеера


Вложения:
Комментарий к файлу: версия 0.4
внутри значек компи лированный файл и исходник
ДЛЛ и Лиьу добавьте в папку

Плеер.rar [86.01 KiB]
Скачиваний: 397
Вернуться наверх
 Профиль  
 
 Заголовок сообщения:
СообщениеДобавлено: Пн июн 20, 2011 9:01 am 
Не в сети
профессор
Аватар пользователя

Зарегистрирован: Пн сен 07, 2009 10:00 pm
Сообщений: 1046
Откуда: Николаев
Благодарил (а): 0 раз.
Поблагодарили: 0 раз.
Пункты репутации: 0
Класс!
А где онлайн FM?

_________________
www.mirashic.narod.ru
Первое знакомство с PB


Вернуться наверх
 Профиль  
 
 Заголовок сообщения:
СообщениеДобавлено: Пн июн 20, 2011 9:40 am 
Не в сети
профессор

Зарегистрирован: Вт мар 24, 2009 11:54 am
Сообщений: 357
Благодарил (а): 15 раз.
Поблагодарили: 18 раз.
Пункты репутации: 19
mirashic
прикручу
надеюсь скоро :wink:


Вернуться наверх
 Профиль  
 
 Заголовок сообщения:
СообщениеДобавлено: Пн мар 26, 2012 7:58 pm 
Не в сети
профессор
Аватар пользователя

Зарегистрирован: Сб май 21, 2011 10:27 pm
Сообщений: 246
Откуда: Брест , Беларусь
Благодарил (а): 0 раз.
Поблагодарили: 0 раз.
Пункты репутации: 0
Модернизировал код,заранее mirashic извиняюсь!
Добавлен индикатор громкости
Частично исправлены подглюкивания вылета Эквалайзера


Вложения:
RadioBass.rar [284.59 KiB]
Скачиваний: 327
RadioBass.rar [284.59 KiB]
Скачиваний: 315

_________________
Выпьем ещё раз - чтобы выпить в следущий раз! (С) Иван Пашкевич
Вернуться наверх
 Профиль  
 
Показать сообщения за:  Сортировать по:  
Начать новую тему Ответить на тему  [ Сообщений: 152 ]  На страницу Пред.  1 ... 5, 6, 7, 8, 9, 10, 11  След.

Часовой пояс: UTC + 3 часа


Кто сейчас на форуме

Сейчас этот форум просматривают: нет зарегистрированных пользователей и гости: 1


Вы не можете начинать темы
Вы не можете отвечать на сообщения
Вы не можете редактировать свои сообщения
Вы не можете удалять свои сообщения
Вы не можете добавлять вложения

Найти:
Перейти:  
Создано на основе phpBB® Forum Software © phpBB Group (блог о phpBB)
Сборка создана CMSart Studio
Русская поддержка phpBB