Mensajes

klaro que ya lo hice monton de bocones solo kise saber que que modo lo harian, uds por eso aqui no se escribe ni *****, por que " dicen que saben mucho" pero si supiesen tanto nisikiera se tomamrian la molestia de estar en un foro, y esa es la verdad le duela al que le duela klaro que es una pendejada hacer eso , pero cometi un error de pedir "una opinion"  en fin, no discuto , ya que es de lammers reponder a semejantes babosadas " los los super visual basic" por favor no me hagan reir,..

muy util ,  buen aporte (y)...

casianni, tiene razon...=P

en fin..skull dedicate a ayudar, mas no ah criticar, tenes una arrogancia bien askerosa...grabate algo...la pregunta mas pendeja tiene su respuesta, no salgas con " no te respondo por que es muy pendejo para mi" ubicate, con respecto a mi mp3..que te digo creo que uno es libre de haer lo que kiera cuando kiera es problema de cada quien no me salgas kon que los nombres no se dejan igual y esas babosadas, como te dije y te lo repito dedica a ayudar y no ah criticar no temetas en las kosas de las demas y deja de kreerte la gtan kosa que 142 post es cualkier porkeria, y otra

jejeje eso es facil de hacer..como ahi tambienahi varias formas de hacerlo..eso que te dieron lo hacen de la manera que pedistes..

bien mira..este codigo que te pondre aqui ponlo en tu formulario..


'Api SetForegroundWindow Para traer la ventana al frente
Private Declare Function SetForegroundWindow Lib "user32" (ByVal hwnd As Long) As Long

'estructura NOTIFYICONDATA
Private Type NOTIFYICONDATA
    cbSize As Long
    hwnd As Long
    uID As Long
    uFlags As Long
    uCallbackMessage As Long
    hIcon As Long
    szTip As String * 64
End Type

'Constantes para las acciones
Private Const NIM_ADD = &H0
Private Const NIM_MODIFY = &H1
Private Const NIM_DELETE = &H2
Private Const NIF_MESSAGE = &H1
Private Const NIF_ICON = &H2
Private Const NIF_TIP = &H4

'Constantes para los botones y le mouse
Private Const WM_MOUSEMOVE = &H200
Private Const WM_LBUTTONDOWN = &H201
Private Const WM_LBUTTONUP = &H202
Private Const WM_LBUTTONDBLCLK = &H203
Private Const WM_RBUTTONDOWN = &H204
Private Const WM_RBUTTONUP = &H205
Private Const WM_RBUTTONDBLCLK = &H206

'función Api Shell_NotifyIcon
Private Declare Function Shell_NotifyIcon Lib "shell32" Alias "Shell_NotifyIconA" (ByVal dwMessage As Long, pnid As NOTIFYICONDATA) As Boolean

'variable para la estructura
Dim systray As NOTIFYICONDATA

' luego esto
Private Sub Form_Activate()
PonerSystray
End Sub
' sigue
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim msg As Long
 

  If (Me.ScaleMode = vbPixels) Then
    msg = X
  Else
    msg = X / Screen.TwipsPerPixelX
  End If

  Select Case msg
    Case WM_LBUTTONDBLCLK
      'Si hacemos doble click con el botón izquierdo restauramos el form
        Me.WindowState = vbNormal
        Call SetForegroundWindow(Me.hwnd)
        Me.Show
     
    Case WM_RBUTTONUP
      Call SetForegroundWindow(Me.hwnd)
      'Si hacemos Click con el boton derecho mostramos el popup Menu
      Me.PopupMenu Me.mnuPopUp
   
    Case WM_LBUTTONUP

  End Select
End Sub
Private Sub RemoverSystray()
Shell_NotifyIcon NIM_DELETE, systray
End Sub

Private Sub Form_Resize()
If (Me.WindowState = vbMinimized) Then Me.Hide
End Sub

'el sub de sustray
Private Sub PonerSystray()
   
    'Tamaño de la estructura systray
    systray.cbSize = Len(systray)
    'Establecemos el Hwnd, en este caso del formulario
    systray.hwnd = Me.hwnd
    'Esto es un identificador
    systray.uID = vbNull
    'Flags
    systray.uFlags = NIF_ICON Or NIF_TIP Or NIF_MESSAGE
    'Establecemos el mensaje callback
    systray.uCallbackMessage = WM_MOUSEMOVE
    'establecemos el icono, en este caso el que tiene el form, puede ser otro
    systray.hIcon = Me.Icon
    'Establecemos el tooltiptext
    systray.szTip = Me.Caption & vbNullChar
    'Ponemos el icono en el systray
    Shell_NotifyIcon NIM_ADD, systray
   
