Gráfico Estadístico Covid19 en Visual Basic 6 con Api Res

Este proyecto tiene como fin hacer un Gráfico Estadístico Covid19 en Visual Basic 6 con Api Res.

Los datos son obtenido de una APi que esta en linea. https://covid19.mathdro.id/api/

EL primer paso es agregar un componente y 3 referencias que son las siguientes:

Componente:

Microsoft Office XP Web Components

Referencias:

Microsoft WinHTTP Services, Version 5.1
Microsoft Scripting Runtime
Microsoft Internet Controls

Luego de esto agregamos al proyecto Un Modulo de clase y 2 Modulos que se encargar de tratar los datos tipo JSON les dejo el enlace de descarga:

Después de tener los modulos importados el siguiente paso es traer el listado de países se van a importar desde la API

Sub ObenerPaises()
    Dim p             As Object
    Dim Texto         As String
    Dim sInputJson    As String
    Dim cab           As Integer
    
     Set httpURL = New WinHttp.WinHttpRequest
     
    'lista de paises
    cadena = "https://covid19.mathdro.id/api/countries"
    httpURL.Open "GET", cadena
    httpURL.Send
    Texto = httpURL.ResponseText
    If Texto = "[]" Then
       MsgBox ("No se obtuvo resultados")
       Exit Sub
    End If
    
    sInputJson = "{items:" & Texto & "}"
    
    Set p = JSON.parse(Texto)
    
    
    NumPaises = p.Item("countries").Count
    ReDim Lista_ISO_Paises(NumPaises)
    cmbPaises.AddItem "Datos Globales"
    index = 1
    For Num = 1 To NumPaises
        nombre_pais = p.Item("countries").Item(Num).Item("name")
        ISO3 = p.Item("countries").Item(Num).Item("iso3")
        cmbPaises.AddItem nombre_pais
        Lista_ISO_Paises(index) = ISO3
        index = index + 1
   Next Num
   
   cmbPaises.ListIndex = 0
End Sub

Luego al combobox de Paises en el evento click va el siguiente codigo:

Private Sub cmbPaises_Click()
    Dim ISO3 As String
    
    index = cmbPaises.ListIndex
    If index > 0 Then
        ISO3 = Lista_ISO_Paises(index)
    Else
        ISO3 = ""
    End If
    
    Call DatosGlobales(ISO3)
    
End Sub

En el codigo anterior vemos una variable tipo array llamada  Lista_ISO_Paises que va declarada a nivel de formulario:

Dim Lista_ISO_Paises() As String

Y el procedimiento DatosGlobales que tiene 2 funciones:  si no se le pasan parametros trae los datos globales de CODIV-19 pero si pasamos el ISO3 de un país solo mostrara la información de ese país.

Sub DatosGlobales(Optional ISO3 As String = "")
    Dim p             As Object
    Dim Texto         As String
    Dim sInputJson    As String
    Dim cab           As Integer
    
    Set httpURL = New WinHttp.WinHttpRequest
    
    If ISO3 = "" Then
       cadena = "https://covid19.mathdro.id/api"
    Else
       cadena = "https://covid19.mathdro.id/api/countries/" & ISO3
    End If
    
    httpURL.Open "GET", cadena
    httpURL.Send
    Texto = httpURL.ResponseText
    If Texto = "[]" Then
       MsgBox ("No se obtuvo resultados")
       Exit Sub
    End If
    
    sInputJson = "{items:" & Texto & "}"
    
    Set p = JSON.parse(Texto)
    
    ffecha = Mid(p.Item("lastUpdate"), 1, 10)
    ffecha = Replace(ffecha, "-", "/")
    
    Fecha = Format(CDate(ffecha), "dd/mm/yyyy")
    
    lblFecha1.Caption = Fecha
    lblFecha2.Caption = Fecha
    lblFecha3.Caption = Fecha
    
    confirmados = p.Item("confirmed").Item("value")
    lblConfirmados.Caption = FormatNumber(confirmados)
    
    Recuperados = p.Item("recovered").Item("value")
    lblRecuperados.Caption = FormatNumber(Recuperados)
    
    Fallecidos = p.Item("deaths").Item("value")
    lblFallecidos.Caption = FormatNumber(Fallecidos)
    
    If ISO3 = "" Then
        Call GraficoGlobal
    Else
        Call GraficoPais(confirmados, Fallecidos, Recuperados)
    End If
End Sub

Por ultimo nos queda el gráfico uso 2 procedimiento uno para el gráfico global y el otro para el gráfico por pais.

