Menampilkan Daftar Harga Cryptocurrency dengan Visual Basic 6.0 (VB6)

Artikel kali ini Admin akan berbagi kode yang berfungsi untuk menampilkan daftar harga Cryptocurrency. Daftar harga cryptocurrency ini diambil dari sebuah halaman web yaitu CoinGecko.

Daftar harga ini saya akan tampilkan dalam bentuk ListView dengan dilengkapi beberapa fitur yaitu Darkmode, Expor Excel, pilihan mata uang dan jumlah Coin yang akan di tampilkan.

Daftar Harga Cryptocurremcy

Hasil Expor Excel

Berikut dibawah ini adalah langkah-langkah untuk menampilkan harga Cryptocurrency dengan vb6 :

1. Buka Form vb6 dengan Standar EXE

2. Aktifkan Microsoft XML, v6.0 dengan cara Project >> References >> Microsoft XML, v6.0 

3. Aktifkan Microsoft ListView Control 6.0 dengan cara Project >> Components >> Microsoft Windows Common Controls 6.0

4. Pada Form tanamkan 2 Label, 2 Combobox, 1 Frame, 2 Commandbutton, Timer dan 1 LisView dengan ketentuan sebagai berikut :

Label1            Caption: Jumlah Coin:          Name:lblLimit

Label2            Caption: Status                      Name:lblStatus

Combo1                                                        Name:cboLimit  

Combo2                                                        Name:cboCurrency

Commanbutton1    Caption: Expor Excel    Name:cmdExport 

Commanbutton2    Caption: Expor Excel    Name:cmdDark

ListView1                                                     Name:lvCrypto        View = 3 (Report), FullRowSelect = True

          Frame1                    Caption: Tools

           Timer                                                            Name:Timer1

5. Desainlah Form seperti gambar dibawah ini :

Desain form

6. Setelah mendesain Form seperti diatas, lalu copy-paste kode dibawah ini di bagian General-Declarations  :

' =========================

' GLOBAL

' =========================

Option Explicit

Dim lastPrices As Object

Dim isDarkMode As Boolean

Dim currentCurrency As String

Dim coinLimit As Long

' =========================

' FORM LOAD

' =========================

Private Sub Form_Load()

    Set lastPrices = CreateObject("Scripting.Dictionary")

    isDarkMode = False

    

    ' Jumlah coin

cboLimit.Clear

cboLimit.AddItem "10"

cboLimit.AddItem "25"

cboLimit.AddItem "50"

cboLimit.AddItem "100"

cboLimit.ListIndex = 3      ' default 100

coinLimit = CLng(cboLimit.text)

    ' Currency

    cboCurrency.Clear

    cboCurrency.AddItem "IDR"

    cboCurrency.AddItem "USD"

    cboCurrency.ListIndex = 0

    currentCurrency = "idr"

    With lvCrypto

        .View = lvwReport

        .FullRowSelect = True

        .GridLines = True

        .ColumnHeaders.Clear

        .ColumnHeaders.Add , , "Rank", 700

        .ColumnHeaders.Add , , "Nama", 2600

        .ColumnHeaders.Add , , "Harga", 1800

        .ColumnHeaders.Add , , "24h %", 900

        .ColumnHeaders.Add , , "Market Cap", 2400

    End With

    Timer1.Interval = 30000

    FetchCrypto

        

End Sub

' =========================

' TIMER

' =========================

Private Sub Timer1_Timer()

    FetchCrypto

End Sub

' =========================

' FETCH API

' =========================

Sub FetchCrypto()

    On Error GoTo ErrHandler

    Dim http As Object

    Set http = CreateObject("MSXML2.XMLHTTP")

    Dim url As String

   url = "https://api.coingecko.com/api/v3/coins/markets?vs_currency=" & _

      currentCurrency & _

      "&order=market_cap_desc&per_page=" & coinLimit & _

      "&page=1&sparkline=false"

    http.Open "GET", url, False

    http.send

    If http.Status = 200 Then

        ParseJSON http.responseText

        lblStatus.Caption = "Last update: " & Format(Now, "HH:mm:ss")

    End If

    Exit Sub

ErrHandler:

    lblStatus.Caption = "Gagal update data"

End Sub

' =========================

' PARSE JSON (URUTAN ASLI API)

' =========================

Sub ParseJSON(json As String)

    Dim items() As String

    items = Split(json, """id""")

    lvCrypto.ListItems.Clear

    Dim i As Long

    Dim rank As Long

    rank = 0

    For i = 1 To UBound(items)

        Dim block As String

        block = items(i)

        rank = rank + 1

        RenderItem _

            rank, _

            GetValue(block, "id"), _

            GetValue(block, "name"), _

            UCase(GetValue(block, "symbol")), _

            Val(GetValue(block, "current_price")), _

            Val(GetValue(block, "price_change_percentage_24h")), _

            Val(GetValue(block, "market_cap"))

    Next i

End Sub

' =========================

' RENDER ITEM (TANPA SORT)

' =========================