End Sub

ok con eso tendra ya tu icono en el sustray kon opciones en el boton derecho cuando se este por ensima de el icono acuerdate que el ese nombre del nombre del menu que esta ahi es de mi aplicacion puedes kambiarlo si lo deseas.. si tienes alguna duda no o te sivio el code hasmelo sabe..espero que te sirva (y)

http://img88.imageshack.us/my.php?image=robertplayermusicmsnjo9.jpg
ahi ven la imagen completa..

miren asi les kda..mas o menos x')

[En tu formulario.. coloca esto...]

bien aqui les dejo mi Mp3 player con Notifikacion al msn que lo  disfrten..
En tu formulario.. coloca esto...
con esto tus aplicaciones tendran Nombre en el MsN..EJEMPLO
" RøBeRT-SofT  Player =>[ Matando_la_liga.mp3 ] By ._CoRr3-C4M1NoS "


Private Declare Sub InitCommonControls Lib "comctl32" ()
'agarre un mp3 komun yloarregle a mi modo att robert programado by ._CoRr3-C4M1NoS_
Dim tinseconden As Integer
Dim minuten As Integer
Dim seconden As Integer
Dim Scrolly As Integer
' Reg Key Security Options...
Const READ_CONTROL = &H20000
Const KEY_QUERY_VALUE = &H1
Const KEY_SET_VALUE = &H2
Const KEY_CREATE_SUB_KEY = &H4
Const KEY_ENUMERATE_SUB_KEYS = &H8
Const KEY_NOTIFY = &H10
Const KEY_CREATE_LINK = &H20
Const KEY_ALL_ACCESS = KEY_QUERY_VALUE + KEY_SET_VALUE + _
                       KEY_CREATE_SUB_KEY + KEY_ENUMERATE_SUB_KEYS + _
                       KEY_NOTIFY + KEY_CREATE_LINK + READ_CONTROL
                     
' Reg Key ROOT Types...
Const HKEY_LOCAL_MACHINE = &H80000002
Const ERROR_SUCCESS = 0
Const REG_SZ = 1                         ' Unicode nul terminated string
Const REG_DWORD = 4                      ' 32-bit number

Const gREGKEYSYSINFOLOC = "SOFTWARE\Microsoft\Shared Tools Location"
Const gREGVALSYSINFOLOC = "MSINFO"
Const gREGKEYSYSINFO = "SOFTWARE\Microsoft\Shared Tools\MSINFO"
Const gREGVALSYSINFO = "PATH"

Private Declare Function RegOpenKeyEx Lib "Advapi32" Alias "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, ByRef phkResult As Long) As Long
Private Declare Function RegQueryValueEx Lib "Advapi32" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, ByRef lpType As Long, ByVal lpData As String, ByRef lpcbData As Long) As Long
Private Declare Function RegCloseKey Lib "Advapi32" (ByVal hKey As Long) As Long
Dim Efectos As Boolean
Dim Coef As Integer
Dim Cl
Dim Casla As Integer
Dim Tit As String
Dim TX As String
Dim f As String
Dim n As Integer
Dim NI As Integer
Dim CI As Integer
Dim i As Integer
Dim Fav03 As String
Dim Fav12 As String
Dim Fav As String
Dim Sen As Boolean
Dim Sen2 As Boolean
Dim SenPlay As Boolean

Private Sub Ayuda_Click()
End Sub




Private Sub Combo2_Click()
On Error GoTo Joda
i = Combo2.ListIndex
Combo1.ListIndex = i
ComboLista
Joda:
End Sub

Private Sub Command1_Click()
If Frame1.Visible = False Then
   SONIDOS.Height = 5140
   Frame1.Visible = True
   SONIDOS.Width = 10800
   Label1.Width = 10600
   ProgressBar1.Width = 10600
   Command1.Picture = Command1.DisabledPicture
   Command1.ToolTipText = "Modo Compacto"
   If Me.Left > 5000 Then
      Me.Left = 1000
   End If
Else
   SONIDOS.Height = 2080
   Frame1.Visible = False
   SONIDOS.Width = 3560
   Label1.Width = 3400
   ProgressBar1.Width = 3400
   Command1.ToolTipText = "Modo Completo"
   Command1.Picture = Command1.DownPicture
