Public Class Form1
    Private WithEvents tmrRefresh As New Timer With {.Enabled = True, .Interval = 1}
 
    Private Sub tmrRefresh_Tick(sender As Object, e As EventArgs) Handles tmrRefresh.Tick
        Dim gr As Graphics
        Dim bmp As Bitmap = My.Resources.white
        Dim br As New SolidBrush(Color.Black)
        Dim free As String = AutoScaleSize(My.Computer.Info.AvailablePhysicalMemory, 2, False)
        Dim x() As String
        Dim por As Integer
        Dim colBar As Color
 
        Text = free
        x = Split(free)
        free = x(0)
        x = Split(free, ",")
        If Len(x(0)) = 1 Then x(0) = $"0{x(0)}"
        If Len(x(1)) = 1 Then x(1) = $"0{x(1)}"
 
        gr = Graphics.FromImage(bmp)
        gr.DrawString($"{x(0)},", New Font("Arial", 12, FontStyle.Bold), br, New PointF(0, 0))
        gr.DrawString(x(1), New Font("Arial", 12, FontStyle.Bold), br, New PointF(0, 14))
 
        por = Porciento(My.Computer.Info.AvailablePhysicalMemory,
                        My.Computer.Info.TotalPhysicalMemory)
        Select Case por
            Case Is >= 75 : colBar = Color.Green
            Case Is >= 50 : colBar = Color.Yellow
            Case Is >= 25 : colBar = Color.Orange
            Case Is >= 0 : colBar = Color.Red
        End Select
        gr.DrawLine(New Pen(colBar, 5), 28, 2, 28, 30)
 
        Icon = ToIcon(bmp, 32, 32)
 
        bmp.Dispose()
        gr.Dispose()
        br.Dispose()
 
    End Sub
 
End Class
 
Module modExtras
 
    Public Function Porciento(Parte As ULong,
                              Total As ULong,
                              Optional Round As Boolean = False,
                              Optional Decimals As Integer = 0) As Double
        Porciento = 0
        Try
            Porciento = Parte * 100 / Total
            If Round Then Porciento = Math.Round(Porciento, Decimals)
        Catch ex As Exception
        End Try
    End Function
 
    Public Function ToIcon(Image As Image,
                           Width As Integer,
                           Height As Integer,
                           Optional MakeTransparent As Boolean = False,
                           Optional Transparent As Color = Nothing) As Icon
        ToIcon = Nothing
        'Try
        If IsNothing(Transparent) Then Transparent = Color.White
        Dim thumb As Bitmap = CType(Image.GetThumbnailImage(Width, Height, Nothing, IntPtr.Zero), Bitmap)
        If MakeTransparent Then thumb.MakeTransparent(Transparent)
        ToIcon = Icon.FromHandle(thumb.GetHicon())
        thumb.Dispose()
        Image.Dispose()
        'Catch ex As Exception
        'End Try
    End Function
 
    Public Function AutoScaleSize(Bytes As Decimal,
                                  Optional Decimals As Integer = 2,
                                  Optional FullName As Boolean = False,
                                  Optional BaseMil As Boolean = False) As String
        AutoScaleSize = ""
        Try
            Dim C As Integer
            Dim b As Decimal = Bytes
            Dim Div As Integer
 
            If BaseMil Then Div = 1000 Else Div = 1024
            Do While b >= Div
                b /= Div
                C += 1
            Loop
            b = Math.Round(b, Decimals)
            Select Case C
                Case 0 : If FullName Then Return b & " Bytes" Else Return b & " B"
                Case 1 : If FullName Then Return b & " KiloBytes" Else Return b & " KB"
                Case 2 : If FullName Then Return b & " MegaBytes" Else Return b & " MB"
                Case 3 : If FullName Then Return b & " GigaBytes" Else Return b & " GB"
                Case 4 : If FullName Then Return b & " TeraBytes" Else Return b & " TB"
                Case 5 : If FullName Then Return b & " PetaBytes" Else Return b & " PB"
                Case 6 : If FullName Then Return b & " ExaBytes" Else Return b & " EB"
                Case 7 : If FullName Then Return b & " ZettaBytes" Else Return b & " ZB"
                Case 8 : If FullName Then Return b & " YottaBytes" Else Return b & " YB"
                Case Else : If FullName Then Return Bytes & " Bytes" Else Return Bytes & " B"
            End Select
        Catch ex As Exception
        End Try
    End Function
 
End Module