Trucos Varios I
MP3 & MULTITHREADING CON VB
'Copia la DLL en el directorio Windows\system\
Type PlayRecord
FileName As String
SeekAtStart As Long
Owner As Long
Result As Long
End Type
Declare Sub mp3gettime Lib "MP3.DLL" (DATA As PlayRecord, total As Double, perframe As Double)
Declare Sub mp3play Lib "MP3.DLL" (DATA As PlayRecord)
Declare Sub mp3stop Lib "MP3.DLL" ()
Declare Sub mp3seek Lib "MP3.DLL" (position As Integer)
Dim PR as PlayRecord
PR.FileName="c:\mp3\...."
Call mp3play(PR)
El código del form de ejemplo y de los módulos BAS:
'El formulario (frmPlayer.frm)
Option Explicit
Private Total As Double
Private PerFrame As Double
Private ProgressTop As Integer
Private ProgressValue As Integer
Private Playing As Boolean
'Gestiona las acciones sobre los controles
Private Sub botones_Click(Index As Integer)
Select Case Index
Case 0
PlayFile
SetControls False, True, True, True, False
Playing = True
Case 1, 2: MsgBox "Las funciones de Seek no las he implementado, eso os lo dejo a vosotros! :-)"
Case 3
StopFile
SetControls True, False, False, False, True
ProgressValue = 0
ProgressBar.AutoRedraw = True
ProgressBar.Cls
ProgressBar.AutoRedraw = False
LCD.Caption = InTime(Total)
Playing = False
Case 4
Dialog.ShowOpen
If Dialog.FileName = "" Then Exit Sub
Mp3Info.FileName = Dialog.FileName
Me.Caption = GetFileName(Dialog.FileName)
SetControls True, False, False, False, True
GetTime Total, PerFrame
ProgressTop = Fix((Total / PerFrame) / 16)
ProgressValue = 0
LCD.Caption = InTime(Total)
End Select
End Sub
'Secuencia de inicialización
Private Sub Form_Load()
HookForm Me
Mp3Info.Owner = Me.hWnd
Playing = False
SetControls False, False, False, False, True
End Sub
'Detener la interceptación de mensajes
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
unHookForm
End Sub
'No puedo salir si se esta reproduciendo
Private Sub Form_Unload(Cancel As Integer)
If Playing Then
StopFile
Playing = False
Cancel = 1
End If
End Sub
'Activa-Desactiva los botones
Private Sub SetControls(ByVal bPlay As Boolean, ByVal bRewind As Boolean, ByVal bForward As Boolean, ByVal bStop As Boolean, ByVal bEject As Boolean)
Botones(0).Enabled = bPlay
Botones(1).Enabled = bRewind
Botones(2).Enabled = bForward
Botones(3).Enabled = bStop
Botones(4).Enabled = bEject
End Sub
'Avanza la barra de progreso
Private Sub PushBar()
Dim Contador As Integer
ProgressBar.AutoRedraw = True
For Contador = 1 To Fix(ProgressBar.ScaleWidth / ProgressTop)
ProgressBar.Line (ProgressValue + Contador, 0)-Step(0, ProgressBar.ScaleHeight)
Next Contador
ProgressBar.AutoRedraw = False
ProgressValue = ProgressValue + Contador
End Sub
'Destino de los mensajes interceptados
Public Sub MessageReceived(ByVal Message As Long, ByVal wParam As Long, ByVal lParam As Long)
Select Case Message
Case FRAME_POS: LCD.Caption = InTime(Total - (PerFrame * wParam)): PushBar
Case APPLY_POS: Debug.Print Now, "Seek Process Done!"
Case PLAY_STOP: SetControls True, False, False, False, True: Playing = False
End Select
End Sub
'Muestra o esconde el *about*
Private Sub LCD_Click()
frmPlayer.Height = IIf(frmPlayer.Height = 3615, 1710, 3615)
End Sub
'El módulo: MP3Control.bas
Option Explicit
'Tipos definidos
Private Type PlayRecord
FileName As String
SeekAtStart As Long
Owner As Long
Result As Long
End Type
'Constantes Globales
Public Const FRAME_POS = &H2EE0
Public Const APPLY_POS = &H2EE1
Public Const PLAY_STOP = &H2EE2
'Variables Globales
Public Mp3Info As PlayRecord
'Funciones Importadas de "mp3.dll"
Private Declare Sub mp3gettime Lib "MP3.DLL" (DATA As PlayRecord, Total As Double, PerFrame As Double)
Private Declare Sub mp3play Lib "MP3.DLL" (DATA As PlayRecord)
Private Declare Sub mp3stop Lib "MP3.DLL" ()
Private Declare Sub mp3seek Lib "MP3.DLL" (Position As Integer)
'Funciones Importadas del API
Private Declare Function CreateThread Lib "kernel32" (ByVal Null1 As Long, ByVal Null2 As Long, ByVal StartAddress As Long, Parameter As Any, ByVal Null3 As Long, ThreadId As Long) As Long
'Reproduce el archivo
Private Sub StartSong()
mp3play Mp3Info
End Sub
'Reproduce el archivo en un thread independiente
Public Sub PlayFile()
Dim Identifier As Long
CreateThread 0, 0, AddressOf StartSong, 0, 0, Identifier
End Sub
'Obtiene la duración del archivo
Public Sub GetTime(Total As Double, PerFrame As Double)
mp3gettime Mp3Info, Total, PerFrame
End Sub
'Situa la reproducción en un punto concreto
Public Sub JumpTo(Frame As Integer)
mp3seek Frame
End Sub
'Para la reproducción
Public Sub StopFile()
mp3stop
End Sub
'Módulo: PrivateEye.bas
Option Explicit
'Variables globales en el módulo
Private Targe
tForm As Form
Private TargetHandle As Long
Private PrevWndProc As Long
Private Const GWL_WNDPROC = (-4&)
'Funciones Importadas del API
Private Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hWnd As Long, ByVal MSG As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
'Aquí se reciben los mensajes
Private Function WndProc(ByVal hWnd As Long, ByVal uMSG As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
WndProc = CallWindowProc(PrevWndProc, hWnd, uMSG, wParam, lParam)
If Not TargetForm Is Nothing Then TargetForm.MessageReceived uMSG, wParam, lParam
End Function
'Inicia la interceptación de mensajes
Public Sub HookForm(ByVal Target As Form)
If Not TargetForm Is Nothing Then unHookForm
Set TargetForm = Target
TargetHandle = Target.hWnd
PrevWndProc = SetWindowLong(TargetHandle, GWL_WNDPROC, AddressOf WndProc)
End Sub
'Detiene la interceptación de mensajes
Public Sub unHookForm()
If TargetHandle <> 0 Then SetWindowLong TargetHandle, GWL_WNDPROC, PrevWndProc
End Sub
'Módulo: AuxFuncs.bas
Option Explicit
'Convierte milisegundos --> String hora
Public Function InTime(ByVal Milisecs As Double) As String
Dim Minutes As Integer, Seconds As Integer
Minutes = 0
Seconds = Fix(Milisecs / 1000)
While (Seconds > 59)
Seconds = Seconds - 60
Minutes = Minutes + 1
Wend
InTime = Format(Minutes, "00") & ":" & Format(Seconds, "00")
End Function
'Extrae el nombre de archivo de una ruta completa
Public Function GetFileName(ByVal Path As String) As String
Dim Contador As Integer
Contador = 1
While Mid(Path, Len(Path) - Contador, 1) <> "\"
Contador = Contador + 1
Wend
GetFileName = Mid(Path, Len(Path) - Contador + 1)
End Function
|