Sub RenderItem(rank As Long, coinId As String, name As String, symbol As String, _

               price As Double, change24h As Double, marketCap As Double)

    Dim itm As MSComctlLib.ListItem   ' ? INI YANG KURANG

    Set itm = lvCrypto.ListItems.Add(, , CStr(rank))

    itm.SubItems(1) = name & " (" & symbol & ")"

    itm.SubItems(4) = Format(marketCap, "#,##0")

    Dim symbolCurrency As String

    If currentCurrency = "idr" Then

        symbolCurrency = "Rp "

    Else

        symbolCurrency = "$ "

    End If

    If lastPrices.Exists(coinId) Then

        If price > lastPrices(coinId) Then

            itm.SubItems(2) = "+ " & symbolCurrency & Format(price, "#,##0.00")

            itm.ForeColor = vbGreen

        ElseIf price < lastPrices(coinId) Then

            itm.SubItems(2) = "- " & symbolCurrency & Format(price, "#,##0.00")

            itm.ForeColor = vbRed

        Else

            itm.SubItems(2) = symbolCurrency & Format(price, "#,##0.00")

        End If

    Else

        itm.SubItems(2) = symbolCurrency & Format(price, "#,##0.00")

    End If

    itm.SubItems(3) = Format(change24h, "0.00") & "%"

    lastPrices(coinId) = price

End Sub

' =========================

' DOUBLE CLICK ? COINGECKO

' =========================

Private Sub lvCrypto_DblClick()

    If lvCrypto.SelectedItem Is Nothing Then Exit Sub

    Dim coinName As String

    coinName = Split(lvCrypto.SelectedItem.SubItems(1), " (")(0)

    Dim url As String

    url = "https://www.coingecko.com/en/coins/" & Replace(LCase(coinName), " ", "-")

    Shell "cmd /c start " & url, vbHide

End Sub

' =========================

' EXPORT EXCEL

' =========================

Private Sub cmdExport_Click()

    Dim xl As Object

    Set xl = CreateObject("Excel.Application")

    xl.Workbooks.Add

    xl.Visible = True

    Dim i As Long

    ' HEADER

    xl.Cells(1, 1).Value = "Rank"

    xl.Cells(1, 2).Value = "Nama"

    xl.Cells(1, 3).Value = "Harga (IDR)"

    xl.Cells(1, 4).Value = "24h %"

    xl.Cells(1, 5).Value = "Market Cap"

    xl.Range("A1:E1").Font.Bold = True

    ' DATA

    For i = 1 To lvCrypto.ListItems.Count

        xl.Cells(i + 1, 1).Value = lvCrypto.ListItems(i).text              ' Rank

        xl.Cells(i + 1, 2).Value = lvCrypto.ListItems(i).SubItems(1)      ' Nama

        xl.Cells(i + 1, 3).Value = lvCrypto.ListItems(i).SubItems(2)      ' Harga

        xl.Cells(i + 1, 4).Value = lvCrypto.ListItems(i).SubItems(3)      ' 24h %

        xl.Cells(i + 1, 5).Value = lvCrypto.ListItems(i).SubItems(4)      ' Market Cap

    Next i

    xl.Columns("A:E").AutoFit

End Sub

' =========================

' DARK MODE

' =========================

Private Sub cmdDark_Click()

    isDarkMode = Not isDarkMode

    ApplyTheme

End Sub

' =========================

' THEME DARK MODE

' =========================

Sub ApplyTheme()

    If isDarkMode Then

        Me.BackColor = RGB(30, 30, 30)

        lvCrypto.BackColor = RGB(45, 45, 45)

        lvCrypto.ForeColor = vbWhite

        lblStatus.ForeColor = vbWhite

        Frame1.BackColor = RGB(45, 45, 45)

        Frame1.ForeColor = vbWhite

        lblLimit.ForeColor = vbWhite

               

    Else

        Me.BackColor = vbWhite

        lvCrypto.BackColor = vbWhite

        lvCrypto.ForeColor = vbBlack

        lblStatus.ForeColor = vbBlack

        Frame1.BackColor = vbWhite

        Frame1.ForeColor = vbBlack

        lblLimit.ForeColor = vbBlack

        

    End If

End Sub

' =========================

' JSON HELPER

' =========================

Function GetValue(text As String, key As String) As String

    On Error Resume Next

    Dim tmp As String

    tmp = Split(text, """" & key & """:")(1)

    tmp = Split(tmp, ",")(0)

    tmp = Replace(tmp, """", "")

    GetValue = tmp

End Function

' ================================

' PILIHAN MATA UANG

' ================================

Private Sub cboCurrency_Click()

    If cboCurrency.text = "IDR" Then

        currentCurrency = "idr"

    Else

        currentCurrency = "usd"

    End If

    lastPrices.removeAll

    FetchCrypto

End Sub

Private Sub cboLimit_Click()

    If cboLimit.text <> "" Then

        coinLimit = CLng(cboLimit.text)

        lastPrices.removeAll

        FetchCrypto

    End If

End Sub

Jalankan Project Anda, silahkan uiji coba fungsi masing-masing