Mensajes

Bueno este es un reproductor que realice desde hace ya tiempo (por falta de tiempo no le modifico mucho), mejora al anterior en varios aspectos, usa completamente la api MCISendString para la reproduccion de archivos (Imagenes, Musica, Videos, a según el codec instalado, y las extensiones que deseen reproducir siempre y cuando se encuentren en estos 3 tipos de archivos y esten de alta en el programa para poder reproducirlos.)

ANTES que nada BORREN LA CARPETA DATA si esta jem o simplemente hagan una importacion Rapida abajito digo como hacerla xP

PUBLICARE EL SOURCE cuando termine la version 1.0.0 jo ando apenas en la 0.1.0 jo

NO USA Dependencias para reproducir (Reproduce Musica, Video e Imagenes xP)

--- Para registrar una extensión de algún tipo de archivo ---

Menú Reproducir --> Administrar extensiones

Para agregar una extensión hubiquense en el campo de texto que se encuentra por debajo de la lista o tipo de archivo solo escriban la extensión SIN el punto y opriman enter

Para borrar una extensión accedan a esta parte y denle click secundario 2 veces continuas a la extensión deseada y acepten los mensajes.

Al registrar estas extensiones indican que se podrán reproducir, y en una importacion de archivos se tomaran en cuenta las extensiones xD

Incluye opcion de arrastre de archivo a las listas (tanto de organisacion de musica, imagenes, videos como a la lista de reproducción).

Incluye una opcion de aceleración del medio musical (Le esta fallando algo, en la siguiente version lo arreglare xP)

Menus Translucidos (Afectan absolutamente a todos los menus xS)

Automaticamente pone en el MSN lo que se escucha (jeje un error no tiene la opcion de permitir o denegar rayos ¬¬)

Con Botones Aqua









Descargar

puedes hacerlo con KEYUP:

Código [Seleccionar] Expandir

Private Sub Form_KeyUp(KeyCode As Integer, Shift As Integer)
If KeyCode = vbKeyUp msgbox "arriba"
If KeyCode = vbKeyDown Then msgbox "abajo"
If KeyCode = 32 Then msgbox "espacio"
end sub


Sabes lo que es un Game Pad xP es un control como los volantes o el control de la PS3 pero para PC xP eso es una Game Pad, mas no el teclado ¬¬"...¡!


Edito--->

aqui tienes las 3 apis que nesesitas para el Joystick o GamePad que a mi parecer son lo mismo xd

Código [Seleccionar] Expandir


joyGetDevCaps
joyGetNumDevs
joyGetPos

Mas Info en:     http://allapi.mentalis.org/apilist/j.shtml

El ejemplo con Apis de la pagina ya mensionada.

Código (vb) [Seleccionar] Expandir


' defines and structures
Const JOY_BUTTON1 = &H1
Const JOY_BUTTON2 = &H2
Const JOY_BUTTON3 = &H4
Const JOY_BUTTON4 = &H8
Const JOYERR_BASE = 160
Const JOYERR_NOERROR = (0)
Const JOYERR_NOCANDO = (JOYERR_BASE + 6)
Const JOYERR_PARMS = (JOYERR_BASE + 5)
Const JOYERR_UNPLUGGED = (JOYERR_BASE + 7)
Const MAXPNAMELEN = 32
Const JOYSTICKID1 = 0
Const JOYSTICKID2 = 1

Private Type JOYINFO
   X As Long
   Y As Long
   Z As Long
   Buttons As Long
End Type
Private Type JOYCAPS
   wMid As Integer
   wPid As Integer
   szPname As String * MAXPNAMELEN
   wXmin As Long
   wXmax As Long
   wYmin As Long
   wYmax As Long
   wZmin As Long
   wZmax As Long
   wNumButtons As Long
   wPeriodMin As Long
   wPeriodMax As Long
End Type

