in translate :il y a quelques temps KarlKox avait fait un code qui utilisait une Dll capable de lire les fichiers au format *.ym
j'ai mis a jour ce player a la version 5.20 LTS de Purebasic
in frenchhere is some time KarlKox had a code that used a DLL can read files in *. ym
I updated the player has the 5.20 LTS version Purebasic
in translate:voici le code :
(mode ThreadSafe ON )Here is the code
Code: Select all
; PureBasic Visual Designer v3.81 build 1321
; YM Engine By Leonard ( http://leonard.oxg.free.fr/ )
; PureBasic Port by KarLKoX ( KarLKoX@ifrance.com )
; PureBasic Visual Designer v3.81 build 1321
; mis en purebasic v.5.20 par Dobro
;- Window Constants
;
Enumeration
#Window
EndEnumeration
Enumeration
#file2
EndEnumeration
;- Gadget Constants
;
Enumeration
#btnStop
#btnPause
#btnPlay
#btnOpen
#TrackBar
#Frame3D_1
#lblArtist
#lblTitle
#lblComment
#lblDuration
; #lblBitrate
#lblReplayer
#lblType
#artist
#title
#comment
#duration
#replayer
#type
#sldVolume
EndEnumeration
; YM Engine By Leonard ( http://leonard.oxg.free.fr/ )
; PureBasic Port by KarLKoX ( KarLKoX@ifrance.com )
#YM = 0
Structure ymMusicInfo_t
pSongName.l
pSongAuthor.l
pSongComment.l
pSongType.l
pSongPlayer.l
musicTimeInSec.l
EndStructure
Declare MyCallback(WindowID, message, wParam, lParam)
Declare Open_Window()
Declare Init_YM_DLL()
Declare Close_YM_DLL()
Declare YM_Init()
Declare YM_Open(Path.s, pBlock.l, nSize.l)
Declare YM_Play()
Declare YM_Pause()
Declare YM_Stop()
Declare YM_Seek(seconds.l)
Declare YM_SetVolume(newvolume.l)
Declare YM_Close()
Declare YM_Get_Info(info.l)
Declare.l YM_FFT()
Global m_bSeeking.b, m_bPlaying.b, m_bPause.b, m_bActive.b
Global m_lngTimerID.l, m_hThread.l ,flag=0
Structure fftarray
Value.f[512]
EndStructure
Structure bar_heights
Value.w[256]
EndStructure
Global bar.bar_heights
#SpectrumImage = 1
Declare updateFFT(Value)
Declare MyCallback(WindowID, message, wParam, lParam)
Global scale.f, x00.f, y00.f
; Logarithmic values are taken from the "simple spectrum" xmms plugin
scale.f = 100 / ( Log((1 - 0.33) / 0.33) * 2 )
x00.f = 0.33*0.33*64/(2 * 0.33 - 1)
y00.f = -Log(-x00) * scale
If InitSprite() = 0
MessageRequester("","Problem with InitSprite()",0):End
EndIf
Open_Window()
CreateImage(#SpectrumImage,256,100)
Init_YM_DLL()
YM_Init()
SendMessage_(GadgetID(#sldVolume), #TBM_SETRANGE, 0, 0 | ((255)<<16) )
SetGadgetState(#sldVolume, 255)
if flag=1
m_hThread=CreateThread(@updateFFT(),0)
m_lngTimerID = SetTimer_(WindowID(WindowID), 0, 1000, 0)
m_bActive = #True
m_bPause = #False
m_bPlaying = #False
flag=0
Endif
Repeat
Event = WaitWindowEvent(20)
Select Event
Case #PB_Event_Gadget
GadgetID = EventGadget()
Select GadgetID
Case #btnStop
;-stop
YM_Stop()
m_bPlaying = #False
m_secondes = 0
SetGadgetState(#TrackBar, (m_secondes))
ClearScreen(RGB(0, 0, 0))
Case #btnPause
;-pause
m_bPause ! 1
If (m_bPause = #True)
SetGadgetText(#btnPause, "Resume")
YM_Pause()
Else
SetGadgetText(#btnPause, "Pause")
YM_Play()
EndIf
Case #btnPlay
;-play
YM_Play()
m_bPlaying = #True
Case #btnOpen
;-open
openfile (#file2,"chemin.inf")
path$=readString (#file2)
CloseFile(#file2)
If path$=""
Path$="c:\"
Endif
Filename$ = OpenFileRequester("Please choose a file to play", Path$, "YM Music|*.ym", 0)
path$=GetPathPart(Filename$)
openfile (#file2,"chemin.inf")
WriteString (#file2,path$)
CloseFile(#file2)
;- Read the file and hold all the data to a block of data
if Filename$<>""
Result = ReadFile(0, Filename$)
If (Result = 0)
MessageRequester("Error", "An error occured while reading the file " + Filename$)
EndIf
nSize = Lof(0)
Datas = AllocateMemory(nSize)
ReadData(0,Datas, nSize)
If (Filename$ <> "")
If (m_bPlaying = #True)
YM_Stop()
m_bPlaying = #False
If (Filename$ <> m_cursong$)
YM_Close()
YM_Init()
SetGadgetState(#TrackBar, 0)
; the label gadgets are not updated so i tell windows to do it (don't know why ??)
SendMessage_(WindowID(#Window), #WM_PAINT, 0, 0)
EndIf
EndIf
EndIf
m_cursong$ = Filename$
If (m_cursong$)
; if you don't want to load from memory, put 0 to the 2nd and the 3rd parameter
YM_Open(m_cursong$, Datas, nSize)
YM_Get_Info(info.ymMusicInfo_t)
SetGadgetText(#title, PeekS(info\pSongName))
SetGadgetText(#artist, PeekS(info\pSongAuthor))
SetGadgetText(#comment, PeekS(info\pSongComment))
SetGadgetText(#type, PeekS(info\pSongType))
SetGadgetText(#replayer, PeekS(info\pSongPlayer))
SetGadgetText(#duration, Str(info\musicTimeInSec) + " seconds")
SendMessage_(GadgetID(#TrackBar), #TBM_SETRANGE, 0, 0 | ((info\musicTimeInSec)<<16) )
YM_SetVolume(255)
EndIf
Endif
EndSelect
Case #WM_TIMER
If (m_bPlaying = #True) And (m_bPause = #False)
m_secondes + 1
If m_bSeeking = #False
SetGadgetState(#TrackBar, (m_secondes))
EndIf
Else
If (m_bPause = #False)
SetGadgetState(#TrackBar, 0)
EndIf
EndIf
Case #WM_LBUTTONUP
newpos.l = GetGadgetState(#TrackBar)
m_secondes = newpos
Debug m_secondes
YM_Seek(newpos)
m_bSeeking = #False
EndSelect
Until Event = #PB_Event_CloseWindow
m_bActive = 0
If (m_hTread) : KillThread(m_hThread) : EndIf ; <<<<<<< ne pas activer cette ligne (Dobro)
If (m_lngTimerID) : KillTimer_(WindowID(#Window), m_lngTimerID) : EndIf
If (m_bPlaying) : YM_Stop() : EndIf
YM_Close()
Close_YM_DLL()
End
;- Procedures Zone
Procedure Open_Window()
;-openwindow
hwnd = OpenWindow(#Window, 405, 71, 332, 385, "Simple YM Player by KarLKoX",#PB_Window_SystemMenu | #PB_Window_TitleBar )
SetWindowCallback(@MyCallback()) :flag=1
;If (hwnd)
offscreen = OpenWindowedScreen(WindowId(#Window), 40,280, 256,100,0,0,0)
If offscreen = 0
MessageRequester("","Problem with OpenWindowedScreen()",0):End
EndIf
; If CreateGadgetList(WindowID(#Window))
ButtonGadget(#btnStop, 170, 9, 68, 30, "Stop")
ButtonGadget(#btnPause, 90, 9, 68, 30, "Pause")
ButtonGadget(#btnPlay, 10, 9, 68, 30, "Play")
ButtonGadget(#btnOpen, 250, 9, 68, 30, "Open")
TrackBarGadget(#TrackBar, 13, 42, 304, 25, 0, 10)
FrameGadget(#Frame3D_1, 13, 100, 302, 175, "YM Informations")
TextGadget(#lblArtist, 23, 115, 89, 18, "Artist")
TextGadget(#lblTitle, 23, 140, 89, 18, "Title")
TextGadget(#lblComment, 23, 165, 89, 18, "Comment")
TextGadget(#lblDuration, 23, 190, 89, 18, "Duration")
; TextGadget(#lblBitrat, 23, 175, 89, 18, "Bitrate")
TextGadget(#lblReplayer, 23, 215, 89, 18, "Replayer")
TextGadget(#lblType, 23, 240, 89, 18, "Songtype")
TextGadget(#artist, 90, 115, 200, 20, "")
TextGadget(#title, 90, 140, 200, 20, "")
TextGadget(#comment, 90, 165, 200, 20, "")
TextGadget(#duration, 90, 190, 200, 20, "")
TextGadget(#replayer, 90, 215, 200, 20, "")
TextGadget(#type, 90, 240, 200, 20, "")
TrackBarGadget(#sldVolume, 13, 70, 304, 25, 0, 255)
;EndIf
;EndIf
EndProcedure
; Instanciate The DLL
Procedure Init_YM_DLL()
Protected *DLL
*DLL = OpenLibrary(#YM, "YmPlugin.dll")
If *DLL = 0
MessageRequester("Error", "Can't load YmPlugin.dll", 0)
End
Else
ProcedureReturn *DLL
EndIf
EndProcedure
Procedure Close_YM_DLL()
ProcedureReturn CloseLibrary(#YM)
EndProcedure
Procedure YM_Init()
ProcedureReturn CallFunction(#YM, "_YM_Init@0")
EndProcedure
Procedure YM_Open(Path.s, pBlock.l, nSize.l)
ProcedureReturn CallFunction(#YM, "_YM_Open@12", @Path.s, pBlock.l, nSize.l)
EndProcedure
Procedure YM_Play()
ProcedureReturn CallFunction(#YM, "_YM_Play@0")
EndProcedure
Procedure YM_Pause()
ProcedureReturn CallFunction(#YM, "_YM_Pause@0")
EndProcedure
Procedure YM_Stop()
ProcedureReturn CallFunction(#YM, "_YM_Stop@0")
EndProcedure
Procedure YM_Seek(seconds.l)
ProcedureReturn CallFunction(#YM, "_YM_Seek@4", seconds.l)
EndProcedure
Procedure YM_SetVolume(newvolume.l)
ProcedureReturn CallFunction(#YM, "_YM_SetVolume@4", newvolume.l)
EndProcedure
Procedure YM_Close()
ProcedureReturn CallFunction(#YM, "_YM_Close@0")
EndProcedure
Procedure YM_Get_Info(info.l)
ProcedureReturn CallFunction(#YM, "_YM_Get_Info@4", info)
EndProcedure
Procedure.l YM_FFT()
ProcedureReturn CallFunction(#YM, "_YM_FFT@0")
EndProcedure
;- a VERY bad spectrum analyzer but it show that YM_FFT() works :)
Procedure updateFFT(Value)
ClearScreen(RGB(0, 0, 0))
FlipBuffers()
While m_bActive
StartDrawing(ScreenOutput())
If (m_bPlaying)
; Return an array of 512 floats
CopyMemory(YM_FFT(), hfft.fftarray, 4*512)
; logarithmic amplitude
For i=0 To 255
fft.f = (hfft\Value[i])
Y = ( Log(fft - x00) * scale + y00 )
If (i = 255)
tmp = Y
Else
tmp = bar\Value[i+1] / 4
EndIf
If (i = 0)
tmp2 = Y
Else
tmp2 = bar\Value[i-1] + tmp
EndIf
Y = 2 * Y + tmp
Y = (2 * bar\Value[i] + Y) / 3
y1 = Y
If (Y < 0)
Y = 0
EndIf
bar\Value[i] = Y
Y = 100 - 1 - bar\Value[i]
If (Y < 0)
Y = 0
EndIf
If (i < Y)
rgbRed = i << 1
rgbGreen = $FF - (i << 1)
rgbBlue = $1F
Else
rgbRed = Y << 1
rgbGreen = $FF - (Y << 1)
rgbBlue = $1F
EndIf
color = RGB(rgbRed, rgbGreen, rgbBlue)
LineXY(i, 100, i, Y, color)
Next
EndIf
StopDrawing()
FlipBuffers()
Delay(20)
ClearScreen(RGB(0, 0, 0))
Wend
EndProcedure
;- This Callback Is Here To Be Used To Process Some Windows Events
Procedure MyCallback(WindowID, message, wParam, lParam)
ReturnValue = #PB_ProcessPureBasicEvents
If message = #WM_HSCROLL
If lParam = GadgetID(#TrackBar)
m_bSeeking = #True
ReturnValue = 1
ElseIf lParam = GadgetID(#sldVolume)
newvol = GetGadgetState(#sldVolume)
If newvol <= 0 : newvol = 1 : EndIf
YM_SetVolume(newvol)
ReturnValue = 1
EndIf
EndIf
ProcedureReturn ReturnValue
EndProcedure
; EPB
in translate :voici un lien vers l'archive qui comprends le code 'Main.pb' et la fameuse Dll
http://michel.dobro.free.fr/Forum_pb/Ka ... gin-PB.zipHere is a link to the archive that understand the code 'Main.pb' and the famous DLLs
in translate
http://low.fi/~visy/ym-archive/You will find full file * ym here.:
thanks to Karlkox