miércoles, 23 de marzo de 2011

Reproductor de video


Option Explicit
Dim MM As New MovieModule


' Botón Play
''''''''''''''''''''''''''
Private Sub Command1_Click()
    On Error Resume Next
    ' play
    MM.playMovie
    MM.setVolume Volume.Value * 10 ' establece el volumen
    ' Activa el timer
    Timer1.Enabled = True
    ' posición máxima
    SliderPosition.Max = Val(MM.getLengthInSec)
    MM.timeOut 0.5
    ' estado actual
    StatusBar1.Panels(1).Text = "Status: " & MM.getStatus
    ' Estado del error
    StatusBar1.Panels(3).Text = "Error Status: " & MM.checkError

End Sub

' botón que detiene
'''''''''''''''''''''''''
Private Sub Command2_Click()
    MM.stopMovie   ' detiene
    Timer1.Enabled = False
    MM.timeOut 1
    ' estado de reprodución
    StatusBar1.Panels(1).Text = "Status: " & MM.getStatus
    ' estado de error
    StatusBar1.Panels(3).Text = "Error Status: " & MM.checkError
End Sub

' botón de pausa
''''''''''''''''''''''''''''''
Private Sub Command3_Click()
    If Command3.Caption = "Pausa" Then
        MM.pauseMovie
        Command3.Caption = "Resume"
        Timer1.Enabled = False
    Else
        MM.resumeMovie
        Command3.Caption = "Pausa"
        Timer1.Enabled = True
    End If
    MM.timeOut 1
    StatusBar1.Panels(1).Text = "Status: " & MM.getStatus
    StatusBar1.Panels(3).Text = "Error Status: " & MM.checkError
End Sub

' botón que abre y carga la pelicula
''''''''''''''''''''''''''''''''''''''
Private Sub Command4_Click()
    Dim a As Long
    Dim b As Long

    C.Filter = "Avi Files (*.avi)|*.avi|Mpeg Files (*.mpeg)|*.mpeg|Mpg Files (*.mpg)|*.mpg|Mov Files (*.mov)|*.mov|All Files (*.*)|*.*"
    C.ShowOpen
    MM.Filename = C.Filename
    Me.Caption = C.Filename
' abre el video
    ' si se pasa overlapped la abre en una ventana aparte
    MM.openMovieWindow Picture1.hWnd, "child"
    C.Filename = ""
' actualiza los datos del movie
    StatusBar1.Panels(1).Text = "Status: " & MM.getStatus
    StatusBar1.Panels(3).Text = "Error Status: " & MM.checkError

End Sub


' cierra el MCI
'''''''''''''''''''''''''''
Private Sub Command5_Click()
    MM.closeMovie 'close the mci device
    StatusBar1.Panels(1).Text = "Status: " & MM.getStatus
    StatusBar1.Panels(3).Text = "Error Status: " & MM.checkError
    Timer1.Enabled = False
End Sub




Private Sub FloatButton1_Click()

End Sub

Private Sub L4_Click()

End Sub

Private Sub L3_Click()

End Sub


Private Sub Form_Resize()
    Fr.Width = Me.ScaleWidth - 300
    SliderPosition.Width = Me.ScaleWidth - 100
    Picture1.Width = Me.ScaleWidth - 300
    Picture1.Height = Me.ScaleHeight - (Picture1.top + StatusBar1.Height)
   
    ' redimensiona el tamaño del movie
    MM.sizeLocateMovie 0, 0, _
                       (Picture1.Width / Screen.TwipsPerPixelX), _
                       (Picture1.Height / Screen.TwipsPerPixelY)
End Sub

Private Sub SliderPosition_Click()
    'change the playback position of the movie
    MM.setPositionTo SliderPosition.Value
End Sub


'Timer que actualiza los datos del video
'''''''''''''''''''''''''''''''''''
Private Sub Timer1_Timer()
    On Error Resume Next
    ' posición en segundos
    StatusBar1.Panels(2).Text = "Posicion: " & MM.getFormatPosition & " de: " & MM.getFormatLength
    ' posición
    SliderPosition.Value = MM.getPositionInSec
End Sub


' establece los valores por defecto para el volumen y para _
  la velocidad de reproducción
  '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Sub Form_Load()
    Volume.Value = 80
End Sub
' cierra el dispositivo
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Sub Form_Unload(Cancel As Integer)
    MM.closeMovie
    Unload Me
    End
End Sub