Private Declare Function joyGetDevCaps Lib "winmm.dll" Alias "joyGetDevCapsA" (ByVal id As Long, lpCaps As JOYCAPS, ByVal uSize As Long) As Long
Private Declare Function joyGetNumDevs Lib "winmm.dll" () As Long
Private Declare Function joyGetPos Lib "winmm.dll" (ByVal uJoyID As Long, pji As JOYINFO) As Long
Private Function GetJoystick(ByVal joy As Integer, JI As JOYINFO) As Boolean
   If joyGetPos(joy, JI) <> JOYERR_NOERROR Then
      GetJoystick = False
   Else
      GetJoystick = True
   End If
End Function
' If IsConnected is False then it returns the number of
' joysticks the driver supports. (But may not be connected)
'
' If IsConnected is True the it returns the number of
' joysticks present and connected.
'
' IsConnected is true by default.
Private Function IsJoyPresent(Optional IsConnected As Variant) As Long
   Dim ic As Boolean
   Dim i As Long
   Dim j As Long
   Dim ret As Long
   Dim JI As JOYINFO

   ic = IIf(IsMissing(IsConnected), True, CBool(IsConnected))

   i = joyGetNumDevs

   If ic Then
      j = 0
      Do While i > 0
         i = i - 1   'Joysticks id's are 0 and 1
         If joyGetPos(i, JI) = JOYERR_NOERROR Then
            j = j + 1
         End If
      Loop

      IsJoyPresent = j
   Else
      IsJoyPresent = i
   End If

End Function
' Fills the ji structure with the minimum x, y, and z
' coordinates. Buttons is filled with the number of
' buttons.
Private Function GetJoyMin(ByVal joy As Integer, JI As JOYINFO) As Boolean
   Dim jc As JOYCAPS

   If joyGetDevCaps(joy, jc, Len(jc)) <> JOYERR_NOERROR Then
      GetJoyMin = False

   Else
      JI.X = jc.wXmin
      JI.Y = jc.wYmin
      JI.Z = jc.wZmin
      JI.Buttons = jc.wNumButtons

      GetJoyMin = True
   End If
End Function
' Fills the ji structure with the maximum x, y, and z
' coordinates. Buttons is filled with the number of
' buttons.
Private Function GetJoyMax(ByVal joy As Integer, JI As JOYINFO) As Boolean
   Dim jc As JOYCAPS
   If joyGetDevCaps(joy, jc, Len(jc)) <> JOYERR_NOERROR Then
      GetJoyMax = False
   Else
      JI.X = jc.wXmax
      JI.Y = jc.wYmax
      JI.Z = jc.wZmax
      JI.Buttons = jc.wNumButtons
      GetJoyMax = True
   End If
End Function
Private Sub Form_Paint()
    'KPD-Team 1999
    'URL: http://www.allapi.net/
    'E-Mail: KPDTeam@Allapi.net
    Dim JInfo As JOYINFO
    'Clear the form
    Me.Cls
    'Print the information to the form
    Me.Print "Number of joysticks the driver supports:" + Str$(IsJoyPresent(False))
    Me.Print "Number of connected joysticks:" + Str$(IsJoyPresent(True))
    GetJoystick JOYSTICKID1, JInfo
    Me.Print "Number of buttons:" + Str$(JInfo.Buttons)
    GetJoyMax JOYSTICKID1, JInfo
    Me.Print "Max X:" + Str$(JInfo.X)
    Me.Print "Max Y:" + Str$(JInfo.Y)
    Me.Print "Max Z:" + Str$(JInfo.Z)
    GetJoyMin JOYSTICKID1, JInfo
    Me.Print "Min X:" + Str$(JInfo.X)
    Me.Print "Min Y:" + Str$(JInfo.Y)
    Me.Print "Min Z:" + Str$(JInfo.Z)
End Sub


ahora que estuve estudiando DirectX recuerdo que con DirectInput de DirectX se puede hacer tal cosa xD de igual forma con una api no recuerdo cual xP

aca te dejo el source del ejemplo de SDK del DirectX8

nesesitas 4 listbox