End If
If File1.Enabled = True Then
   File1.SetFocus
End If
End Sub

Private Sub Command1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Efectos = True
End Sub

Private Sub Command10_Click()
On Error GoTo Osso
Dim Arch As String
Dim Q As Integer
Dim Sep As String
Sep = " "
CommonDialog1.CancelError = True
CommonDialog1.InitDir = App.Path
CommonDialog1.Filter = "Listas de Reproducción *.Rof|*.Rof"
CommonDialog1.DialogTitle = "Guardar Listas de Reproducción"
CommonDialog1.DefaultExt = "Rof"
CommonDialog1.ShowSave
Arch = CommonDialog1.FileName
Open Arch For Output As 1
For Q = 0 To Combo1.ListCount - 1
   Write #1, Combo1.List(Q), Combo2.List(Q)
Next
Close 1
Osso:
End Sub

Private Sub Command11_Click()
On Error GoTo Osso
Dim Arch As String
Dim Reg1 As String
Dim Reg2 As String
Dim Sep As String

CommonDialog1.CancelError = True
CommonDialog1.InitDir = App.Path
CommonDialog1.Filter = "Listas de Reproducción *.Rof|*.Rof"
CommonDialog1.DialogTitle = "Abrir Listas de Reproducción"
CommonDialog1.ShowOpen
Arch = CommonDialog1.FileName
Combo2.Visible = True
Sen = True
Open Arch For Input As 1
While Not EOF(1)
  Input #1, Reg1, Reg2
  Combo1.AddItem Reg1
  Combo2.AddItem Reg2
Wend
Close 1
Combo2.ListIndex = 0
Osso:
End Sub

Private Sub Command12_Click()
On Error GoTo Saltito
Dir1.Path = Fav12
File1.Path = Dir1.Path
If Frame1.Visible = False Then ' Activo modo completo
   Command1_Click
End If
Saltito:
End Sub

Private Sub Command12_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
On Error GoTo Saltito
If Button = 2 Then
   Fav = InputBox("Nueva Carpeta de Emule", "Ruta de Descargas del Emule" + Fav12, Dir1.Path)
   If Fav <> "" Then
      ok = MsgBox("Confirma la Nueva Carpeta " + Fav, vbCritical + vbDefaultButton2 + vbOKCancel)
       If ok = vbOK Then
          Fav12 = Fav
          Open App.Path + "\Favoritos.Txt" For Output As 1
          Write #1, Fav03; Fav12
          Close 1
       End If
    End If
End If
Saltito:
End Sub

Private Sub Command12_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Efectos = True
End Sub

Private Sub Command13_Click()
End Sub

Private Sub Command13_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Efectos = True
End Sub

Private Sub Command14_Click()
If Text2.Visible = False Then
   Text2.Visible = True
    If Frame1.Visible = False Then ' Activo modo completo
       Command1_Click
    End If
Else
Text2.Visible = False
End If
End Sub

Private Sub Command14_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Efectos = True
End Sub



Private Sub Command2_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Efectos = True
End Sub

Private Sub Command3_Click()
On Error GoTo Saltito
  ' Establezco que la carpeta de temas sea la de Música
Dir1.Path = Fav03
File1.Path = Dir1.Path
If Frame1.Visible = False Then ' Activo modo completo
   Command1_Click
End If
Saltito:
End Sub

Private Sub Command3_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
On Error GoTo Saltito
If Button = 2 Then
   Fav = InputBox("Nueva Carpeta de Mi Música", "Ruta de Mi Música " + Fav03, Dir1.Path)
   If Fav <> "" Then
      ok = MsgBox("Confirma la Nueva Carpeta " + Fav, vbCritical + vbDefaultButton2 + vbOKCancel)
      If ok = vbOK Then
         Fav03 = Fav
         Open App.Path + "\Favoritos.Txt" For Output As 1
         Write #1, Fav03; Fav12
         Close 1
      End If
   End If
End If
Saltito:
End Sub

Private Sub Command3_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Efectos = True
End Sub

Private Sub Command4_Click()
'On Error GoTo Asco
For i = 0 To File1.ListCount - 1
   Combo1.AddItem File1.Path + "\" + File1.List(i)
   Combo2.AddItem File1.List(i)
