Autor Tema: Mostrar Los Top 10 Con Objeto Label(0) (Leído 1999 veces)

Bluebird · « **en:** Lunes 21 de Noviembre de 2005, 21:49 »

Holas....

Estoy intentando que a partir de una consulta de una base de datos access pueda mostrar en una pantallita la lista de los 10 temas mas escuchados...creo que no la estoy pegando en la matriz label(0).

El código es el que sigue:

Código: Text

 
Option Explicit
Option Base 1
Dim Tapa As Integer
Dim creditos As Integer
Dim Pasa_Pago As Boolean
 
' Carga las tapas de los albunes
 
Private Sub Adodc1_MoveComplete(ByVal adReason As ADODB.EventReasonEnum, ByVal pError As ADODB.Error, adStatus As ADODB.EventStatusEnum, ByVal pRecordset As ADODB.Recordset)
On Error GoTo err
    cargaTemas Adodc1.Recordset!nalbum
    If Dir(&#34;c:&#092;mp3&#092;imagenes&#092;&#34; & Adodc1.Recordset!nalbum & &#34;.jpg&#34;) &#60;&#62; &#34;&#34; Then
        PicTapa.Picture = LoadPicture(&#34;c:&#092;mp3&#092;imagenes&#092;&#34; & Adodc1.Recordset!nalbum & &#34;.jpg&#34;)
    Else
        PicTapa.Picture = LoadPicture(&#34;c:&#092;mp3&#092;imagenes&#092;noimage.jpg&#34;)
        
    End If
err:
End Sub
 
Private Sub cmdAdelante_Click()
If Adodc1.Recordset.Bookmark &#60;&#62; Adodc1.Recordset.RecordCount Then
    Adodc1.Recordset.MoveNext
    
End If
End Sub
 
Private Sub cmdAtras_Click()
If Adodc1.Recordset.Bookmark &#62; 1 Then
    Adodc1.Recordset.MovePrevious
    
End If
End Sub
 
Private Sub cmdCreditos_Click()
End Sub
 
Private Sub Form_KeyPress(keyascii As Integer)
Dim nT As Integer
Dim R As Integer
Select Case keyascii
   Case Asc(&#34;0&#34;)
    
    If List3.ListCount &#62; 0 Then
        Pasa_Pago = True
        Mp1.Stop
        Mp1.Open &#34;c:&#092;mp3&#092;&#34; & List3.ItemData(0) & &#34;.mp3&#34;
        Mp1.Volume = -10
        Graba_tema List3.ItemData(0)
        List3.RemoveItem (0)
    Else
        Pasa_Pago = False
        RandTema
    End If
 
    Case Asc(&#34;6&#34;)
        cmdAdelante_Click
    Case Asc(&#34;4&#34;)
        cmdAtras_Click
    Case Asc(&#34;2&#34;)
        If List1.ListCount - 1 &#60;&#62; List1.ListIndex Then
            List1.ListIndex = List1.ListIndex + 1
        End If
    Case Asc(&#34;8&#34;)
        If List1.ListIndex &#62; 0 Then
            List1.ListIndex = List1.ListIndex - 1
        End If
    Case Asc(&#34;5&#34;)
    [COLOR=red]        If creditos = 0 Then
            frametop10.Visible = True
cargaadodc Adodc1, &#34;SELECT TOP 10 Tema, Autor, NúmeroDeDuplicados FROM Reproducidos ORDER BY NúmeroDeDuplicados DESC;&#34;
                For R = 0 To 9
                        Label10(R).DataField = “”
                        Label11(R).DataField = “”
                Next R
            End If[/COLOR]
        
        If List1.ListIndex &#60;&#62; -1 Then
            If creditos &#62; 0 Then
                List2.AddItem Label3(0).Caption & &#34; - &#34; & List1.Text
                List2.ItemData(List2.NewIndex) = List1.ItemData(List1.ListIndex)
                creditos = creditos - 1
                Label1.Caption = creditos
            End If
                If List2.ListCount &#62; 0 Then
                    ''''frmMP3Play.Show ''1
                    For nT = 0 To List2.ListCount - 1
                        List3.AddItem List2.List(nT)
                        List3.ItemData(List3.NewIndex) = List2.ItemData(nT)
                    Next
                        List2.Clear
                        Pasa_Tema
                End If
        End If
           
     Case Asc(&#34;9&#34;) '''moneda
            frametop10.Visible = False
            creditos = creditos + TemXcre
            Label1.Caption = creditos
    Case Asc(&#34;7&#34;)
        If InputBox(&#34;Cierra&#34;) = &#34;77&#34; Then ShutdownSystem EWX_POWEROFF
  
    Case vbKeyEscape
        End
End Select
End Sub
 
Private Sub Form_Load()
frametop10.Visible = False
Pasa_Pago = False
cargaadodc Adodc1, &#34;SELECT Albumes.ID_Album as nalbum, Albumes.Album, Albumes.id_autor, Albumes.Genero, Autores.Autor FROM Autores INNER JOIN Albumes ON Autores.ID_Autor = Albumes.id_autor ORDER BY Genero,Autores.Autor;&#34;
   'Load Form2
    WndShow1.WindowHandle = frmSeleccionTemas.hWnd
    WndShow1.Show
creditos = 0
Label1.Caption = creditos
Label7.Caption = IIf(TemXcre = 1, &#34;1 Moneda = 1 Tema/s&#34;, &#34;1 Moneda = &#34; & TemXcre & &#34; Temas/s&#34;)
Mp2.FileName = App.Path & &#34;&#092;vidfon.wmv&#34;
Me.Width = Screen.Width
Me.Height = Screen.Height
End Sub
 
Private Sub Mp1_EndOfStream(ByVal Result As Long)
pasa_siguiente
End Sub
 
' Carga temas Albunes
 
Private Function cargaTemas(ndisco)
Dim Reco As ADODB.Recordset
Dim nv
Set Reco = New ADODB.Recordset
Reco.Open &#34;select * from temas where id_album = &#34; & ndisco & &#34; order by id_tema&#34;, Constri, adOpenStatic, adLockReadOnly
nv = 1
If Reco.RecordCount &#60;&#62; 0 Then
List1.Clear
    Do While Not Reco.EOF
        List1.AddItem Format&#036;(nv, &#34;00&#34;) & &#34; - &#34; & Reco!Tema
        List1.ItemData(List1.NewIndex) = Reco!Id_Tema
        nv = nv + 1
    Reco.MoveNext
    Loop
End If
Reco.Close
End Function
 
Private Sub Pasa_Tema()
 
If Pasa_Pago = False Then
    If List3.ListCount &#62; 0 Then
       ' Mp3.Command = &#34;Stop&#34;
        Pasa_Pago = True
        Mp1.Stop
        Mp1.Open &#34;c:&#092;mp3&#092;&#34; & List3.ItemData(0) & &#34;.mp3&#34;
        Mp1.Volume = -50
        Graba_tema List3.ItemData(0)
        List3.RemoveItem (0)
    Else
        Pasa_Pago = False
        RandTema
    End If
End If
 
End Sub
Private Sub pasa_siguiente()
Label8(0).Caption = &#34;&#34;
Label8(1).Caption = &#34;&#34;
 
       If List3.ListCount &#62; 0 Then
        Pasa_Pago = True
        Mp1.Stop
        Mp1.Open &#34;c:&#092;mp3&#092;&#34; & List3.ItemData(0) & &#34;.mp3&#34;
        Mp1.Volume = -10
        Graba_tema List3.ItemData(0)
        List3.RemoveItem (0)
    Else
        Pasa_Pago = False
        RandTema
    End If
 
End Sub
Private Sub RandTema()
Dim rec1 As ADODB.Recordset
Dim Ntemas As Integer
Dim nroTem As Integer
Dim rn
Label8(0).Caption = &#34;&#34;
Label8(1).Caption = &#34;&#34;
'Label8(2).Caption = &#34;&#34;
 
Pasa_Pago = False
Set rec1 = New ADODB.Recordset
rec1.Open &#34;select * from temas&#34;, Constri, adOpenStatic, adLockReadOnly
Ntemas = rec1.RecordCount
Randomize
rn = Int((Ntemas * Rnd))   ' Genera valores aleatorios entre 1 y 6.
'rn = Int(Ntemas / 60 * Second(Time))
rec1.MoveFirst
rec1.Move rn
nroTem = rec1(0)
rec1.Close
Set rec1 = Nothing
Mp1.Stop
TMRTema.Enabled = True
Mp1.Volume = -2700
Mp1.Open &#34;c:&#092;mp3&#092;&#34; & nroTem & &#34;.mp3&#34;
 
End Sub
 
Private Sub tmrPasa_Timer()
tmrPasa.Enabled = False
pasa_siguiente
End Sub
 
Private Function Graba_tema(nTem As Integer)
Dim con As ADODB.Connection
Dim rec1 As ADODB.Recordset
Set con = New ADODB.Connection
Set rec1 = New ADODB.Recordset
rec1.Open &#34;SELECT Temas.Tema, Autores.Autor FROM Autores INNER JOIN (Albumes INNER JOIN Temas ON Albumes.ID_Album = Temas.Id_album) ON Autores.ID_Autor = Albumes.id_autor WHERE (((Temas.Id_Tema)=&#34; & nTem & &#34;));&#34;, Constri, adOpenStatic, adLockReadOnly
    If rec1.RecordCount &#60;&#62; 0 Then
        Label8(0).Caption = rec1(0)
        Label8(0).Refresh
        Label8(1).Caption = rec1(1)
        Label8(1).Refresh
                
    End If
 
rec1.Close
con.Open Constri
con.Execute &#34;insert into reproducciones (id_tema) values (&#34; & nTem & &#34;)&#34;
con.Close
Set con = Nothing
End Function
 
Private Sub TMRTema_Timer()
Label4.Caption = Mp1.CurrentPosition
If Pasa_Pago = False Then
    If Mp1.CurrentPosition &#62; 40 Then
        Mp1.Stop
        pasa_siguiente
      '  TMRTema.Enabled = False
    End If
End If
End Sub
 
 
 

En el sector marcado en rojo es donde quiero que se ejecute...
Gracias y saludos

solcito

Mira no leí tu código porq la verdad no tengo ganas

Pero si quieres mostrar registros de una base lo mejor en una datagrid o msflexgrid u ListBox, cualquier cosa menos labels :S

Saludos

Bluebird

Solcito:

Si no quieres ver el código completo fijate solo en la sección "Case "5""...¿me recomiendas mejor esos otros métodos ?...

Gracias

SoloCodigo

Autor Tema: Mostrar Los Top 10 Con Objeto Label(0) (Leído 1999 veces)

Bluebird

Mostrar Los Top 10 Con Objeto Label(0)

solcito

Re: Mostrar Los Top 10 Con Objeto Label(0)

Bluebird

Re: Mostrar Los Top 10 Con Objeto Label(0)