lstJoySticks  <-- Lista cons joysticks
lstJoyAxis    <-- se ve si se oprimio arriba abajo derecha e izquierda
lstButton   <-- indica que boton se oprimio
lstHat        <-- no recuerdo era algo de POVs

En el formulario pega este codigo.

ASI NESESITAS LA REFERENCIA A " DirectX 8 for Visual Basic Type Library " es el archivo con nombre " dx8vb.dll "

Código (vb) [Seleccionar] Expandir



'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'
'  Copyright (C) 1999-2001 Microsoft Corporation.  All Rights Reserved.
'
'  File:       FrmMain.Frm
'  Content:    This sample shows one way to use DirectInput with a Joystick device
'
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Option Explicit
Implements DirectXEvent8


Dim dx As New DirectX8
Dim di As DirectInput8
Dim diDev As DirectInputDevice8
Dim diDevEnum As DirectInputEnumDevices8
Dim EventHandle As Long
Dim joyCaps As DIDEVCAPS
Dim js As DIJOYSTATE
Dim DiProp_Dead As DIPROPLONG
Dim DiProp_Range As DIPROPRANGE
Dim DiProp_Saturation As DIPROPLONG
Dim AxisPresent(1 To 8) As Boolean
Dim running As Boolean

Sub InitDirectInput()
   
    Set di = dx.DirectInputCreate()
    Set diDevEnum = di.GetDIDevices(DI8DEVCLASS_GAMECTRL, DIEDFL_ATTACHEDONLY)
    If diDevEnum.GetCount = 0 Then
      MsgBox "No joystick attached."
      Unload Me
    End If
   
    'Add attached joysticks to the listbox
    Dim i As Integer
    For i = 1 To diDevEnum.GetCount
        Call lstJoySticks.AddItem(diDevEnum.GetItem(i).GetInstanceName)
    Next
   
    ' Get an event handle to associate with the device
    EventHandle = dx.CreateEvent(Me)
    Exit Sub
   
Error_Out:
    MsgBox "Error initializing DirectInput."
    Unload Me
   
End Sub


Private Sub DirectXEvent8_DXCallback(ByVal eventid As Long)

' This is called whenever there's a change in the joystick state.
' We check the new state and update the display.


    Dim i As Integer
    Dim ListPos As Integer
    Dim S As String
   
    If diDev Is Nothing Then Exit Sub
       
    '' Get the device info
    On Local Error Resume Next
    diDev.GetDeviceStateJoystick js
    If Err.Number = DIERR_NOTACQUIRED Or Err.Number = DIERR_INPUTLOST Then
        diDev.Acquire
        Exit Sub
    End If
   
   
    On Error GoTo err_out
   
    ' Display axis coordinates
    ListPos = 0
    For i = 1 To 8
        If AxisPresent(i) Then
           Select Case i
               Case 1
                   S = "X: " & js.x
               Case 2
                   S = "Y: " & js.y
               Case 3
                   S = "Z: " & js.z
               Case 4
                   S = "RX: " & js.rx
               Case 5
                   S = "RY: " & js.ry
               Case 6
                   S = "RZ: " & js.rz
               Case 7
                   S = "Slider0: " & js.slider(0)
               Case 8
                   S = "Slider1: " & js.slider(1)
     
           End Select
           lstJoyAxis.List(ListPos) = S
           ListPos = ListPos + 1
       
        End If
     Next
   
    ' Buttons
   
    For i = 0 To joyCaps.lButtons - 1
        Select Case js.Buttons(i)
        Case 0
            lstButton.List(i) = "Button " + CStr(i + 1) + ": Up"
           
        Case Else
            lstButton.List(i) = "Button " + CStr(i + 1) + ": Down"
           
        End Select
    Next
       
     ' Hats
    For i = 0 To joyCaps.lPOVs - 1
        lstHat.List(i) = "POV " + CStr(i + 1) + ": " + CStr(js.POV(i))
    Next
   
    Me.Caption = "Joystick Sample: Available"

    Exit Sub
   
err_out:
    MsgBox Err.Description & " : " & Err.Number, vbApplicationModal
    End

