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:
Modulos JSON (637 descargas )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 (755 descargas )
Total Page Visits: 10471 - Today Page Visits: 4