'slider para cambiar el volumen
'''''''''''''''''''''''''''''''''''
Private Sub Volume_ValueChanged()
    MM.setVolume Volume.Value * 10
    labelVol.Caption = "Volumen: " & Volume.Value & "%"
End Sub

Conversor de multimedia

Option Explicit

' -- \\ Descripción :            Módulo con presets para usar con el programa ffmpeg.exe - http://es.wikipedia.org/wiki/FFmpeg
' -- \\ Autor       :            Luciano Lodola -- http://www.recursosvisualbasic.com.ar/ -- Nota. Los presets están extraidos de un archivo XML del siguiente programa: http://code.google.com/p/winff/

' -- Dependencias de ffmpeg.exe --> libavcodec.dll

' ---------------------------------------------------------------------------------------------------

Enum ePresets
    [01_CDWavStereo] = 0
    [02_GigabeatFS] = 1
    [03_GigabeatWS] = 2
    [04_H1020FS] = 3
    [05_H1020WS] = 4
    [06_H105FS] = 5
    [07_H105WS] = 6
    [08_H300FS] = 7
    [09_H300WS] = 8
    [10_I5GFS] = 9
    [11_I5GWS] = 10
    [12_M4a] = 11
    [13_NeurosOSDTVHQNTSC] = 12
    [14_NeurosOSDTVHQPAL] = 13
    [15_NeurosOSDTVSFNTSC] = 14
    [16_NeurosOSDTVSFPAL] = 15
    [17_NeurosOSDTVWSHQNTSC] = 16
    [18_NeurosOSDTVWSHQPAL] = 17
    [19_NeurosOSDTVWSSFNTSC] = 18
    [20_NeurosOSDTVWSSFPAL] = 19
    [21_PalmXviDFS] = 20
    [22_PalmXviDWS] = 21
    [23_PhotoFS] = 22
    [24_PhotoWS] = 23
    [25_X5FS] = 24
    [26_X5WS] = 25
    [27_XviDAVIFS] = 26
    [28_XviDAVIWS] = 27
    [29_XviDAVIWSAna] = 28
    [30_XviDPSP169] = 29
    [31_XviDPSP43] = 30
    [32_ac3dvd192] = 31
    [33_ac3dvd384] = 32
    [34_divx] = 33
    [35_dvntsc] = 34
    [36_dvpal] = 35
    [37_e200FS] = 36
    [38_e200WS] = 37
    [39_mp3] = 38
    [40_mp3m] = 39
    [41_nanoFS] = 40
    [42_nanoWS] = 41
    [43_ntscdvdgoodqFS] = 42
    [44_ntscdvdgoodqWS] = 43
    [45_ntscdvdhqFS] = 44
    [46_ntscdvdhqWS] = 45
    [47_ntscdvdlq] = 46
    [48_ntscvcdhq] = 47
    [49_paldvdgoodqFS] = 48
    [50_paldvdgoodqWS] = 49
    [51_paldvdhqFS] = 50
    [52_paldvdhqWS] = 51
    [53_paldvdlq] = 52
    [54_palvcdhq] = 53
    [55_qmov] = 54
    [56_wma] = 55
    [57_wmv] = 56
    [58_x264HQFS] = 57
    [59_x264HQPSP43] = 58
    [60_x264HQWS] = 59
    [61_cdma3g] = 60
    [62_XviDAVIZENFS] = 61
    [63_XviDAVIZENWS] = 62
    [64_BlackberryCurvefs] = 63
    [65_BlackberryCurvews] = 64
    [66_lgchocolate] = 65
    [67_blackberrymp3] = 66
    [68_blackberryws] = 67
    [69_blackberryfs] = 68
    [70_flvwebFS] = 69
    [71_flvwebWS] = 70
    [72_x264HQPSP169robertswain] = 71
    [73_iPodiTunesSmallCRF21FS] = 72
    [74_iPodiTunesSmallCRF21WS] = 73
    [75_iPodiTunesSmallCRF21WSAna] = 74
    [76_iPodiTunesSmallCRF21WSLBFix] = 75
    [77_iPodiTunesTVOutCRF21FS] = 76
    [78_iPodiTunesTVOutCRF21WS] = 77
    [79_iPodiTunesTVOutCRF21WSAna] = 78
    [80_iPodiTunesTVOutCRF21WSLBFix] = 79
    [81_iPodXviDFS] = 80
    [82_iPodXviDWS] = 81
    [83_iPodXviDWSAna] = 82
    [84_ogg4] = 83
    [85_ogg2] = 84
    [86_ogg5] = 85
    [87_ogg1] = 86
    [88_wma1] = 87
    [89_wmv3a] = 88
    [90_wma2] = 89
    [91_wmv3d] = 90
    [92_wmv3c] = 91
    [93_wmv3b] = 92
End Enum

' -- declaraciones de funciones
Private Declare Function PathFindExtension Lib "shlwapi" Alias "PathFindExtensionA" (ByVal pPath As String) As Long
Private Declare Function lstrcpyA Lib "kernel32" (ByVal RetVal As String, ByVal Ptr As Long) As Long
Private Declare Function lstrlenA Lib "kernel32" (ByVal Ptr As Any) As Long

Private mPresetsCount               As Integer
Private mPresetDescription          As String
Private mPresetExtension            As String
Private mPresetCategory             As String
Private mPresetParameters           As String


Property Get PresetsCount() As Integer
    PresetsCount = mPresetsCount
End Property

Private Sub Class_Initialize()
    mPresetsCount = 93
End Sub

Property Get PresetDescription() As String
    PresetDescription = mPresetDescription
End Property
  
Property Get PresetExtension() As String
    PresetExtension = mPresetExtension
End Property

Property Get PresetCategory() As String
    PresetCategory = mPresetCategory
End Property

Property Get PresetParameters() As String
    PresetParameters = mPresetParameters
End Property

Function setPreset(lPreset As ePresets) As String
    If lPreset = 0 Then
        mPresetDescription = "Wav for CD"
        mPresetParameters = "-vn -ar 44100"
        mPresetExtension = "wav"
        mPresetCategory = "Audio"
    End If
    If lPreset = 1 Then
        mPresetDescription = "RB Toshiba Gigabeat F/X 4:3"
        mPresetParameters = "-acodec libmp3lame -ab 128 -ar 44100 -vcodec mpeg2video -s 320x240 -b 600kb -strict -1"
        mPresetExtension = "mpg"
        mPresetCategory = "Rockbox"
    End If
    If lPreset = 2 Then
        mPresetDescription = "RB Toshiba Gigabeat F/X 16:9"
        mPresetParameters = "-acodec libmp3lame -ab 128 -ar 44100 -vcodec mpeg2video -s 320x176 -b 600kb -strict -1"
        mPresetExtension = "mpg"
        mPresetCategory = "Rockbox"
    End If
    If lPreset = 3 Then
        mPresetDescription = "RB iRiver H10 20GB 4:3"
        mPresetParameters = "-acodec libmp3lame -ab 128 -ar 44100 -vcodec mpeg2video -s 160x128 -b 224kb -strict -1"
        mPresetExtension = "mpg"
        mPresetCategory = "Rockbox"
    End If
    If lPreset = 4 Then
        mPresetDescription = "RB iRiver H10 20GB 16:9"
        mPresetParameters = "-acodec libmp3lame -ab 128 -ar 44100 -vcodec mpeg2video -s 160x96 -b 224kb -strict -1"
        mPresetExtension = "mpg"
        mPresetCategory = "Rockbox"
    End If
    If lPreset = 5 Then
        mPresetDescription = "RB iRiver H10 5/6GB 4:3"
        mPresetParameters = "-acodec libmp3lame -ab 128 -ar 44100 -vcodec mpeg2video -s 128x96 -b 224kb -strict -1"
        mPresetExtension = "mpg"
        mPresetCategory = "Rockbox"
    End If
    If lPreset = 6 Then
        mPresetDescription = "RB iRiver H10 5/6GB 16:9"
        mPresetParameters = "-acodec libmp3lame -ab 128 -ar 44100 -vcodec mpeg2video -s 128x80 -b 224kb -strict -1"
        mPresetExtension = "mpg"
        mPresetCategory = "Rockbox"
    End If
    If lPreset = 7 Then
        mPresetDescription = "RB iRiver H300 4:3"
        mPresetParameters = "-acodec libmp3lame -ab 96 -ar 44100 -vcodec mpeg2video -s 224x176 -b 224kb -r 10 -strict -1"
        mPresetExtension = "mpg"
        mPresetCategory = "Rockbox"
    End If
    If lPreset = 8 Then
        mPresetDescription = "RB iRiver H300 16:9"
        mPresetParameters = "-acodec libmp3lame -ab 96 -ar 44100 -vcodec mpeg2video -s 224x128 -b 256kb -r 15 -strict -1"
        mPresetExtension = "mpg"
        mPresetCategory = "Rockbox"
    End If
    If lPreset = 9 Then
        mPresetDescription = "RB Apple iPod Video 4:3"
        mPresetParameters = "-acodec libmp3lame -ab 128 -ar 44100 -vcodec mpeg2video -s 320x240 -b 400kb -strict -1"
        mPresetExtension = "mpg"
        mPresetCategory = "Rockbox"
    End If
    If lPreset = 10 Then
        mPresetDescription = "RB Apple iPod Video 16:9"
        mPresetParameters = "-acodec libmp3lame -ab 128 -ar 44100 -vcodec mpeg2video -s 320x176 -b 400kb -strict -1"
        mPresetExtension = "mpg"
        mPresetCategory = "Rockbox"
    End If
    If lPreset = 11 Then
        mPresetDescription = "M4a"
        mPresetParameters = "-vn -acodec libfaac -ab 112k -ac 2"
        mPresetExtension = "m4a"
        mPresetCategory = "Audio"
    End If
    If lPreset = 12 Then
        mPresetDescription = "Neuros High Quality NTSC (4:3)"
        mPresetParameters = "-r 29.97 -vcodec libxvid -s 640x480 -aspect 4:3 -maxrate 2500k -b 2000k -qmin 3 -qmax 5 -bufsize 4096 -mbd 2 -flags +4mv -trellis -aic -cmp 2 -subcmp 2 -g 300 -acodec libfaac -ar 48000 -ab 128k -ac 2"
        mPresetExtension = "mp4"
        mPresetCategory = "Neuros OSD"
    End If
    If lPreset = 13 Then
        mPresetDescription = "Neuros High Quality PAL (4:3)"
        mPresetParameters = "-r 25 -vcodec libxvid -s 640x480 -aspect 4:3 -maxrate 2500k -b 2000k -qmin 3 -qmax 5 -bufsize 4096 -mbd 2 -flags +4mv -trellis -aic -cmp 2 -subcmp 2 -g 300 -acodec libfaac -ar 48000 -ab 128k -ac 2"
        mPresetExtension = "mp4"
        mPresetCategory = "Neuros OSD"
    End If
    If lPreset = 14 Then
        mPresetDescription = "Neuros Small File NTSC (4:3)"
        mPresetParameters = "-b 800k -r 29.97 -s 320x240 -aspect 4:3 -vcodec libxvid -ar 48000 -ab 80k -ac 2 -acodec libfaac"
        mPresetExtension = "mp4"
        mPresetCategory = "Neuros OSD"
    End If
    If lPreset = 15 Then
        mPresetDescription = "Neuros Small File PAL (4:3)"
        mPresetParameters = "-b 800k -r 25 -s 320x240 -aspect 4:3 -vcodec libxvid -ar 48000 -ab 80k -ac 2 -acodec libfaac"
        mPresetExtension = "mp4"
        mPresetCategory = "Neuros OSD"
    End If
    If lPreset = 16 Then
        mPresetDescription = "Neuros High Quality NTSC (16:9)"
        mPresetParameters = "-r 29.97 -vcodec libxvid -s 704x384 -aspect 16:9 -maxrate 3000k -b 2500k -qmin 3 -qmax 5 -bufsize 4096 -mbd 2 -bf 2 -flags +4mv -trellis -aic -cmp 2 -subcmp 2 -g 300 -acodec libfaac -ar 48000 -ab 128k -ac 2"
        mPresetExtension = "mp4"
        mPresetCategory = "Neuros OSD"
    End If
    If lPreset = 17 Then
        mPresetDescription = "Neuros High Quality PAL (16:9)"
        mPresetParameters = "-r 25 -vcodec libxvid -s 704x384 -aspect 16:9 -maxrate 3000k -b 2500k -qmin 3 -qmax 5 -bufsize 4096 -mbd 2 -bf 2 -flags +4mv -trellis -aic -cmp 2 -subcmp 2 -g 300 -acodec libfaac -ar 48000 -ab 128k -ac 2"
        mPresetExtension = "mp4"
        mPresetCategory = "Neuros OSD"
    End If
    If lPreset = 18 Then
        mPresetDescription = "Neuros Small File NTSC (16:9)"
        mPresetParameters = "-b 800k -r 29.97 -s 352x240 -aspect 16:9 -vcodec libxvid -ar 48000 -ab 80k -ac 2 -acodec libfaac"
        mPresetExtension = "mp4"
        mPresetCategory = "Neuros OSD"
    End If
    If lPreset = 19 Then
        mPresetDescription = "Neuros Small File PAL (16:9)"
        mPresetParameters = "-b 800k -r 25 -s 352x240 -aspect 16:9 -vcodec libxvid -ar 48000 -ab 80k -ac 2 -acodec libfaac"
        mPresetExtension = "mp4"
        mPresetCategory = "Neuros OSD"
    End If
    If lPreset = 20 Then
        mPresetDescription = "Xvid for Palm (4:3)"
        mPresetParameters = "-r 29.97 -vcodec libxvid -s 428x320 -aspect 4:3 -maxrate 550k -b 500k -qmin 3 -qmax 5 -bufsize 4096 -mbd 2 -flags +4mv -trellis -aic -cmp 2 -subcmp 2 -g 300 -acodec libfaac -ar 44100 -ab 80k -ac 2"
        mPresetExtension = "mp4"
        mPresetCategory = "Palm"
    End If
    If lPreset = 21 Then
        mPresetDescription = "XviD for Palm (3:2)"
        mPresetParameters = "-r 29.97 -vcodec libxvid -s 480x320 -aspect 3:2 -maxrate 450k -b 430k -qmin 3 -qmax 5 -bufsize 4096 -mbd 2 -flags +4mv -trellis -aic -cmp 2 -subcmp 2 -g 300 -acodec libfaac -ar 44100 -ab 80k -ac 2"
        mPresetExtension = "mp4"
        mPresetCategory = "Palm"
    End If
    If lPreset = 22 Then
        mPresetDescription = "RB Apple iPod Photo/Color 4:3"
        mPresetParameters = "-acodec libmp3lame -ab 128 -ar 44100 -vcodec mpeg2video -s 224x176 -b 320kb -r 15 -strict -1"
        mPresetExtension = "mpg"
        mPresetCategory = "Rockbox"
    End If
    If lPreset = 23 Then
        mPresetDescription = "RB Apple iPod Photo/Color 16:9"
        mPresetParameters = "-acodec libmp3lame -ab 128 -ar 44100 -vcodec mpeg2video -s 224x128 -b 320kb -r 24 -strict -1"
        mPresetExtension = "mpg"
        mPresetCategory = "Rockbox"
    End If
    If lPreset = 24 Then
        mPresetDescription = "RB Cowon iAudio X5 4:3"
        mPresetParameters = "-acodec libmp3lame -ab 128 -ar 44100 -vcodec mpeg2video -s 160x128 -b 176kb -r 15 -strict -1"
        mPresetExtension = "mpg"
        mPresetCategory = "Rockbox"
    End If
    If lPreset = 25 Then
        mPresetDescription = "RB Cowon iAudio X5 16:9"
        mPresetParameters = "-acodec libmp3lame -ab 128 -ar 44100 -vcodec mpeg2video -s 160x96 -b 224kb -r 24 -strict -1"
        mPresetExtension = "mpg"
        mPresetCategory = "Rockbox"
    End If
    If lPreset = 26 Then
        mPresetDescription = "XviD in AVI (4:3)"
        mPresetParameters = "-r 29.97 -vcodec libxvid -vtag XVID -s 640x480 -aspect 4:3 -maxrate 1800k -b 1500k -qmin 3 -qmax 5 -bufsize 4096 -mbd 2 -bf 2 -flags +4mv -trellis -aic -cmp 2 -subcmp 2 -g 300 -acodec libmp3lame -ar 48000 -ab 128k -ac 2"
        mPresetExtension = "avi"
        mPresetCategory = "AVI"
    End If
    If lPreset = 27 Then
        mPresetDescription = "XviD in AVI (16:9)"
        mPresetParameters = "-r 29.97 -vcodec libxvid -vtag XVID -s 704x384 -aspect 16:9 -maxrate 1800k -b 1500k -qmin 3 -qmax 5 -bufsize 4096 -mbd 2 -bf 2 -flags +4mv -trellis -aic -cmp 2 -subcmp 2 -g 300 -acodec libmp3lame -ar 48000 -ab 128k -ac 2"
        mPresetExtension = "avi"
        mPresetCategory = "AVI"
    End If
    If lPreset = 28 Then
        mPresetDescription = "XviD in AVI (16:9 Anamorphic)"
        mPresetParameters = "-r 29.97 -croptop 58 -cropbottom 62 -vcodec libxvid -vtag XVID -s 640x272 -aspect 2.35 -maxrate 1800k -b 1500k -qmin 3 -qmax 5 -bufsize 4096 -mbd 2 -bf 2 -flags +4mv -trellis -aic -cmp 2 -subcmp 2 -g 300 -acodec libmp3lame -ar 48000 -ab 128k -ac 2"
        mPresetExtension = "avi"
        mPresetCategory = "AVI"
    End If
    If lPreset = 29 Then
        mPresetDescription = "XviD for PSP (16:9)"
        mPresetParameters = "-r 29.97 -vcodec libxvid -s 640x480 -aspect 16:9 -maxrate 1500k -b 1250k -qmin 3 -qmax 5 -bufsize 4096 -mbd 2 -flags +4mv -trellis -aic -cmp 2 -subcmp 2 -g 300 -acodec libfaac -ar 48000 -ab 80k -ac 2 -s 320x240"
        mPresetExtension = "mp4"
        mPresetCategory = "PSP"
    End If
    If lPreset = 30 Then
        mPresetDescription = "XviD for PSP (4:3)"
        mPresetParameters = "-r 29.97 -vcodec libxvid -s 640x480 -aspect 4:3 -maxrate 1500k -b 1250k -qmin 3 -qmax 5 -bufsize 4096 -mbd 2 -flags +4mv -trellis -aic -cmp 2 -subcmp 2 -g 300 -acodec libfaac -ar 48000 -ab 80k -ac 2 -s 320x240"
        mPresetExtension = "mp4"
        mPresetCategory = "PSP"
    End If
    If lPreset = 31 Then
        mPresetDescription = "Ac3 DVD - 192kbps Stereo"
        mPresetParameters = "-acodec ac3 -ab 192k -ar 48000 -ac 2"
        mPresetExtension = "ac3"
        mPresetCategory = "Audio"
    End If
    If lPreset = 32 Then
        mPresetDescription = "Ac3 DVD - 384kbps Stereo"
        mPresetParameters = "-acodec ac3 -ab 384k -ar 48000 -ac 2"
        mPresetExtension = "ac3"
        mPresetCategory = "Audio"
    End If
    If lPreset = 33 Then
        mPresetDescription = "MS Compatible AVI"
        mPresetParameters = "-f avi -acodec libmp3lame -vcodec msmpeg4 -ab 192 -b 1250"
        mPresetExtension = "avi"
        mPresetCategory = "AVI"
    End If
    If lPreset = 34 Then
        mPresetDescription = "Raw DV for NTSC 4:3"
        mPresetParameters = "-target ntsc-dv -aspect 4:3"
        mPresetExtension = "dv"
        mPresetCategory = "DV"
    End If
    If lPreset = 35 Then
        mPresetDescription = "Raw DV for PAL 4:3"
        mPresetParameters = "-target pal-dv -aspect 4:3"
        mPresetExtension = "dv"
        mPresetCategory = "DV"
    End If
    If lPreset = 36 Then
        mPresetDescription = "RB Sandisk Sansa e200 4:3"
        mPresetParameters = "-acodec libmp3lame -ab 128 -ar 44100 -vcodec mpeg2video -s 224x176 -b 320kb -strict -1"
        mPresetExtension = "mpg"
        mPresetCategory = "Rockbox"
    End If
    If lPreset = 37 Then
        mPresetDescription = "RB Sandisk Sansa e200 16:9"
        mPresetParameters = "-acodec libmp3lame -ab 128 -ar 44100 -vcodec mpeg2video -s 224x128 -b 320kb -strict -1"
        mPresetExtension = "mpg"
        mPresetCategory = "Rockbox"
    End If
    If lPreset = 38 Then
        mPresetDescription = "MP3"
        mPresetParameters = "-acodec libmp3lame -ab 160k -ac 2 -ar 44100"
        mPresetExtension = "mp3"
        mPresetCategory = "Audio"
    End If
    If lPreset = 39 Then
        mPresetDescription = "MP3 (Mono)"
        mPresetParameters = "-acodec libmp3lame -ab 32k -ac 1 -ar 22050"
        mPresetExtension = "mp3"
        mPresetCategory = "Mobile Phones"
    End If
    If lPreset = 40 Then
        mPresetDescription = "RB Apple iPod Nano 4:3"
        mPresetParameters = "-acodec libmp3lame -ab 128 -ar 44100 -vcodec mpeg2video -s 176x128 -b 256kb -strict -1"
        mPresetExtension = "mpg"
        mPresetCategory = "Rockbox"
    End If
    If lPreset = 41 Then
        mPresetDescription = "RB Apple iPod Nano 16:9"
        mPresetParameters = "-acodec libmp3lame -ab 128 -ar 44100 -vcodec mpeg2video -s 176x128 -b 256kb -strict -1"
        mPresetExtension = "mpg"
        mPresetCategory = "Rockbox"
    End If
    If lPreset = 42 Then
        mPresetDescription = "NTSC DVD (4:3)"
        mPresetParameters = "-vcodec mpeg2video -r 29.97 -s 352x480 -aspect 4:3 -b 4000k -mbd rd -trellis -mv0 -cmp 2 -subcmp 2 -acodec mp2 -ab 192k -ar 48000 -ac 2"
        mPresetExtension = "mpg"
        mPresetCategory = "DVD"
    End If
    If lPreset = 43 Then
        mPresetDescription = "NTSC DVD (16:9)"
        mPresetParameters = "-vcodec mpeg2video -r 29.97 -s 352x480 -aspect 16:9 -b 4000k -mbd rd -trellis -mv0 -cmp 2 -subcmp 2 -acodec mp2 -ab 192k -ar 48000 -ac 2"
        mPresetExtension = "mpg"
        mPresetCategory = "DVD"
    End If
    If lPreset = 44 Then
        mPresetDescription = "NTSC DVD HQ (4:3)"
        mPresetParameters = "-target ntsc-dvd -r 29.97 -s 720x480 -aspect 4:3 -b 8000k -mbd rd -trellis -mv0 -cmp 0 -subcmp 2"
        mPresetExtension = "mpg"
        mPresetCategory = "DVD"
    End If
    If lPreset = 45 Then
        mPresetDescription = "NTSC DVD HQ (16:9)"
        mPresetParameters = "-target ntsc-dvd -r 29.97 -s 720x480 -aspect 16:9 -b 8000k -g 12 -mbd rd -trellis -mv0 -cmp 0 -subcmp 2"
        mPresetExtension = "mpg"
        mPresetCategory = "DVD"
    End If
    If lPreset = 46 Then
        mPresetDescription = "NTSC DVD Fast (LQ)"
        mPresetParameters = "-target ntsc-dvd -b 5000kb -r 29.97 -s 720x480 -ar 48000 -ab 384kb"
        mPresetExtension = "mpg"
        mPresetCategory = "DVD"
    End If
    If lPreset = 47 Then
        mPresetDescription = "NTSC VCD (HQ)"
        mPresetParameters = "-target ntsc-vcd -mbd rd -trellis -mv0 -cmp 0 -subcmp 2"
        mPresetExtension = "mpg"
        mPresetCategory = "VCD"
    End If
    If lPreset = 48 Then
        mPresetDescription = "PAL DVD (4:3)"
        mPresetParameters = "-vcodec mpeg2video -r 25.00 -s 352x576  -aspect 4:3 -b 4000k -mbd rd -trellis -mv0 -cmp 2 -subcmp 2 -acodec mp2 -ab 192k -ar 48000 -ac 2"
        mPresetExtension = "mpg"
        mPresetCategory = "DVD"
    End If
    If lPreset = 49 Then
        mPresetDescription = "PAL DVD (16:9)"
        mPresetParameters = "-vcodec mpeg2video -r 25.00 -s 352x576 -aspect 16:9 -b 4000k -mbd rd -trellis -mv0 -cmp 2 -subcmp 2 -acodec mp2 -ab 192k -ar 48000 -ac 2"
        mPresetExtension = "mpg"
        mPresetCategory = "DVD"
    End If
    If lPreset = 50 Then
        mPresetDescription = "PAL DVD HQ (4:3)"
        mPresetParameters = "-target pal-dvd -aspect 4:3 -b 8000k -mbd rd -trellis -mv0 -cmp 0 -subcmp 2"
        mPresetExtension = "mpg"
        mPresetCategory = "DVD"
    End If
    If lPreset = 51 Then
        mPresetDescription = "PAL DVD HQ (16:9)"
        mPresetParameters = "-target pal-dvd -aspect 16:9 -b 8000k -mbd rd -trellis -mv0 -cmp 0 -subcmp 2"
        mPresetExtension = "mpg"
        mPresetCategory = "DVD"
    End If
    If lPreset = 52 Then
        mPresetDescription = "PAL DVD Fast (LQ)"
        mPresetParameters = "-target pal-dvd -b 5000kb -r 25 -s 720x576 -ar 48000 -ab 384kb"
        mPresetExtension = "mpg"
        mPresetCategory = "DVD"
    End If
    If lPreset = 53 Then
        mPresetDescription = "PAL VCD (HQ)"
        mPresetParameters = "-target pal-vcd -mbd rd -trellis -mv0 -cmp 0 -subcmp 2"
        mPresetExtension = "mpg"
        mPresetCategory = "VCD"
    End If
    If lPreset = 54 Then
        mPresetDescription = "Quicktime MOV"
        mPresetParameters = "-acodec libfaac -b 1250 -r 25 -ab 128"
        mPresetExtension = "mov"
        mPresetCategory = "Quicktime"
    End If
    If lPreset = 55 Then
        mPresetDescription = "WMA"
        mPresetParameters = "-vn  -acodec wmav2"
        mPresetExtension = "wma"
        mPresetCategory = "Audio"
    End If
    If lPreset = 56 Then
        mPresetDescription = "WMV2"
        mPresetParameters = "-vcodec wmv2  -acodec wmav2 -b 1000kb"
        mPresetExtension = "wmv"
        mPresetCategory = "WMV"
    End If
    If lPreset = 57 Then
        mPresetDescription = "H.264 in MP4(4:3)"
        mPresetParameters = "-r 29.97 -vcodec libx264 -s 640x480 -aspect 4:3 -flags +loop -cmp +chroma -deblockalpha 0 -deblockbeta 0 -b 1250k -maxrate 1500k -bufsize 4M -bt 256k -refs 1 -bf 3 -coder 1 -me_method umh -me_range 16 -subq 7 -partitions +parti4x4+parti8x8+partp8x8+partb8x8 -g 250 -keyint_min 25 -level 30 -qmin 10 -qmax 51 -qcomp 0.6 -trellis 2 -sc_threshold 40 -i_qfactor 0.71 -acodec libfaac -ab 112k -ar 48000 -ac 2"
        mPresetExtension = "mp4"
        mPresetCategory = "MP4"
    End If
    If lPreset = 58 Then
        mPresetDescription = "H.264 for PSP (4:3)"
        mPresetParameters = "-r 29.97 -vcodec libx264 -s 640x480 -aspect 4:3 -b 1250k -maxrate 4M -bufsize 4M -flags +loop -cmp +chroma -partitions +parti4x4+partp8x8+partb8x8 -me_method umh -subq 6 -trellis 1 -refs 2 -bf 1 -coder 1 -me_range 16 -g 300 -keyint_min 25 -sc_threshold 40 -i_qfactor 0.71 -bt 1250k -qcomp 0.6 -qmin 10 -qmax 51 -qdiff 4 -level 21 -acodec libfaac -ab 128k -ar 48000 -ac 2"
        mPresetExtension = "mp4"
        mPresetCategory = "PSP"
    End If
    If lPreset = 59 Then
        mPresetDescription = "H.264 in MP4 (16:9)"
        mPresetParameters = "-r 29.97 -vcodec libx264 -s 704x384 -aspect 16:9 -flags +loop -cmp +chroma -deblockalpha 0 -deblockbeta 0 -b 1250k -maxrate 1500k -bufsize 4M -bt 256k -refs 1 -bf 3 -coder 1 -me_method umh -me_range 16 -subq 7 -partitions +parti4x4+parti8x8+partp8x8+partb8x8 -g 250 -keyint_min 25 -level 30 -qmin 10 -qmax 51 -qcomp 0.6 -trellis 2 -sc_threshold 40 -i_qfactor 0.71 -acodec libfaac -ab 112k -ar 48000 -ac 2"
        mPresetExtension = "mp4"
        mPresetCategory = "MP4"
    End If
    If lPreset = 60 Then
        mPresetDescription = "CDMA phone 3g2"
        mPresetParameters = "-ar 22050 -ab 128k -acodec libfaac -s qcif -b 128kb -r 14.985"
        mPresetExtension = "3g2"
        mPresetCategory = "Mobile Phones"
    End If
    If lPreset = 61 Then
        mPresetDescription = "XviD for Zen (4:3)"
        mPresetParameters = "-r 29.97 -vcodec libxvid -vtag XVID -s 320x240 -aspect 4:3 -maxrate 1800k -b 1500k  -acodec libmp3lame -ar 48000 -ab 128k -ac 2"
        mPresetExtension = "avi"
        mPresetCategory = "Creative Zen"
    End If
    If lPreset = 62 Then
        mPresetDescription = "XviD for Zen (16:9)"
        mPresetParameters = "-r 29.97 -vcodec libxvid -vtag XVID -s 320x240 -aspect 16:9 -maxrate 1800k -b 1500k  -acodec libmp3lame -ar 48000 -ab 128k -ac 2"
        mPresetExtension = "avi"
        mPresetCategory = "Creative Zen"
    End If
    If lPreset = 63 Then
        mPresetDescription = "Blackberry Curve FS"
        mPresetParameters = "-vcodec mpeg4 -b 400k -r 24 -s 320x240 -aspect 4:3 -acodec libfaac -ar 22050 -ac 2 -ab 48k"
        mPresetExtension = "mp4"
        mPresetCategory = "Blackberry"
    End If
    If lPreset = 64 Then
        mPresetDescription = "Blackberry Curve WS"
        mPresetParameters = "-vcodec mpeg4 -b 400k -r 24 -s 320x180 -aspect 16:9 -acodec libfaac -ar 22050 -ac 2 -ab 48k"
        mPresetExtension = "mp4"
        mPresetCategory = "Blackberry"
    End If
    If lPreset = 65 Then
        mPresetDescription = "LG Chocolate"
        mPresetParameters = "-s 240x192 -r 11.988 -b 192 -ab 56 -vcodec libxvid -acodec libfaac"
        mPresetExtension = "mp4"
        mPresetCategory = "LG"
    End If
    If lPreset = 66 Then
        mPresetDescription = "Blackberry Music"
        mPresetParameters = "-acodec libmp3lame -ab 128k -ac 2 -ar 44100"
        mPresetExtension = "mp3"
        mPresetCategory = "Blackberry"
    End If
    If lPreset = 67 Then
        mPresetDescription = "Blackberry Video 16:9"
        mPresetParameters = "-r 24 -vcodec libx264 -s 320x180 -aspect 16:9 -maxrate 800k -bufsize 80k -b 400k -acodec libfaac -ar 44100 -ab 80k -ac 2"
        mPresetExtension = "mp4"
        mPresetCategory = "Blackberry"
    End If
    If lPreset = 68 Then
        mPresetDescription = "Blackberry Video 4:3"
        mPresetParameters = "-r 24 -vcodec libx264 -s 240x180 -aspect 4:3 -maxrate 800k -bufsize 80k -b 400k -acodec libfaac -ar 44100 -ab 80k -ac 2"
        mPresetExtension = "mp4"
        mPresetCategory = "Blackberry"
    End If
    If lPreset = 69 Then
        mPresetDescription = "Flash: Video (flv) for Web use (4:3)"
        mPresetParameters = "-vcodec flv -f flv -r 29.97 -s 320x240 -aspect 4:3 -b 300kb -g 160 -cmp dct  -subcmp dct  -mbd 2 -flags +aic+cbp+mv0+mv4 -trellis 1 -ac 1 -ar 22050 -ab 56k"
        mPresetExtension = "flv"
        mPresetCategory = "Websites"
    End If
    If lPreset = 70 Then
        mPresetDescription = "Flash: Video (flv) for Web use (16:9)"
        mPresetParameters = "-vcodec flv -f flv -r 29.97 -s 320x180 -aspect 16:9 -b 300kb -g 160 -cmp dct -subcmp dct -mbd 2 -flags +aic+cbp+mv0+mv4 -trellis 1 -ac 1 -ar 22050 -ab 56k"
        mPresetExtension = "flv"
        mPresetCategory = "Websites"
    End If
    If lPreset = 71 Then
        mPresetDescription = "H.264 for PSP (16:9)"
        mPresetParameters = "-r 29.97 -vcodec libx264 -s 480x272 -aspect 16:9 -b 1250k -maxrate 4M -bufsize 4M -flags +loop -cmp +chroma -partitions +parti4x4+partp8x8+partb8x8 -me_method umh -subq 6 -trellis 1 -refs 2 -bf 1 -coder 1 -me_range 16 -g 300 -keyint_min 25 -sc_threshold 40 -i_qfactor 0.71 -bt 1250k -qcomp 0.6 -qmin 10 -qmax 51 -qdiff 4 -level 21 -acodec libfaac -ab 128k -ar 48000 -ac 2"
        mPresetExtension = "mp4"
        mPresetCategory = "PSP"
    End If
    If lPreset = 72 Then
        mPresetDescription = "iPod Small Screen 4:3 CRF 21 (iTunes)"
        mPresetParameters = "-r 29.97 -vcodec libx264 -flags +loop -cmp +chroma -deblockalpha 0 -deblockbeta 0 -crf 21 -bt 256k -refs 1 -coder 0 -me_method full -me_range 16 -subq 5 -partitions +parti4x4+parti8x8+partp8x8 -g 250 -keyint_min 25 -level 30 -trellis 2 -sc_threshold 40 -i_qfactor 0.71 -s 320x240 -aspect 4:3 -acodec libfaac -ab 112k -ar 48000 -ac 2"
        mPresetExtension = "m4v"
        mPresetCategory = "iPod-iTunes"
    End If
    If lPreset = 73 Then
        mPresetDescription = "iPod Small Screen 16:9 CRF 21 (iTunes)"
        mPresetParameters = "-r 29.97 -vcodec libx264 -flags +loop -cmp +chroma -deblockalpha 0 -deblockbeta 0 -crf 21 -bt 256k -refs 1 -coder 0 -me_method full -me_range 16 -subq 5 -partitions +parti4x4+parti8x8+partp8x8 -g 250 -keyint_min 25 -level 30 -trellis 2 -sc_threshold 40 -i_qfactor 0.71 -s 320x176 -aspect 16:9 -acodec libfaac -ab 112k -ar 48000 -ac 2"
        mPresetExtension = "m4v"
        mPresetCategory = "iPod-iTunes"
    End If
    If lPreset = 74 Then
        mPresetDescription = "iPod Small Screen 16:9 Anamorphic CRF 21 (iTunes)"
        mPresetParameters = "-r 29.97 -croptop 60 -cropbottom 60 -vcodec libx264 -flags +loop -cmp +chroma -deblockalpha 0 -deblockbeta 0 -crf 21 -bt 256k -refs 1 -coder 0 -me_method full -me_range 16 -subq 5 -partitions +parti4x4+parti8x8+partp8x8 -g 250 -keyint_min 25 -level 30 -trellis 2 -sc_threshold 40 -i_qfactor 0.71 -s 320x144 -aspect 2.35 -acodec libfaac -ab 112k -ar 48000 -ac 2"
        mPresetExtension = "m4v"
        mPresetCategory = "iPod-iTunes"
    End If
    If lPreset = 75 Then
        mPresetDescription = "iPod Small Screen 4:3 to 16:9 CRF  21 (iTunes)"
        mPresetParameters = "-r 29.97 -croptop 64 -cropbottom 64 -vcodec libx264 -flags +loop -cmp +chroma -deblockalpha 0 -deblockbeta 0 -crf 21 -bt 256k -refs 1 -coder 0 -me_method full -me_range 16 -subq 5 -partitions +parti4x4+parti8x8+partp8x8 -g 250 -keyint_min 25 -level 30 -trellis 2 -sc_threshold 40 -i_qfactor 0.71 -s 320x176 -aspect 16:9 -acodec libfaac -ab 112k -ar 48000 -ac 2"
        mPresetExtension = "m4v"
        mPresetCategory = "iPod-iTunes"
    End If
    If lPreset = 76 Then
        mPresetDescription = "iPod TV Out 4:3 CRF 21 (iTunes)"
        mPresetParameters = "-r 29.97 -vcodec libx264 -flags +loop -cmp +chroma -deblockalpha 0 -deblockbeta 0 -crf 21 -bt 256k -refs 1 -coder 0 -me_method full -me_range 16 -subq 5 -partitions +parti4x4+parti8x8+partp8x8 -g 250 -keyint_min 25 -level 30 -trellis 2 -sc_threshold 40 -i_qfactor 0.71 -s 512x384 -aspect 4:3 -acodec libfaac -ab 112k -ar 48000 -ac 2"
        mPresetExtension = "m4v"
        mPresetCategory = "iPod-iTunes"
    End If
    If lPreset = 77 Then
        mPresetDescription = "iPod TV Out 16:9 CRF 21 (iTunes)"
        mPresetParameters = "-r 29.97 -vcodec libx264 -flags +loop -cmp +chroma -deblockalpha 0 -deblockbeta 0 -crf 21 -bt 256k -refs 1 -coder 0 -me_method full -me_range 16 -subq 5 -partitions +parti4x4+parti8x8+partp8x8 -g 250 -keyint_min 25 -level 30 -trellis 2 -sc_threshold 40 -i_qfactor 0.71 -s 624x352 -aspect 16:9 -acodec libfaac -ab 112k -ar 48000 -ac 2"
        mPresetExtension = "m4v"
        mPresetCategory = "iPod-iTunes"
    End If
    If lPreset = 78 Then
        mPresetDescription = "iPod TV Out 16:9 Anamorphic CRF 21 (iTunes)"
        mPresetParameters = "-r 29.97 -croptop 60 -cropbottom 60 -vcodec libx264 -flags +loop -cmp +chroma -deblockalpha 0 -deblockbeta 0 -crf 21 -bt 256k -refs 1 -coder 0 -me_method full -me_range 16 -subq 5 -partitions +parti4x4+parti8x8+partp8x8 -g 250 -keyint_min 25 -level 30 -trellis 2 -sc_threshold 40 -i_qfactor 0.71 -s 640x272 -aspect 2.35 -acodec libfaac -ab 112k -ar 48000 -ac 2"
        mPresetExtension = "m4v"
        mPresetCategory = "iPod-iTunes"
    End If
    If lPreset = 79 Then
        mPresetDescription = "iPod TV Out 4:3 to 16:9 CRF  21 (iTunes)"
        mPresetParameters = "-r 29.97 -croptop 64 -cropbottom 64 -vcodec libx264 -flags +loop -cmp +chroma -deblockalpha 0 -deblockbeta 0 -crf 21 -bt 256k -refs 1 -coder 0 -me_method full -me_range 16 -subq 5 -partitions +parti4x4+parti8x8+partp8x8 -g 250 -keyint_min 25 -level 30 -trellis 2 -sc_threshold 40 -i_qfactor 0.71 -s 640x352 -aspect 16:9 -acodec libfaac -ab 112k -ar 48000 -ac 2"
        mPresetExtension = "m4v"
        mPresetCategory = "iPod-iTunes"
    End If
    If lPreset = 80 Then
        mPresetDescription = "XviD for iPod (4:3)"
        mPresetParameters = "-r 29.97 -vcodec libxvid -s 640x480 -aspect 4:3 -maxrate 1500k -b 1250k -qmin 3 -qmax 5 -bufsize 4096 -mbd 2 -flags +4mv -aic 2 -cmp 2 -subcmp 2 -trellis 1 -g 300 -acodec libfaac -ar 48000 -ab 80k -ac 2"
        mPresetExtension = "mp4"
        mPresetCategory = "Ipod"
    End If
    If lPreset = 81 Then
        mPresetDescription = "XviD for iPod (16:9)"
        mPresetParameters = "-r 29.97 -vcodec libxvid -s 704x384 -aspect 16:9 -maxrate 1500k -b 1250k -qmin 3 -qmax 5 -bufsize 4096 -mbd 2 -flags +4mv -aic 2 -cmp 2 -subcmp 2 -trellis 1 -g 300 -acodec libfaac -ar 48000 -ab 80k -ac 2"
        mPresetExtension = "mp4"
        mPresetCategory = "Ipod"
    End If
    If lPreset = 82 Then
        mPresetDescription = "XviD for iPod (16:9 Anamorphic)"
        mPresetParameters = "-r 29.97 -croptop 60 -cropbottom 60 -vcodec libxvid -s 640x272 -aspect 2.35 -maxrate 1500k -b 1250k -qmin 3 -qmax 5 -bufsize 4096 -mbd 2 -flags +4mv -aic 2 -cmp 2 -subcmp 2 -trellis 1 -g 300 -acodec libfaac -ar 48000 -ab 80k -ac 2"
        mPresetExtension = "mp4"
        mPresetCategory = "Ipod"
    End If
    If lPreset = 83 Then
        mPresetDescription = "OGG-64-kbps"
        mPresetParameters = "-acodec vorbis -aq 13 -vn"
        mPresetExtension = "OGG"
        mPresetCategory = "Audio"
    End If
    If lPreset = 84 Then
        mPresetDescription = "OGG-96-kbps"
        mPresetParameters = "-acodec vorbis -aq 23 -vn"
        mPresetExtension = "OGG"
        mPresetCategory = "Audio"
    End If
    If lPreset = 85 Then
        mPresetDescription = "OGG-128-kbps"
        mPresetParameters = "-acodec vorbis -aq 39 -vn"
        mPresetExtension = "OGG"
        mPresetCategory = "Audio"
    End If
    If lPreset = 86 Then
        mPresetDescription = "OGG-160-kbps"
        mPresetParameters = "-acodec vorbis -aq 60 -vn"
        mPresetExtension = "OGG"
        mPresetCategory = "Audio"
    End If
    If lPreset = 87 Then
        mPresetDescription = "WMA-32k-mono-22050"
        mPresetParameters = "-vn  -acodec wmav2 -ab 32k -ac 1 -ar 22050"
        mPresetExtension = "wma"
        mPresetCategory = "Audio"
    End If
    If lPreset = 88 Then
        mPresetDescription = "WMV-4:3-320-x240-757kbps-32k-mono"
        mPresetParameters = "-vcodec wmv2  -acodec wmav2 -aspect 4:3 -b 757k -ab 32k -ac 1 -ar 22050 -s 320x240"
        mPresetExtension = "wmv"
        mPresetCategory = "WMV"
    End If
    If lPreset = 89 Then
        mPresetDescription = "WMV-4:3-320-x240-500kbps-32k-mono"
        mPresetParameters = "-vcodec wmv2  -acodec wmav2 -aspect 4:3 -b 500k -ab 32k -ac 1 -ar 22050 -s 320x240"
        mPresetExtension = "wmv"
        mPresetCategory = "WMV"
    End If
    If lPreset = 90 Then
        mPresetDescription = "WMA-64k-stereo-22050"
        mPresetParameters = "-vn  -acodec wmav2 -ab 64k -ac 2 -ar 22050"
        mPresetExtension = "wma"
        mPresetCategory = "Audio"
    End If
    If lPreset = 91 Then
        mPresetDescription = "WMV-16:9-320-x240-757kbps-32k-mono"
        mPresetParameters = "-vcodec wmv2  -acodec wmav2 -aspect 16:9 -b 757k -ab 32k -ac 1 -ar 22050 -s 320x240"
        mPresetExtension = "wmv"
        mPresetCategory = "WMV"
    End If
    If lPreset = 92 Then
        mPresetDescription = "WMV-4:3-320-x240-200kbps-32k-mono"
        mPresetParameters = "-vcodec wmv2  -acodec wmav2 -aspect 4:3 -b 200k -ab 32k -ac 1 -ar 22050 -s 320x240"
        mPresetExtension = "wmv"
        mPresetCategory = "WMV"
    End If
    If lPreset = 93 Then
        mPresetDescription = "WMV-4:3-320-x240-300kbps-16k-mono"
        mPresetParameters = "-vcodec wmv2  -acodec wmav2 -aspect 4:3 -b 300k -ab 16k -ac 1 -ar 22050 -s 320x240"
        mPresetExtension = "wmv"
        mPresetCategory = "WMV"
    End If
End Function

' ----------------------------------------------------------------------
' -- Función de ajuste para usar con PathFindExtension
' ----------------------------------------------------------------------
Function GetExtension(ByVal sPath As String) As String
  Dim sTemp As String
  'Given a path and filename, return only the filename extension.
  sTemp = pvGetStrFromPtrA(PathFindExtension(sPath))
   
  If Len(sTemp) Then GetExtension = Replace(sTemp, ".", vbNullString)
End Function
 
' ----------------------------------------------------------------------------------
' \\ -- Devuelve un string desde un puntero
' ----------------------------------------------------------------------------------
Private Function pvGetStrFromPtrA(ByVal lpszA As Long) As String
  'Given a pointer to a string, return the string
   pvGetStrFromPtrA = String$(lstrlenA(ByVal lpszA), 0)
   Call lstrcpyA(ByVal pvGetStrFromPtrA, ByVal lpszA)
End Function
 
' ---------------------------------------------------------------------------------------------------------------------------

'Option Explicit
'Private Sub Form_Load()

'    Open App.Path & "\presets.xml" For Input As #1
'    Open App.Path & "\code.txt" For Output As #2
  
'    Dim sLine   As String
'    Dim sRet    As String
'    Dim i       As Integer
  
'    While Not EOF(1)
      
'        Line Input #1, sLine
'        If InStr(sLine, "params") Then
'            sLine = Replace(sLine, "<params>", "")
'            sLine = Trim(Replace(sLine, "</params>", ""))
'            sRet = sRet & vbNewLine & String(8, " ") & "mPresetParameters = " & Chr(34) & sLine & Chr(34)
'        ElseIf InStr(sLine, "<label>") Then
'            sLine = Replace(sLine, "<label>", "")
'            sLine = Trim(Replace(sLine, "</label>", ""))
'            sRet = sRet & vbNewLine & String(8, " ") & "mPresetDescription = " & Chr(34) & sLine & Chr(34)
'        ElseIf InStr(sLine, "<extension>") Then
'            sLine = Replace(sLine, "<extension>", "")
'            sLine = Trim(Replace(sLine, "</extension>", ""))
'            sRet = sRet & vbNewLine & String(8, " ") & "mPresetExtension = " & Chr(34) & sLine & Chr(34)
'        ElseIf InStr(sLine, "<category>") Then
'            sLine = Replace(sLine, "<category>", "")
'            sLine = Trim(Replace(sLine, "</category>", ""))
'
'            sRet = sRet & vbNewLine & String(8, " ") & "mPresetCategory = " & Chr(34) & sLine & Chr(34)
'
'            Print #2, String(4, " ") & "If lPreset = " & CStr(i) & " Then"
'            sRet = Right(sRet, Len(sRet) - Len(vbNewLine))
'            Print #2, sRet
'            Print #2, vbTab & "end if"
'            i = i + 1
'            sRet = ""
'        End If
'    Wend
'    Close
'End Sub

Buscador Mp3

Private Type tOptions
    bPlayMp3                            As Boolean
    bDeleteId3v1                        As Boolean
    bDeleteId3v2                        As Boolean
    lStyles                             As eStyleGui
    lIconSize                           As Boolean
End Type

Private Enum eLvSelectedItems
    [eErrorItem] = 0
    [eAll] = 1
End Enum


' \\ - Colecciones, clases
' -----------------------------------------------------------------------------------------------------

Private mColUrlsError                   As Collection
Private WithEvents mcFind               As cFind
Private WithEvents mcSCLvFind           As cSubclassListView
Private mcDownloads                     As cDownload
Private mcscLvDownload                  As cSubclassListView
Private mcscLvFiles                     As cSubclassListView
Private mcStyles                        As cStyles
Private mcToolTip                       As cToolTip
Private mcDlgs                          As cDlgs
Private mcMCI                           As cMCI
Private mcIcon                          As cIcon
Private mcIni                           As Cini
Private mcTimer                         As cTimer
Private mcSCToolBar                     As cSubclassToolBar
Implements WinSubHook2.iTimer

' \\ - Variables, arrays
' -----------------------------------------------------------------------------------------------------

Private mbKeyBack                       As Boolean
Private mTimerStatus                    As Boolean
Private mOptions                        As tOptions
Private mIniPath                        As String
Private mSelCurrentFileName             As String
Private mTagsEdit                       As Boolean




' ----------------------------------------------------------------------------------------------------------------------------------
' \\ - Carga de formulario
' ----------------------------------------------------------------------------------------------------------------------------------

Private Sub Form_Load()
   Call mInitObjects                                    ' Inicar clases y colecciones
   Call mInitConfigPaths                                ' establecer rutas
   Call mSetMenuValues                                  ' establecer valores de menu
   Call mSetStyle                                       ' Configurar estilo del frm
   Call mLoadIcons                                      ' cargar iconos
   Call mSetControlsValues                              ' establecer valores de controles y propiedades varias
   Call mSetCtrlCaptions
   Call mLoadUrlError                                   ' cargar lista de url con errores
End Sub



' ----------------------------------------------------------------------------------------------------------------------------------
' \\ - Instanciar objetos
' ----------------------------------------------------------------------------------------------------------------------------------


Sub mInitObjects()
   ' Inicializar clases
   Set mcFind = New cFind                               ' Para buscar y obtener las Urls
   Set mcDownloads = New cDownload                      ' Colección con los archivos de descargas
   Set mcStyles = New cStyles
   Set mcToolTip = New cToolTip                         ' ToolTip
   Set mcDlgs = New cDlgs                               ' Cuadros de diálogo
   Set mcTimer = New cTimer                             ' Para el timer que actualiza los datos para las descargas
   Set mcMCI = New cMCI
   Set mcIni = New Cini
   Set mcIcon = New cIcon
 
   Set mcSCLvFind = New cSubclassListView               ' para el Skin del Listview de resultados
   Set mcscLvDownload = New cSubclassListView           ' para el Skin del Listview de descargas
   Set mcscLvFiles = New cSubclassListView              ' para el Skin del Listview con descargas finalizadas
   Set mcSCToolBar = New cSubclassToolBar
   Set mColUrlsError = New Collection                   ' Almacenar direcciones urls con error
End Sub


' ----------------------------------------------------------------------------------------------------------------------------------
' \\ - Asignar los paths y leer valores del config.ini
' ----------------------------------------------------------------------------------------------------------------------------------


Private Sub mInitConfigPaths()
 
   mIniPath = App.Path & "\config.ini"
 
   ' definir paths para archivo temporal Html, y para guardar y escribir los mp3 en el disco
   With mcFind
       .TempPath = App.Path & "\data"
       .HtmlPath = .TempPath & "temp.html"
       .DownloadFolder = App.Path & "\download"
   End With
 
   ' Cargar valores de configuración desde el archivo Ini
   With mOptions
       .bPlayMp3 = mcIni.getValue(mIniPath, "Reproducción", "PlayMp3", False)
       .bDeleteId3v1 = mcIni.getValue(mIniPath, "Tags", "EliminarID3v1", False)
       .bDeleteId3v2 = mcIni.getValue(mIniPath, "Tags", "EliminarID3v2", False)
       .lIconSize = mcIni.getValue(mIniPath, "Iconos", "Tamaño", 0)
       .lStyles = mcIni.getValue(mIniPath, "Estilo", "Estilo", 0)
       ' setear menus
       ' Alto y ancho de los íconos de los listview
       If mOptions.lIconSize = True Then
          mcIcon.HeightImage = 32
          mcIcon.WidthImage = 32
       End If
       If mOptions.lIconSize = False Then
          mcIcon.HeightImage = 16
          mcIcon.WidthImage = 16
       End If
   End With

End Sub

' ----------------------------------------------------------------------------------------------------------------------------------
' \\ - Configurar valores checked para los menu
' ----------------------------------------------------------------------------------------------------------------------------------


Private Sub mSetMenuValues()

   With mOptions
       ' setear menus
       mnuPlayOpt.Checked = .bPlayMp3
       mnuSettingsTags(0).Checked = .bDeleteId3v1
       mnuSettingsTags(1).Checked = .bDeleteId3v2
       ' Alto y ancho de los íconos de los listview
       If mOptions.lIconSize = True Then mnuSizeIcons(1).Checked = True
       If mOptions.lIconSize = False Then mnuSizeIcons(0).Checked = True
   End With
 
   ' setear menus de estilos
   Dim xMenu As Menu
   For Each xMenu In mnuStyles
       xMenu.Checked = False
   Next
 
   mnuStyles(CInt(mOptions.lStyles)).Checked = True

End Sub

' ----------------------------------------------------------------------------------------------------------------------------------
' \\ - Estilo de lfrm
' ----------------------------------------------------------------------------------------------------------------------------------


Private Sub mSetStyle()
   ' Colección con las clases para subclasificar los Listview (para los Skin de los ColumnHeaders )
   Dim ColSClassLv As New Collection
   With ColSClassLv
        .Add mcSCLvFind
        .Add mcscLvDownload
        .Add mcscLvFiles
   End With
   ' Establecer estilo y esquema de colores
   Call mcStyles.ChangeStyle(Me, ColSClassLv, cmdSearch, mcSCToolBar, CLng(mOptions.lStyles))
   Set ColSClassLv = Nothing
 
   ' Subclasificar los listview
   Call mcSCLvFind.SubClassListView(lvFind.hwnd)
   Call mcscLvDownload.SubClassListView(lvDownloads.hwnd)
   Call mcscLvFiles.SubClassListView(lvFiles.hwnd)
End Sub


' ----------------------------------------------------------------------------------------------------------------------------------
' \\ - Cargar los iconos de los lv en el imglist, y el de las pantallas
' ----------------------------------------------------------------------------------------------------------------------------------

Private Sub mLoadIcons()
   ' setear el imagelist para los iconos de  los listview
   With imgList
        .ImageHeight = mcIcon.HeightImage
        .ImageWidth = mcIcon.WidthImage
        .BackColor = lvFind.BackColor
        ' pic temporal para dibujar el ícono que luego se guarda en el imgList
        picTemp.Width = .ImageWidth * 15
        picTemp.Height = .ImageHeight * 15
      
        Dim f As Integer
        f = FreeFile
        Dim sTempMp3 As String
        sTempMp3 = mcFind.TempPath & "temp.mp3"
        Open sTempMp3 For Output As f
      
        Dim mMp3Icon As StdPicture
        ' Obtener el ícono Mp3 como un StdPicture
        If mcIcon.HeightImage = 16 Then
            Set mMp3Icon = mcIcon.GetFileIcon(sTempMp3, eSmall)
        ElseIf mcIcon.HeightImage = 32 Then
            Set mMp3Icon = mcIcon.GetFileIcon(sTempMp3, enormal)
        End If
      
        ' agregarlo al control imgList
        .ListImages.Add , "mp3", mMp3Icon
        Set mMp3Icon = Nothing
      
        ' Cargar los otros íconos ( para descarga, error etc ..)
        Call mFillImageList(App.Path & "\img\error.ico", mcDownloads.GetStatusText(eError))
        Call mFillImageList(App.Path & "\img\Listo.ico", mcDownloads.GetStatusText(eFinished))
        Call mFillImageList(App.Path & "\img\descargando.ico", mcDownloads.GetStatusText(eDownloading))
        Call mFillImageList(App.Path & "\img\espera.ico", mcDownloads.GetStatusText(eNew))
      
   End With
 
   ' Dibujar en los picbox los íconos de las pantallas ( Buscar y descargar )
   With mcIcon
       Call .DrawBitmapDC(App.Path & "\img\buscar.ico", picFind.hdc, 0, 0, 48, 48, picFind.Container.BackColor)
       Call .DrawBitmapDC(App.Path & "\img\descargas.ico", picDown.hdc, 0, 0, 48, 48, picDown.Container.BackColor)
   End With

 
   Close f
   If mcFind.CheckFileExists(sTempMp3) Then
      On Local Error Resume Next
      Kill sTempMp3
      On Error GoTo 0
   End If

   Set mcIcon = Nothing
End Sub


' ----------------------------------------------------------------------------------------------------------------------------------
' \\ - Inicio de Propiedades varias de controles
' ----------------------------------------------------------------------------------------------------------------------------------


Private Sub mSetControlsValues()
 
   ' deshabilitar txt de tags
   Call mEnabledControls(False, "txtid3v1")
   Call mEnabledControls(False, "txtid3v2")
   Call mEnabledControls(False, "cboGen")
 
   ' Opciones de descarga asincrónica ( forzar actualización )
   ucDownloadMp3.AsyncOptionDownload = vbAsyncReadResynchronize
   ucDownHtml.AsyncOptionDownload = vbAsyncReadForceUpdate
 
   ' seleccionar la primer pantalla, y activar el primer botón del toolbar
   With tbMain
      .Buttons(1).Value = tbrPressed
      Call tbMain_ButtonClick(.Buttons(1))
   End With
 
   Dim i As Integer
   ' cargar letras en el combo ( desde la A - Z )
   With cboArtista
        .AddItem "#"
        For i = 97 To 122
            .AddItem UCase(Chr(i))
        Next
   End With
 
   ' seleccionar el combo de directorios de Mp3
   'lstDirectory.ListIndex = 0
 
   Dim sGen As String
   For i = 0 To 200
      sGen = modInfoMp3.GetGenreName(i)
      If sGen = vbNullString Then
         Exit For
      Else
        cboGen(0).AddItem sGen
        cboGen(1).AddItem sGen
      End If
   Next

   cboGen(0).ListIndex = 0
   cboGen(1).ListIndex = 1
   lstDirectory.ListIndex = 0

End Sub




' ----------------------------------------------------------------------------------------------------------------------------------
' \\ - Sub para actualizar los datos en el Listview de transferencias de acuerdo al estado actual de cada archivo mp3
' ----------------------------------------------------------------------------------------------------------------------------------

Private Sub mUpdateLvItems(sKey As String)

    Dim xLvItem       As ListItem
    Dim xDownItem     As cDownloadItem
  
    ' Referencia al item actual de la colección de archivos mp3
    Set xDownItem = mcDownloads.Item(sKey)
  
    ' Comprobar que el item existe en la colección
    If Not xDownItem Is Nothing Then
      
        With xDownItem
          
            Select Case .Status
              
                ' ----------------------------------------------------------------------------------------------------------------------------------
                ' Nueva descarga ( Agregar el lvItem en espera )
                ' ----------------------------------------------------------------------------------------------------------------------------------
                Case eNew
                    ' verificar que el item existe .. por las dudas
                    If mCheckExistLvItem(sKey, lvDownloads) Then
                        Set xLvItem = lvDownloads.ListItems(sKey)
                        xLvItem.Text = .Title
                        xLvItem.SubItems(1) = mcDownloads.GetStatusText(eNew)
                    End If
              
                ' ----------------------------------------------------------------------------------------------------------------------------------
                ' Finalizado
                ' ----------------------------------------------------------------------------------------------------------------------------------
              
                Case eFinished
                    ' verificar que el item No existe .. por las dudas ( Para agregarlo al listview de terminados )
                    If Not mCheckExistLvItem(.Key, lvFiles) Then
              
                        ' agregar el item finalizado en el primer lugar
                        Set xLvItem = lvFiles.ListItems.Add(1, .Key, .Title)
                        ' leer info mp3
                        Dim bRet As Boolean
                        tInfoMpg = tInfoMpg_c
                        bRet = modInfoMp3.ReadMPEGInfo(.FileName, tInfoMpg)
                    Else ' error ..salir y eliminarlo
                        If mCheckExistLvItem(.Key, lvDownloads) Then
                            lvDownloads.ListItems.Remove .Key
                        End If
                        Exit Sub
                    End If
          
                    ' Ignorar archivos menores a 500 K
                    If bRet And (tInfoMpg.FileSize > 500000) Then
                        ' verificar si hay que borrar los tags autmáticamente al descargar
                        If mOptions.bDeleteId3v1 Then
                            Call modInfoMp3.DeleteID3v1(.FileName)
                        End If
                        If mOptions.bDeleteId3v2 Then
                            Call modInfoMp3.DeleteID3v2(.FileName)
                        End If
              
                        ' Agregar los datos del archivo finalizado
                        xLvItem.SubItems(1) = mcDownloads.GetStatusText(eFinished)
                        xLvItem.SubItems(2) = mcDownloads.GetFileSize(tInfoMpg.FileSize)
                        xLvItem.SubItems(3) = mcDownloads.GetFormatLenght(tInfoMpg.Length)
                        mcDownloads.Item(.Key).Status = eFinished
              
                    Else
                        mcDownloads.Item(.Key).Status = eError
                        xLvItem.SubItems(1) = mcDownloads.GetStatusText(eError)
                      
                        If mcFind.CheckFileExists(.FileName) Then
                            On Error Resume Next
                            Kill .FileName
                            On Error GoTo 0
                        End If
                      
                        'Agregar url con error
                        Call mAddUrlError(.Key)
                      
                    End If
                    ' eliminar el LvItem
                    If mCheckExistLvItem(.Key, lvDownloads) Then
                        lvDownloads.ListItems.Remove .Key
                    End If
       
              
                ' ----------------------------------------------------------------------------------------------------------------------------------
                ' Con error
                ' ----------------------------------------------------------------------------------------------------------------------------------
                Case eError
                    ' Eliminarlo del lv de transferencias
                    If mCheckExistLvItem(.Key, lvDownloads) Then
                        lvDownloads.ListItems.Remove .Key
                    End If
                    ' Agregar mp3 con error ... en el Lv de finalizados
                    If Not mCheckExistLvItem(.Key, lvFiles) Then
                        Set xLvItem = lvFiles.ListItems.Add(1, .Key, .Title)
                    End If
                  
                    'Agregar url con error
                    Call mAddUrlError(.Key)
                  
                ' ----------------------------------------------------------------------------------------------------------------------------------
                ' Descargando
                ' ----------------------------------------------------------------------------------------------------------------------------------
                Case eDownloading
                    If mCheckExistLvItem(.Key, lvDownloads) Then
                        Set xLvItem = lvDownloads.ListItems(.Key)
                        xLvItem.SubItems(1) = mcDownloads.GetStatusText(eDownloading)
                        xLvItem.SubItems(2) = .Percent
                        xLvItem.SubItems(3) = mcDownloads.GetFileSize(.FileSize)
                    End If
            End Select
        End With
    End If
   
    ' Actualizar el ícono
    If Not xLvItem Is Nothing Then
       Call mUpdateSmallIcons(xLvItem)
    End If
    ' Actualizar barra de estado
    Call mUpdateStatusBar
   
End Sub


' ----------------------------------------------------------------------------------------------------------------------------------
' \\ - Asignar Caption de los controles (UcBtn) por que al compilar o por otro error vb en algún caso puede eliminar la propiedad Caption y otras. (Creo que si el Uc se compila en ves de usarlo como privado, no ocurre esto)
' ----------------------------------------------------------------------------------------------------------------------------------
Private Sub mSetCtrlCaptions()
   
    cmdSearch.Caption = "Buscar >>"
    cmdPages(0).Caption = "<"
    cmdPages(1).Caption = ">"
   
    cmdDownloads(0).Caption = "Opciones >>"
    cmdDownloads(1).Caption = "Opciones >>"
    cmdTags.Caption = "Opciones >>"
   
    cmdPrevMp3(0).Caption = "Play"
    cmdPrevMp3(1).Caption = "Stop"
   
End Sub


Private Sub lvFiles_MouseUp(Button As Integer, Shift As Integer, x As Single, Y As Single)
   
   
   
    If Button <> vbLeftButton Then Exit Sub
   
   
    Dim Item As ListItem
   
    Set Item = lvFiles.HitTest(x, Y)
   
    If Item Is Nothing Then Exit Sub
   
    ' si se editó algún campo, preguntar si se quiere guardar los cambios
    If Me.TagsEdit Then
       If MsgBox("Se han modificado los tags del archivo: " & mSelCurrentFileName & " .  ¿ Guardar los cambios ?", vbQuestion + vbYesNo) = vbYes Then
          Call mnuTags_Click(0)
       End If
    End If
   
    ' Leer los tags
    If Item.SmallIcon = mcDownloads.GetStatusText(eError) Then
        Call mClearInfoMp3
        Call mEnabledControls(False, "txtId3v1")
        Call mEnabledControls(False, "txtId3v2")
        Call mEnabledControls(False, "cboGen")
        mSelCurrentFileName = ""
        Me.TagsEdit = False
    Else
        mSelCurrentFileName = mcFind.DownloadFolder & Item.Text
        Call mClearInfoMp3
        Call mEnabledControls(True, "txtId3v1")
        Call mEnabledControls(True, "txtId3v2")
        Call mEnabledControls(True, "cboGen")
        Call mLoadInfoMp3(Item)
        Call mShowTagInfo
        Me.TagsEdit = False
    End If

End Sub

' ----------------------------------------------------------------------------------------------------------------------------------
' \\ - Evento cuando se termina de obtener las Urls
' ----------------------------------------------------------------------------------------------------------------------------------
Private Sub mCFind_EndGetUrlsMp3()
On Error GoTo err_handler
   
    Dim xLvItem         As ListItem

    Dim i               As Long
    Dim J               As Integer
   
    ' Limpiar listview
    lvFind.ListItems.Clear
   
    ' REcorrer la colección de Urls
    For i = 1 To mcFind.Count
        ' Agregar al listview de resultados
        With mcFind.Item(i)
           Set xLvItem = lvFind.ListItems.Add(, .Url, .Title, , "mp3")
           xLvItem.SubItems(1) = .Url
        End With
    Next
   
    ' Eliminar items con error
    On Error Resume Next
    Dim sKey As String
    For i = 1 To mColUrlsError.Count
        sKey = mColUrlsError.Item(i).Key
        Call mcFind.Delete(sKey)
        lvFind.ListItems.Remove sKey
    Next
    On Error GoTo 0
   
    ' No hubo resultados
    With mcFind
        If .Count = 0 Then
             MsgBox "No se encontraron archivos para el término: " & txtSearch.Text, vbInformation, "Resultado de búsqueda"
             lblNumPage.Caption = "1"
             lblResult.Caption = vbNullString
             lblCurrentFile.Caption = ""
        Else ' mostrar resultados
             lblResult.Caption = "Archivos encontrados: " & "( " & CStr(.Count) & " )"
             lblCurrentFile.Caption = " > Búsqueda actual: " & txtSearch.Text
        End If
    End With
   
    Me.MousePointer = 0
   
Exit Sub
err_handler:
Me.MousePointer = 0
MsgBox Err.Description, vbCritical, "Error en EndGetUrls"

End Sub


' ----------------------------------------------------------------------------------------------------------------------------------
' \\ - Evento  - Antes de obtener las Urls
' ----------------------------------------------------------------------------------------------------------------------------------

Private Sub mCFind_StartSearchMp3s(ByVal sUrl As String)
       
   
    Me.MousePointer = vbHourglass
    With lvFind
        .ListItems.Clear
    End With
   
    ' Cancelar la descarga previa de otra búsqueda
    With ucDownHtml
        Call .CancelAllDownload
        ' descargar Html
        Call .Download(sUrl) ' Sigue en ucDownHtml_Finished
    End With
   
End Sub



' ----------------------------------------------------------------------------------------------------------------------------------
' \\ - Sub para agregar los íconos al imgList
' ----------------------------------------------------------------------------------------------------------------------------------

Private Sub mFillImageList(sFileName As String, sKey As String)
    With imgList
        mcIcon.DrawBitmapDC sFileName, picTemp.hdc, 0, 0, mcIcon.WidthImage, mcIcon.HeightImage, lvFind.BackColor
        picTemp.Picture = picTemp.Image
        .ListImages.Add , sKey, picTemp.Image
        picTemp.Cls
        picTemp.Picture = LoadPicture("")
    End With
End Sub

' ----------------------------------------------------------------------------------------------------------------------------------
' \\ - Botón para comenzar la búsqueda de Mp3s
' ----------------------------------------------------------------------------------------------------------------------------------
Private Sub cmdSearch_Click()
    If Trim(txtSearch.Text) = "" Then
        Exit Sub
    ElseIf lstDirectory.ListIndex = -1 Then
       MsgBox "Falta seleccionar un directorio de la lista", vbExclamation, "Directorio"
    Else
        lblNumPage.Caption = "1"
        With mcFind
            ' Si ya se estaba buscando, ... cancelar la descarga del html
            ucDownHtml.CancelAllDownload
            ' Buscar ( Artista, directorio, número de página )
            Call .FindMp3(txtSearch.Text, lstDirectory.ListIndex, CInt(lblNumPage.Caption))
        End With
    End If
End Sub


' ----------------------------------------------------------------------------------------------------------------------------------
' \\ - Cancelar todos los Downloads actuales ( Preguntando o sin preguntar )
' ----------------------------------------------------------------------------------------------------------------------------------

Private Function mCancelAll(showDialog As Boolean) As Boolean
    If showDialog Then
        If MsgBox("Detener ?", vbQuestion + vbYesNo) = vbNo Then
           Exit Function
        End If
    End If
   
    ucDownloadMp3.CancelAllDownload         ' artchivos Mp3
    ucDownHtml.CancelAllDownload            ' Página Html
   
    mCancelAll = True
End Function


' ----------------------------------------------------------------------------------------------------------------------------------
' \\ - Mostrar menú popup para el listview de búsqueda
' ----------------------------------------------------------------------------------------------------------------------------------
Private Sub lvFind_MouseDown(Button As Integer, Shift As Integer, x As Single, Y As Single)
    Call mShowLVPopUpMenu(Button, mnuFindOptions, lvFind, x, Y)
End Sub


' ----------------------------------------------------------------------------------------------------------------------------------
' \\ - Eliminar los items con error y el archivo txt con la lista de urls
' ----------------------------------------------------------------------------------------------------------------------------------
Private Sub mnuDeleteErrorUrls_Click()
    On Error GoTo error_handler
   
    If mColUrlsError.Count = 0 Then
       MsgBox "No hay Urls con error para eliminar", vbInformation
    Else
       If mcFind.CheckFileExists(mcFind.TempPath & "url_error.txt") Then
            Kill mcFind.TempPath & "url_error.txt"
            MsgBox "Se eliminaron " & CStr(mColUrlsError.Count) & " direcciones url", vbInformation
       End If
       Set mColUrlsError = Nothing
       Set mColUrlsError = New Collection
    End If
    Exit Sub
error_handler:
   
End Sub

' ----------------------------------------------------------------------------------------------------------------------------------
' \\ - Menú de opciones ´para la pantalla de búsqeuda
' ----------------------------------------------------------------------------------------------------------------------------------
Private Sub mnuOptionsFind_Click(Index As Integer)
    Dim xItem As ListItem
   
    If lvFind.MultiSelect = False Then lvFind.MultiSelect = True
   
    ' recorrer todos los items
    For Each xItem In lvFind.ListItems
        Select Case Index
            ' Descargar
            Case 0
                If xItem.Selected Then
                    Call mAddNewDownload(xItem)
                End If
            ' seleccionar todo
            Case 2
                xItem.Selected = True
        End Select
    Next
End Sub

' ----------------------------------------------------------------------------------------------------------------------------------
' \\ - Opción de menú ( Reproducir con el programa predeterminado, o usando MCI )
' ----------------------------------------------------------------------------------------------------------------------------------

Private Sub mnuPlayOpt_Click()
    With mnuPlayOpt
        .Checked = Not .Checked
        mOptions.bPlayMp3 = CBool(.Checked) ' guardar valor para después usarlo en el Unload del form
    End With
End Sub



' ----------------------------------------------------------------------------------------------------------------------------------
' \\ - Opción de menú Para eliminar tags automáticamente al descargar los archivos
' ----------------------------------------------------------------------------------------------------------------------------------

Private Sub mnuSettingsTags_Click(Index As Integer)
    Select Case Index
        ' v1
        Case 0
            mnuSettingsTags(0).Checked = Not mnuSettingsTags(0).Checked
            mOptions.bDeleteId3v1 = CBool(mnuSettingsTags(0).Checked)
        ' v2
        Case 1
            mnuSettingsTags(1).Checked = Not mnuSettingsTags(1).Checked
            mOptions.bDeleteId3v2 = CBool(mnuSettingsTags(1).Checked)
    End Select
End Sub


' ----------------------------------------------------------------------------------------------------------------------------------
' \\ - Opción de menú Para el tamaño de íconos ( 16 o 32 pix)
' ----------------------------------------------------------------------------------------------------------------------------------

Private Sub mnuSizeIcons_Click(Index As Integer)
     mnuSizeIcons(0).Checked = False
     mnuSizeIcons(1).Checked = False
    
     mnuSizeIcons(Index).Checked = True
    
     If mnuSizeIcons(0).Checked Then
        mOptions.lIconSize = False
     End If
     If mnuSizeIcons(1).Checked Then
        mOptions.lIconSize = True
     End If
    
     MsgBox "Para visualziar los cambios se debe reiniciar el programa", vbInformation
    
End Sub


' ----------------------------------------------------------------------------------------------------------------------------------
' \\ - Opción de menú Para cambiar los estilos
' ----------------------------------------------------------------------------------------------------------------------------------

Private Sub mnuStyles_Click(Index As Integer)
   
    mOptions.lStyles = Index
    If MsgBox("Para cambiar el estilo hay que reiniciar el programa. ¿ Salir ?", vbQuestion + vbYesNo) = vbYes Then
       Unload Me
    End If
End Sub

' ----------------------------------------------------------------------------------------------------------------------------------
' \\ - PicBox con la cabececera de Tags
' ----------------------------------------------------------------------------------------------------------------------------------

Private Sub picBoxTitle_Resize()
    With picBoxTitle
        .Cls
        Call cmdSearch.DrawSkin(.hdc, (.ScaleWidth / 15) - 2, (.ScaleHeight / 15) - 2, TS_NORMAL)
        .CurrentX = 120
        .CurrentY = 90
        picBoxTitle.Print "Información del archivo :"
    End With
End Sub


' ----------------------------------------------------------------------------------------------------------------------------------
' \\ - ToolBar - Opciones
' ----------------------------------------------------------------------------------------------------------------------------------

Private Sub tbMain_ButtonClick(ByVal Button As MSComctlLib.Button)
    With picBoxMain
        Select Case Button.Index
            Case 1: .Item(0).ZOrder 0                                 ' pantalla Buscar
            Case 2: .Item(1).ZOrder 0                                    ' pantalla transferencias
            Case 4
                Me.PopupMenu mnuSettings, , Button.Left, Button.Top + Button.Height
                mcSCToolBar.Refresh
            Case 6
                Call mcFind.FileOpen(Me.hwnd, App.Path & "\Download") ' Abrir carpeta de descargas
        End Select
    End With
End Sub


' ----------------------------------------------------------------------------------------------------------------------------------
' \\ - Setear variable a False para cuando se selecciona un fichero con error
' ----------------------------------------------------------------------------------------------------------------------------------

Private Sub txtId3v1_KeyPress(Index As Integer, KeyAscii As Integer)
    Me.TagsEdit = CBool(Len(mSelCurrentFileName))
End Sub

' ----------------------------------------------------------------------------------------------------------------------------------
' \\ - Setear variable a False para cuando se selecciona un fichero con error
' ----------------------------------------------------------------------------------------------------------------------------------

Private Sub txtId3v2_KeyPress(Index As Integer, KeyAscii As Integer)
    Me.TagsEdit = CBool(Len(mSelCurrentFileName))
End Sub

' ----------------------------------------------------------------------------------------------------------------------------------
' \\ - Eventos del Textbox para autocompletar al escribir
' ----------------------------------------------------------------------------------------------------------------------------------
Private Sub txtSearch_Change()

    Call AutoCompletar_TextBox(txtSearch)
   
    Dim bRet As Boolean
   
    ' deshabilitar botones cuando no hay texto
    bRet = Len(txtSearch.Text)
    cmdSearch.Enabled = bRet
    cmdPages(0).Enabled = bRet
    cmdPages(1).Enabled = bRet
End Sub


' ----------------------------------------------------------------------------------------------------------------------------------
' \\ - Seleccionar todo el texto al hacer doble clic en el textbox para buscar
' ----------------------------------------------------------------------------------------------------------------------------------

Private Sub txtSearch_DblClick()
    With txtSearch
        .SelStart = 0
        .SelLength = Len(.Text)
    End With
End Sub

Private Sub txtSearch_KeyDown(KeyCode As Integer, Shift As Integer)
    Select Case KeyCode
        Case vbKeyBack, vbKeyDelete
            Select Case Len(txtSearch.Text)
                Case Is <> 0
                    mbKeyBack = True
            End Select
    End Select
End Sub


' ----------------------------------------------------------------------------------------------------------------------------------
' \\ - escribir en disco el Html al finalizar la descarga
' ----------------------------------------------------------------------------------------------------------------------------------

Private Sub ucDownHtml_Finished(x As AsyncProperty)
    On Error GoTo error_handler
    With mcFind
        ' Descarga Ok
        If x.StatusCode = vbAsyncStatusCodeEndDownloadData Then
            Call mSaveData(x.Value, .TempPath & "temp.html") ' guardar Html
            Call .GetUrlsMp3(.TempPath & "temp.html")       ' Llnear colección con las Urls ( sigue en EndGetUrls )
        ' Descarga con error
        Else
            If mcFind.CheckConnection = False Then
                MsgBox "No se detectó conexión a internet", vbCritical
            Else
                MsgBox "No se pudo completar la búsqueda. Pruebe realizando una nueva, o reiniciando el programa", vbCritical
            End If
            Me.MousePointer = 0
        End If
       
        ' Eliminar archivo Html
        If mcFind.CheckFileExists(.TempPath & "temp.html") Then
           Kill .TempPath & "temp.html"
        End If
    End With
   
Exit Sub
error_handler:
If App.LogMode = 0 Then MsgBox Err.Description, , "ucDownHtml_Finished"
End Sub


' ----------------------------------------------------------------------------------------------------------------------------------
' \\ - Crear archivo y guardar los datos ( se llama desde el evento Finished de los controles de descarga )
' ----------------------------------------------------------------------------------------------------------------------------------

Function mSaveData(vData() As Byte, sUrlPath As String) As Boolean
   
    On Error GoTo error_handler
   
    ' Abrir archivo
    Dim nFileNumber As Long
    nFileNumber = FreeFile
    Open sUrlPath For Binary Access Write As nFileNumber
   
    ' Escribir el array de bytes para crear el archivo
    Put nFileNumber, , vData
    Close nFileNumber
    mSaveData = True
   
error_handler:
   
   
End Function

' ----------------------------------------------------------------------------------------------------------------------------------
' \\ - Evento de finalización de una descarga Mp3
' ----------------------------------------------------------------------------------------------------------------------------------

Private Sub ucDownloadMp3_Finished(x As AsyncProperty)
   
    ' Descarga Ok
    If x.StatusCode = vbAsyncStatusCodeEndDownloadData Then
        If mSaveData(x.Value, mcDownloads.Item(x.PropertyName).FileName) Then
            ' Guardar el estado
            mcDownloads.Item(x.PropertyName).Status = eFinished
            ' Actualizar el listview de descargas
            Call mUpdateLvItems(x.PropertyName)
        Else
            On Error Resume Next
            lvDownloads.ListItems.Remove x.PropertyName
            mcDownloads.Delete x.PropertyName
            On Error GoTo 0
        End If
           
    ' Descarga con error
    Else
        ' Guardar estado
        mcDownloads.Item(x.PropertyName).Status = eError
        ' Actualizar items del Lv
        Call mUpdateLvItems(x.PropertyName)
    End If
   
End Sub


Private Function mCheckExistLvItem(sKey As String, ObjLv As ListView) As Boolean
   
    On Error GoTo error_handler
    Dim xItem As ListItem
    Set xItem = ObjLv.ListItems(sKey)
   
    Set xItem = Nothing
    mCheckExistLvItem = True
    Exit Function
error_handler:
   
End Function

' ----------------------------------------------------------------------------------------------------------------------------------
' \\ - Mostrar datos de las descargas en el StatusBar
' ----------------------------------------------------------------------------------------------------------------------------------

Private Sub mUpdateStatusBar()
    Dim strStatus1 As String
    Dim strStatus2 As String
   
    If lvDownloads.ListItems.Count > 0 Then
        strStatus1 = "Descargando: " & CStr(lvDownloads.ListItems.Count) & " | "
    Else
        strStatus1 = ""
    End If
   
    If lvFiles.ListItems.Count > 0 Then
        strStatus2 = "Terminados: " & CStr(lvFiles.ListItems.Count)
    Else
        strStatus2 = ""
    End If
   
   
    If Len(strStatus2) = 0 And strStatus1 <> "" Then
        strStatus1 = Left(strStatus1, Len(strStatus1) - 1)
    End If
    lblStatus.Caption = strStatus1 & strStatus2
   
End Sub


' ----------------------------------------------------------------------------------------------------------------------------------
' \\ - Actualizar íconos del listview de descargas
' ----------------------------------------------------------------------------------------------------------------------------------

Private Sub mUpdateSmallIcons(pItemLv As ListItem)
   
    With mcDownloads
        If .CheckItemExist(pItemLv.Key) Then
           pItemLv.SmallIcon = .GetStatusText(.Item(pItemLv.Key).Status)
        End If
    End With
   
End Sub


' ----------------------------------------------------------------------------------------------------------------------------------
' \\ - Evento de progreso - Para los Mp3s
' ----------------------------------------------------------------------------------------------------------------------------------

Private Sub ucDownloadMp3_Progress(x As AsyncProperty, Percent As Single)

On Error GoTo error_handler
   
    ' Guardar datos en el item de la coección
 With mcDownloads.Item(x.PropertyName)
        .Progress = Percent
        .FileSize = x.BytesMax
        .BytesRead = .BytesRead
        .Percent = Val(CStr(.Progress)) & " %"
       
        If Percent >= 1 Then
            .Status = eDownloading
        Else
            .Status = eNew
        End If
    End With
   
Exit Sub
error_handler:
'If App.LogMode = 0 Then MsgBox Err.Description, vbCritical, "Error en  - ucDownloadMp3_Progress"
End Sub



' -----------------------------------------------------------------------------------------------------
' \\ - Cargar información (Tags) del archivo Mp3 en el control Listview
' -----------------------------------------------------------------------------------------------------

Private Sub mShowTagInfo()
   
    ' Información Mpeg ( Bitrate, tags, frcuencia, versión  ...)
    ' ------------------------------------------------------
   
    With tInfoMpg
        Call mClearInfoMp3
        lblMpegInfo(0).Caption = .MPEGVersion
        lblMpegInfo(1).Caption = .Bitrate
        lblMpegInfo(2).Caption = .Frequency
        lblMpegInfo(3).Caption = .ChannelMode
        lblMpegInfo(4).Caption = mcDownloads.GetFormatLenght(.Length)
        lblMpegInfo(5).Caption = mcDownloads.GetFileSize(.FileSize)
    End With
   
    ' Información iD3v1
    ' -------------------------------------------------------------------
    With tInfoV1
   
        txtId3v1(0).Text = .Title
        txtId3v1(1).Text = .Album
        txtId3v1(2).Text = .Artist
        cboGen(0).Text = .Genre
        txtId3v1(4).Text = .SongYear
        txtId3v1(5).Text = .TrackNr
        txtId3v1(6).Text = .Comment
       
    End With
   
    ' Información iD3v2
    ' -------------------------------------------------------------------
   
    With tInfoV2
        txtId3v2(7).Text = .Title
        txtId3v2(0).Text = .Album
        txtId3v2(1).Text = .Artist
        cboGen(1).Text = .Genre
        txtId3v2(3).Text = .SongYear
        txtId3v2(4).Text = .TrackNr
        txtId3v2(5).Text = .Comment
        txtId3v2(6).Text = .ArtistAdditional
        txtId3v2(8).Text = .CDNumber
        txtId3v2(9).Text = .EncodingSettings
        txtId3v2(10).Text = .Copyright
        txtId3v2(11).Text = .FileType
        txtId3v2(12).Text = .Language
    End With
   
End Sub


' ----------------------------------------------------------------------------------------------------------------------------------
' \\ - Opción de menú para cancelar descargas y Reiniciar
' ----------------------------------------------------------------------------------------------------------------------------------

Private Sub mnuCancelDownloads_Click(Index As Integer)
   
On Error GoTo err_handler
   
    Dim xItem As ListItem
   
    ' Detener temporalmente el Timer que actualiza los datos en el lv de descargas
    If mcTimer.TmrStop Then TimerStatus = False
   
    Select Case Index
       
        ' Eliminar descargas seleccionadas
        ' ----------------------------------------------------------------------------------------------------------------------------------
        Case 0
            Dim arrKeys() As String
            arrKeys = mGetLvSelectedItems(lvDownloads, eAll)
           
            Dim i As Integer
            For i = 0 To UBound(arrKeys)
                If arrKeys(i) <> vbNullString Then
                    On Error Resume Next
                    Call ucDownloadMp3.CancelDownload(arrKeys(i))
                    Call mcDownloads.Delete(arrKeys(i))
                    lvDownloads.ListItems.Remove arrKeys(i)
                    On Error GoTo 0
                End If
            Next
            Erase arrKeys
       
        ' Eliminar todas las descargas
        ' ----------------------------------------------------------------------------------------------------------------------------------
        Case 2
           
            If MsgBox("Eliminar todas las descargas actuales ?", vbQuestion + vbYesNo) = vbYes Then
               
               For Each xItem In lvDownloads.ListItems
                    Call ucDownloadMp3.CancelDownload(xItem.Key)
                    Call mcDownloads.Delete(xItem.Key)
               Next
               lvDownloads.ListItems.Clear
            End If
        ' Reiniciar descarga
        ' ----------------------------------------------------------------------------------------------------------------------------------
        Case 4
            If Not lvDownloads.SelectedItem Is Nothing Then
               Call ucDownloadMp3.CancelDownload(lvDownloads.SelectedItem.Key)
               Call ucDownloadMp3.Download(lvDownloads.SelectedItem.Key)
            End If
       
        ' Seleccionar todos los lvItems
        ' ----------------------------------------------------------------------------------------------------------------------------------
        Case 6
            lvDownloads.MultiSelect = True
            For Each xItem In lvDownloads.ListItems
                xItem.Selected = True
            Next
           
    End Select
   
    ' Volver a activar el timer
    TimerStatus = mcTimer.TmrStart(Me, mGetTimerInterval, 0)
   
Exit Sub
err_handler:
    MsgBox Err.Description, vbCritical, "mnuCancelDownloads_Click"
End Sub



' -----------------------------------------------------------------------------------------------------
'\\ - Botón Play y Stop
' -----------------------------------------------------------------------------------------------------
Private Sub cmdPrevMp3_Click(Index As Integer)

    ' Si no hay item salir ...
    If lvFiles.SelectedItem Is Nothing Then Exit Sub
   
    With mcMCI
        Select Case Index
            Case 0: Call .ExecuteCommand(ePlayMp3, mcFind.DownloadFolder & lvFiles.SelectedItem.Text)
            Case 1: Call .ExecuteCommand(eStopMp3, mcFind.DownloadFolder & lvFiles.SelectedItem.Text)
        End Select
    End With
End Sub



' -----------------------------------------------------------------------------------------------------
' \\ - Redimensionar controles
' -----------------------------------------------------------------------------------------------------

Private Sub Form_Resize()
   
    On Local Error Resume Next
   
    Dim i As Integer
   
    ' si está minimizado  ...salir
    If WindowState = vbMinimized Then Exit Sub
    For i = 0 To picBoxMain.Count - 1
        picBoxMain(i).Move 0, tbMain.Height + 15, ScaleWidth, ScaleHeight - (tbMain.Height + 15 + picStatus.Height + 15)
    Next
   
    ' Listview de resultados de búsqueda
    With lvFind
        .Width = (ScaleWidth - .Left) - 100
        .Height = picBoxMain(0).Height - 240 - .Top
    End With
   
    ' Botón de menú de opciones
    With cmdDownloads(0)
        .Top = 800
        .Left = 120
    End With
                   
    ' Listview con los archivos que se están descargando
    With lvDownloads
        .Left = 120
        .Width = 8000
        .Height = 3500
        .Top = cmdDownloads(0).Height + cmdDownloads(0).Top + 15
    End With
   
    ' Listview con los archivos ya descargados
    With lvFiles
        .Left = 120
        .Width = 8000
        .Height = 3500
        .Top = lvDownloads.Top + lvDownloads.Height + 80 + cmdDownloads(1).Height
    End With
   
    ' Listview con los archivos que se están descargando
    With cmdDownloads(1)
        .Top = lvDownloads.Top + lvDownloads.Height + 60
        .Left = 120
    End With
       
    ' Contenedor para los controles de Tags
    With frameConInfoMp3
       
        .Left = lvFiles.Left + lvFiles.Width + 60
        .Width = Me.ScaleWidth - (lvFiles.Width + lvFiles.Left + 120)
        .Top = 120
        .Height = picBoxMain(0).Height - 240
    End With
   
    With picBoxTitle
        .Width = frameConInfoMp3.Width - 240
    End With
   
    ' Listbox con la lista de Artistas
    lstArt.Height = picBoxMain(0).ScaleHeight - (lstArt.Top + 30)
   
    ' botones de reproducción
    cmdPrevMp3(1).Left = ScaleWidth - (cmdPrevMp3(1).Width + 120)
    cmdPrevMp3(0).Left = ScaleWidth - (cmdPrevMp3(0).Width + cmdPrevMp3(1).Width + 120)

End Sub


' -----------------------------------------------------------------------------------------------------
' \\ - Ordenar Columnas para el Listview de archivos ya descargados
' -----------------------------------------------------------------------------------------------------
Private Sub lvFiles_ColumnClick(ByVal ColumnHeader As MSComctlLib.ColumnHeader)
    Call LvColumnClick(lvFiles, ColumnHeader.Index)
End Sub

' -----------------------------------------------------------------------------------------------------
' \\ - Ordenar Columnas para el Listview de archivos que se están descargando
' -----------------------------------------------------------------------------------------------------
Private Sub lvDownloads_ColumnClick(ByVal ColumnHeader As MSComctlLib.ColumnHeader)
    Call LvColumnClick(lvDownloads, ColumnHeader.Index)
End Sub

' -----------------------------------------------------------------------------------------------------
' \\ - Ordenar Columnas para el Listview de resultados
' -----------------------------------------------------------------------------------------------------

Private Sub lvFind_ColumnClick(ByVal ColumnHeader As MSComctlLib.ColumnHeader)
    Call LvColumnClick(lvFind, ColumnHeader.Index)
End Sub


' -----------------------------------------------------------------------------------------------------
' \\ - Mostrar menú Popup para le LV de archivos en descarga
' -----------------------------------------------------------------------------------------------------
Private Sub lvDownloads_MouseDown(Button As Integer, Shift As Integer, x As Single, Y As Single)
    Call mShowLVPopUpMenu(Button, mnuCanDown, lvDownloads, x, Y)
End Sub

' -----------------------------------------------------------------------------------------------------
' \\ - Sub para ordenar las columnas de un ListView
' -----------------------------------------------------------------------------------------------------
Private Sub LvColumnClick(Lv As ListView, lIndexCol As Integer)
    With Lv
        .SortOrder = (.SortOrder + 1) Mod 2
        .SortKey = lIndexCol - 1
        .Sorted = True
    End With
End Sub


' -----------------------------------------------------------------------------------------------------
' \\ - Sub para desplegar PopUp menu para los ListView
' -----------------------------------------------------------------------------------------------------
Private Sub mShowLVPopUpMenu(Button As Integer, pMenu As Menu, pLv As ListView, x As Single, Y As Single)
   
    If Button <> vbRightButton Then Exit Sub
   
    Dim xItem As ListItem
    Set xItem = pLv.HitTest(x, Y)
   
    If Not xItem Is Nothing Then
       If xItem.Selected = False Then
          pLv.MultiSelect = False
       End If
       xItem.Selected = True
       Me.PopupMenu pMenu
       pLv.MultiSelect = False
    End If
    DoEvents
    pLv.MultiSelect = True
   
End Sub

' -----------------------------------------------------------------------------------------------------
' \\ - Reproducir archivo Mp3 al hacer doble clic
' -----------------------------------------------------------------------------------------------------
Private Sub lvFiles_DblClick()
    With lvFiles
        If Not .SelectedItem Is Nothing Then
       
            If mcFind.CheckFileExists(mcFind.DownloadFolder & .SelectedItem.Text) Then
       
                ' Reproducir con MciExecute
                If mOptions.bPlayMp3 = False Then
                    Call cmdPrevMp3_Click(0)
                Else
                    Call mnuOptionsFile_Click(1)
                End If
                ' Remarcar item
                .SelectedItem.Bold = True
                .SelectedItem.ForeColor = mcStyles.ForeColorSelectedItems
            Else
                MsgBox "El archivo a reproducir no se encuentra en el directorio de descargas", vbExclamation, "No se encuentra el archivo"
            End If
           
        End If
    End With
End Sub

' -----------------------------------------------------------------------------------------------------
' \\ - Leer y Cargar los tags al hacer clic en un item
' -----------------------------------------------------------------------------------------------------

Private Sub lvFiles_ItemClick(ByVal Item As MSComctlLib.ListItem)
   
   
   
End Sub


' -----------------------------------------------------------------------------------------------------
' \\ - Habilitar o deshabiilitar controles por el nombre
' -----------------------------------------------------------------------------------------------------

Sub mEnabledControls(bValue As Boolean, sName As String)
    Dim xCtrl As Control
    For Each xCtrl In Me.Controls
        If LCase(xCtrl.Name) = LCase(sName) Then
            If xCtrl.Enabled = bValue Then
                Exit Sub
            Else
                xCtrl.Enabled = bValue
            End If
        End If
    Next
End Sub

' -----------------------------------------------------------------------------------------------------
' \\ - Eliminar propiedad text o caption de los controles
' -----------------------------------------------------------------------------------------------------
Private Sub mClearInfoMp3()
   
    Dim xCtrl As Control
   
    For Each xCtrl In Me.Controls
        If LCase(xCtrl.Tag) = LCase("InfoMp3") Then
           xCtrl = vbNullString
        End If
    Next
   
End Sub

' -----------------------------------------------------------------------------------------------------
' \\ - Desplegar popupmenu para el listview de archivos ya descargados
' -----------------------------------------------------------------------------------------------------
Private Sub lvFiles_MouseDown(Button As Integer, Shift As Integer, x As Single, Y As Single)

    Call mShowLVPopUpMenu(Button, mnuOptDownload, lvFiles, x, Y)
End Sub


' -----------------------------------------------------------------------------------------------------
' \\ - Destruir ToolTip cuando el mouse entra en el control Listview de resultados
' -----------------------------------------------------------------------------------------------------
Private Sub mCscLvFind_MouseEnter()
    Call mcToolTip.Destroy
End Sub

' -----------------------------------------------------------------------------------------------------
' \\ - Destruir ToolTip cuando el mouse sale del control Listview de resultados
' -----------------------------------------------------------------------------------------------------
Private Sub mCscLvFind_MouseOut()
    Call mcToolTip.Destroy
End Sub


' -----------------------------------------------------------------------------------------------------
' \\ - Menú de opciones de Tags
' -----------------------------------------------------------------------------------------------------
Private Sub mnuTags_Click(Index As Integer)
   
    ' Si no hay archivo salir ..
    If (Len(mSelCurrentFileName) = 0) Then
        MsgBox "No hay un archivo cargado para editar", vbExclamation, "Tags"
        Exit Sub
    End If
   
    ' Restaurar flag de edición de tags
    Me.TagsEdit = False
   
    ' Estructura de datos para pasar a la función que lee y escribe los tags
    Dim tTag        As ID3v1Tag
    Dim tTag2       As ID3v2Tag
    Dim xItem       As ListItem
   
    ' limpiar los types
    tInfoV1 = tInfoV1_c
    tInfoV2 = tInfoV2_c
    tInfoMpg = tInfoMpg_c
   
   
    Select Case Index
       
        ' Modificar y crear
        ' --------------------------------------------------------------------------------------
   
        Case 0
           
            ' Versión 1
            ' -------------------------
            tTag.Title = txtId3v1(0).Text
            tTag.Album = txtId3v1(1).Text
            tTag.Artist = txtId3v1(2).Text
            tTag.Genre = cboGen(0).Text
            tTag.SongYear = txtId3v1(4).Text
            tTag.TrackNr = txtId3v1(5).Text
            tTag.Comment = txtId3v1(6).Text
           
            Call modInfoMp3.WriteID3v1(mSelCurrentFileName, tTag)
           
            ' Versión 2
            ' ------------------------------------------------------------------

            tTag2.Title = txtId3v2(7).Text
            tTag2.Album = txtId3v2(0).Text
            tTag2.Artist = txtId3v2(1).Text
            tTag2.Genre = cboGen(1).Text
            tTag2.SongYear = txtId3v2(3).Text
            tTag2.TrackNr = txtId3v2(4).Text
            tTag2.Comment = txtId3v2(5).Text
            tTag2.ArtistAdditional = txtId3v2(6).Text
            tTag2.CDNumber = txtId3v2(8).Text
            tTag2.EncodingSettings = txtId3v2(9).Text
            tTag2.Copyright = txtId3v2(10).Text
            tTag2.FileType = txtId3v2(11).Text
            tTag2.Language = txtId3v2(12).Text
           
            ' escribir
            Call modInfoMp3.WriteID3v2(mSelCurrentFileName, tTag2, VERSION_2_4, False, False, True)
           
        ' Eliminar tags
        ' ----------------------------------------------------------------
        Case 2
            ' v1
            If modInfoMp3.ReadMPEGInfo(mSelCurrentFileName, tInfoMpg) Then
                If tInfoMpg.ID3v1Version <> -1 Then
                    Call modInfoMp3.DeleteID3v1(mSelCurrentFileName)
                End If
            End If
        Case 3
            ' v2
            If modInfoMp3.ReadMPEGInfo(mSelCurrentFileName, tInfoMpg) Then
                If tInfoMpg.ID3v2Version <> -1 Then
                    Call modInfoMp3.DeleteID3v2(mSelCurrentFileName)
                End If
            End If
           
        ' eliminar todos los tags de los archivos cargados en LvFiles
        Case 4
            If lvFiles.ListItems.Count > 0 Then
                If MsgBox("Eliminar todos los tags de los archivos descargados: ?.", vbQuestion + vbYesNo) = vbYes Then
                    Dim sFileName As String
                    For Each xItem In lvFiles.ListItems
                        sFileName = mcFind.DownloadFolder & xItem.Text
                        Call modInfoMp3.DeleteID3v1(sFileName)
                        Call modInfoMp3.DeleteID3v2(sFileName)
                    Next
                End If
            Else
                MsgBox "No hay archivos para eliminar", vbCritical
            End If
    End Select
   
End Sub

' -----------------------------------------------------------------------------------------------------
' \\ -Cargar Listado de artístas en listbox, (desde los archivos txt)
' -----------------------------------------------------------------------------------------------------
Private Sub cboArtista_Click()
    Me.MousePointer = vbHourglass
    DoEvents
    Call mFillLstArts(App.Path & "\data\" & cboArtista.Text & ".txt")
    Me.MousePointer = vbDefault
End Sub


' -----------------------------------------------------------------------------------------------------
' \\ - Mostrar menú popup de opciones ( para listview de descargas y para los que finalizaron )
' -----------------------------------------------------------------------------------------------------

Private Sub cmdDownloads_Click(Index As Integer)
    Select Case Index
       
        ' menú de descargas
        Case 0
            If lvDownloads.ListItems.Count > 0 Then
                Me.PopupMenu mnuCanDown, , cmdDownloads(0).Left, picBoxMain(1).Top + cmdDownloads(0).Top + cmdDownloads(0).Height
            End If
        ' ya descargados
        Case 1
            If lvFiles.ListItems.Count > 0 Then
                Me.PopupMenu mnuOptDownload, , cmdDownloads(1).Left, picBoxMain(1).Top + cmdDownloads(1).Top + cmdDownloads(1).Height
            End If
    End Select
End Sub


' -----------------------------------------------------------------------------------------------------
' \\ - Buscar en la siguiente página o en la anterior
' -----------------------------------------------------------------------------------------------------

Private Sub cmdPages_Click(Index As Integer)
   
    With lblNumPage
        Select Case Index
            Case 0
                If (CInt(.Caption) > 1) Then .Caption = CStr(CInt(.Caption) - 1)
            Case 1
                .Caption = CStr(CInt(.Caption) + 1)
        End Select
    End With
   
    ' Comenzar búsqueda
    With mcFind
         Call .FindMp3(txtSearch.Text, lstDirectory.ListIndex, CInt(lblNumPage.Caption))
    End With
End Sub


' -----------------------------------------------------------------------------------------------------
' \\ - Timer para actualizar los datos de las transferencias
' -----------------------------------------------------------------------------------------------------
Private Sub iTimer_Proc(ByVal lElapsedMS As Long, ByVal lTimerID As Long)

    Select Case lTimerID
        Case 0
            With ucDownloadMp3
                ' si ya no hay archivos, .. desactivar el timer y salir
                If .CurrentDownloads.Count = 0 Then
                    If mcTimer.TmrStop Then
                        TimerStatus = False
                        Exit Sub
                    End If
                End If
                Dim xLvItem As ListItem
                For Each xLvItem In lvDownloads.ListItems
                    Call mUpdateLvItems(xLvItem.Key)
                Next
            End With
           
            mcTimer.TmrStop
            TimerStatus = mcTimer.TmrStart(Me, mGetTimerInterval, 0)
           
        Case 1 ' otro timer
    End Select
   
End Sub

' -----------------------------------------------------------------------------------------------------
' \\ - Mostrar el artista en el textbox al hacer clic en listbox
' -----------------------------------------------------------------------------------------------------
Private Sub lstArt_Click()
    txtSearch.Text = lstArt.Text
End Sub

' -----------------------------------------------------------------------------------------------------
' \\ - Leer y Cargar Tags del archivo Mp3 en el listview
' -----------------------------------------------------------------------------------------------------
Private Sub mLoadInfoMp3(lvItem As ListItem)
   
    ' limpiar los types
    tInfoMpg = tInfoMpg_c
    tInfoV1 = tInfoV1_c
    tInfoV2 = tInfoV2_c
   
    ' Obtener ruta del Mp3
    Dim sFileName As String
    sFileName = mcFind.DownloadFolder & lvItem.Text
   
    ' Guardar la ruta
    mSelCurrentFileName = sFileName
   
    If modInfoMp3.ReadMPEGInfo(sFileName, tInfoMpg) Then
        Call modInfoMp3.ReadID3v1(sFileName, tInfoV1)            ' v1
        Call modInfoMp3.ReadID3v2(sFileName, tInfoV2)            ' v2
    End If
   
End Sub



' -----------------------------------------------------------------------------------------------------
' \\ - Función para devolver un array con los items del listview ( para todos los que se encuentran seleccionados, o para los que están marcados como error)
'--------------------------------------------------------------------------------------------------------

Private Function mGetLvSelectedItems(Lv As ListView, lOpt As eLvSelectedItems) As String()
   
   
    On Error GoTo err_handler
   
    Dim arrKeys() As String
    Dim xLvItem As ListItem
   
    ReDim arrKeys(0)
   
    ' devolver todos los seleccionados
    If lOpt = eAll Then
        For Each xLvItem In Lv.ListItems
            If xLvItem.Selected Then
                arrKeys(UBound(arrKeys)) = xLvItem.Key
                ReDim Preserve arrKeys(UBound(arrKeys) + 1)
            End If
        Next
    ' devolver todos los que dieron error
    ElseIf lOpt = eErrorItem Then
        For Each xLvItem In Lv.ListItems
            If xLvItem.SubItems(1) = mcDownloads.GetStatusText(eError) Then
                arrKeys(UBound(arrKeys)) = xLvItem.Key
                ReDim Preserve arrKeys(UBound(arrKeys) + 1)
            End If
        Next
    End If
    ' quitar el último vacio
    If UBound(arrKeys) > 0 Then
        ReDim Preserve arrKeys(UBound(arrKeys) - 1)
    End If
   
    ' retornar array de items
    mGetLvSelectedItems = arrKeys
   
Exit Function
err_handler:
    If App.LogMode = 0 Then
        MsgBox Err.Description, vbCritical, "mGetLvSelectedItems"
    End If
   
End Function


' -----------------------------------------------------------------------------------------------------
' \\ - Opciones de menú para el listview con la lista de archivos ya descargados
' -----------------------------------------------------------------------------------------------------

Private Sub mnuOptDown_Click(Index As Integer)

On Error GoTo err_handler

    Dim xLvItem         As ListItem
    Dim arrKeys()       As String
    Dim i               As Integer
   
    Select Case Index
        ' Eliminar todos los archivos de la lista, y también del disco
        ' -------------------------------------------------------------
        Case 1
            ' obtener los que están seleccionados
            arrKeys = mGetLvSelectedItems(lvFiles, eAll)
            If UBound(arrKeys) > 0 Then
               If MsgBox("¿ Eliminar archivos del disco  ?", vbQuestion + vbYesNo) = vbNo Then
                   Exit Sub
               End If
            End If
           
           
            Dim sFileName As String
            ' recorrer items
            For i = 0 To UBound(arrKeys)
                If arrKeys(i) <> vbNullString Then
                    sFileName = mcFind.DownloadFolder & lvFiles.ListItems(arrKeys(i)).Text
                    ' Eliminar del disco, de la colección y del listview
                    On Error Resume Next
                    If mcFind.CheckFileExists(sFileName) Then Kill sFileName
                    Call mcDownloads.Delete(arrKeys(i))
                    lvFiles.ListItems.Remove arrKeys(i)
                    On Error GoTo 0
                End If
            Next
           
            Erase arrKeys
           
           
        ' Eliminar de la lista los que dieron error
        ' -------------------------------------------------------------
        Case 2
            arrKeys = mGetLvSelectedItems(lvFiles, eErrorItem)
            For i = 0 To UBound(arrKeys)
                If arrKeys(i) <> vbNullString Then
                    On Error Resume Next
                    mcDownloads.Delete arrKeys(i)
                    lvFiles.ListItems.Remove arrKeys(i)
                    On Error GoTo 0
                End If
            Next
            Erase arrKeys
           
        ' Eliminar toda la lista
        ' -------------------------------------------------------------
        Case 4
            If lvFiles.ListItems.Count > 0 Then
                If MsgBox("Limpiar la lista?", vbQuestion + vbYesNo) = vbYes Then
                    For Each xLvItem In lvFiles.ListItems
                        On Error Resume Next
                        ' remover item de la colección
                        Call mcDownloads.Delete(xLvItem.Key)
                        On Error GoTo 0
                    Next
                    lvFiles.ListItems.Clear
                End If
            End If
        Case 6
            Call mSelectAllLvItems(lvFiles)
        Case 8
            arrKeys = mGetLvSelectedItems(lvFiles, eAll)
           
            For i = 0 To UBound(arrKeys)
                Call mAddUrlError(arrKeys(i))
            Next
    End Select
   
    ' si no hay mas archivos, cerrar Mci por si estaba en reproducción
    If lvFiles.ListItems.Count = 0 Then
       mSelCurrentFileName = vbNullString
       Call mcMCI.ExecuteCommand(eCloseMp3, vbNullString)
       Call mClearInfoMp3
       Call mEnabledControls(True, "txtId3v1")
       Call mEnabledControls(True, "txtId3v2")
       Call mEnabledControls(True, "cboGen")
       Me.TagsEdit = False
    End If
   
Exit Sub
err_handler:
   
    MsgBox Err.Description, vbCritical, "mnuOptDown_Click"
   
End Sub


' ----------------------------------------------------------------------------------------------------------------------------------
' Menú de opciones para mostrar diálogo de propiedades de archivo, y para abrir el Mp3 con el reproductor predeterminado de windows
' ----------------------------------------------------------------------------------------------------------------------------------
Private Sub mnuOptionsFile_Click(Index As Integer)
    Select Case Index
        Case 0
            ' Reproducir con MCI
            Call lvFiles_DblClick
        Case 1
            ' Reproducir con el predeterminado
            If Not lvFiles.SelectedItem Is Nothing Then
                Call mcFind.FileOpen(Me.hwnd, mcFind.DownloadFolder & lvFiles.SelectedItem.Text)
            End If
        Case 3
            ' Diálogo de propiedades
            If Not lvFiles.SelectedItem Is Nothing Then
                Call mcDlgs.showDlgFileProperty(mcFind.DownloadFolder & lvFiles.SelectedItem.Text, Me.hwnd)
            End If
    End Select
End Sub





' ------------------------------------------------------------------------------------
' Seleccionar todos los items de un LV
' ------------------------------------------------------------------------------------
Private Sub mSelectAllLvItems(ObjLv As ListView)
   
    ObjLv.MultiSelect = True
    Dim xItem As ListItem
    For Each xItem In ObjLv.ListItems
        xItem.Selected = True
    Next

End Sub



' ----------------------------------------------------------------------------------------------------------------------------------
' \\ - Volver a Redibujar Skin para el PicBox de barra de estado cuando se redimensiona el control
' ----------------------------------------------------------------------------------------------------------------------------------
Private Sub picStatus_Resize()
    With picStatus
        .Cls
        Call cmdSearch.DrawSkin(.hdc, (.ScaleWidth / 15) - 2, (.ScaleHeight / 15) - 2, TS_NORMAL)
    End With
End Sub

' ----------------------------------------------------------------------------------------------------------------------------------
' \\ - Desplegar menú de opciones de Tags
' ----------------------------------------------------------------------------------------------------------------------------------

Private Sub cmdTags_Click()
    If Not lvFiles.SelectedItem Is Nothing Then
        Me.PopupMenu mnuTagOpt, , cmdTags.Left + frameConInfoMp3.Left, frameConInfoMp3.Top + cmdTags.Top + cmdTags.Height + picBoxMain(0).Top
    End If
End Sub


' ----------------------------------------------------------------------------------------------------------------------------------
' \\ - Antes de cerrar el form, verificar si hay descargas en progreso
' ----------------------------------------------------------------------------------------------------------------------------------

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
   
    On Error GoTo err_handler
   
    With ucDownloadMp3.CurrentDownloads
        If .Count > 0 Then
            ' Mostrar pantalla de transferencias
            'ucMenu1.Buttons(2).Selected = True
            DoEvents
            If MsgBox("Se están descargando " & CStr(.Count) & " archivos. ¿ Salir ?", vbQuestion + vbYesNo) = vbNo Then
                Cancel = True
            End If
        Else
            ' Cancelar todo y salir
            Call mCancelAll(False)
        End If
    End With
   
Exit Sub
err_handler:

    MsgBox Err.Description, vbCritical, "Form_QueryUnload"
       
End Sub


' ----------------------------------------------------------------------------------------------------------------------------------
' \\ - Destruir referencias y descargar objetos
' ----------------------------------------------------------------------------------------------------------------------------------

Private Sub Form_Unload(Cancel As Integer)

On Error GoTo err_handler
   
   Call mSaveUrlError

   ' Cargar valores de configuración desde el archivo Ini
   With mcIni
       Call .writeValue(mIniPath, "Reproducción", "PlayMp3", mOptions.bPlayMp3)
       Call .writeValue(mIniPath, "Tags", "EliminarID3v1", mOptions.bDeleteId3v1)
       Call .writeValue(mIniPath, "Tags", "EliminarID3v2", mOptions.bDeleteId3v2)
       Call .writeValue(mIniPath, "Estilo", "Estilo", mOptions.lStyles)
       Call .writeValue(mIniPath, "Iconos", "Tamaño", mOptions.lIconSize)
   End With
   
   Set mColUrlsError = Nothing
   
   mcSCToolBar.UnSubClassToolBar
   Set mcSCToolBar = Nothing
   
   Set mcFind = Nothing
   Set mcSCLvFind = Nothing
   Set mcscLvDownload = Nothing
   Set mcscLvFiles = Nothing
   Set mcDownloads = Nothing
   Set mcToolTip = Nothing
   Set mcDlgs = Nothing
   Set mcIni = Nothing
   Set mcMCI = Nothing
   Set mcStyles = Nothing
   mcTimer.TmrStop
   Set mcTimer = Nothing
  
   End
  
Exit Sub
err_handler:

    MsgBox Err.Description, vbCritical, "Form unload"
  
End Sub



' ----------------------------------------------------------------------------------------------------------------------------------
' \\ - Almacenar Items con error
' ----------------------------------------------------------------------------------------------------------------------------------

Private Sub mAddUrlError(sKey As String)
   
    On Error Resume Next
    mColUrlsError.Add sKey, sKey
End Sub


' ----------------------------------------------------------------------------------------------------------------------------------
' \\ - Guardar en un archivo de texto las url con error
' ----------------------------------------------------------------------------------------------------------------------------------

Private Sub mSaveUrlError()
    On Error GoTo error_handler
    Dim f As Integer
    f = FreeFile
    Open mcFind.TempPath & "url_error.txt" For Output As #1
   
    Dim i As Integer
    For i = 1 To mColUrlsError.Count
        Print #f, mColUrlsError.Item(i)
    Next
    Close f
    Exit Sub
error_handler:
    Close
End Sub


' ----------------------------------------------------------------------------------------------------------------------------------
' \\ - Cargar las url de error desde el archivo de texto
' ----------------------------------------------------------------------------------------------------------------------------------

Private Sub mLoadUrlError()

   On Error GoTo error_handler
   Dim sUrl             As String
   Dim f                As Integer
  
   f = FreeFile
  
   Open mcFind.TempPath & "url_error.txt" For Input As #f
  
   While Not EOF(f)
       Line Input #f, sUrl
       Call mAddUrlError(sUrl)
   Wend
   Close #f
  
   Exit Sub
error_handler:
   Close
   
End Sub



' ----------------------------------------------------------------------------------------------------------------------------------
' \\ - Agregar nueva descarga al ahcer doble clic en un resultado
' ----------------------------------------------------------------------------------------------------------------------------------

Private Sub lvFind_DblClick()
    ' Enviar el item seleccionado actualmente
    Call mAddNewDownload(lvFind.SelectedItem)
End Sub

' ----------------------------------------------------------------------------------------------------------------------------------
' \\ - Sub para agregar nueva descarga
' ----------------------------------------------------------------------------------------------------------------------------------

Sub mAddNewDownload(pItemLv As ListItem)
   
    On Error GoTo error_handler
   
    ' .. si no hay item salir
    If pItemLv Is Nothing Then Exit Sub
   
    Dim xItemLvDown As ListItem

    With pItemLv
        'si ya se encuentra esta descarga, mostrar tooltip y salir
        If mcDownloads.CheckItemExist(.Key) Then
           mcToolTip.Destroy
           mcToolTip.Icon = TTIconInfo
           mcToolTip.Style = TTBalloon
           mcToolTip.VisibleTime = 4000
           mcToolTip.DelayTime = 1
           mcToolTip.Title = .Text
           mcToolTip.Create lvFind.hwnd
           mcToolTip.TipText = "El archivo seleccionado ya se encuentra en la lista de descargas"
           Call mUpdateSmallIcons(pItemLv)
           Exit Sub
        ' Agregar nueva
        Else
           ' Nuevo Item para guardar en la colección
           Dim xItemDownload As New cDownloadItem
           xItemDownload.Key = mcFind.Item(.Key).Key            ' Clave
           xItemDownload.Url = mcFind.Item(.Key).Url            ' Dirección url
           xItemDownload.Title = mcFind.Item(.Key).Title        ' Titulo - Nombre del archivo
           xItemDownload.Status = eNew                          ' Estado
           xItemDownload.FileName = mcFind.Item(.Key).FileName  ' Nombre de archivo - Ruta completa
           ' Agregar a la colección
           Call mcDownloads.Add(xItemDownload.Title, xItemDownload.Url, xItemDownload.FileName, xItemDownload.Url, eNew)
           ' Agregar al Listview
           Set xItemLvDown = lvDownloads.ListItems.Add(1, xItemDownload.Key)
           ' Actualizar listview
           Call mUpdateLvItems(xItemDownload.Url)
           ' Agregar descarga
           Call ucDownloadMp3.Download(xItemDownload.Url)
          
           ' Comenzar timer
           mcTimer.TmrStop
           TimerStatus = mcTimer.TmrStart(Me, mGetTimerInterval, 0)
          
           .Bold = True
           .ForeColor = mcStyles.ForeColorSelectedItems
           Set xItemDownload = Nothing
        End If
    End With
   
    Exit Sub
error_handler:
   MsgBox Err.Description, vbCritical, "Error: " & CStr(Err.Number)
   
End Sub


' ----------------------------------------------------------------------------------------------------------------------------------
' \\ - Usar valor de Interval de acuerdo a la cantidad de items que hay cargados
' ----------------------------------------------------------------------------------------------------------------------------------

Private Function mGetTimerInterval() As Long
    Dim lItemsCount As Long
    lItemsCount = lvDownloads.ListItems.Count
   
    If lItemsCount <= 5 Then
        mGetTimerInterval = 2000
    ElseIf lItemsCount > 5 And lItemsCount <= 10 Then
        mGetTimerInterval = 3000
    ElseIf lItemsCount > 10 And lItemsCount <= 15 Then
        mGetTimerInterval = 4000
    ElseIf lItemsCount > 15 And lItemsCount <= 25 Then
        mGetTimerInterval = 6000
    Else
        mGetTimerInterval = 10000
    End If
   
End Function

' ----------------------------------------------------------------------------------------------------------------------------------
' \\ - Guardar estado del Timer
' ----------------------------------------------------------------------------------------------------------------------------------
Property Get TimerStatus() As Boolean
    TimerStatus = mTimerStatus
End Property

Property Let TimerStatus(bValue As Boolean)
    mTimerStatus = bValue
End Property

' ----------------------------------------------------------------------------------------------------------------------------------
' \\ - Guardar modificación de tags
' ----------------------------------------------------------------------------------------------------------------------------------
Property Get TagsEdit() As Boolean
    TagsEdit = mTagsEdit
End Property

Property Let TagsEdit(bValue As Boolean)
    mTagsEdit = bValue
End Property


' ----------------------------------------------------------------------------------------------------------------------------------
' \\ -  Autocompletar TextBox al escribir
' ----------------------------------------------------------------------------------------------------------------------------------
Public Function AutoCompletar_TextBox(textBox As textBox)

Dim i As Integer
Dim posSelect As Integer

    Select Case (mbKeyBack Or Len(textBox.Text) = 0)
        Case True
            mbKeyBack = False
            Exit Function
    End Select
    With textBox
        For i = 0 To lstArt.ListCount - 1
            If InStr(1, lstArt.List(i), .Text, vbTextCompare) = 1 Then
                posSelect = .SelStart

                .Text = lstArt.List(i)
                .SelStart = posSelect
                .SelLength = Len(.Text) - posSelect
                lstArt.ListIndex = i
                Exit For
            End If
        Next i

    End With
End Function

' ----------------------------------------------------------------------------------------------------------------------------------
' \\ - Leer txt, y cargar artístas en el listbox
' ----------------------------------------------------------------------------------------------------------------------------------
Private Sub mFillLstArts(sFileName As String)
    On Error GoTo error_handler
   
   
    Dim sValue As String
    lstArt.Clear
   
    If mcFind.CheckFileExists(sFileName) Then
        Dim f As Integer
        f = FreeFile
      
        Open sFileName For Input As #f
        ' leer lineas del archivo
        While Not EOF(f)
            Line Input #f, sValue
            lstArt.AddItem sValue
        Wend
        Close f
    End If
   
    Exit Sub
error_handler:
    MsgBox Err.Description
End Sub

' -----------------------------------------------------------------------------------------------------
' \\ - Eliminar archivos al presionar la tecla Delete
' -----------------------------------------------------------------------------------------------------


Private Sub lvDownloads_KeyDown(KeyCode As Integer, Shift As Integer)
    Select Case KeyCode
        Case vbKeyDelete: Call mnuCancelDownloads_Click(0)
    End Select
End Sub


' -----------------------------------------------------------------------------------------------------
' \\ - Eliminar archivos al presionar la tecla Delete, y reproducir al presionar enter
' -----------------------------------------------------------------------------------------------------

Private Sub lvFiles_KeyDown(KeyCode As Integer, Shift As Integer)
    Select Case KeyCode
        Case vbKeyDelete: Call mnuOptDown_Click(1)
        Case vbKeyReturn: Call lvFiles_DblClick
    End Select
End Sub

' -----------------------------------------------------------------------------------------------------
' \\ - Buscar al presionar la tecla enter,Abrir carpeta d e descargas
' -----------------------------------------------------------------------------------------------------

Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
    Select Case KeyCode
        Case vbKeyReturn: Call cmdSearch_Click
        Case vbKeyF2: Call tbMain_ButtonClick(tbMain.Buttons(6))
    End Select
End Sub



' -----------------------------------------------------------------------------------------------------
' \\ - eventos de controles para cambiar el backcolor cuando reciben y pierden el foco
' -----------------------------------------------------------------------------------------------------

Private Sub lstArt_GotFocus()
    lstArt.BackColor = mcStyles.BackColorControlFocus
End Sub

Private Sub lstArt_LostFocus()
    lstArt.BackColor = mcStyles.BackColorControls
End Sub

Private Sub txtSearch_GotFocus()
    With txtSearch
        .BackColor = mcStyles.BackColorControlFocus
        .SelStart = 0
        .SelLength = Len(.Text)
    End With
End Sub

Private Sub txtSearch_LostFocus()
    txtSearch.BackColor = mcStyles.BackColorTextBox
End Sub


Private Sub txtId3v1_GotFocus(Index As Integer)
    Call mChangeBackColorCtrl(mcStyles.BackColorControls, txtId3v1())
    txtId3v1(Index).BackColor = mcStyles.BackColorControlFocus
End Sub

Private Sub txtId3v1_LostFocus(Index As Integer)
    Call mChangeBackColorCtrl(mcStyles.BackColorControls, txtId3v1())
End Sub

Private Sub txtId3v2_GotFocus(Index As Integer)
    Call mChangeBackColorCtrl(mcStyles.BackColorControls, txtId3v2())
    txtId3v2(Index).BackColor = mcStyles.BackColorControlFocus
End Sub

Private Sub txtId3v2_LostFocus(Index As Integer)
    Call mChangeBackColorCtrl(mcStyles.BackColorControls, txtId3v2())
End Sub

Private Sub lvFind_GotFocus()
    If mcStyles.CurrentStyle > 0 Then lvFind.BackColor = mcStyles.BackColorControlFocus
End Sub

Private Sub lvFind_LostFocus()
    If mcStyles.CurrentStyle > 0 Then lvFind.BackColor = mcStyles.BackColorControls
End Sub

Private Sub mChangeBackColorCtrl(lcolor As Long, xArrCtrl As Variant)
    Dim xCtrl As Variant
    For Each xCtrl In xArrCtrl
        xCtrl.BackColor = lcolor
    Next
    cboGen(0).BackColor = lcolor
    cboGen(1).BackColor = lcolor
End Sub

Private Sub cboDirectory_Click()
    lblNumPage.Caption = "1"
End Sub

Private Sub cboGen_Click(Index As Integer)
    Me.TagsEdit = CBool(Len(mSelCurrentFileName))
End Sub

Private Sub cboGen_GotFocus(Index As Integer)
    Call mChangeBackColorCtrl(mcStyles.BackColorControls, txtId3v1())
    cboGen(Index).BackColor = mcStyles.BackColorControlFocus
End Sub

Private Sub cboGen_LostFocus(Index As Integer)
    Call mChangeBackColorCtrl(mcStyles.BackColorControls, txtId3v1())
End Sub
Private Sub cboGen_KeyPress(Index As Integer, KeyAscii As Integer)
    KeyAscii = 0
End Sub

Private Sub lstdirectory_Click()
    If Me.Visible Then
        lblNumPage.Caption = "1"
        Call cmdSearch_Click
    End If
End Sub

Private Sub lstDirectory_GotFocus()
    lstDirectory.BackColor = mcStyles.BackColorControlFocus
End Sub

Private Sub lstDirectory_LostFocus()
    lstDirectory.BackColor = mcStyles.BackColorControls
End Sub
Con la tecnología de Blogger.

Busqueda

Sabias que?

chat

Popular Posts