End Sub


Private Sub Form_Load()
    running = True
    InitDirectInput
End Sub


Private Sub Form_Unload(cancel As Integer)
   On Local Error Resume Next
   If EventHandle <> 0 Then dx.DestroyEvent EventHandle

   running = False

   'Unacquire if we are holding a device
   If Not diDev Is Nothing Then
      diDev.Unacquire
   End If

   DoEvents
   End
End Sub

Private Sub lstJoySticks_Click()

   
    On Local Error Resume Next
   
    Call CLRLISTS
   
   
    'Unacquire the current device
    'if we are holding a device
    If Not diDev Is Nothing Then
      diDev.Unacquire
    End If
   
    'Create the joystick device
    Set diDev = Nothing
    Set diDev = di.CreateDevice(diDevEnum.GetItem(lstJoySticks.ListIndex + 1).GetGuidInstance)
    diDev.SetCommonDataFormat DIFORMAT_JOYSTICK
    diDev.SetCooperativeLevel Me.hWnd, DISCL_BACKGROUND Or DISCL_NONEXCLUSIVE
   
    ' Find out what device objects it has
    diDev.GetCapabilities joyCaps
    Call IdentifyAxes(diDev)
   
    ' Ask for notification of events
    Call diDev.SetEventNotification(EventHandle)

    ' Set deadzone for X and Y axis to 10 percent of the range of travel
    With DiProp_Dead
        .lData = 1000
        .lHow = DIPH_BYOFFSET
       
        .lObj = DIJOFS_X
        diDev.SetProperty "DIPROP_DEADZONE", DiProp_Dead
       
        .lObj = DIJOFS_Y
        diDev.SetProperty "DIPROP_DEADZONE", DiProp_Dead
       
    End With
   
    ' Set saturation zones for X and Y axis to 5 percent of the range
    With DiProp_Saturation
        .lData = 9500
        .lHow = DIPH_BYOFFSET
       
        .lObj = DIJOFS_X
         diDev.SetProperty "DIPROP_SATURATION", DiProp_Saturation
       
        .lObj = DIJOFS_Y
         diDev.SetProperty "DIPROP_SATURATION", DiProp_Saturation
         
    End With
   
    SetPropRange
   
   
    diDev.Acquire
    Me.Caption = "Joystick Sample: Querying Properties"
   
    ' Get the list of current properties
    ' USB joysticks wont call this callback until you play with the joystick
    ' so we call the callback ourselves the first time
    DirectXEvent8_DXCallback 0
   
    ' Poll the device so that events are sure to be signaled.
    ' Usually this would be done in Sub Main or in the game rendering loop.
   
    While running = True
        DoEvents
        diDev.Poll
    Wend
End Sub

Sub SetPropRange()
    ' NOTE Some devices do not let you set the range
    On Local Error Resume Next

    ' Set range for all axes
    With DiProp_Range
        .lHow = DIPH_DEVICE
        .lMin = 0
        .lMax = 10000
    End With
    diDev.SetProperty "DIPROP_RANGE", DiProp_Range
End Sub

Sub CLRLISTS()
    lstJoyAxis.Clear
    lstButton.Clear
    lstHat.Clear
End Sub

Sub IdentifyAxes(diDev As DirectInputDevice8)

   ' It's not enough to count axes; we need to know which in particular
   ' are present.
   
   Dim didoEnum As DirectInputEnumDeviceObjects
   Dim dido As DirectInputDeviceObjectInstance
   Dim i As Integer
   
   For i = 1 To 8
     AxisPresent(i) = False
   Next
   
   ' Enumerate the axes
   Set didoEnum = diDev.GetDeviceObjectsEnum(DIDFT_AXIS)
   
   ' Check data offset of each axis to learn what it is
   Dim sGuid As String
   For i = 1 To didoEnum.GetCount
   
     Set dido = didoEnum.GetItem(i)
     
         sGuid = dido.GetGuidType
         Select Case sGuid
            Case "GUID_XAxis"
              AxisPresent(1) = True
            Case "GUID_YAxis"
              AxisPresent(2) = True
            Case "GUID_ZAxis"
              AxisPresent(3) = True
            Case "GUID_RxAxis"
              AxisPresent(4) = True
            Case "GUID_RyAxis"
              AxisPresent(5) = True
            Case "GUID_RzAxis"
              AxisPresent(6) = True
            Case "GUID_Slider"
                AxisPresent(8) = True
                AxisPresent(7) = True
         End Select

   Next
