A soundplayer and radio player with a basic WMP
This post follows the previous one and speaks of radio streamer and soundplayer (two in one) but with windows mediaplayer.
Before begin download the skin WMP image in the next section as it and rename it to ywmp1.png (put it in the source folder of the prg).
the animated gif of the player is from a web link.
can customize these two objects in code but adjust the clickable transparent shapes and labels...
the code make transparent the color gb(255,0,255) and set the top level form titlebar to zero.(choose a color dont exist on form objects to make it transparent).
the form is movable by mousedown.
can open, any supported media file on disc or navigate to any sound media url on the web to play.
the WMP is created as invisible and is public.its destroyed when exiting the form.
the internet radio FM urls are personal but can replace them with custom ones.
Of course internet must be connected (its tested on the code).
-Note: this is a basic souncplayer.Can add many wmp automations for other actions.Make a particular attention to choose the skin image(specially the borders for transparency).
can build an exe with a simple project (add the prg+skin+config.fpw and compile)
(for working with videos the WMP must be visible.see the links at the bottom of this article)
*the second code is a basic sound player based on the WMP.
Click on code to select [then copy] -click outside to deselect
*1*
if !_vfp.startmode=0
on shutdown quit
endi
local m.ycheck
m.ycheck=yinternet()
Publi yform
yform=Newobject("yradio_soundPlayer")
yform.Show
Read Events
Retu
*
Function yinternet()
Declare Integer InternetCheckConnection In wininet;
STRING lpszUrl, Integer dwFlags, Integer dwReserved
#Define FLAG_ICC_FORCE_CONNECTION 1
lcURL="http://www.microsoft.com"
lResult = (InternetCheckConnection(lcURL, FLAG_ICC_FORCE_CONNECTION, 0)=1)
If lResult=.T.
Return .T.
Else
Messagebox("There is no internet connexion ! this must be established mandatory to run some codes.",0+16,"internet Connection")
Return .F.
Endi
Endfunc
*
Define Class yradio_soundPlayer As Form
BorderStyle = 0
Height = 210
Width = 325
ShowWindow = 2
ShowTips = .T.
AutoCenter = .T.
Caption = "Form1"
BackColor = Rgb(255,0,255)
Name = "Form1"
Add Object image1 As Image With ;
Anchor = 15, ;
Picture = "ywmp1.png", ;
Stretch = 2, ;
Height = 198, ;
Left = 9, ;
Top = 0, ;
Width = 312, ;
Name = "Image1"
Add Object label2 As Label With ;
AutoSize = .T., ;
FontBold = .T., ;
FontName = "Webdings", ;
FontSize = 24, ;
BackStyle = 0, ;
Caption = "4", ;
Height = 35, ;
Left = 56, ;
MousePointer = 15, ;
Top = 152, ;
Width = 35, ;
ForeColor = Rgb(0,255,0), ;
ToolTipText = "Play/pause", ;
Name = "Label2"
Add Object shape1 As Shape With ;
Top = 6, ;
Left = 292, ;
Height = 10, ;
Width = 10, ;
BackStyle = 0, ;
MousePointer = 15, ;
ToolTipText = "Close", ;
Name = "Shape1"
Add Object shape2 As Shape With ;
Top = 6, ;
Left = 281, ;
Height = 10, ;
Width = 10, ;
BackStyle = 0, ;
MousePointer = 15, ;
ToolTipText = "Reduce", ;
Name = "Shape2"
Add Object label1 As Label With ;
AutoSize = .T., ;
FontBold = .T., ;
FontName = "Wingdings", ;
FontSize = 28, ;
BackStyle = 0, ;
BorderStyle = 1, ;
Caption = "1", ;
Height = 43, ;
Left = 48, ;
MousePointer = 15, ;
Top = 36, ;
Width = 53, ;
ForeColor = Rgb(0,255,0), ;
ToolTipText = "Open audio media file", ;
Name = "Label1"
Add Object image2 As Image With ;
Picture = Home(1)+"graphics\icons\misc\volume01.ico", ;
Stretch = 2, ;
BackStyle = 0, ;
Height = 27, ;
Left = 252, ;
MousePointer = 15, ;
Top = 158, ;
Width = 27, ;
ToolTipText = "Adjust system volume", ;
Name = "Image2"
Add Object label4 As Label With ;
FontBold = .T., ;
FontSize = 7, ;
Alignment = 2, ;
Caption = "", ;
Height = 18, ;
Left = 134, ;
Top = 2, ;
Width = 145, ;
ForeColor = Rgb(0,255,0), ;
BackColor = Rgb(0,0,0), ;
Name = "Label4"
Add Object timer1 As Timer With ;
Top = 0, ;
Left = 228, ;
Height = 23, ;
Width = 23, ;
Interval = 60000, ;
Name = "Timer1"
Add Object label5 As Label With ;
FontSize = 7, ;
fontbold=.T., ;
Alignment = 2, ;
BackStyle = 0, ;
Caption = "", ;
Height = 13, ;
Left = 108, ;
Top = 151, ;
Width = 168, ;
ForeColor = Rgb(255,255,0), ;
BackColor = Rgb(0,0,0), ;
Name = "Label5"
Add Object combo1 As ComboBox With ;
FontSize = 8, ;
RowSourceType = 2, ;
RowSource = "ycurs.station", ;
Height = 18, ;
Left = 35, ;
MousePointer = 15, ;
Style = 2, ;
ToolTipText = "My Radios", ;
Top = 96, ;
Width = 85, ;
ForeColor = Rgb(255,255,0), ;
BackColor = Rgb(128,0,64), ;
BorderStyle = 0, ;
DisplayCount = 10, ;
Name = "Combo1"
Add Object shape3 As Shape With ;
Top = 164, ;
Left = 101, ;
Height = 18, ;
Width = 24, ;
BackStyle = 0, ;
BorderStyle = 0, ;
BorderWidth = 2, ;
MousePointer = 15, ;
BorderColor = Rgb(255,0,0), ;
Name = "Shape3"
Add Object olecontrol1 As OleControl With ;
oleclass="shell.explorer.2", ;
Top = 24, ;
Left = 125, ;
Height = 125, ;
Width = 169, ;
Anchor = 768, ;
Name = "Olecontrol1"
Add Object yshape As Shape With ;
Top = 156, ;
Left = 293, ;
Height = 13, ;
Width = 12, ;
Curvature = 99, ;
MousePointer = 15 , ;
ToolTipText = "Mute on/off" , ;
BackColor = Rgb(255,0,0) , ;
Name = "Shape4"
Procedure shape4.Click
wmp.settings.mute=!wmp.settings.mute
Endproc
Procedure Init
Set Curs Off
Thisform.TitleBar=0
Thisform.label4.Caption=Dtoc(Date())+" "+Substr(Time(),1,5)
#Define LWA_COLORKEY 1
#Define LWA_ALPHA 2
#Define GWL_EXSTYLE -20
#Define WS_EX_LAYERED 0x80000
Local nExStyle, nRgb, nAlpha, nFlags
yHWnd=Thisform.HWnd
nExStyle = GetWindowLong(yHWnd, GWL_EXSTYLE)
nExStyle = Bitor(nExStyle, WS_EX_LAYERED)
= SetWindowLong(yHWnd, GWL_EXSTYLE, nExStyle)
nRgb = Thisform.BackColor &&the color to make transparent
nAlpha =128
nFlags = LWA_COLORKEY
= SetLayeredWindowAttributes(yHWnd, m.nRgb,m.nAlpha, m.nFlags)
Thisform.combo1.Value=ycurs.station
Thisform.combo1.click
Endproc
Procedure Destroy
Wmp=Null
Clea Events
Endproc
Procedure Load
Declare Integer GetWindowLong In user32;
INTEGER HWnd, Integer nIndex
Declare Integer SetWindowLong In user32;
INTEGER HWnd, Integer nIndex, Integer dwNewLong
Declare Integer SetLayeredWindowAttributes In user32;
INTEGER HWnd, Integer crKey,;
SHORT bAlpha, Integer dwFlags
Publi Wmp As WindowsMediaPlayer
Wmp = Createobject("WMPlayer.OCX.7")
With Wmp
.settings.autoStart = .T.
.settings.Volume=100
.settings.setMode('loop',.T.) &&loop
Endwith
Create Cursor ycurs (station c(12),yURL c(100))
&&adjust your radio FM urls here
Insert Into ycurs Values("El Bayadh","http://bayadh.ice.infomaniak.ch/32.aac")
Insert Into ycurs Values("Laghouat","http://laghouat.ice.infomaniak.ch/03.aac")
Insert Into ycurs Values("Biskra","http://biskra.ice.infomaniak.ch/07.aac")
Insert Into ycurs Values("Bechar","http://bechar.ice.infomaniak.ch/08.aac")
Insert Into ycurs Values("Naama","http://naama.ice.infomaniak.ch/45.aac")
Insert Into ycurs Values("Djelfa","http://djelfa.ice.infomaniak.ch/17.aac")
Insert Into ycurs Values("Tlemcen","http://tlemcen.ice.infomaniak.ch/13.aac")
Insert Into ycurs Values("Chaine 2","http://ch2.ice.infomaniak.ch/chaine2.aac")
Insert Into ycurs Values("Jil FM","http://jil-fm.ice.infomaniak.ch/jilfm.aac")
Insert Into ycurs Values("Chaine 3","http://ch3.ice.infomaniak.ch/chaine3.aac")
Insert Into ycurs Values("Chaine 1","http://ch1.ice.infomaniak.ch/chaine1.aac")
Insert Into ycurs Values("Coran","http://radiocoran-culture.ice.infomaniak.ch/coran.aac")
Insert Into ycurs Values("Bahja","http://elbahdja.ice.infomaniak.ch/elbahdja.aac")
Insert Into ycurs Values("Radio Orient","http://mp3lg.tdf-cdn.com/radioorient/all/radioorient.mp3")
Insert Into ycurs Values("Dzair","'http://radio-dzair.net:8000/;stream.mp3")
Insert Into ycurs Values("Sahara","http://radio-dzair.net:8026/;stream.mp")
Insert Into ycurs Values("Oriental","http://radio-dzair.net:8006/;stream.mp3")
Insert Into ycurs Values("Andalous","http://radio-dzair.net:8038/;stream.mp3")
Insert Into ycurs Values("Maghreb 2","http://broadcast.infomaniak.net:80/francemaghreb-high.mp3")
Insert Into ycurs Values("Klara classic","http://mp3.streampower.be/klaracontinuo-high")
Insert Into ycurs Values("france Inter","http://audio.scdn.arkena.com/11008/franceinter-midfi128.mp3")
Insert Into ycurs Values("Radio classic","http://radioclassique.ice.infomaniak.ch/radioclassique-high.mp3")
Insert Into ycurs Values("Classic Suisse","http://www.radioswissclassic.ch/fr/live/mp3.m3u")
Insert Into ycurs Values("France musique","http://audio.scdn.arkena.com/11012/francemusique-midfi128.mp3")
Insert Into ycurs Values("France Info","http://audio.scdn.arkena.com/11006/franceinfo-midfi128.mp3")
Sele ycurs
Locate
Endproc
Procedure image1.MouseDown
Lparameters nButton, nShift, nXCoord, nYCoord
lnHandle = Thisform.HWnd
param1 = 274
param2 = 0xF012
Declare Integer ReleaseCapture In WIN32API
Declare Integer SendMessage In WIN32API Integer, Integer, Integer, Integer
bb=ReleaseCapture()
bb=SendMessage(lnHandle, param1, param2,0)
Endproc
Procedure label2.MouseLeave
Lparameters nButton, nShift, nXCoord, nYCoord
This.BorderStyle=0
Endproc
Procedure label2.MouseEnter
Lparameters nButton, nShift, nXCoord, nYCoord
This.BorderStyle=1
Endproc
Procedure label2.Click
If Wmp.playstate=3
Wmp.Controls.Pause
This.FontName="Arial"
This.FontSize=20
This.Caption=" II "
Else
Wmp.Controls.Play
This.FontName="Webdings"
This.FontSize=24
This.Caption="4"
Endi
Endproc
Procedure shape1.Click
Thisform.Release
Endproc
Procedure shape2.Click
Thisform.WindowState=1
Endproc
Procedure label1.Click
With Wmp
.URL = Getfile("mp3|wav|m3u|wpl") &&any media,any format supported by WMP
Thisform.label5.Caption=Justfname(.URL)
With Thisform.label2
.FontName="Webdings"
.FontSize=24
.Caption="4"
Endwith
Endwith
Endproc
Procedure image2.Click
#Define APPCOMMAND_VOLUME_MUTE 0x80000
#Define APPCOMMAND_VOLUME_UP 0xA0000
#Define APPCOMMAND_VOLUME_DOWN 0x90000
#Define WM_APPCOMMAND 0x319
Declare Integer SendMessage In user32;
INTEGER HWnd,;
INTEGER Msg,;
INTEGER wParam,;
INTEGER Lparam
SendMessage(_vfp.HWnd, WM_APPCOMMAND, _vfp.HWnd, APPCOMMAND_VOLUME_UP)
Endproc
Procedure timer1.Timer
Thisform.label4.Caption=Dtoc(Date())+" "+Substr(Time(),1,5)
Endproc
Procedure combo1.Click
Sele ycurs
Wmp.Controls.stop
Wmp.URL=Allt(yURL) &&important
Thisform.label5.Caption=Justfname(yURL)
With Thisform.label2
.FontName="Webdings"
.FontSize=24
.Caption="4"
Endwith
Endproc
Procedure shape3.Click
Wmp.Controls.stop
Endproc
Procedure shape3.MouseEnter
Lparameters nButton, nShift, nXCoord, nYCoord
This.BorderStyle=1
Endproc
Procedure shape3.MouseLeave
Lparameters nButton, nShift, nXCoord, nYCoord
This.BorderStyle=0
Endproc
Procedure olecontrol1.Init
Local m.myvar
TEXT to m.myvar noshow
<body topmargin=0 leftmargin=0 bgcolor=black oncontextmenu="return false;" scroll="no">
<img src="http://big.assets.huffingtonpost.com/tumblr_myuxk2c6vc1qzt4vjo1_r2_500.gif" style="width:169;height:121;float:left;">")
</body>
ENDTEXT
Set Safe Off
m.lcdest=Addbs(Sys(2023))+"temp.html"
Strtofile(m.myvar,m.lcdest)
This.Navigate(m.lcdest)
Endproc
Enddefine
*
*-- EndDefine:yradio_soundPlayer
download the first image as save it as ywmp1.png in the source folder of the copied prg above.Can customize this skin image and put over the clickable shapes and labels..I updated the color rgb(255,0,255) instead white.
Click on code to select [then copy] -click outside to deselect
*2* added on tuesday 10 november 2015; 00:19:39
this is a basic soundplayer based on windows mediaplayer( created as invisible object)
download the first image as skin and rename it to wmp0.gif in the source folder with the prg
can see some implemented things as slider, duration, durationString...
this is made to play only all supported medias sounds on disc.
Click on code to select [then copy] -click outside to deselect
![]()
*2* publi yform yform=newObject("ywmp") yform.show read events retu * DEFINE CLASS ywmp AS form BorderStyle = 0 Top = 0 Left = 0 Height = 82 Width = 388 ShowWindow = 2 ShowTips = .T. Caption = "ySoundplayer" MaxButton = .F. ycl = 0 Name = "Form1" ADD OBJECT image1 AS image WITH ; Picture = "wmp0.png", ; Height = 52, ; Left = 0, ; Top = 0, ; Width = 515, ; Name = "Image1" ADD OBJECT shape1 AS shape WITH ; Top = 8, ; Left = 12, ; Height = 37, ; Width = 60, ; BackStyle = 0, ; BorderStyle = 0, ; MousePointer = 15, ; ToolTipText = "media ", ; Name = "Shape1" ADD OBJECT shape2 AS shape WITH ; Top = 7, ; Left = 221, ; Height = 39, ; Width = 39, ; BackStyle = 0, ; BorderStyle = 0, ; BorderWidth = 2, ; Curvature = 99, ; MousePointer = 15, ; ToolTipText = "play/pause", ; BorderColor = RGB(255,0,0), ; Name = "Shape2" ADD OBJECT shape3 AS shape WITH ; Top = 13, ; Left = 142, ; Height = 25, ; Width = 25, ; BackStyle = 0, ; BorderStyle = 0, ; MousePointer = 15, ; ToolTipText = "stop", ; BorderColor = RGB(255,0,0), ; Name = "Shape3" ADD OBJECT shape4 AS shape WITH ; Top = 12, ; Left = 310, ; Height = 25, ; Width = 24, ; BackStyle = 0, ; BorderWidth = 0, ; MousePointer = 15, ; ToolTipText = "Adjust volume", ; Name = "Shape4" ADD OBJECT ylab AS label WITH ; FontBold = .T., ; BackStyle = 0, ; Caption = "0 %", ; Height = 25, ; Left = 185, ; Top = 55, ; Width = 49, ; ForeColor = RGB(0,255,0), ; Name = "ylab" ADD OBJECT shape6 AS shape WITH ; Top = 14, ; Left = 102, ; Height = 25, ; Width = 25, ; BackStyle = 0, ; BorderStyle = 0, ; BorderWidth = 2, ; Curvature = 99, ; MousePointer = 15, ; ToolTipText = "loop on/off", ; BorderColor = RGB(0,255,0), ; Name = "Shape6" ADD OBJECT timer1 AS timer WITH ; Top = 48, ; Left = 148, ; Height = 25, ; Width = 25, ; Enabled = .F., ; Interval = 2000, ; Name = "Timer1" ADD OBJECT line1 AS line WITH ; BorderWidth = 2, ; Height = 1, ; Left = 99, ; Top = 61, ; Width = 73, ; Name = "Line1" ADD OBJECT shape5 AS shape WITH ; Top = 55, ; Left = 93, ; Height = 13, ; Width = 13, ; BorderWidth = 2, ; Curvature = 99, ; BackColor = RGB(0,255,0), ; BorderColor = RGB(255,0,0), ; Name = "Shape5" ADD OBJECT label1 AS label WITH ; AutoSize = .T., ; FontName = "Webdings", ; FontSize = 20, ; BackStyle = 0, ; Caption = "5", ; Height = 32, ; Left = 346, ; MousePointer = 15, ; Top = 12, ; Width = 29, ; ForeColor = RGB(255,0,0), ; ToolTipText = "Mute on/off", ; Name = "Label1" ADD OBJECT label2 AS label WITH ; AutoSize = .T., ; FontBold = .T., ; BackStyle = 0, ; Caption = "", ; Height = 17, ; Left = 9, ; Top = 56, ; Width = 2, ; ForeColor = RGB(255,128,0), ; Name = "Label2" ADD OBJECT label3 AS label WITH ; FontBold = .T., ; FontSize = 7, ; WordWrap = .T., ; BackStyle = 0, ; Caption = "", ; Height = 26, ; Left = 216, ; Top = 55, ; Width = 169, ; ForeColor = RGB(255,255,255), ; Name = "Label3" PROCEDURE Load Declare Integer SendMessage In WIN32API Integer, Integer, Integer, Integer Publi Wmp As WindowsMediaPlayer Wmp = Createobject("WMPlayer.OCX.7") With Wmp .settings.autoStart = .T. .settings.Volume=100 .settings.setMode('loop',.f.) &&.t. loop Endwith ENDPROC PROCEDURE Init thisform.backcolor=0 ENDPROC PROCEDURE Destroy wmp=null clea events ENDPROC PROCEDURE shape1.Click local lcmedia m.lcmedia=getfile("mp3,wav,snd,au,aif,wma,mid") wmp.url=m.lcmedia thisform.timer1.enabled=.t. thisform.shape2.tooltiptext="playing" thisform.label1.forecolor=255 wmp.settings.mute=.f. with thisform.shape3 .tooltiptext="Stop" endwith thisform.label3.caption=lower(justfname(wmp.url)) ENDPROC PROCEDURE shape2.MouseLeave LPARAMETERS nButton, nShift, nXCoord, nYCoord this.borderstyle=0 ENDPROC PROCEDURE shape2.MouseEnter LPARAMETERS nButton, nShift, nXCoord, nYCoord this.borderstyle=1 ENDPROC PROCEDURE shape2.Click If Wmp.playstate=3 Wmp.Controls.Pause this.tooltiptext="paused" Else Wmp.Controls.Play this.tooltiptext="playing" Endi this.borderstyle=iif(this.borderstyle=1,0,1) with thisform.shape3 .tooltiptext="Stop" endwith ENDPROC PROCEDURE shape3.MouseLeave LPARAMETERS nButton, nShift, nXCoord, nYCoord this.borderstyle=0 ENDPROC PROCEDURE shape3.MouseEnter LPARAMETERS nButton, nShift, nXCoord, nYCoord this.borderstyle=1 ENDPROC PROCEDURE shape3.Click wmp.controls.stop this.tooltiptext="stopped" ENDPROC PROCEDURE shape4.Click #Define APPCOMMAND_VOLUME_MUTE 0x80000 #Define APPCOMMAND_VOLUME_UP 0xA0000 #Define APPCOMMAND_VOLUME_DOWN 0x90000 #Define WM_APPCOMMAND 0x319 Declare Integer SendMessage In user32; INTEGER HWnd,; INTEGER Msg,; INTEGER wParam,; INTEGER Lparam SendMessage(_vfp.HWnd, WM_APPCOMMAND, _vfp.HWnd, APPCOMMAND_VOLUME_UP) ENDPROC PROCEDURE shape6.Click thisform.ycl=iif(thisform.ycl=0,1,0) wmp.settings.setMode('loop',iif(thisform.ycl=0,.f.,.t.)) this.borderstyle=iif(this.borderstyle=1,0,1) this.tooltiptext=iif(this.borderstyle=1,"Loop","No loop") ENDPROC PROCEDURE timer1.Timer Local xduration,xcurrentposition xcurrentposition=0 xduration=1 With wmp If .playstate=3 Or .playstate=2 &&play or pause xcurrentposition=.Controls.currentposition xduration=.currentmedia.duration Thisform.shape5.Left=Thisform.line1.Left+(xcurrentposition/xduration)*(Thisform.line1.Width) Else Thisform.shape5.Left=Thisform.line1.Left-Thisform.shape5.Width/2 &&stop or starting Endi Thisform.shape5.ToolTipText=Trans(100*xcurrentposition/xduration,"999" )+" %" Thisform.ylab.Caption=Thisform.shape5.ToolTipText Endwith thisform.label2.caption="dur="+wmp.currentmedia.durationString ENDPROC PROCEDURE shape5.Init This.Left=Thisform.line1.Left-This.Width/2 ENDPROC PROCEDURE label1.Click this.forecolor=iif(this.forecolor=255,rgb(0,255,0),255) wmp.settings.mute=iif(wmp.settings.mute=.f.,.t.,.f.) this.tooltiptext=iif(wmp.settings.mute=.f.,"mute off","muted") ENDPROC ENDDEFINE * *-- EndDefine: ywmp
*Important:*the code above is tested on visual foxpro 9 sp2-under windows 10 pro & windows mediaplayer.