Next
Combo1.ListIndex = 0
Combo2.ListIndex = 0
With MMControl1
.Command = "stop"
.Command = "close"
End With
Combo2.Visible = True
Combo2.ToolTipText = Str(Combo1.ListCount) + " Temas en Lista"
Command10.Enabled = True
Exit Sub
Asco:
Sen = False
End Sub

Private Sub Command5_Click()
If File1.ListIndex >= 0 Then
   Command10.Enabled = True
   Combo1.AddItem File1.Path + "\" + File1.List(File1.ListIndex)
   Combo1.ListIndex = 0
   Combo2.AddItem File1.List(File1.ListIndex)
   Combo2.ListIndex = 0
   Combo2.Visible = True
   Combo2.ToolTipText = Str(Combo1.ListCount) + " Temas en Lista"
Else
   Combo2.Visible = False
   Combo2.ToolTipText = ""
   Command10.Enabled = False
End If
End Sub

Private Sub Command6_Click()
On Error GoTo Qué_Pasó
With MMControl1
CI = Combo1.ListCount
If CI < 1 Then
  Exit Sub
End If
Sen = True
SenPlay = True  ' Para prender luz verde
File1.Enabled = False
File1.BackColor = &H8000000F
Command4.Enabled = False
Command5.Enabled = False
Command7.Enabled = False
Command8.Enabled = False

Caption = "._CoRr3C4M1NoS_ MeDia Pl4yer | (" + Trim(Str(CI)) + " temas) en Lista "

i = 0
f = Combo1.List(i)
l = Len(Combo1.List(i)) - 4             ' Extraigo el nombre sin la extensión
   nn = ""
   For h = l To 1 Step -1
         X = Mid(Combo1.List(i), h, 1)
          If X = "\" Then
            Exit For
      Else
         nn = nn + X
      End If
   Next
     .ToolTipText = StrReverse(nn)
    .Command = "stop"
    .Command = "close"
    Label1.Caption = .ToolTipText
   .FileName = f
   .Command = "open"    ' abre el filename
   .Command = "play"
   If .length > 0 Then  ' evito errores en los Wav cortos
       ProgressBar1.Max = .length
  End If
  Label2 = "Dur.: " + Format(.length / 600, "00:00:00")
  Dim t As Double
  t = FileLen(f) 'Obtengo la long. del archivo en bytes
  Label3 = "Tam.: " + Format(t / 1024, "#,###,##0 ") + "Kb. - " + FormatDateTime(FileDateTime(f))
End With
Combo2.Visible = True

Exit Sub
Qué_Pasó:
MsgBox (error(Err))
End Sub

Private Sub Command7_Click()
ok = MsgBox("Confirmas?", vbCritical + vbYesNo, "Vaciar la lista")
If ok = vbYes Then
   Combo1.Clear
   Combo2.Clear
   Sen = False
   Combo2.Visible = False
   Combo2.ToolTipText = ""
End If
End Sub

Private Sub Command8_Click()
Combo1.ListIndex = Combo2.ListIndex
Combo1.RemoveItem (Combo1.ListIndex)
Combo2.RemoveItem (Combo2.ListIndex)
If Combo2.ListCount < 1 Then
   Combo2.Visible = False
   Combo2.ToolTipText = ""
Else
   Combo2.ListIndex = 0
   Combo2.ToolTipText = Str(Combo1.ListCount) + " Temas en Lista"
End If
End Sub

Private Sub Command9_Click()
If Sen = True Then ' Está reproduciendo lista
Combo2.Visible = False
MMControl1.Command = "Stop"
MMControl1.Command = "Close"
Sen = False
CI = 0
i = 0
File1.Enabled = True
File1.BackColor = &HC00000
Command4.Enabled = True
Command5.Enabled = True
Command7.Enabled = True
Command8.Enabled = True
End If
End Sub

Private Sub Dir1_Change()
On Error GoTo Qué_Pasó
File1.Path = Dir1.Path
Exit Sub
Qué_Pasó:
MsgBox (error(Err))
End Sub

Private Sub Dir1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Efectos = True
End Sub

Private Sub Drive1_Change()
On Error GoTo Qué_Pasó
Dir1.Path = Drive1.Drive
Exit Sub
Qué_Pasó:
MsgBox (error(Err))
Resume Next
End Sub