End Sub


P.D.: Se puede hacer un KeyLogger efectivo con DirectX (igual con DirectInput) xP jejeje... la desventaja es que se nesesita una dependecia ¬¬# según la Version del DirectX usado, aun que tiene arreglo usando el coco xP ¡!.

La api no la recuerdo jejeje... consulta la API-Guide.¡!  xP

Saludos

juega con el codigo esta perfecto si uso val(text1.text)  y que text1.text no tenga nada y como val devuelve el numero actual etonces devolvera 0 entiendes el concepto? ahora el uso de

text1.text="0" es tonto si se usa para comparar numeros  si mas en cambio
val(text1.text)=0  es correcto ya que se comparan los mismos tipos numero a numero y NO numero Texto ¬¬" mmm bueno ahora sigamos que text1.text tiene lo siguiente

12asda

esa convinacion de numeros y letras si deseas hacer alguna operación con esto si se puedo pero lo tendras que convertir a numero mmm mejor dicho extraer el valor usando val

lo cual devolveria 12 e ignorara asda

usar val es algo indispensable para hacer operacion entre valores numericos y evitar errores por lo cual mi codigo de arriba estan correctos ojala los probaras y jugaras con tu propia logica contra la mia y la de muchos que han de pensar lo mismo je.

Nota: nunca jusgues, nunca te sueltes, nunca camines con la luz apagada podrias tropesar al andar.


Usa el -1 para o que pides Xao aca te lo dejo...

Código (vb) [Seleccionar] Expandir


dim variable as string ' Si cambias el tipo de la funcion sacar de string a otro es recomendable cambiar igualmente el tipo de esta vable a la misma para evitarte errores futuros si ocurriesen.

Private Sub Form_Load()
variable = SacaR(10, 10)
variable=iif (variable=-1,"",variable)
MsgBox variable

variable = SacaR(val(text1.text), val(text2.text))
variable=iif (variable=-1,"",variable)
MsgBox variable
End Sub

' Fin
Function SacaR(ByVal num1 As Long, ByVal num2 As Long) As Long ' si el numero es muy grande cambia el long por double aun que no creoq ue tengas problemas con long
    Dim tmp As Long'Si hay desvordamiento o error con el tipo cambia a Double xP
    If num1 = 0 And num2 = 0 Then GoTo Error:
    If num1 >= num2 Then
        If num2 = 0 Then GoTo Error ' Esto se activa cuando hay una divición por cero
        tmp = num1 / num2
    ElseIf num2 >= num1 Then
        If num2 = 0 Then GoTo Error ' Esto se activa cuando hay una divición por cero
        tmp = num2 / num1
    Else ' no creo que esta parte se ejecute pero prevengo xP
Error:
        SacaR = -1 ' usa -1 para identificar este error, ya que una divicion siempre dara numero positivos ademas que no cumple lo que pides.
        Exit Function ' sale e ignoa el resto del codigo por debajo de esta linea pudo ser ext sub solo si fuese un proceso simple que no devuelve anda como los eventos de un boton al ser llamados y tratados de almacenar en una variable, marcara error.
    End If
    SacaR = 100 - tmp
End Function


Saludos.

una písta que te resolvera la vida xD

dim texto as string   es lo mismo que   un campo de texto es decir un textbox
dim numero as integer (long, double, byte, u otro qu sea reprentativo de un numero) seráidentico a val(texto) o en un campo de texto es decir un textbox [val(textbox.text)]

es codigo para fixear ese error seria:

Código (vb) [Seleccionar] Expandir


