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 (263 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 (369 descargas )