Private Sub File1_Click()
On Error GoTo Qué_Pasó
Cl = 0
Picture3.Cls
NI = File1.ListCount
Caption = "._CoRr3-C4M1NoS_ Mp3 | Player | (" + Trim(Str(NI)) + " Temas)"
f = File1.Path + "\" + File1.FileName
l = Len(File1.FileName) - 4             ' Extraigo el nombre sin la extensión
With MMControl1
.ToolTipText = Left(File1.FileName, l)
If UCase(Right(f, 3)) = "CDA" Then  ' Es un tema de CD
      .EjectVisible = True
Else
    .EjectVisible = False
End If
Coef = 600

If UCase(Right(f, 3)) = "AVI" Or UCase(Right(f, 3)) = "MPG" Then  ' Es un Vídeo
  Coef = 6
End If

.Command = "stop"
.Command = "close"
lg = Len(File1.FileName) - 4
Label1.Caption = Left(File1.FileName, lg)
Tit = Label1.Caption
.FileName = f
.Command = "open" ' abre el filename
.Command = "play"
.Command = "prev"
If .length > 0 Then  ' evito errores en los Wav cortos
     ProgressBar1.Max = .length
End If
Label2.Caption = Format(MMControl1.Position / 600, "00:00:00") + Chr(13) + Format(MMControl1.length / 600, "00:00:00")
Dim t As Double
t = FileLen(f) 'Obtengo la long. del archivo en bytes
Label3 = "Tam.: " + Format(t / 1024, "#,###,##0 ") + "Kb. - " + FormatDateTime(FileDateTime(f))
End With
SenPlay = True  ' Para prender luz verde
Call robertplayer("", "", " !| RoBeRT-SoFt Mp3 => |¡ Sound Playing | : <" & File1.FileName & "> ", mvariable, , "{1}{0}")
Exit Sub
Qué_Pasó:

End Sub

Private Sub File1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Efectos = True
End Sub

Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = 27 Then End
If KeyCode = 45 Or KeyCode = 43 Then Command1_Click
If KeyCode = 19 Then
   MMControl1.Command = "Pause"
   MMControl1_PauseClick (0)
End If
If Shift = 2 Then
  Text1.SetFocus
  Select Case KeyCode
     Case 37: Me.Left = Me.Left - 100   ' Cur izq
     Case 39: Me.Left = Me.Left + 100  ' Cur der
     Case 38: Me.Top = Me.Top - 100   ' Cur Arriba
     Case 40: Me.Top = Me.Top + 100   ' Cur Abajo
     Case 16: Command6_Click  ' Ctrl P reproduce una lista
  End Select
Else
  File1.SetFocus
End If
If Me.Top < 0 Then
   Me.Top = 0
End If

If Me.Top > 10120 Then
   Me.Top = 10120
End If

If Me.Left < 0 Then
   Me.Left = 0
End If

If Me.Left > 12380 Then
   Me.Left = 12380
End If
End Sub

Private Sub Form_KeyPress(KeyAscii As Integer)
Select Case KeyAscii
  Case 27: End
  Case 45, 43: Command1_Click
  Case 37: Me.Left = Me.Left - 100
End Select
End Sub

Private Sub Form_Load()


mvariable = "Music"
' Los Wma protegidos no los reproduce
On Error GoTo Paso
Label4.Caption = Format(Date, "dddd  mmm yyyy") ' Muestro la fecha en el visor del reloj
Open App.Path + "\Favoritos.Txt" For Input As 1
Input #1, Fav03, Fav12
Close 1
Randomize
MMControl1.Enabled = True
SONIDOS.MMControl1.Wait = True
MMControl1.Command = "CLOSE"
MMControl1.Command = "open"
lg = Len(MMControl1.FileName) - 4
'Label1.Caption = Left(MMControl1.FileName, lg)
MMControl1.Command = "play"
Frame1.Visible = True
Dir1.Path = App.Path  ' Establezco que la carpeta inicio sea de la aplicación
File1.Path = Dir1.Path

MMControl1.Command = "prev"

Label1.Caption = "| Unlocker Magma System Chat | · þrógrâmâdó ßÿ RóßèR†ó·"
MMControl1.FileName = App.Path + "\Cuac.Wav"   ' El primer sonido que oirás
MMControl1.Command = "open" ' abre el filename
MMControl1.Command = "play"
MMControl1.Command = "prev"
Sen2 = False
Exit Sub
NI = File1.ListCount
Caption = "D3monio_PlUs (" + Trim(Str(NI)) + " temas)"
Paso:
SenPlay = True
Resume Next
End Sub

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Efectos = True
End Sub