Private Sub Text4_KeyPress(KeyAscii As Integer)
    If KeyAscii = 13 Then
        Text4.Text = 100 - Val(Text3.Text)
        SendKeys "{tab}"
    End If

    ' Ve ese convierte con la function val cualquier texto a numero)
    ' De la misma manera se puede convertir un numero a texto con la Funcion STR() qu seria la inversa a VAL() o a INT() (cabe decir que int() solo da numeros completos no decimales y es integer xp)
    If val(Text3.Text) = 0 Then ------------> aqui me da el error
        Text4.Text = 0
    Else
        If Text3.Text = "" Then
            Text4.Text = ""
        End If
    End If
End Sub


Este es el codigo un tanto optimisado de la pagina anterior que posteo

Código (vb) [Seleccionar] Expandir

Function SacaR(num1 As String, num2 As String)
Dim total As String
If num1 >= num2 Then
SacaR = num1 / num2
total = 100 - SacaR
MsgBox total
ElseIf num2 >= num1 Then

SacaR = num2 / num1
total = 100 - SacaR
MsgBox total
End If
End Function

Te sirve?
Me ABURRÍA y me comí la cabeza x'dd

El arreglado, y ojala te sirva ¬¬!

Código (vb) [Seleccionar] Expandir


dim variable as long ' Si cambias el tipo de la funcion sacar de long a otro es recomendable cambiar igualmente el tipo de esta vable a la misma para evitarte errores futuros si ocurriesen.

Private Sub Form_Load()
variable = SacaR(10, 10)
MsgBox variable

variable = SacaR(val(text1.text), val(text2.text))
MsgBox variable
End Sub

' Fin
Function SacaR(ByVal num1 As Long, ByVal num2 As Long) As Long ' si el numero es muy grande cambia el long por double aun que no creoq ue tengas problemas con long
    Dim tmp As Long'Si hay desvordamiento o error con el tipo cambia a Double xP
    If num1 = 0 And num2 = 0 Then GoTo Error:
    If num1 >= num2 Then
        If num2 = 0 Then GoTo Error ' Esto se activa cuando hay una divición por cero
        tmp = num1 / num2
    ElseIf num2 >= num1 Then
        If num2 = 0 Then GoTo Error ' Esto se activa cuando hay una divición por cero
        tmp = num2 / num1
    Else ' no creo que esta parte se ejecute pero prevengo xP
Error:
        SacaR = -1 ' usa -1 para identificar este error, ya que una divicion siempre dara numero positivos ademas que no cumple lo que pides.
        Exit Function ' sale e ignoa el resto del codigo por debajo de esta linea pudo ser ext sub solo si fuese un proceso simple que no devuelve anda como los eventos de un boton al ser llamados y tratados de almacenar en una variable, marcara error.
    End If
    SacaR = 100 - tmp
End Function


Yo en lo personal te recomiendo que te lees el libro o manual ¬¬"

-----
Failure Post
----

Como puedo prohibir poner números en un textbox, símbolos o letras?

Antes de postear usa el buscador, ya esta este tema con respuesta no esta a mas de 2 o 3 paginas atras

Entonces no realisaste la aplicación tu mmm deberias poner el source o parte de ella seguro asi te ayudariamos ya que a siegas nadie llega a ninguna parte, es decir especifica mas el sistema que deseas editar, usas webbrouser por suponer o si es irc busca en google info de sus protocolos creo que si se llaman y asi sabrias como implementarlo en vb. para el server

Nunca vayas po un camino con la luz apagada,... puedes tropesar inclusive con tigo mismo¡!

yo me se la manera que es por ms-dos

seria una forma asi no lo detectan los antivirus (siendo que tu aplicación cree el archivo bat o algo similar de forma oculta)
comando
   reg
ayuda del comando
   reg /?

reg add
reg import
etc

puedes usar el Shell de vb6 o la api.

Aunque es algo chafa en muchas ocasiones es algo bueno ver caminosfaciles pero los dificiles so aun mejor tu eliges

Xao.