Sub GraficoPais(Infectados, Fallecidos, Recuperados)

    Dim Columnas(3)
    Dim Valores(3)
    
    Columnas(1) = "Infectados"
    Columnas(2) = "Fallecidos"
    Columnas(3) = "Recuperados"
    
    Valores(1) = Infectados
    Valores(2) = Fallecidos
    Valores(3) = Recuperados
    
    numitem = ChartSpace1.Charts(0).SeriesCollection.Count - 1
    If numitem > 0 Then
        
        For i = 0 To numitem
            ChartSpace1.Charts(0).SeriesCollection.Delete (0)
        Next i
    End If
    
    
    Set chConstants = ChartSpace1.Constants
        
    ChartSpace1.Charts(0).SeriesCollection.Add

    ChartSpace1.Charts(0).SeriesCollection(0).Caption = "Infectados"
    ChartSpace1.Charts(0).SeriesCollection(0).SetData chConstants.chDimCategories, chConstants.chDataLiteral, Columnas(1)
    ChartSpace1.Charts(0).SeriesCollection(0).SetData chConstants.chDimValues, chConstants.chDataLiteral, Valores(1)
    
    ChartSpace1.Charts(0).SeriesCollection.Add

    ChartSpace1.Charts(0).SeriesCollection(1).Caption = "Fallecidos"
    ChartSpace1.Charts(0).SeriesCollection(1).SetData chConstants.chDimCategories, chConstants.chDataLiteral, Columnas(2)
    ChartSpace1.Charts(0).SeriesCollection(1).SetData chConstants.chDimValues, chConstants.chDataLiteral, Valores(2)
    
    ChartSpace1.Charts(0).SeriesCollection.Add

    ChartSpace1.Charts(0).SeriesCollection(2).Caption = "Recuperados"
    ChartSpace1.Charts(0).SeriesCollection(2).SetData chConstants.chDimCategories, chConstants.chDataLiteral, Columnas(3)
    ChartSpace1.Charts(0).SeriesCollection(2).SetData chConstants.chDimValues, chConstants.chDataLiteral, Valores(3)
 
    
End Sub

Sub GraficoGlobal()
    Dim Lista_Fechas()
    Dim v_Confirmados()
    Dim v_Fallecidos()
    Dim v_Recuperados()
    Dim NumFechas, Num As Integer
    
    
    Dim p             As Object
    Dim Texto         As String
    Dim sInputJson    As String
    Dim cab           As Integer
    
    Set httpURL = New WinHttp.WinHttpRequest
    
    cadena = "https://covid19.mathdro.id/api/daily/"
    
    httpURL.Open "GET", cadena
    httpURL.Send
    Texto = httpURL.ResponseText
    If Texto = "[]" Then
       MsgBox ("No se obtuvo resultados")
       Exit Sub
    End If
    
    sInputJson = "{items:" & Texto & "}"
    
    Set p = JSON.parse(Texto)
    
    NumFechas = p.Count
    
    ReDim Lista_Fechas(NumFechas)
    ReDim v_Confirmados(NumFechas)
    ReDim v_Fallecidos(NumFechas)
    ReDim v_Recuperados(NumFechas)
    
    For Num = 1 To NumFechas
        Lista_Fechas(Num) = p.Item(Num).Item("reportDate")
        v_Confirmados(Num) = p.Item(Num).Item("confirmed").Item("total")
        v_Fallecidos(Num) = p.Item(Num).Item("deaths").Item("total")
        v_Recuperados(Num) = p.Item(Num).Item("recovered").Item("total")
        
    Next Num
    
    numitem = ChartSpace1.Charts(0).SeriesCollection.Count - 1
    If numitem > 0 Then
        For i = 0 To numitem
            ChartSpace1.Charts(0).SeriesCollection.Delete (0)
        Next i
    End If
    
    Set chConstants = ChartSpace1.Constants
    
    ChartSpace1.Charts(0).SeriesCollection.Add

    ChartSpace1.Charts(0).SeriesCollection(0).Caption = "Infectados"
    ChartSpace1.Charts(0).SeriesCollection(0).SetData chConstants.chDimCategories, chConstants.chDataLiteral, Lista_Fechas
    ChartSpace1.Charts(0).SeriesCollection(0).SetData chConstants.chDimValues, chConstants.chDataLiteral, v_Confirmados
    
    ChartSpace1.Charts(0).SeriesCollection.Add

    ChartSpace1.Charts(0).SeriesCollection(1).Caption = "Fallecidos"
    ChartSpace1.Charts(0).SeriesCollection(1).SetData chConstants.chDimCategories, chConstants.chDataLiteral, Lista_Fechas
    ChartSpace1.Charts(0).SeriesCollection(1).SetData chConstants.chDimValues, chConstants.chDataLiteral, v_Fallecidos
    
    
    
End Sub

Solo queda el evento load del formulario:

Private Sub Form_Load()
    Call ObenerPaises
    Call GraficoGlobal
End Sub

Descargar Código Proyecto Gráfico Covid-19 (378 descargas )