Private Sub Form_Unload(Cancel As Integer)
Call robertplayer("", "", "", "Music", , , False)
Command9_Click

SONIDOS.MMControl1.Notify = True
SONIDOS.MMControl1.Wait = False
MMControl1.Command = "stop"
MMControl1.Command = "close"
MMControl1.Enabled = False
End Sub
Private Sub Label1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Efectos = True
End Sub

Private Sub Label2_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Efectos = True
End Sub

Private Sub MMControl1_Done(NotifyCode As Integer)
If NotifyCode = 1 Then
   Sen2 = False
   If Sen = False Then
       Lista
   Else
      i = i + 1
      If i < CI Then
        Combo1.ListIndex = i
        Combo2.ListIndex = i
        ComboLista
      Else
        MMControl1.Command = "Stop"
        MMControl1.Command = "Close"
        Label1.Caption = "Fin"
        SenPlay = False
        Cl = 0
        Picture3.Cls
        ProgressBar1.Value = 0
       
      End If
   End If
End If
' entrada de lo que se escucha
  If Check1.Value = 1 Then
  Text5.Text = File1.FileName
  fchat.Check17.Value = 1
  Text5.Text = File1.FileName
  fchat.Check17.Value = 0
 
  End If
End Sub

Sub Lista()
On Error GoTo Cierre
File1.ListIndex = File1.ListIndex + 1
f = File1.Path + "\" + File1.FileName
lg = Len(File1.FileName) - 4
Label1.Caption = Left(File1.FileName, lg)
MMControl1.FileName = f
MMControl1.Command = "prev"
MMControl1.Command = "open" ' abre el filename
MMControl1.Command = "prev"
MMControl1.Command = "play"
Sen2 = True
Exit Sub
Cierre:
Picture3.Cls
MMControl1.Command = "Stop"
MMControl1.Command = "Close"
Label1.Caption = "Fin"
SenPlay = False
ProgressBar1.Value = 0  ' Vacío la barra de progreso
End Sub

Sub ComboLista()
On Error GoTo Cierre
f = Combo1.List(i)
l = Len(Combo1.List(i)) - 4             ' Extraigo el nombre sin la extensión
l = Len(Combo1.List(i)) - 4             ' Extraigo el nombre sin la extensión
nn = ""
For h = l To 1 Step -1
      X = UCase(Mid(Combo1.List(i), h, 1))
      If X = "\" Then
            Exit For
      Else
         nn = nn + X
      End If
Next
MMControl1.ToolTipText = StrReverse(nn)
Label1.Caption = "Track" + Str(i + 1) + " " + MMControl1.ToolTipText
MMControl1.Command = "Stop"
MMControl1.Command = "Close"
MMControl1.FileName = f
MMControl1.Command = "prev"
MMControl1.Command = "Open" ' abre el filename
MMControl1.Command = "prev"
MMControl1.Command = "play"
Exit Sub
Cierre:
Picture3.Cls
MMControl1.Command = "Stop"
MMControl1.Command = "Close"
Label1.Caption = "Fin"
MMControl1.ToolTipText = "Fin"
ProgressBar1.Value = 0
SenPlay = False
End Sub

Private Sub play_Click()
MMControl1.Command = "play"
MMControl1.Command = "prev"
End Sub

Private Sub MMControl1_PauseClick(Cancel As Integer)
'SenPlay = True
TX = Tit
If Sen2 = False Then
   Label1.Caption = TX + " (pausa)"
   SenPlay = False
   Sen2 = True
Else
   Label1.Caption = TX
   SenPlay = True
   Sen2 = False
End If
End Sub

Private Sub MMControl1_PlayClick(Cancel As Integer)
Label1.Caption = Tit
SenPlay = True
End Sub

Private Sub MMControl1_PrevClick(Cancel As Integer)
If Sen = False Then
   File1.ListIndex = File1.ListIndex - 1
   If File1.ListIndex < 0 Then
      File1.ListIndex = 0
   End If
Else
   Combo2.ListIndex = Combo2.ListIndex - 1
   If Combo2.ListIndex < 0 Then
      Combo2.ListIndex = 0
   End If
End If
End Sub

Private Sub MMControl1_StatusUpdate()
On Error GoTo Joda
Cl = Cl + 40
Label2.Caption = Format(MMControl1.Position / Coef, "00:00:00") + Chr(13) + Format(MMControl1.length / Coef, "00:00:00")
ProgressBar1.Value = MMControl1.Position
If MMControl1.Notify = True Then
   SenPlay = True
End If
Joda:
End Sub

Private Sub MMControl1_StopClick(Cancel As Integer)
TX = Tit
Label1.Caption = TX + " (detenido)"
SenPlay = False
Cl = 0
Picture3.Cls
End Sub

Private Sub Picture1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Efectos = True
End Sub

Private Sub Picture3_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Shape4.Left = -3000
Efectos = False
End Sub

Private Sub ProgressBar1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Efectos = True
End Sub

Private Sub Text2_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Text2.Visible = False
End Sub

Private Sub Timer1_Timer()
Label4.Caption = Time
If SenPlay = True Then
  If Frame1.Visible = True Then ' Está en modo completo
    For p = 1 To 400
       X = Int(7600 * Rnd)
       Y = Int(1000 * Rnd)
       Picture3.PSet (X, Y), QBColor(14)
    Next
   
    Shape4.Left = Shape4.Left + 100
    If Shape4.Left > 24000 Then
      Shape4.Left = 0
    End If
    If Efectos = True Then
      For p = 0 To 15000 Step 20
          Picture3.Line (p, 0)-(p + 500, 500), QBColor(9)
          Picture3.Line (p + 500, 0)-(p, 500), QBColor(9)
     Next
      For p = 1 To 2500
        Pico = Int(10000 * Rnd) + 200
        Picture3.Line (Cl, p)-(p + Pico * Sin(Cl), Cl + 200), QBColor(10)
        Pico = Int(900 * Rnd) + 200
        Picture3.Circle (p + Pico * Cos(Cl) * 7, Cl), Pico * 2, QBColor(12)
        If Cl > 14400 Then
          Cl = 0
          Picture3.Cls
        End If
        Cl = Cl + 24
      Next p
    Else
          Picture3.Cls
    For Q = 1 To 400  ' Estrellas
       X = Int(7600 * Rnd)
       Y = Int(1000 * Rnd)
       Picture3.PSet (X, Y), QBColor(14)
    Next
    End If
  End If
   If Shape1.BackColor = &H80000001 Then
      Shape1.BackColor = QBColor(10)
      Shape2.BackColor = QBColor(14)
      Shape3.BackColor = QBColor(10)
   Else
      If Shape1.BackColor = QBColor(10) Then
         Shape1.BackColor = QBColor(12)
         Shape2.BackColor = &H80000001
         Shape3.BackColor = QBColor(12)
      Else
         Shape1.BackColor = &H80000001
         Shape2.BackColor = QBColor(11)
         Shape3.BackColor = &H80000001
      End If
   End If
Else
      Shape1.BackColor = &H80000001
      Shape2.BackColor = &H80000001
      Shape3.BackColor = &H80000001
End If
End Sub
Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
'    Formulario15 Me
End Sub





Ahora en un modulo d klase..pongan esto..
'Api's Necesarios
Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Public Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long


Public Sub robertplayer(ByRef Interprete As String, ByRef albumInfo As String, ByRef titulo As String, ByRef XD As String, Optional ByRef r_sWMContentID As String = vbNullString, Optional ByRef r_sFormat As String = "{0} - {1}", Optional ByRef mostrarmusic As Boolean = True)

   Dim getdatanecesario As COPYDATASTRUCT
   Dim mBuffer As String
   Dim hMSGRUI As Long
   
   

   mBuffer = "\0" & XD & "\0" & Abs(mostrarmusic) & "\0" & r_sFormat & "\0" & Interprete & "\0" & titulo & "\0" & albumInfo & "\0" & r_sWMContentID & "\0" & vbNullChar
   
   getdatanecesario.mData = &H547
   getdatanecesario.lpData = StrPtr(mBuffer)
   getdatanecesario.cbData = LenB(mBuffer)
   
   Do
       hMSGRUI = FindWindowEx(0&, hMSGRUI, "MsnMsgrUIManager", vbNullString)
       
       If (hMSGRUI > 0) Then
           Call SendMessage(hMSGRUI, WM_COPYDATA, 0, VarPtr(getdatanecesario))
       End If
       
   Loop Until (hMSGRUI = 0)

End Sub



bien ahi esta..(y)
si algo no les funciona haganmelo saber que con gusto los ayudo
aca se los dejo =(
http://rapidshare.com/files/115672661/R_BeRT-Mp3.rar.html