VB.NET Draw a graph using current upload/download speed.
Hi there, I made an application that is monitoring bandwidth. It has some custom features but it doesn't really matter because I just need it to show a graphical history of what download/upload speed was.
Example: Using current download/upload speed, I need to draw in a picturebox RED/GREEN lines.
Let's say 50kbps DL and 30KBPS UL and it should draw a green line that is bigger than red one.
Also, it should auto scroll forward and would be nice if user could rewind it back to check but it's not that important.
Thanks.
PS. I already have part where application is getting current download/upload speed, so I just need to draw a graph using those values.
On the left side it should show the values in kbps to indicate how much is that line,
Let's say if application is drawing a green line of 50kbps and red line 30kbps it should show on the left that it is 50 and 30 like a scale otherwise you never know what is the value of that line.
Example: Using current download/upload speed, I need to draw in a picturebox RED/GREEN lines.
Let's say 50kbps DL and 30KBPS UL and it should draw a green line that is bigger than red one.
Also, it should auto scroll forward and would be nice if user could rewind it back to check but it's not that important.
Thanks.
PS. I already have part where application is getting current download/upload speed, so I just need to draw a graph using those values.
On the left side it should show the values in kbps to indicate how much is that line,
Let's say if application is drawing a green line of 50kbps and red line 30kbps it should show on the left that it is 50 and 30 like a scale otherwise you never know what is the value of that line.
Which platform are you using? Winforms? WPF?
By the way, a progressbar will fit your needs.
Play with this little example...it may give you some ideas:
*The form as a Picturebox of size 300x150 on it.
*The form as a Picturebox of size 300x150 on it.
Public Class Form1
Private GridSize As Integer = 25
Private CurrentValue As Integer
Private R As New Random
Private WithEvents tmrScroll As New Timer
Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
CurrentValue = R.Next(0, PictureBox1.Height)
Dim bmp As New Bitmap(PictureBox1.ClientRectangle.Width, PictureBox1.ClientRectangle.Height)
Using G As Graphics = Graphics.FromImage(bmp)
G.Clear(Color.Black)
End Using
PictureBox1.Image = bmp
tmrScroll.Interval = 100
tmrScroll.Start()
End Sub
Private Sub tmrScroll_Tick(ByVal sender As Object, ByVal e As System.EventArgs) Handles tmrScroll.Tick
CurrentValue = CurrentValue + IIf(R.Next(0, 2) = 0, -1, 1)
If CurrentValue < 0 Then
CurrentValue = 0
End If
If CurrentValue > PictureBox1.Height Then
CurrentValue = PictureBox1.Height
End If
Static xCounter As Integer = 0
xCounter = xCounter + 1
Dim bmp As New Bitmap(PictureBox1.ClientRectangle.Width, PictureBox1.ClientRectangle.Height)
Using G As Graphics = Graphics.FromImage(bmp)
G.Clear(Color.Black)
For y As Integer = 0 To bmp.Height Step GridSize
G.DrawLine(Pens.Green, bmp.Width - 1, y, bmp.Width, y)
Next
G.DrawImage(PictureBox1.Image, -1, 0) ' <-- draw everything in the PictureBox ONE pixel to the Left of where it is now
If xCounter = 25 Then
xCounter = 0
G.DrawLine(Pens.Green, bmp.Width - 1, 0, bmp.Width - 1, bmp.Height)
End If
G.DrawRectangle(Pens.LightGreen, New Rectangle(bmp.Width - 1, CurrentValue, 1, 1)) ' <-- draw the new "current" value at the right edge of the bitmap
End Using
PictureBox1.Image = bmp
End Sub
End Class
ASKER
It is a windows forms application. Thanks Idle_Mind - I will check that out now.
ASKER
Right, so the speed is like from 0 to xxxxx kbps like download speed can be 4031 and upload speed 10 then I need to draw 2 lines 1 green 1 red. Also as I mentioned before I need something on the left side of the graph that indicates how much that line actually is...
GraphExample.jpg
GraphExample.jpg
ASKER
Sorry last image was missing something here's a new one.
GraphExample.jpg
GraphExample.jpg
ASKER
I tried to use current download speed as a CurrentValue
log.txt
Dim adapter As NetworkAdapter = Me.adapters(Me.ListAdapters.SelectedIndex)
CurrentValue = [String].Format("{0:n}", adapter.DownloadSpeedKbps)
G.DrawRectangle(Pens.LightGreen, New Rectangle(bmp.Width - 1, CurrentValue, 1, 1)) ' <-- draw the new "current" value at the right edge of the bitmap
Dim sw As New StreamWriter("log.txt", True)
sw.WriteLine(CurrentValue)
sw.Close()
sw.Dispose()
log.txt
ASKER
Am I asking too much, or just no-one knows how to do it? Because I saw so many applications that are doing that kind of graph drawing..
ASKER
The code below is from Freemeter, it is monitoring bandwidth but a bit different way. The point is there is a graph that is perfectly drawing upload and download lines. I can't figure out what to use from this code but You guys are more professional so I hope you do.
Thanks for reading.
Thanks for reading.
Imports System.Reflection
Imports System.Threading
Imports System.Runtime.InteropServices
Imports System.IO
Imports System.ComponentModel
Imports System.Text
Imports System.Drawing.Imaging
Imports Microsoft.Win32
Imports System.Net
Imports System.Globalization
Imports System.Xml
Imports System.Security.Cryptography
Imports System.Net.Sockets
Imports System.Net.NetworkInformation
'
Public Class Form1
Public ClipData As String = ""
Public MailServers As New ArrayList()
Public Shared m_notifyicon As New NotifyIcon()
Public MailTimer As New System.Windows.Forms.Timer()
#Region ""
Public will_reboot As Boolean = False
#End Region
Private ClipTimer As New System.Windows.Forms.Timer()
Private myAssembly As Assembly = Assembly.GetExecutingAssembly()
Private monitor As New NetworkMonitor()
Private backgroundWorker1 As Thread
Private timerInterval As Integer = 1000
Private WLength As Integer, WHeight As Integer, scale As Integer
Private m_closing As Boolean = False
Private display_xscale As String, display_yscale As String
Private downlines As Integer() = New Integer(15) {}
Private uplines As Integer() = New Integer(15) {}
Private full_downlines As Integer(), full_uplines As Integer()
Private full_downspeeds As Double(), full_upspeeds As Double()
Public downspeed As Double = 0.0R
'modified to from private -> public by miechu
Public upspeed As Double = 0.0R
'modified to from private -> public by miechu
Private respond_to_latest As Boolean = False
Private label1 As New Label()
Private label2 As New Label()
Private label3 As New Label()
Private label4 As New Label()
Private pictureBox1 As New PictureBox()
Private resizer As New PictureBox()
Private m_menu As New ContextMenu()
Private trackBar1 As New TrackBar()
Private trackBar2 As New TrackBar()
Private colorDialog1 As New ColorDialog()
Private DOWNLOAD_COLOR As Color = Color.FromArgb(255, 0, 255, 0)
Private UPLOAD_COLOR As Color = Color.FromArgb(255, 255, 0, 0)
Private OVERLAP_COLOR As Color = Color.FromArgb(255, 255, 255, 0)
Private FORGROUND_COLOR As Color = Color.White
Private BACKGROUND_COLOR As Color
Private HIGHLIGHT_COLOR As Color
Private SHADOW_COLOR As Color
Private downloadPen As New Pen(Color.FromArgb(255, 0, 255, 0), 1)
Private uploadPen As New Pen(Color.FromArgb(255, 255, 0, 0), 1)
Private overlapPen As New Pen(Color.FromArgb(255, 255, 255, 0), 1)
'Cool icon representation
Private icon_representation As Boolean = False
Private icons_loaded As Boolean = False
Private upload_icon_green As Image
Private upload_icon_red As Image
Private download_icon_green As Image
Private download_icon_red As Image
'##TotalsLog##
Private logs_form As Totals_Log
Public LogTimer As New System.Windows.Forms.Timer()
Public LogEnabled As Boolean
Public LogInterval As Integer
'for counting time in ms
<DllImport("Kernel32.dll", EntryPoint:="QueryPerformanceCounter")> _
Private Shared Function QueryPerformanceCounter(ByRef lpPerformanceCount As Long) As Boolean
End Function
<DllImport("Kernel32.dll", EntryPoint:="QueryPerformanceFrequency")> _
Private Shared Function QueryPerformanceFrequency(ByRef lpFrequency As Long) As Boolean
End Function
'For destroying the leaky GDI Object handles
<DllImport("user32.dll", EntryPoint:="DestroyIcon")> _
Private Shared Function DestroyIcon(ByVal oIcon As IntPtr) As Boolean
End Function
<DllImport("gdi32.dll", EntryPoint:="DeleteObject")> _
Private Shared Function DeleteObject(ByVal oBm As IntPtr) As Boolean
End Function
Public Sub New()
InitializeComponent()
If monitor.Adapters.Length = 0 Then
MessageBox.Show("I can't find any network adapters on this computer.", "FreeMeter Failed.")
Return
End If
logs_form = New Totals_Log()
AddHandler MailTimer.Tick, AddressOf MailTimer_Tick
ClipTimer.Interval = 1000
AddHandler ClipTimer.Tick, AddressOf ClipTimer_Tick
Visible = False
StartPosition = FormStartPosition.Manual
Name = "Form1"
FormBorderStyle = FormBorderStyle.None
MaximizeBox = False
MinimizeBox = False
ControlBox = False
ShowInTaskbar = False
BackColor = BACKGROUND_COLOR
ForeColor = FORGROUND_COLOR
HIGHLIGHT_COLOR = HSL_to_RGB(BACKGROUND_COLOR.GetHue(), BACKGROUND_COLOR.GetSaturation(), BACKGROUND_COLOR.GetBrightness() + 0.3)
SHADOW_COLOR = HSL_to_RGB(BACKGROUND_COLOR.GetHue(), BACKGROUND_COLOR.GetSaturation(), BACKGROUND_COLOR.GetBrightness() - 0.1)
AutoScaleMode = AutoScaleMode.None
MinimumSize = New Size(66, 45)
MaximumSize = New Size(606, 455)
AddHandler Resize, AddressOf Form1_Resize
DoubleBuffered = True
MakeMenus()
RestoreRegistry()
Try
SetDefaults()
LoadConfiguration()
Catch
End Try
Check_Menus()
Form1_Borders()
'control for resizing
resizer.Location = New Point(ClientSize.Width - 13, ClientSize.Height - 13)
resizer.Size = New Size(11, 11)
resizer.Name = "resizer"
Make_Grabhandle()
Controls.Add(Me.resizer)
AddHandler resizer.MouseMove, AddressOf Resize_MouseMove
AddHandler resizer.MouseDown, AddressOf Resize_MouseDown
AddHandler resizer.MouseUp, AddressOf Resize_MouseUp
resizer.Cursor = Cursors.SizeNWSE
'SysTray Icon which is animated to show smaller graph
m_notifyicon.ContextMenu = m_menu
'Dim s As Stream = myAssembly.GetManifestResourceStream("FreeMeter.ico")
'Icon = New Icon(s)
'm_notifyicon.Icon = Me.Icon
's.Close()
m_notifyicon.Visible = True
AddHandler m_notifyicon.MouseDown, AddressOf Icon_MouseDown
'full graph
pictureBox1.Location = New Point(3, 3)
pictureBox1.Size = New Size(ClientSize.Width - 6, ClientSize.Height - 18)
pictureBox1.Name = "FullMeter"
pictureBox1.BackColor = Color.Black
Controls.Add(Me.pictureBox1)
pictureBox1.ContextMenu = m_menu
AddHandler pictureBox1.MouseDown, AddressOf Main_MouseDown
AddHandler pictureBox1.MouseMove, AddressOf Form1_MouseMove
'download text display
label1.Location = New Point(10, WHeight - 14)
label1.Size = New Size(WLength / 2 - 10 - 5, 13)
label1.BackColor = BACKGROUND_COLOR
label1.ForeColor = FORGROUND_COLOR
label1.Font = New Font("MS Serif", 7)
label1.TextAlign = ContentAlignment.TopLeft
Controls.Add(Me.label1)
label1.ContextMenu = m_menu
AddHandler label1.MouseDown, AddressOf Main_MouseDown
'upload text display
label2.Location = New Point(WLength / 2 + 9 - 5, WHeight - 14)
label2.Size = New Size(WLength / 2 - 9 - 13 + 5, 13)
label2.BackColor = BACKGROUND_COLOR
label2.ForeColor = FORGROUND_COLOR
label2.Font = New Font("MS Serif", 7)
label2.TextAlign = ContentAlignment.TopLeft
Controls.Add(Me.label2)
label2.ContextMenu = m_menu
AddHandler label2.MouseDown, AddressOf Main_MouseDown
'down arrow
label3.Location = New Point(1, WHeight - 14)
label3.Size = New Size(9, 13)
label3.BackColor = BACKGROUND_COLOR
label3.ForeColor = DOWNLOAD_COLOR
label3.Font = New Font("Wingdings", 7)
label3.TextAlign = ContentAlignment.BottomLeft
label3.Text = "ê"
Controls.Add(Me.label3)
label3.ContextMenu = m_menu
AddHandler label3.MouseDown, AddressOf Main_MouseDown
'up arrow
label4.Location = New Point(WLength / 2 - 5, WHeight - 14)
label4.Size = New Size(9, 13)
label4.BackColor = BACKGROUND_COLOR
label4.ForeColor = UPLOAD_COLOR
label4.Font = New Font("Wingdings", 7)
label4.TextAlign = ContentAlignment.TopLeft
label4.Text = "é"
Controls.Add(Me.label4)
label4.ContextMenu = m_menu
AddHandler label4.MouseDown, AddressOf Main_MouseDown
' Color Dialog
colorDialog1.FullOpen = True
colorDialog1.AnyColor = True
colorDialog1.AllowFullOpen = True
' Hue Trackbar
trackBar1.AutoSize = False
trackBar1.Location = New Point(2, WHeight - 14)
trackBar1.Margin = New Padding(0)
trackBar1.Size = New Size(WLength - 15, 15)
trackBar1.Maximum = 360
trackBar1.Name = "trackBar1"
trackBar1.TickFrequency = 45
AddHandler trackBar1.ValueChanged, AddressOf Trackbar1_Update
AddHandler trackBar1.MouseUp, AddressOf Trackbar1_Hide
Controls.Add(Me.trackBar1)
trackBar1.SendToBack()
trackBar1.Hide()
trackBar1.Value = CInt(BACKGROUND_COLOR.GetHue())
' Transparency Trackbar
trackBar2.AutoSize = False
trackBar2.Location = New Point(2, WHeight - 14)
trackBar2.Margin = New Padding(0)
trackBar2.Size = New Size(WLength - 15, 15)
trackBar2.LargeChange = 10
trackBar2.SmallChange = 1
trackBar2.Name = "trackBar2"
trackBar2.TickFrequency = 10
AddHandler trackBar2.ValueChanged, AddressOf Trackbar2_Update
AddHandler trackBar2.MouseUp, AddressOf Trackbar2_Hide
Controls.Add(Me.trackBar2)
trackBar2.SendToBack()
trackBar2.Hide()
backgroundWorker1 = New Thread(New ThreadStart(AddressOf backgroundWorker1_DoWork))
backgroundWorker1.IsBackground = False
backgroundWorker1.Priority = ThreadPriority.AboveNormal
backgroundWorker1.Start()
Check_Version(Me, New EventArgs())
'hack to initially try to reduce the memory footprint of the app (admin only)
Try
Dim loProcess As Process = Process.GetCurrentProcess()
loProcess.MaxWorkingSet = loProcess.MaxWorkingSet
loProcess.Dispose()
Catch
End Try
Dim ShrinkTimer As New System.Windows.Forms.Timer()
ShrinkTimer.Interval = 60000
AddHandler ShrinkTimer.Tick, AddressOf ShrinkTimer_Tick
ShrinkTimer.Start()
If File.Exists("upload.bmp") AndAlso File.Exists("upload2.bmp") AndAlso File.Exists("download.bmp") AndAlso File.Exists("download2.bmp") Then
upload_icon_red = Bitmap.FromFile("upload.bmp")
upload_icon_green = Bitmap.FromFile("upload2.bmp")
download_icon_red = Bitmap.FromFile("download.bmp")
download_icon_green = Bitmap.FromFile("download2.bmp")
DirectCast(upload_icon_red, Bitmap).MakeTransparent(Color.FromArgb(255, 0, 255))
DirectCast(upload_icon_green, Bitmap).MakeTransparent(Color.FromArgb(255, 0, 255))
DirectCast(download_icon_red, Bitmap).MakeTransparent(Color.FromArgb(255, 0, 255))
DirectCast(download_icon_green, Bitmap).MakeTransparent(Color.FromArgb(255, 0, 255))
icons_loaded = True
End If
End Sub
Private Sub UnhandledException(ByVal sender As Object, ByVal e As UnhandledExceptionEventArgs)
Dim form As New ErrorForm(TryCast(e.ExceptionObject, Exception))
form.ShowDialog()
End Sub
'the timer stuff
Private Sub backgroundWorker1_DoWork()
Dim freq As Long = 0
If QueryPerformanceFrequency(freq) Then
If freq <> 0 Then
If freq = 1000 Then
MessageBox.Show("Uses GetTickCount", "?")
End If
Dim count1 As Long = 0
Dim count2 As Long = 0
While Not m_closing
QueryPerformanceCounter(count1)
ElapsedTimer()
QueryPerformanceCounter(count2)
Dim time_ms As Long = (count2 - count1) * 1000 / freq
If time_ms > CLng(timerInterval) Then
time_ms = CLng(timerInterval)
End If
Thread.Sleep(CInt((CLng(timerInterval) - time_ms)))
End While
Else
MessageBox.Show("I can't find QueryPerformanceFrequency()", "FreeMeter Failed.")
End If
Else
MessageBox.Show("I failed to use QueryPerformanceFrequency()", "FreeMeter Failed.")
End If
End Sub
Private Sub ElapsedTimer()
For Each adapter As NetworkAdapter In monitor.Adapters
If adapter.Enabled Then
adapter.refresh()
End If
Next
RefreshSpeeds()
DrawIconRepresentation()
DrawFullMeter()
If colorcycle.Checked AndAlso Me.Visible Then
Dim h As Double = 0, sa As Double = 0, l As Double = 0
RGB_to_HSL(BACKGROUND_COLOR, h, sa, l)
h = h + 1
If h > 360.0R Then
h = 0
End If
BACKGROUND_COLOR = InlineAssignHelper(label1.BackColor, InlineAssignHelper(label2.BackColor, InlineAssignHelper(label3.BackColor, InlineAssignHelper(label4.BackColor, HSL_to_RGB(h, sa, l)))))
SetColor(Me, BACKGROUND_COLOR)
HIGHLIGHT_COLOR = HSL_to_RGB(h, sa, l + 0.3)
SHADOW_COLOR = HSL_to_RGB(h, sa, l - 0.1)
Make_Grabhandle()
Form1_Borders()
End If
End Sub
Private checkingmail As Boolean = False
Private Sub MailTimer_Tick(ByVal sender As [Object], ByVal e As EventArgs)
If mailcheck.Checked OrElse sender.Equals(mailchecknow) Then
If sender.Equals(mailchecknow) Then
checkingmail = True
End If
Dim checkmailWorker As New BackgroundWorker()
checkmailWorker.WorkerReportsProgress = False
AddHandler checkmailWorker.DoWork, AddressOf CheckMailWorker_DoWork
checkmailWorker.RunWorkerAsync()
checkmailWorker.Dispose()
End If
End Sub
Private Sub CheckMailWorker_DoWork(ByVal sender As [Object], ByVal e As DoWorkEventArgs)
Dim balloon_text As New StringBuilder()
Dim ErrorOccured As Boolean = False, NewMailOccurred As Boolean = False
Dim TTI As ToolTipIcon = ToolTipIcon.Info
For Each server As MailServer In MailServers
If server.Enabled Then
Dim newmsgcount As Integer = 0
Dim errmsg As String = Nothing
If server.Type = "1" Then
'imap
Dim pop As New IMAP(server.Host, server.User, server.Pass)
newmsgcount = pop.GetNumberOfMessages()
errmsg = pop.ErrMsg
ElseIf server.Type = "0" Then
'pop
Dim pop As New POP3(server.Host, server.User, server.Pass)
newmsgcount = pop.GetNumberOfMessages()
errmsg = pop.ErrMsg
End If
If newmsgcount = -1 Then
'error
balloon_text.Append(errmsg)
balloon_text.Append(" (")
balloon_text.Append(server.Host)
balloon_text.Append(")" & vbLf)
'server.Enabled = false;
ErrorOccured = True
ElseIf newmsgcount = 0 Then
server.OldMsgCount = 0
If checkingmail Then
balloon_text.Append("No New Messages on ")
balloon_text.Append(server.Host)
balloon_text.Append(vbLf)
End If
ElseIf newmsgcount = server.OldMsgCount AndAlso checkingmail Then
balloon_text.Append("No New Messages on ")
balloon_text.Append(server.Host)
balloon_text.Append(vbLf)
ElseIf newmsgcount > server.OldMsgCount Then
balloon_text.Append(newmsgcount - server.OldMsgCount)
If newmsgcount - server.OldMsgCount = 1 Then
balloon_text.Append(" new message on ")
Else
balloon_text.Append(" new messages on ")
End If
balloon_text.Append(server.Host)
balloon_text.Append(vbLf)
server.OldMsgCount = newmsgcount
NewMailOccurred = True
End If
End If
Next
If balloon_text.Length > 0 Then
Dim balloon_title As String = ""
If ErrorOccured Then
balloon_title = "There were errors checking your email."
TTI = ToolTipIcon.[Error]
ElseIf NewMailOccurred Then
balloon_title = "You have new email!"
Else
balloon_title = "No New Messages."
End If
m_notifyicon.ShowBalloonTip(1, balloon_title, balloon_text.ToString(), TTI)
End If
checkingmail = False
End Sub
Private Sub ClipTimer_Tick(ByVal sender As Object, ByVal e As EventArgs)
If clip_watch.Checked Then
Dim o As IDataObject = Clipboard.GetDataObject()
If o IsNot Nothing Then
If o.GetDataPresent(DataFormats.Text, False) Then
Dim s As String = DirectCast(o.GetData(DataFormats.Text), String)
If s IsNot Nothing AndAlso s <> [String].Empty Then
s = s.Trim()
s = s.Replace(vbCr, "").Replace(vbLf, "")
'newlines
s = s.Replace(": ", "").Replace("³ ", "").Replace("| ", "").Replace(" ", "")
'weird chars that i find in my URLs copied from my different appplications like email and IRC
s = s.Replace(">", "")
'commonly in email RE:'s
If ClipData = "" Then
ClipData = s
End If
If s <> ClipData Then
ClipData = s
If s.StartsWith("http://") OrElse s.StartsWith("https://") OrElse s.StartsWith("ftp://") OrElse s.StartsWith("www.") Then
Process.Start(s)
End If
End If
Else
ClipData = Nothing
End If
Else
ClipData = Nothing
End If
Else
ClipData = Nothing
End If
End If
End Sub
Private Sub ShrinkTimer_Tick(ByVal sender As Object, ByVal e As EventArgs)
'hack to initially try to reduce the memory footprint of the app (admin only)
Try
Dim loProcess As Process = Process.GetCurrentProcess()
loProcess.MaxWorkingSet = loProcess.MaxWorkingSet
loProcess.Dispose()
Catch
End Try
End Sub
'cycle colors and color trackbar
Private Sub Trackbar1_Update(ByVal sender As [Object], ByVal e As EventArgs)
Dim h As Double = 0, sa As Double = 0, l As Double = 0
Dim tb As TrackBar = DirectCast(sender, TrackBar)
RGB_to_HSL(BACKGROUND_COLOR, h, sa, l)
h = tb.Value
BackColor = InlineAssignHelper(BACKGROUND_COLOR, InlineAssignHelper(label1.BackColor, InlineAssignHelper(label2.BackColor, InlineAssignHelper(label3.BackColor, InlineAssignHelper(label4.BackColor, HSL_to_RGB(h, sa, l))))))
HIGHLIGHT_COLOR = HSL_to_RGB(h, sa, l + 0.3)
SHADOW_COLOR = HSL_to_RGB(h, sa, l - 0.1)
Make_Grabhandle()
Form1_Borders()
End Sub
Private Sub Trackbar1_Hide(ByVal sender As [Object], ByVal e As MouseEventArgs)
trackBar1.SendToBack()
trackBar1.Enabled = False
trackBar1.Hide()
End Sub
Private Sub Trackbar1_Show(ByVal sender As [Object], ByVal e As EventArgs)
colorcycle.Checked = False
trackBar1.BringToFront()
trackBar1.Enabled = True
trackBar1.Show()
End Sub
Private Sub Cycle_Colors(ByVal sender As [Object], ByVal e As EventArgs)
If colorcycle.Checked Then
colorcycle.Checked = False
Else
colorcycle.Checked = True
End If
End Sub
Private Sub Color_Click(ByVal sender As [Object], ByVal e As EventArgs)
Dim h As Double = 0, sa As Double = 0, l As Double = 0
colorcycle.Checked = False
colorDialog1.Color = BACKGROUND_COLOR
If colorDialog1.ShowDialog() = DialogResult.OK Then
BackColor = InlineAssignHelper(BACKGROUND_COLOR, InlineAssignHelper(label1.BackColor, InlineAssignHelper(label2.BackColor, InlineAssignHelper(label3.BackColor, InlineAssignHelper(label4.BackColor, colorDialog1.Color)))))
RGB_to_HSL(BACKGROUND_COLOR, h, sa, l)
HIGHLIGHT_COLOR = HSL_to_RGB(h, sa, l + 0.3)
SHADOW_COLOR = HSL_to_RGB(h, sa, l - 0.1)
Make_Grabhandle()
Form1_Borders()
End If
End Sub
Private Sub TextColor_Click(ByVal sender As [Object], ByVal e As EventArgs)
colorDialog1.Color = FORGROUND_COLOR
If colorDialog1.ShowDialog() = DialogResult.OK Then
ForeColor = InlineAssignHelper(FORGROUND_COLOR, InlineAssignHelper(label1.ForeColor, InlineAssignHelper(label2.ForeColor, colorDialog1.Color)))
End If
End Sub
Private Sub DefaultColor_Click(ByVal sender As [Object], ByVal e As EventArgs)
Dim h As Double = 0, sa As Double = 0, l As Double = 0
colorcycle.Checked = False
ForeColor = InlineAssignHelper(FORGROUND_COLOR, InlineAssignHelper(label1.ForeColor, InlineAssignHelper(label2.ForeColor, Color.White)))
BACKGROUND_COLOR = Color.FromArgb(255, 44, 81, 138)
RGB_to_HSL(BACKGROUND_COLOR, h, sa, l)
BackColor = InlineAssignHelper(BACKGROUND_COLOR, InlineAssignHelper(label1.BackColor, InlineAssignHelper(label2.BackColor, InlineAssignHelper(label3.BackColor, InlineAssignHelper(label4.BackColor, HSL_to_RGB(h, sa, l))))))
HIGHLIGHT_COLOR = HSL_to_RGB(h, sa, l + 0.3)
SHADOW_COLOR = HSL_to_RGB(h, sa, l - 0.1)
Make_Grabhandle()
Form1_Borders()
End Sub
'transparency and opacity
Private Sub Trackbar2_Update(ByVal sender As [Object], ByVal e As EventArgs)
Dim tb As TrackBar = DirectCast(sender, TrackBar)
Me.Opacity = CSng(tb.Value) / 100
End Sub
Private Sub Trackbar2_Hide(ByVal sender As [Object], ByVal e As EventArgs)
trackBar2.SendToBack()
trackBar2.Enabled = False
trackBar2.Hide()
End Sub
Private Sub Trackbar2_Show(ByVal sender As [Object], ByVal e As EventArgs)
trackBar2.BringToFront()
trackBar2.Enabled = True
trackBar2.Show()
End Sub
Private Sub Opaque_Click(ByVal sender As [Object], ByVal e As EventArgs)
Me.Opacity = 1.0R
trackBar2.Value = 100
End Sub
'draw the UI
Private Sub Form1_Borders()
'do 3D borders
Dim borders As New Bitmap(ClientSize.Width, ClientSize.Height, PixelFormat.Format24bppRgb)
Dim formGraphics As Graphics = Graphics.FromImage(DirectCast(borders, Image))
formGraphics.Clear(BACKGROUND_COLOR)
formGraphics.DrawRectangle(New Pen(HIGHLIGHT_COLOR), 2, 2, WLength - 5, WHeight - 17)
formGraphics.DrawLine(New Pen(HIGHLIGHT_COLOR), 0, 0, WLength - 1, 0)
formGraphics.DrawLine(New Pen(HIGHLIGHT_COLOR), 0, 0, 0, WHeight - 1)
formGraphics.DrawLine(New Pen(SHADOW_COLOR), 0, WHeight - 1, WLength - 1, WHeight - 1)
formGraphics.DrawLine(New Pen(SHADOW_COLOR), WLength - 1, WHeight - 1, WLength - 1, 0)
formGraphics.DrawRectangle(New Pen(BACKGROUND_COLOR), WLength - 1, 0, 1, 1)
formGraphics.DrawRectangle(New Pen(BACKGROUND_COLOR), 0, WHeight - 1, 1, 1)
Dim oFB As IntPtr = borders.GetHbitmap()
Me.BackgroundImage = Image.FromHbitmap(oFB)
DeleteObject(oFB)
formGraphics.Dispose()
borders.Dispose()
End Sub
Private Sub Make_Grabhandle()
Dim grabhandle As New Bitmap(11, 11, PixelFormat.Format24bppRgb)
Dim g As Graphics = Graphics.FromImage(DirectCast(grabhandle, Image))
g.FillRectangle(New SolidBrush(BACKGROUND_COLOR), New Rectangle(0, 0, 11, 11))
Dim r As Rectangle() = New Rectangle() {New Rectangle(9, 1, 2, 2), New Rectangle(5, 5, 2, 2), New Rectangle(9, 5, 2, 2), New Rectangle(1, 9, 2, 2), New Rectangle(5, 9, 2, 2), New Rectangle(9, 9, 2, 2)}
g.FillRectangles(New SolidBrush(HIGHLIGHT_COLOR), r)
r = New Rectangle() {New Rectangle(8, 0, 2, 2), New Rectangle(4, 4, 2, 2), New Rectangle(8, 4, 2, 2), New Rectangle(0, 8, 2, 2), New Rectangle(4, 8, 2, 2), New Rectangle(8, 8, 2, 2)}
g.FillRectangles(New SolidBrush(SHADOW_COLOR), r)
Try
Dim oBm1 As IntPtr = grabhandle.GetHbitmap()
resizer.Image = Image.FromHbitmap(oBm1)
DeleteObject(oBm1)
Catch e As Exception
Console.WriteLine(e.ToString())
End Try
g.Dispose()
grabhandle.Dispose()
End Sub
Private Sub RefreshSpeeds()
'scroll values in icaon arrays.
For i As Integer = 0 To downlines.Length - 2
downlines(i) = downlines(i + 1)
uplines(i) = uplines(i + 1)
Next
'scroll values in large arrays.
For i As Integer = 0 To full_downspeeds.Length - 2
If i < full_downspeeds.Length - 1 Then
full_downspeeds(i) = full_downspeeds(i + 1)
full_upspeeds(i) = full_upspeeds(i + 1)
full_downlines(i) = full_downlines(i + 1)
full_uplines(i) = full_uplines(i + 1)
End If
Next
'calculate latest icon values
downspeed = InlineAssignHelper(upspeed, 0.0R)
For Each adapter As NetworkAdapter In monitor.Adapters
If adapter.Enabled Then
downspeed += adapter.DownloadSpeed(timerInterval)
upspeed += adapter.UploadSpeed(timerInterval)
If downspeed < 0 Then
downspeed = 0
End If
If upspeed < 0 Then
upspeed = 0
End If
End If
Next
logs_form.UpdateData(upspeed / (1024 / timerInterval), downspeed / (1024 / timerInterval))
If downspeed < 0 OrElse upspeed < 0 Then
MessageBox.Show(("something is wrong! downspeed=" & downspeed & " upspeed=") + upspeed)
End If
downlines(15) = CInt((16 * downspeed / scale))
uplines(15) = CInt((16 * upspeed / scale))
If downlines(15) > 16 Then
downlines(15) = 16
End If
If uplines(15) > 16 Then
uplines(15) = 16
End If
'calculate latest large values
full_downspeeds(full_downspeeds.Length - 1) = downspeed
full_upspeeds(full_downspeeds.Length - 1) = upspeed
full_downlines(full_downspeeds.Length - 1) = CInt((pictureBox1.Height * downspeed / scale))
full_uplines(full_downspeeds.Length - 1) = CInt((pictureBox1.Height * upspeed / scale))
If full_downlines(full_downspeeds.Length - 1) > pictureBox1.Height Then
full_downlines(full_downspeeds.Length - 1) = pictureBox1.Height
End If
If full_uplines(full_downspeeds.Length - 1) > pictureBox1.Height Then
full_uplines(full_downspeeds.Length - 1) = pictureBox1.Height
End If
If autoscale_checked.Checked Then
Auto_Scale()
End If
End Sub
Private Sub DrawIconRepresentation()
Dim b As New Bitmap(16, 16, PixelFormat.Format16bppRgb555)
Dim g As Graphics = Graphics.FromImage(DirectCast(b, Image))
If Not icon_representation Then
'draw each line in the graph
DrawGraph(g, 16, downlines, uplines, True)
Else
'draw cool icon
DrawCoolIcon(g)
b.MakeTransparent(Color.FromArgb(255, 0, 255))
End If
Dim oIcon As IntPtr = b.GetHicon()
m_notifyicon.Icon = Icon.FromHandle(oIcon)
g.Dispose()
b.Dispose()
DestroyIcon(oIcon)
End Sub
Private Sub DrawCoolIcon(ByVal graph As Graphics)
graph.Clear(Color.FromArgb(255, 0, 255))
If icons_loaded Then
If upspeed > 0 Then
graph.DrawImage(upload_icon_green, 0, 0, upload_icon_green.Width, upload_icon_green.Height)
Else
graph.DrawImage(upload_icon_red, 0, 0, upload_icon_red.Width, upload_icon_red.Height)
End If
If downspeed > 0 Then
graph.DrawImage(download_icon_green, 0, 0, download_icon_green.Width, download_icon_green.Height)
Else
graph.DrawImage(download_icon_red, 0, 0, download_icon_red.Width, download_icon_red.Height)
End If
Else
Dim color__1 As Pen
If upspeed > 0 Then
color__1 = Pens.Green
Else
color__1 = Pens.Red
End If
'upload
For i As Integer = 6 To 0 Step -1
graph.DrawLine(color__1, 2 + i, 6 - i, 14 - i, 6 - i)
Next
If downspeed > 0 Then
color__1 = Pens.Green
Else
color__1 = Pens.Red
End If
'download
For i As Integer = 0 To 5
graph.DrawLine(color__1, 2 + i, 9 + i, 14 - i, 9 + i)
Next
End If
End Sub
Private Sub DrawFullMeter()
If Me.Visible Then
Dim full_time_visible As Integer = timerInterval * pictureBox1.Width / 1000
Dim bm As New Bitmap(pictureBox1.Width, pictureBox1.Height, PixelFormat.Format16bppRgb555)
Dim g As Graphics = Graphics.FromImage(DirectCast(bm, Image))
'draw each line in the graph
DrawGraph(g, pictureBox1.Height, full_downlines, full_uplines, False)
Dim oBm As IntPtr = bm.GetHbitmap()
pictureBox1.Image = Image.FromHbitmap(oBm)
DeleteObject(oBm)
bm.Dispose()
g.Dispose()
End If
DoStringOutput()
End Sub
Private Sub Auto_Scale()
If pictureBox1.Height * Max(full_downspeeds) / scale > pictureBox1.Height OrElse pictureBox1.Height * Max(full_upspeeds) / scale > pictureBox1.Height Then
Select Case scale
Case 4200
scale = 7000
Exit Select
'33.6k
Case 7000
scale = 8000
Exit Select
'56k
Case 8000
scale = 16000
Exit Select
'64k
Case 16000
scale = 32000
Exit Select
'128k
Case 32000
scale = 80000
Exit Select
'256k
Case 64000
scale = 80000
Exit Select
'512k
Case 80000
scale = 128000
Exit Select
'640k
Case 128000
scale = 192000
Exit Select
'1m
Case 192000
scale = 256000
Exit Select
'1.5m
Case 256000
scale = 384000
Exit Select
'2m
Case 384000
scale = 640000
Exit Select
'3m
Case 640000
scale = 896000
Exit Select
'5m
Case 896000
scale = 1280000
Exit Select
'7m
Case 1280000
scale = 1408000
Exit Select
'10m
Case 1408000
scale = 4096000
Exit Select
'11m
Case 4096000
scale = 6912000
Exit Select
'32m
Case 6912000
scale = 12800000
Exit Select
'54m
Case 12800000
scale = 128000000
Exit Select
'100m
End Select
ResizeScale()
Check_Menus()
ElseIf pictureBox1.Height * Max(full_downspeeds) / scale < pictureBox1.Height / 3 AndAlso pictureBox1.Height * Max(full_upspeeds) / scale < pictureBox1.Height / 3 Then
Select Case scale
Case 7000
scale = 4200
Exit Select
'56k
Case 8000
scale = 7000
Exit Select
'64k
Case 16000
scale = 8000
Exit Select
'128k
Case 32000
scale = 16000
Exit Select
'256k
Case 64000
scale = 32000
Exit Select
'512k
Case 80000
scale = 64000
Exit Select
'640k
Case 128000
scale = 80000
Exit Select
'1m
Case 192000
scale = 128000
Exit Select
'1.5m
Case 256000
scale = 192000
Exit Select
'2m
Case 384000
scale = 256000
Exit Select
'3m
Case 640000
scale = 384000
Exit Select
'5m
Case 896000
scale = 640000
Exit Select
'7m
Case 1280000
scale = 896000
Exit Select
'10m
Case 1408000
scale = 1280000
Exit Select
'11m
Case 4096000
scale = 1408000
Exit Select
'32m
Case 6912000
scale = 4096000
Exit Select
'54m
Case 12800000
scale = 6912000
Exit Select
'100m
Case 128000000
scale = 12800000
Exit Select
'1g
End Select
ResizeScale()
Check_Menus()
End If
End Sub
Private Sub DrawGraph(ByVal graph As Graphics, ByVal height As Integer, ByVal dlines As Integer(), ByVal ulines As Integer(), ByVal drawingIcon As Boolean)
For i As Integer = 0 To dlines.Length - 1
If dlines(i) > 0 OrElse ulines(i) > 0 Then
If dlines(i) > ulines(i) Then
If graphs_download.Checked AndAlso graphs_upload.Checked Then
graph.DrawLine(downloadPen, i, height, i, height - dlines(i))
graph.DrawLine(overlapPen, i, height, i, height - ulines(i))
ElseIf graphs_download.Checked AndAlso Not graphs_upload.Checked Then
graph.DrawLine(downloadPen, i, height, i, height - dlines(i))
ElseIf Not graphs_download.Checked AndAlso graphs_upload.Checked Then
graph.DrawLine(uploadPen, i, height, i, height - ulines(i))
End If
ElseIf dlines(i) < ulines(i) Then
If graphs_download.Checked AndAlso graphs_upload.Checked Then
graph.DrawLine(uploadPen, i, height, i, height - ulines(i))
graph.DrawLine(overlapPen, i, height, i, height - dlines(i))
ElseIf Not graphs_download.Checked AndAlso graphs_upload.Checked Then
graph.DrawLine(uploadPen, i, height, i, height - ulines(i))
ElseIf graphs_download.Checked AndAlso Not graphs_upload.Checked Then
graph.DrawLine(downloadPen, i, height, i, height - dlines(i))
End If
ElseIf dlines(i) = ulines(i) Then
If graphs_upload.Checked AndAlso graphs_download.Checked Then
graph.DrawLine(overlapPen, i, height, i, height - ulines(i))
ElseIf Not graphs_upload.Checked AndAlso graphs_download.Checked Then
graph.DrawLine(downloadPen, i, height, i, height - dlines(i))
ElseIf graphs_upload.Checked AndAlso Not graphs_download.Checked Then
graph.DrawLine(uploadPen, i, height, i, height - ulines(i))
End If
End If
End If
Next
Dim down As Integer = dlines(dlines.Length - 1)
Dim up As Integer = ulines(ulines.Length - 1)
If graphs_download.Checked AndAlso graphs_summary.Checked Then
graph.DrawLine(Pens.Black, dlines.Length - 2, 0, dlines.Length - 2, height)
graph.DrawLine(Pens.Black, dlines.Length - 1, 0, dlines.Length - 1, height - down)
graph.DrawLine(Pens.White, dlines.Length - 1, height, dlines.Length - 1, height - down)
End If
If graphs_upload.Checked AndAlso graphs_summary.Checked Then
graph.DrawLine(Pens.Black, 1, 0, 1, height)
graph.DrawLine(Pens.Black, 0, 0, 0, height - up)
graph.DrawLine(Pens.White, 0, height, 0, height - up)
End If
If graph_label_checked.Checked AndAlso Not drawingIcon Then
Dim f As Font
Dim fontName As String = "Verdana"
Dim fontSize As Integer = 6
If font_large.Checked Then
f = New Font(fontName, fontSize + 2, FontStyle.Regular)
ElseIf font_medium.Checked Then
f = New Font(fontName, fontSize + 1, FontStyle.Regular)
Else
f = New Font(fontName, fontSize, FontStyle.Regular)
End If
Dim text As String = (display_xscale & " ") + display_yscale
Dim size As SizeF = graph.MeasureString(text, f)
Dim rect As New RectangleF(New PointF(2, 2), size)
graph.FillRectangle(New SolidBrush(Color.Black), rect)
graph.DrawString(text, f, New SolidBrush(Color.White), rect)
End If
End Sub
Private Sub DoStringOutput()
Dim downunits As String = ""
Dim upunits As String = ""
Dim downformat As String = "F1"
Dim upformat As String = "F1"
Dim label1text As String = ""
Dim label2text As String = ""
If avg_checked.Checked Then
Dim averageDown As Double = Average(full_downspeeds)
Dim averageUp As Double = Average(full_upspeeds)
If units_kbits.Checked Then
Dim downbps As Double = averageDown * 8
Dim upbps As Double = averageUp * 8
If downbps < 1024 Then
downunits = ""
downformat = "F0"
ElseIf downbps < 1024 * 1024 Then
downbps = downbps / 1024
downunits = "k"
Else
downunits = "m"
downbps = downbps / 1024 / 1024
End If
If upbps < 1024 Then
upunits = ""
upformat = "F0"
ElseIf upbps < 1024 * 1024 Then
upbps = upbps / 1024
upunits = "k"
Else
upunits = "m"
upbps = upbps / 1024 / 1024
End If
label1text += (downbps.ToString(downformat) & " ") + downunits & "bps"
label2text += (upbps.ToString(upformat) & " ") + upunits & "bps"
End If
If units_kbytes.Checked Then
If averageDown < 1024 Then
downunits = ""
downformat = "F0"
ElseIf averageDown < 1024 * 1024 Then
averageDown = averageDown / 1024
downunits = "k"
Else
downunits = "m"
averageDown = averageDown / 1024 / 1024
End If
If averageUp < 1024 Then
upunits = ""
upformat = "F0"
ElseIf averageUp < 1024 * 1024 Then
averageUp = averageUp / 1024
upunits = "k"
Else
upunits = "m"
averageUp = averageUp / 1024 / 1024
End If
label1text += (" " & averageDown.ToString(downformat) & " ") + downunits & "B/s"
label2text += (" " & averageUp.ToString(upformat) & " ") + upunits & "B/s"
End If
Dim nText As String = ((timerInterval * full_downspeeds.Length / 1000 & " sec Avg:" & vbLf) + label1text & " Down" & vbLf) + label2text & " Up"
If nText.Length >= 64 Then
m_notifyicon.Text = nText.Substring(0, 64)
Else
m_notifyicon.Text = nText
End If
Else
If units_kbits.Checked Then
Dim downbps As Double = downspeed * 8
Dim upbps As Double = upspeed * 8
If downbps < 1024 Then
downunits = ""
downformat = "F0"
ElseIf downbps < 1024 * 1024 Then
downbps = downbps / 1024
downunits = "k"
Else
downunits = "m"
downbps = downbps / 1024 / 1024
End If
If upbps < 1024 Then
upunits = ""
upformat = "F0"
ElseIf upbps < 1024 * 1024 Then
upbps = upbps / 1024
upunits = "k"
Else
upunits = "m"
upbps = upbps / 1024 / 1024
End If
label1text += (downbps.ToString(downformat) & " ") + downunits & "bps"
label2text += (upbps.ToString(upformat) & " ") + upunits & "bps"
End If
If units_kbytes.Checked Then
If downspeed < 1024 Then
downunits = ""
downformat = "F0"
ElseIf downspeed < 1024 * 1024 Then
downspeed = downspeed / 1024
downunits = "k"
Else
downunits = "m"
downspeed = downspeed / 1024 / 1024
End If
If upspeed < 1024 Then
upunits = ""
upformat = "F0"
ElseIf upspeed < 1024 * 1024 Then
upspeed = upspeed / 1024
upunits = "k"
Else
upunits = "m"
upspeed = upspeed / 1024 / 1024
End If
label1text += (" " & downspeed.ToString(downformat) & " ") + downunits & "B/s"
label2text += (" " & upspeed.ToString(upformat) & " ") + upunits & "B/s"
End If
Dim nText As String = (label1text & " Down" & vbLf) + label2text & " Up"
If nText.Length >= 64 Then
m_notifyicon.Text = nText.Substring(0, 64)
Else
m_notifyicon.Text = nText
End If
End If
SetText(label1, label1text, 0)
SetText(label2, label2text, WLength / 2 - 5)
End Sub
'Average and max functions
Private Shared Function Average(ByVal num As Integer()) As Double
Dim sum As Double = 0.0R
Dim avg As Double = 0.0R
For i As Integer = 0 To num.Length - 1
sum += num(i)
Next
If num.Length > 0 Then
avg = sum / System.Convert.ToDouble(num.Length)
End If
Return avg
End Function
Private Shared Function Average(ByVal num As Double()) As Double
Dim sum As Double = 0.0R
Dim avg As Double = 0.0R
For i As Integer = 0 To num.Length - 1
sum += num(i)
Next
If num.Length > 0 Then
avg = sum / System.Convert.ToDouble(num.Length)
End If
Return avg
End Function
Private Shared Function Max(ByVal A As Double()) As Double
Dim maxVal As Double = A(0)
For i As Integer = 1 To A.Length - 1
If A(i) > maxVal Then
maxVal = A(i)
End If
Next
Return maxVal
End Function
'handle form mouse click and drag events
Private ptOffset As Point
Private Sub Icon_MouseDown(ByVal sender As [Object], ByVal e As MouseEventArgs)
If e.Button = MouseButtons.Left Then
If WindowState = FormWindowState.Normal Then
WindowState = FormWindowState.Minimized
show_checked.Checked = False
Hide()
Else
Show()
show_checked.Checked = True
WindowState = FormWindowState.Normal
End If
Else
Check_Menus()
End If
End Sub
Private Sub Main_MouseDown(ByVal sender As [Object], ByVal e As MouseEventArgs)
ptOffset = New Point(-e.X - pictureBox1.Left, -e.Y - pictureBox1.Top)
Check_Menus()
End Sub
Private Sub Form1_MouseMove(ByVal sender As [Object], ByVal e As MouseEventArgs)
If e.Button = MouseButtons.Left Then
Dim mousePos As Point = Control.MousePosition
mousePos.Offset(ptOffset.X, ptOffset.Y)
Me.Location = mousePos
End If
End Sub
'for resizing
Shared frmLastWidth As Integer = 0, frmLastHeight As Integer = 0, frmWidth As Integer, frmHeight As Integer
Shared frmIsResizing As Boolean = False
Private frmRectangle As New Rectangle()
Private Sub Resize_MouseDown(ByVal sender As Object, ByVal e As MouseEventArgs)
frmWidth = WLength
frmHeight = WHeight
frmRectangle.Location = New Point(Me.Left, Me.Top)
frmRectangle.Size = New Size(frmWidth, frmHeight)
End Sub
Private Sub Resize_MouseUp(ByVal sender As Object, ByVal e As MouseEventArgs)
If frmIsResizing Then
frmRectangle.Location = New Point(Me.Left, Me.Top)
frmRectangle.Size = New Size(frmWidth, frmHeight)
Me.Size = frmRectangle.Size
Me.Width = frmWidth
Me.Height = frmHeight
frmIsResizing = False
End If
Form1_Borders()
End Sub
Private Sub Resize_MouseMove(ByVal sender As Object, ByVal e As MouseEventArgs)
If e.Button = MouseButtons.Left Then
Dim sizeageX As Integer = (MousePosition.X - Me.Location.X)
Dim sizeageY As Integer = (MousePosition.Y - Me.Location.Y)
If sizeageX < 66 Then
sizeageX = 66
End If
If sizeageY < 45 Then
sizeageY = 45
End If
frmWidth = sizeageX
frmHeight = sizeageY
If frmLastWidth = 0 Then
frmLastWidth = frmWidth
End If
If frmLastHeight = 0 Then
frmLastHeight = frmHeight
End If
If frmIsResizing Then
frmRectangle.Location = New Point(Me.Left, Me.Top)
frmRectangle.Size = New Size(frmLastWidth, frmLastHeight)
End If
frmIsResizing = True
frmLastWidth = frmWidth
frmLastHeight = frmHeight
frmRectangle.Location = New Point(Me.Left, Me.Top)
frmRectangle.Size = New Size(frmWidth, frmHeight)
Me.Size = frmRectangle.Size
End If
End Sub
Private Sub Form1_Resize(ByVal sender As [Object], ByVal e As EventArgs)
If ClientSize.Width > 40 AndAlso ClientSize.Height > 40 Then
WLength = ClientSize.Width
WHeight = ClientSize.Height
End If
label1.Location = New Point(10, WHeight - 14)
label1.Size = New Size(WLength / 2 - 9 - 5, 13)
label2.Location = New Point(WLength / 2 + 10 - 5, WHeight - 14)
label2.Size = New Size(WLength / 2 - 9 - 13 + 5, 13)
label3.Location = New Point(1, WHeight - 14)
label4.Location = New Point(WLength / 2 - 4, WHeight - 14)
pictureBox1.Size = New Size(WLength - 6, WHeight - 18)
resizer.Location = New Point(WLength - 13, WHeight - 13)
trackBar1.Location = New Point(2, WHeight - 14)
trackBar1.Size = New Size(WLength - 15, 15)
trackBar2.Location = New Point(2, WHeight - 14)
trackBar2.Size = New Size(WLength - 15, 15)
display_xscale = "time: " & (timerInterval * pictureBox1.Width / 1000).ToString() & "s "
'resize arrays to match new window size
Dim temp As Integer() = New Integer(pictureBox1.Width - 1) {}
Dim temp2 As Double() = New Double(pictureBox1.Width - 1) {}
If full_downlines.Length <= temp.Length Then
Array.Copy(full_downlines, 0, temp, temp.Length - full_downlines.Length, full_downlines.Length)
Else
Array.Copy(full_downlines, full_downlines.Length - temp.Length, temp, 0, temp.Length)
End If
full_downlines = temp
temp = New Integer(pictureBox1.Width - 1) {}
If full_uplines.Length <= temp.Length Then
Array.Copy(full_uplines, 0, temp, temp.Length - full_uplines.Length, full_uplines.Length)
Else
Array.Copy(full_uplines, full_uplines.Length - temp.Length, temp, 0, temp.Length)
End If
full_uplines = temp
temp2 = New Double(pictureBox1.Width - 1) {}
If full_downspeeds.Length <= temp2.Length Then
Array.Copy(full_downspeeds, 0, temp2, temp2.Length - full_downspeeds.Length, full_downspeeds.Length)
Else
Array.Copy(full_downspeeds, full_downspeeds.Length - temp2.Length, temp2, 0, temp2.Length)
End If
full_downspeeds = temp2
temp2 = New Double(pictureBox1.Width - 1) {}
If full_upspeeds.Length <= temp2.Length Then
Array.Copy(full_upspeeds, 0, temp2, temp2.Length - full_upspeeds.Length, full_upspeeds.Length)
Else
Array.Copy(full_upspeeds, full_upspeeds.Length - temp2.Length, temp2, 0, temp2.Length)
End If
full_upspeeds = temp2
Dim font_adjust As Integer = 0
If Not font_small.Checked Then
font_adjust = 1
End If
If WLength > 125 Then
If font_large.Checked Then
label1.Font = InlineAssignHelper(label2.Font, New Font("MS Serif", 7 + font_adjust, FontStyle.Bold))
Else
label1.Font = InlineAssignHelper(label2.Font, New Font("MS Serif", 7 + font_adjust, FontStyle.Regular))
End If
label1.TextAlign = InlineAssignHelper(label2.TextAlign, ContentAlignment.TopLeft)
ElseIf WLength > 95 Then
If font_large.Checked Then
label1.Font = InlineAssignHelper(label2.Font, New Font("MS Serif", 6 + font_adjust, FontStyle.Bold))
Else
label1.Font = InlineAssignHelper(label2.Font, New Font("MS Serif", 6 + font_adjust, FontStyle.Regular))
End If
label1.TextAlign = InlineAssignHelper(label2.TextAlign, ContentAlignment.MiddleLeft)
Else
If font_large.Checked Then
label1.Font = InlineAssignHelper(label2.Font, New Font("MS Serif", 5 + font_adjust, FontStyle.Bold))
Else
label1.Font = InlineAssignHelper(label2.Font, New Font("MS Serif", 5 + font_adjust, FontStyle.Regular))
End If
label1.TextAlign = InlineAssignHelper(label2.TextAlign, ContentAlignment.MiddleLeft)
End If
ResizeScale()
End Sub
'HSL <-> RGB (Hue/Saturation/Luminosity to/from Red/Green/Blue color format)
Public Function HSL_to_RGB(ByVal h As Double, ByVal s As Double, ByVal l As Double) As Color
Dim r As Double = 0, g As Double = 0, b As Double = 0
Dim temp1 As Double, temp2 As Double
h = h / 360.0R
If l = 0 Then
r = InlineAssignHelper(g, InlineAssignHelper(b, 0))
Else
If s = 0 Then
r = InlineAssignHelper(g, InlineAssignHelper(b, l))
Else
temp2 = (If((l <= 0.5), l * (1.0R + s), l + s - (l * s)))
temp1 = 2.0R * l - temp2
Dim t3 As Double() = New Double() {h + 1.0R / 3.0R, h, h - 1.0R / 3.0R}
Dim clr As Double() = New Double() {0, 0, 0}
For i As Integer = 0 To 2
If t3(i) < 0 Then
t3(i) += 1.0R
End If
If t3(i) > 1 Then
t3(i) -= 1.0R
End If
If 6.0R * t3(i) < 1.0R Then
clr(i) = temp1 + (temp2 - temp1) * t3(i) * 6.0R
ElseIf 2.0R * t3(i) < 1.0R Then
clr(i) = temp2
ElseIf 3.0R * t3(i) < 2.0R Then
clr(i) = (temp1 + (temp2 - temp1) * ((2.0R / 3.0R) - t3(i)) * 6.0R)
Else
clr(i) = temp1
End If
Next
r = clr(0)
g = clr(1)
b = clr(2)
End If
End If
Try
Return Color.FromArgb(CInt((255 * r)), CInt((255 * g)), CInt((255 * b)))
Catch generatedExceptionName As ArgumentException
Return BACKGROUND_COLOR
End Try
End Function
Public Sub RGB_to_HSL(ByVal c As Color, ByRef h As Double, ByRef s As Double, ByRef l As Double)
h = c.GetHue()
s = c.GetSaturation()
l = c.GetBrightness()
End Sub
' Menus and menu click handlers
Private m_interval_menu As New MenuItem(), m_scale_menu As New MenuItem(), m_units As New MenuItem(), m_interfaces As New MenuItem(), m_graphs As New MenuItem(), m_colors As New MenuItem(), _
m_utils As New MenuItem()
Private interval_tenth As MenuItem, interval_fifth As MenuItem, interval_half As MenuItem, interval_1 As MenuItem
Private scale_33 As MenuItem, scale_56 As MenuItem, scale_64 As MenuItem, scale_128 As MenuItem, scale_256 As MenuItem, scale_512 As MenuItem, _
scale_640 As MenuItem, scale_1000 As MenuItem, scale_1500 As MenuItem, scale_2000 As MenuItem, scale_3000 As MenuItem, scale_5000 As MenuItem, _
scale_7000 As MenuItem, scale_10000 As MenuItem, scale_11000 As MenuItem, scale_32000 As MenuItem, scale_54000 As MenuItem, scale_100000 As MenuItem, _
scale_1000000 As MenuItem, scale_custom As MenuItem
Private avg_checked As MenuItem, clip_watch As MenuItem, show_checked As MenuItem, topmost_checked As MenuItem, autoscale_checked As MenuItem, graph_label_checked As MenuItem, _
mailcheck As MenuItem, mailchecknow As MenuItem
' added by miechu
Private simple_icon_checked As MenuItem
' end of added by miechu
Private units_kbits As MenuItem, units_kbytes As MenuItem, graphs_download As MenuItem, graphs_upload As MenuItem, graphs_summary As MenuItem, colorcycle As MenuItem, _
m_update As MenuItem
Private font_large As MenuItem, font_medium As MenuItem, font_small As MenuItem
Private Sub MakeMenus()
m_menu.MenuItems.Add(0, InlineAssignHelper(show_checked, New MenuItem("Show Desktop Meter", New EventHandler(AddressOf Show_Click))))
show_checked.Checked = True
m_menu.MenuItems.Add(InlineAssignHelper(topmost_checked, New MenuItem("Always On Top", New EventHandler(AddressOf TopMost_Click))))
' added by miechu
m_menu.MenuItems.Add(InlineAssignHelper(simple_icon_checked, New MenuItem("Simple Notify Icon", New EventHandler(AddressOf SimpleNotifyIcon_Click))))
simple_icon_checked.Checked = False
' end of added by miechu
m_menu.MenuItems.Add(m_colors)
m_menu.MenuItems.Add(New MenuItem("-"))
m_menu.MenuItems.Add(InlineAssignHelper(avg_checked, New MenuItem("Display Averages", New EventHandler(AddressOf Avg_Click))))
m_menu.MenuItems.Add(m_interval_menu)
m_menu.MenuItems.Add(m_scale_menu)
m_menu.MenuItems.Add(m_graphs)
m_menu.MenuItems.Add(m_units)
m_menu.MenuItems.Add(m_interfaces)
m_menu.MenuItems.Add(New MenuItem("-"))
m_menu.MenuItems.Add(m_utils)
m_menu.MenuItems.Add(New MenuItem("-"))
m_menu.MenuItems.Add(New MenuItem("About FreeMeter", New EventHandler(AddressOf About_Click)))
m_menu.MenuItems.Add(New MenuItem("Exit FreeMeter", New EventHandler(AddressOf Exit_Click)))
m_colors.Text = "Colors/Opacity"
m_colors.MenuItems.Add(InlineAssignHelper(colorcycle, New MenuItem("Cycle Colors", New EventHandler(AddressOf Cycle_Colors))))
m_colors.MenuItems.Add(New MenuItem("-"))
m_colors.MenuItems.Add(New MenuItem("Hue Slider", New EventHandler(AddressOf Trackbar1_Show)))
m_colors.MenuItems.Add(New MenuItem("Color", New EventHandler(AddressOf Color_Click)))
m_colors.MenuItems.Add(New MenuItem("Text Color", New EventHandler(AddressOf TextColor_Click)))
m_colors.MenuItems.Add(New MenuItem("Reset To Default", New EventHandler(AddressOf DefaultColor_Click)))
m_colors.MenuItems.Add(New MenuItem("-"))
m_colors.MenuItems.Add(New MenuItem("Transparency Slider", New EventHandler(AddressOf Trackbar2_Show)))
m_colors.MenuItems.Add(New MenuItem("Opaque", New EventHandler(AddressOf Opaque_Click)))
m_interval_menu.Text = "Update Interval"
m_interval_menu.MenuItems.Add(InlineAssignHelper(interval_tenth, New MenuItem("1/10 second", New EventHandler(AddressOf SetTimerInterval))))
m_interval_menu.MenuItems.Add(InlineAssignHelper(interval_fifth, New MenuItem("1/5 second", New EventHandler(AddressOf SetTimerInterval))))
m_interval_menu.MenuItems.Add(InlineAssignHelper(interval_half, New MenuItem("1/2 second", New EventHandler(AddressOf SetTimerInterval))))
m_interval_menu.MenuItems.Add(InlineAssignHelper(interval_1, New MenuItem("1 second", New EventHandler(AddressOf SetTimerInterval))))
m_scale_menu.Text = "Graph Scale"
m_scale_menu.MenuItems.Add(InlineAssignHelper(autoscale_checked, New MenuItem("Auto", New EventHandler(AddressOf SetAutoScale))))
m_scale_menu.MenuItems.Add(New MenuItem("-"))
m_scale_menu.MenuItems.Add(InlineAssignHelper(scale_33, New MenuItem("33.6 kb", New EventHandler(AddressOf SetScale_MenuClick))))
m_scale_menu.MenuItems.Add(InlineAssignHelper(scale_56, New MenuItem("56 kb", New EventHandler(AddressOf SetScale_MenuClick))))
m_scale_menu.MenuItems.Add(InlineAssignHelper(scale_64, New MenuItem("64 kb", New EventHandler(AddressOf SetScale_MenuClick))))
m_scale_menu.MenuItems.Add(InlineAssignHelper(scale_128, New MenuItem("128 kb", New EventHandler(AddressOf SetScale_MenuClick))))
m_scale_menu.MenuItems.Add(InlineAssignHelper(scale_256, New MenuItem("256 kb", New EventHandler(AddressOf SetScale_MenuClick))))
m_scale_menu.MenuItems.Add(InlineAssignHelper(scale_512, New MenuItem("512 kb", New EventHandler(AddressOf SetScale_MenuClick))))
m_scale_menu.MenuItems.Add(InlineAssignHelper(scale_640, New MenuItem("640 kb", New EventHandler(AddressOf SetScale_MenuClick))))
m_scale_menu.MenuItems.Add(InlineAssignHelper(scale_1000, New MenuItem("1 mb", New EventHandler(AddressOf SetScale_MenuClick))))
m_scale_menu.MenuItems.Add(InlineAssignHelper(scale_1500, New MenuItem("1.5 mb", New EventHandler(AddressOf SetScale_MenuClick))))
m_scale_menu.MenuItems.Add(InlineAssignHelper(scale_2000, New MenuItem("2 mb", New EventHandler(AddressOf SetScale_MenuClick))))
m_scale_menu.MenuItems.Add(InlineAssignHelper(scale_3000, New MenuItem("3 mb", New EventHandler(AddressOf SetScale_MenuClick))))
m_scale_menu.MenuItems.Add(InlineAssignHelper(scale_5000, New MenuItem("5 mb", New EventHandler(AddressOf SetScale_MenuClick))))
m_scale_menu.MenuItems.Add(InlineAssignHelper(scale_7000, New MenuItem("7 mb", New EventHandler(AddressOf SetScale_MenuClick))))
m_scale_menu.MenuItems.Add(InlineAssignHelper(scale_10000, New MenuItem("10 mb", New EventHandler(AddressOf SetScale_MenuClick))))
m_scale_menu.MenuItems.Add(InlineAssignHelper(scale_11000, New MenuItem("11 mb", New EventHandler(AddressOf SetScale_MenuClick))))
m_scale_menu.MenuItems.Add(InlineAssignHelper(scale_32000, New MenuItem("32 mb", New EventHandler(AddressOf SetScale_MenuClick))))
m_scale_menu.MenuItems.Add(InlineAssignHelper(scale_54000, New MenuItem("54 mb", New EventHandler(AddressOf SetScale_MenuClick))))
m_scale_menu.MenuItems.Add(InlineAssignHelper(scale_100000, New MenuItem("100 mb", New EventHandler(AddressOf SetScale_MenuClick))))
m_scale_menu.MenuItems.Add(InlineAssignHelper(scale_1000000, New MenuItem("1 gb", New EventHandler(AddressOf SetScale_MenuClick))))
m_scale_menu.MenuItems.Add(InlineAssignHelper(scale_custom, New MenuItem("custom", New EventHandler(AddressOf SetScale_MenuClick))))
m_units.Text = "Units"
m_units.MenuItems.Add(InlineAssignHelper(units_kbits, New MenuItem("Bits per sec (eg kbps)", New EventHandler(AddressOf SetUnits_kbits))))
m_units.MenuItems.Add(InlineAssignHelper(units_kbytes, New MenuItem("Bytes per sec (eg kB/s)", New EventHandler(AddressOf SetUnits_kbytes))))
m_interfaces.Text = "Interfaces"
For Each adapter As NetworkAdapter In monitor.Adapters
Dim tmp As New MenuItem(adapter.Name, New EventHandler(AddressOf SetAdapter))
m_interfaces.MenuItems.Add(tmp)
tmp.Checked = adapter.Enabled
Next
m_utils.Text = "Utilities"
m_utils.MenuItems.Add(InlineAssignHelper(clip_watch, New MenuItem("URL Grabber Enabled", New EventHandler(AddressOf Clip_Click))))
m_utils.MenuItems.Add(New MenuItem("-"))
m_utils.MenuItems.Add(InlineAssignHelper(mailcheck, New MenuItem("Email Notify Enabled", New EventHandler(AddressOf CheckMail_Auto))))
m_utils.MenuItems.Add(InlineAssignHelper(mailchecknow, New MenuItem("Check Email Now", New EventHandler(AddressOf CheckMail_Now))))
m_utils.MenuItems.Add(New MenuItem("Email Server Settings", New EventHandler(AddressOf CheckMail_Settings)))
m_utils.MenuItems.Add(New MenuItem("-"))
m_utils.MenuItems.Add(New MenuItem("Ping Utility", New EventHandler(AddressOf Ping_Click)))
m_utils.MenuItems.Add(New MenuItem("Traceroute Utility", New EventHandler(AddressOf Trace_Click)))
m_utils.MenuItems.Add(New MenuItem("UPnP NAT Utility", New EventHandler(AddressOf UPnP_Click)))
m_utils.MenuItems.Add(New MenuItem("-"))
m_utils.MenuItems.Add(New MenuItem("Totals Log", New EventHandler(AddressOf ShowTotalsLog_Click)))
m_utils.MenuItems.Add(InlineAssignHelper(m_update, New MenuItem("Check For Updates", New EventHandler(AddressOf Check_Version))))
m_graphs.Text = "Graphs"
m_graphs.MenuItems.Add(InlineAssignHelper(graph_label_checked, New MenuItem("Show Graph Heading", New EventHandler(AddressOf SetGraph_Label))))
m_graphs.MenuItems.Add(InlineAssignHelper(graphs_summary, New MenuItem("Show Summary On Left(up) and Right(down)", New EventHandler(AddressOf SetGraph_Summary))))
m_graphs.MenuItems.Add(New MenuItem("-"))
m_graphs.MenuItems.Add(InlineAssignHelper(graphs_download, New MenuItem("Download", New EventHandler(AddressOf SetGraph_Download))))
m_graphs.MenuItems.Add(InlineAssignHelper(graphs_upload, New MenuItem("Upload", New EventHandler(AddressOf SetGraph_Upload))))
m_graphs.MenuItems.Add(New MenuItem("-"))
m_graphs.MenuItems.Add(InlineAssignHelper(font_large, New MenuItem("Large Font", New EventHandler(AddressOf SetFont_Large))))
m_graphs.MenuItems.Add(InlineAssignHelper(font_medium, New MenuItem("Medium Font", New EventHandler(AddressOf SetFont_Medium))))
m_graphs.MenuItems.Add(InlineAssignHelper(font_small, New MenuItem("Small Font", New EventHandler(AddressOf SetFont_Small))))
End Sub
Public Sub Check_Menus()
interval_tenth.Checked = InlineAssignHelper(interval_fifth.Checked, InlineAssignHelper(interval_half.Checked, InlineAssignHelper(interval_1.Checked, False)))
scale_33.Checked = InlineAssignHelper(scale_56.Checked, InlineAssignHelper(scale_64.Checked, InlineAssignHelper(scale_128.Checked, InlineAssignHelper(scale_256.Checked, InlineAssignHelper(scale_512.Checked, InlineAssignHelper(scale_640.Checked, InlineAssignHelper(scale_1000.Checked, InlineAssignHelper(scale_1500.Checked, InlineAssignHelper(scale_2000.Checked, InlineAssignHelper(scale_3000.Checked, InlineAssignHelper(scale_5000.Checked, InlineAssignHelper(scale_7000.Checked, InlineAssignHelper(scale_10000.Checked, InlineAssignHelper(scale_11000.Checked, InlineAssignHelper(scale_32000.Checked, InlineAssignHelper(scale_54000.Checked, InlineAssignHelper(scale_100000.Checked, InlineAssignHelper(scale_1000000.Checked, InlineAssignHelper(scale_custom.Checked, False)))))))))))))))))))
If timerInterval = 100 Then
interval_tenth.Checked = True
ElseIf timerInterval = 200 Then
interval_fifth.Checked = True
ElseIf timerInterval = 500 Then
interval_half.Checked = True
ElseIf timerInterval = 1000 Then
interval_1.Checked = True
End If
Select Case scale
Case 4200
scale_33.Checked = True
display_yscale = "scale: 33.6 kb"
Exit Select
Case 7000
scale_56.Checked = True
display_yscale = "scale: 56 kb"
Exit Select
Case 8000
scale_64.Checked = True
display_yscale = "scale: 64 kb"
Exit Select
Case 16000
scale_128.Checked = True
display_yscale = "scale: 128 kb"
Exit Select
Case 32000
scale_256.Checked = True
display_yscale = "scale: 256 kb"
Exit Select
Case 64000
scale_512.Checked = True
display_yscale = "scale: 512 kb"
Exit Select
Case 80000
scale_640.Checked = True
display_yscale = "scale: 640 kb"
Exit Select
Case 128000
scale_1000.Checked = True
display_yscale = "scale: 1 mb"
Exit Select
Case 192000
scale_1500.Checked = True
display_yscale = "scale: 1.5 mb"
Exit Select
Case 256000
scale_2000.Checked = True
display_yscale = "scale: 2 mb"
Exit Select
Case 384000
scale_3000.Checked = True
display_yscale = "scale: 3 mb"
Exit Select
Case 640000
scale_5000.Checked = True
display_yscale = "scale: 5 mb"
Exit Select
Case 896000
scale_7000.Checked = True
display_yscale = "scale: 7 mb"
Exit Select
Case 1280000
scale_10000.Checked = True
display_yscale = "scale: 10 mb"
Exit Select
Case 1408000
scale_11000.Checked = True
display_yscale = "scale: 11 mb"
Exit Select
Case 4096000
scale_32000.Checked = True
display_yscale = "scale: 32 mb"
Exit Select
Case 6912000
scale_54000.Checked = True
display_yscale = "scale: 54 mb"
Exit Select
Case 12800000
scale_100000.Checked = True
display_yscale = "scale: 100 mb"
Exit Select
Case 128000000
scale_1000000.Checked = True
display_yscale = "scale: 1 gb"
Exit Select
Case Else
scale_custom.Checked = True
display_yscale = "scale: custom (" & Totals_Log.Value(scale, Nothing) & ")"
Exit Select
End Select
End Sub
' handlers for menu clicks
Private Sub SetTimerInterval(ByVal sender As [Object], ByVal e As EventArgs)
For Each m As MenuItem In m_interval_menu.MenuItems
If m.Equals(sender) Then
If Not m.Checked Then
m.Checked = True
End If
Select Case m.Text
Case "1/10 second"
timerInterval = 100
Exit Select
Case "1/5 second"
timerInterval = 200
Exit Select
Case "1/2 second"
timerInterval = 500
Exit Select
Case "1 second"
timerInterval = 1000
Exit Select
End Select
display_xscale = "time: " & timerInterval * pictureBox1.Width / 1000 & "s "
Else
m.Checked = False
End If
Next
End Sub
Private Sub SetAutoScale(ByVal sender As [Object], ByVal e As EventArgs)
autoscale_checked.Checked = Not autoscale_checked.Checked
End Sub
Private Sub ResizeScale()
'resize line values in array to match new scale.
For i As Integer = 0 To full_downlines.Length - 1
full_downlines(i) = CInt((pictureBox1.Height * full_downspeeds(i) / scale))
full_uplines(i) = CInt((pictureBox1.Height * full_upspeeds(i) / scale))
Next
For i As Integer = 0 To downlines.Length - 1
downlines(i) = 16 * CInt(full_downspeeds(full_downlines.Length - 16 + i)) / scale
uplines(i) = 16 * CInt(full_upspeeds(full_downlines.Length - 16 + i)) / scale
Next
End Sub
Private Sub SetScale_MenuClick(ByVal sender As [Object], ByVal e As EventArgs)
'from a menu click to change graph scale
For Each m As MenuItem In m_scale_menu.MenuItems
If m Is autoscale_checked Then
If m.Equals(sender) Then
If Not m.Checked Then
m.Checked = True
End If
Select Case m.Text
Case "33.6 kb"
scale = 4200
Exit Select
Case "56 kb"
scale = 7000
Exit Select
Case "64 kb"
scale = 8000
Exit Select
Case "128 kb"
scale = 16000
Exit Select
Case "256 kb"
scale = 32000
Exit Select
Case "512 kb"
scale = 64000
Exit Select
Case "640 kb"
scale = 80000
Exit Select
Case "1 mb"
scale = 128000
Exit Select
Case "1.5 mb"
scale = 192000
Exit Select
Case "2 mb"
scale = 256000
Exit Select
Case "3 mb"
scale = 384000
Exit Select
Case "5 mb"
scale = 640000
Exit Select
Case "7 mb"
scale = 896000
Exit Select
Case "10 mb"
scale = 1280000
Exit Select
Case "11 mb"
scale = 1408000
Exit Select
Case "32 mb"
scale = 4096000
Exit Select
Case "54 mb"
scale = 6912000
Exit Select
Case "100 mb"
scale = 12800000
Exit Select
Case "1 gb"
scale = 128000000
Exit Select
Case Else
'custom
If True Then
Dim g As New GetValue("Provide custom scale in bytes (1024B = 1KB)")
If g.ShowDialog() = DialogResult.OK Then
Try
scale = Integer.Parse(g.Value)
m.Text = "custom (" & Totals_Log.Value(scale, Nothing) & ")"
Catch
m.Text = "custom"
End Try
End If
Exit Select
End If
End Select
Check_Menus()
ResizeScale()
Else
m.Checked = False
End If
End If
Next
End Sub
Private Sub SetUnits_kbits(ByVal sender As [Object], ByVal e As EventArgs)
units_kbits.Checked = Not units_kbits.Checked
End Sub
Private Sub SetUnits_kbytes(ByVal sender As [Object], ByVal e As EventArgs)
units_kbytes.Checked = Not units_kbytes.Checked
End Sub
Private Sub SetAdapter(ByVal sender As [Object], ByVal e As EventArgs)
For Each adapter As NetworkAdapter In monitor.Adapters
For Each m As MenuItem In m_interfaces.MenuItems
If m Is sender AndAlso adapter.Name = m.Text Then
If m.Checked Then
m.Checked = InlineAssignHelper(adapter.Enabled, False)
Else
m.Checked = InlineAssignHelper(adapter.Enabled, True)
adapter.init()
End If
End If
Next
Next
End Sub
Private Sub SetGraph_Summary(ByVal sender As [Object], ByVal e As EventArgs)
graphs_summary.Checked = Not graphs_summary.Checked
End Sub
Private Sub SetGraph_Label(ByVal sender As [Object], ByVal e As EventArgs)
graph_label_checked.Checked = Not graph_label_checked.Checked
End Sub
Private Sub SetGraph_Download(ByVal sender As [Object], ByVal e As EventArgs)
graphs_download.Checked = Not graphs_download.Checked
End Sub
Private Sub SetGraph_Upload(ByVal sender As [Object], ByVal e As EventArgs)
graphs_upload.Checked = Not graphs_upload.Checked
End Sub
Private Sub SetFont_Large(ByVal sender As [Object], ByVal e As EventArgs)
font_large.Checked = True
font_medium.Checked = InlineAssignHelper(font_small.Checked, False)
End Sub
Private Sub SetFont_Medium(ByVal sender As [Object], ByVal e As EventArgs)
font_medium.Checked = True
font_large.Checked = InlineAssignHelper(font_small.Checked, False)
End Sub
Private Sub SetFont_Small(ByVal sender As [Object], ByVal e As EventArgs)
font_small.Checked = True
font_medium.Checked = InlineAssignHelper(font_large.Checked, False)
End Sub
Private Sub Avg_Click(ByVal sender As [Object], ByVal e As EventArgs)
avg_checked.Checked = Not avg_checked.Checked
End Sub
Private Sub Clip_Click(ByVal sender As [Object], ByVal e As EventArgs)
If clip_watch.Checked Then
clip_watch.Checked = False
ClipData = Nothing
ClipTimer.[Stop]()
Else
clip_watch.Checked = True
ClipData = ""
ClipTimer.Start()
End If
End Sub
Private Sub Show_Click(ByVal sender As [Object], ByVal e As EventArgs)
If WindowState = FormWindowState.Normal Then
WindowState = FormWindowState.Minimized
show_checked.Checked = False
Hide()
Else
Show()
show_checked.Checked = True
WindowState = FormWindowState.Normal
Dim rect As Rectangle = Screen.PrimaryScreen.WorkingArea
If Me.Location.X > rect.Width OrElse Me.Location.Y > rect.Height OrElse Me.Location.Y < 0 OrElse Me.Location.X < 0 Then
Me.CenterToScreen()
End If
End If
End Sub
Private Sub TopMost_Click(ByVal sender As [Object], ByVal e As EventArgs)
topmost_checked.Checked = Not topmost_checked.Checked
TopMost = topmost_checked.Checked
End Sub
Private Sub SimpleNotifyIcon_Click(ByVal sender As [Object], ByVal e As EventArgs)
simple_icon_checked.Checked = Not simple_icon_checked.Checked
icon_representation = simple_icon_checked.Checked
End Sub
Private Sub Exit_Click(ByVal sender As [Object], ByVal e As EventArgs)
m_closing = True
Application.[Exit]()
End Sub
Private Sub About_Click(ByVal sender As [Object], ByVal e As EventArgs)
AboutForm.ShowAboutForm(Me)
End Sub
'handlers for mail menu clicks
Private Sub CheckMail_Auto(ByVal sender As [Object], ByVal e As EventArgs)
If mailcheck.Checked Then
mailcheck.Checked = False
MailTimer.[Stop]()
Else
mailcheck.Checked = True
MailTimer.Start()
End If
End Sub
Private Sub CheckMail_Now(ByVal sender As [Object], ByVal e As EventArgs)
MailTimer_Tick(sender, e)
End Sub
Private Sub CheckMail_Settings(ByVal sender As [Object], ByVal e As EventArgs)
Dim frm As New EmailSettings_Form()
frm.MyParentForm = Me
If frm.ShowDialog() = DialogResult.OK Then
MailServers.Clear()
For i As Integer = 0 To frm.har.Count - 1
Dim server As New MailServer()
server.Host = frm.har(i).ToString()
server.User = frm.uar(i).ToString()
server.Pass = frm.par(i).ToString()
server.Enabled = CBool(frm.ear(i))
server.Type = frm.tar(i).ToString()
MailServers.Add(server)
Next
MailTimer.Interval = frm.Time * 1000 * 60
End If
frm.Dispose()
End Sub
Private Sub Ping_Click(ByVal sender As [Object], ByVal e As EventArgs)
Dim frm As New AdvPing()
frm.MyParentForm = Me
frm.Show(Me)
End Sub
Private Sub Trace_Click(ByVal sender As [Object], ByVal e As EventArgs)
Dim frm As New AdvTrace()
frm.MyParentForm = Me
frm.Show(Me)
End Sub
Private Sub UPnP_Click(ByVal sender As [Object], ByVal e As EventArgs)
Dim frm As New frmUPnP()
frm.MyParentForm = Me
frm.Show(Me)
End Sub
'check version
Private Sub Check_Version(ByVal sender As Object, ByVal e As EventArgs)
If sender.Equals(m_update) Then
respond_to_latest = True
End If
Dim checkversionWorker As New BackgroundWorker()
checkversionWorker.WorkerReportsProgress = False
AddHandler checkversionWorker.DoWork, AddressOf CheckVersionWorker_DoWork
checkversionWorker.RunWorkerAsync()
checkversionWorker.Dispose()
End Sub
Private Sub CheckVersionWorker_DoWork(ByVal sender As Object, ByVal e As DoWorkEventArgs)
Dim ThisAssemblyName As AssemblyName = myAssembly.GetName()
Dim FriendlyVersion As String = (("v" & ThisAssemblyName.Version.Major.ToString() & ".") + ThisAssemblyName.Version.Minor.ToString() & ".") + ThisAssemblyName.Version.Build.ToString()
If Not respond_to_latest Then
Thread.Sleep(30000)
End If
Try
Dim w As WebRequest = WebRequest.Create("http://freemeter.cvs.sourceforge.net/*checkout*/freemeter/FM_CVS/changelog.txt?revision=HEAD")
Dim sw As Stream = w.GetResponse().GetResponseStream()
Dim sr As New StreamReader(sw)
Dim line As String = sr.ReadLine()
Dim result As Integer = [String].Compare(line, 1, FriendlyVersion, 1, 8, True, _
CultureInfo.InvariantCulture)
If result < 0 Then
m_notifyicon.ShowBalloonTip(1, "Your version is newer.", (line & " is online version. You have ") + FriendlyVersion & ".", ToolTipIcon.Info)
ElseIf result > 0 Then
m_notifyicon.ShowBalloonTip(1, "New Update Is Available", (line & " is available. You have ") + FriendlyVersion & "." & vbLf & "Check About dialog for download site.", ToolTipIcon.Info)
ElseIf respond_to_latest Then
m_notifyicon.ShowBalloonTip(1, "No New Updates", "You have the latest version (" & line & ").", ToolTipIcon.Info)
respond_to_latest = False
End If
sr.Close()
sr.Dispose()
sw.Close()
sw.Dispose()
Catch ex As Exception
m_notifyicon.ShowBalloonTip(1, "Check For Update", ex.Message, ToolTipIcon.[Error])
End Try
End Sub
' Registry reading/writing, and form Dispose override
Private Sub RestoreRegistry()
Try
Registry.CurrentUser.DeleteSubKey("Software\FreeMeter")
Catch
End Try
End Sub
Protected Overloads Overrides Sub Dispose(ByVal disposing As Boolean)
If backgroundWorker1 IsNot Nothing Then
backgroundWorker1.Abort()
End If
SaveConfiguration()
If disposing Then
m_notifyicon.Dispose()
End If
MyBase.Dispose(disposing)
End Sub
Private Sub LoadConfiguration()
Dim app_dir As String = Application.ExecutablePath
app_dir = app_dir.Remove(app_dir.LastIndexOf("\"c))
Dim xml_doc As New XmlDocument()
xml_doc.Load(app_dir & "\config.xml")
Dim xml As New Hashtable()
For Each node As XmlNode In xml_doc.DocumentElement.ChildNodes
xml(node.Name) = node.InnerText
Next
avg_checked.Checked = Boolean.Parse(xml("DispAvg").ToString())
units_kbytes.Checked = Boolean.Parse(xml("UnitsKbytes").ToString())
units_kbits.Checked = Boolean.Parse(xml("UnitsKbits").ToString())
graphs_download.Checked = Boolean.Parse(xml("GraphDownload").ToString())
graphs_upload.Checked = Boolean.Parse(xml("GraphUpload").ToString())
autoscale_checked.Checked = Boolean.Parse(xml("AutoScale").ToString())
topmost_checked.Checked = Boolean.Parse(xml("TopMost").ToString())
simple_icon_checked.Checked = Boolean.Parse(xml("SimpleNotifyIcon").ToString())
graph_label_checked.Checked = Boolean.Parse(xml("ShowGraphLabel").ToString())
colorcycle.Checked = Boolean.Parse(xml("ColorCycle").ToString())
mailcheck.Checked = Boolean.Parse(xml("MailCheck").ToString())
clip_watch.Checked = Boolean.Parse(xml("ClipWatch").ToString())
LogEnabled = Boolean.Parse(xml("LogEnabled").ToString())
timerInterval = Integer.Parse(xml("TimerInterval").ToString())
LogInterval = Integer.Parse(xml("LogInterval").ToString())
scale = Integer.Parse(xml("GraphScale").ToString())
WLength = Integer.Parse(xml("DispWidth").ToString())
WHeight = Integer.Parse(xml("DispHeight").ToString())
full_downlines = New Integer(WLength - 1) {}
full_uplines = New Integer(WLength - 1) {}
full_downspeeds = New Double(WLength - 1) {}
full_upspeeds = New Double(WLength - 1) {}
ClientSize = New Size(WLength, WHeight)
If xml("WindowIsVisible").ToString().ToLower() = "true" Then
Show()
Location = New Point(Integer.Parse(xml("WindowX").ToString()), Integer.Parse(xml("WindowY").ToString()))
show_checked.Checked = True
WindowState = FormWindowState.Normal
Else
Location = New Point(Integer.Parse(xml("WindowX").ToString()), Integer.Parse(xml("WindowY").ToString()))
WindowState = FormWindowState.Minimized
show_checked.Checked = False
Hide()
End If
If Integer.Parse(xml("FontSize").ToString()) = 2 Then
font_large.Checked = True
ElseIf Integer.Parse(xml("FontSize").ToString()) = 1 Then
font_medium.Checked = True
Else
font_small.Checked = True
End If
Dim host As String = xml("PopServer").ToString()
Dim user As String = xml("PopUser").ToString()
Dim pass As String = xml("PopPass").ToString()
Dim enab As String = xml("PopEnabled").ToString()
Dim type As String = xml("PopType").ToString()
Dim htokens As String() = host.Split(New Char() {","c}, StringSplitOptions.RemoveEmptyEntries)
Dim utokens As String() = user.Split(New Char() {","c}, StringSplitOptions.RemoveEmptyEntries)
Dim ptokens As String() = pass.Split(New Char() {","c}, StringSplitOptions.RemoveEmptyEntries)
Dim etokens As String() = enab.Split(New Char() {","c}, StringSplitOptions.RemoveEmptyEntries)
Dim ttokens As String() = type.Split(New Char() {","c}, StringSplitOptions.RemoveEmptyEntries)
For i As Integer = 0 To htokens.Length - 1
Dim server As New MailServer()
server.Host = htokens(i)
server.User = utokens(i)
server.Pass = Decrypt(ptokens(i), utokens(i))
server.Type = ttokens(i)
If etokens(i) = "True" Then
server.Enabled = True
Else
server.Enabled = False
End If
server.OldMsgCount = 0
MailServers.Add(server)
Next
MailServers.RemoveAt(0)
'remove the default value
MailTimer.Interval = Integer.Parse(xml("MailCheckInterval").ToString())
If mailcheck.Checked Then
MailTimer.Start()
End If
If clip_watch.Checked Then
ClipTimer.Start()
End If
LogTimer.Interval = LogInterval * 60000
If LogEnabled Then
LogTimer.Start()
End If
trackBar2.Maximum = 100
trackBar2.Minimum = 30
trackBar2.Value = Integer.Parse(xml("Trans").ToString())
Opacity = CSng(trackBar2.Value) / 100
BACKGROUND_COLOR = Color.FromArgb(255, Integer.Parse(xml("BackgroundRed").ToString()), Integer.Parse(xml("BackgroundGreen").ToString()), Integer.Parse(xml("BackgroundBlue").ToString()))
FORGROUND_COLOR = Color.FromArgb(255, Integer.Parse(xml("ForegroundRed").ToString()), Integer.Parse(xml("ForegroundGreen").ToString()), Integer.Parse(xml("ForegroundBlue").ToString()))
TopMost = topmost_checked.Checked
icon_representation = simple_icon_checked.Checked
logs_form.LoadConfiguration(xml)
graphs_summary.Checked = Boolean.Parse(xml("GraphSummary").ToString())
End Sub
Private Sub SetDefaults()
timerInterval = 1000
scale = 7000
avg_checked.Checked = False
WLength = 126
WHeight = 64
full_downlines = New Integer(WLength - 1) {}
full_uplines = New Integer(WLength - 1) {}
full_downspeeds = New Double(WLength - 1) {}
full_upspeeds = New Double(WLength - 1) {}
ClientSize = New Size(WLength, WHeight)
units_kbytes.Checked = True
units_kbits.Checked = False
graphs_download.Checked = True
graphs_upload.Checked = True
autoscale_checked.Checked = True
Me.CenterToScreen()
' Location
topmost_checked.Checked = True
show_checked.Checked = True
WindowState = FormWindowState.Normal
Show()
graph_label_checked.Checked = True
colorcycle.Checked = False
BACKGROUND_COLOR = Color.FromArgb(255, 44, 81, 138)
FORGROUND_COLOR = Color.FromArgb(255, 255, 255, 255)
mailcheck.Checked = False
Dim server As New MailServer()
server.Host = "mail.exampleserver.com"
server.User = "username"
server.Pass = Decrypt(Encrypt("password", "username"), "username")
server.Type = "0"
server.Enabled = False
server.OldMsgCount = 0
MailServers.Add(server)
MailTimer.Interval = 600000
trackBar2.Maximum = 100
trackBar2.Minimum = 30
trackBar2.Value = 100
Opacity = CSng(trackBar2.Value) / 100
clip_watch.Checked = False
LogInterval = 5
LogEnabled = False
font_large.Checked = False
font_medium.Checked = False
font_small.Checked = True
End Sub
Private Sub SaveConfiguration()
Dim app_dir As String = Application.ExecutablePath
app_dir = app_dir.Remove(app_dir.LastIndexOf("\"c))
Dim writer As New XmlTextWriter(app_dir & "\config.xml", Encoding.UTF8)
writer.Formatting = Formatting.Indented
writer.WriteStartDocument()
writer.WriteStartElement("settings")
writer.WriteElementString("DispAvg", avg_checked.Checked.ToString())
writer.WriteElementString("UnitsKbytes", units_kbytes.Checked.ToString())
writer.WriteElementString("UnitsKbits", units_kbits.Checked.ToString())
writer.WriteElementString("GraphDownload", graphs_download.Checked.ToString())
writer.WriteElementString("GraphUpload", graphs_upload.Checked.ToString())
writer.WriteElementString("GraphSummary", graphs_summary.Checked.ToString())
writer.WriteElementString("AutoScale", autoscale_checked.Checked.ToString())
writer.WriteElementString("TopMost", topmost_checked.Checked.ToString())
writer.WriteElementString("SimpleNotifyIcon", simple_icon_checked.Checked.ToString())
writer.WriteElementString("ShowGraphLabel", graph_label_checked.Checked.ToString())
writer.WriteElementString("ColorCycle", colorcycle.Checked.ToString())
writer.WriteElementString("MailCheck", mailcheck.Checked.ToString())
writer.WriteElementString("ClipWatch", clip_watch.Checked.ToString())
writer.WriteElementString("LogEnabled", LogEnabled.ToString())
writer.WriteElementString("TimerInterval", timerInterval.ToString())
writer.WriteElementString("LogInterval", LogInterval.ToString())
' TODO: save data regarding mail
Dim hstring As String = Nothing
Dim ustring As String = Nothing
Dim pstring As String = Nothing
Dim estring As String = Nothing
Dim tstring As String = Nothing
For Each server As MailServer In MailServers
hstring += server.Host & ","
ustring += server.User & ","
pstring += Encrypt(server.Pass, server.User) & ","
estring += server.Enabled.ToString() & ","
tstring += server.Type.ToString() & ","
Next
hstring = hstring.Substring(0, hstring.Length - 1)
ustring = ustring.Substring(0, ustring.Length - 1)
pstring = pstring.Substring(0, pstring.Length - 1)
estring = estring.Substring(0, estring.Length - 1)
tstring = tstring.Substring(0, tstring.Length - 1)
writer.WriteElementString("PopServer", hstring)
writer.WriteElementString("PopUser", ustring)
writer.WriteElementString("PopPass", pstring)
writer.WriteElementString("PopEnabled", estring)
writer.WriteElementString("PopType", tstring)
' TODO: save data regarding mail
writer.WriteElementString("MailCheckInterval", MailTimer.Interval.ToString())
writer.WriteElementString("BackgroundRed", CInt(BACKGROUND_COLOR.R).ToString())
writer.WriteElementString("BackgroundGreen", CInt(BACKGROUND_COLOR.G).ToString())
writer.WriteElementString("BackgroundBlue", CInt(BACKGROUND_COLOR.B).ToString())
writer.WriteElementString("ForegroundRed", CInt(FORGROUND_COLOR.R).ToString())
writer.WriteElementString("ForegroundGreen", CInt(FORGROUND_COLOR.G).ToString())
writer.WriteElementString("ForegroundBlue", CInt(FORGROUND_COLOR.B).ToString())
writer.WriteElementString("WindowX", Me.Location.X.ToString())
writer.WriteElementString("WindowY", Me.Location.Y.ToString())
writer.WriteElementString("DispWidth", ClientSize.Width.ToString())
writer.WriteElementString("DispHeight", ClientSize.Height.ToString())
If WindowState = FormWindowState.Normal Then
writer.WriteElementString("WindowIsVisible", "True")
Else
writer.WriteElementString("WindowIsVisible", "False")
End If
writer.WriteElementString("GraphScale", scale.ToString())
writer.WriteElementString("Trans", trackBar2.Value.ToString())
If font_large.Checked Then
writer.WriteElementString("FontSize", "2")
ElseIf font_medium.Checked Then
writer.WriteElementString("FontSize", "1")
Else
writer.WriteElementString("FontSize", "0")
End If
logs_form.SaveConfiguration(writer)
writer.WriteEndElement()
writer.WriteEndDocument()
writer.Close()
End Sub
'enc denc
Private Function Encrypt(ByVal plainMessage As String, ByVal password As String) As String
Dim des As New TripleDESCryptoServiceProvider()
des.IV = New Byte(7) {}
Dim pdb As New PasswordDeriveBytes(password, New Byte(-1) {})
des.Key = pdb.CryptDeriveKey("RC2", "MD5", 128, New Byte(7) {})
Dim ms As New MemoryStream(plainMessage.Length * 2)
Dim encStream As New CryptoStream(ms, des.CreateEncryptor(), CryptoStreamMode.Write)
Dim plainBytes As Byte() = Encoding.UTF8.GetBytes(plainMessage)
encStream.Write(plainBytes, 0, plainBytes.Length)
encStream.FlushFinalBlock()
Dim encryptedBytes As Byte() = New Byte(ms.Length - 1) {}
ms.Position = 0
ms.Read(encryptedBytes, 0, CInt(ms.Length))
encStream.Close()
ms.Close()
Return Convert.ToBase64String(encryptedBytes)
End Function
Private Function Decrypt(ByVal encryptedBase64 As String, ByVal password As String) As String
Dim des As New TripleDESCryptoServiceProvider()
des.IV = New Byte(7) {}
Dim pdb As New PasswordDeriveBytes(password, New Byte(-1) {})
des.Key = pdb.CryptDeriveKey("RC2", "MD5", 128, New Byte(7) {})
Dim encryptedBytes As Byte() = Convert.FromBase64String(encryptedBase64)
Dim ms As New MemoryStream(encryptedBase64.Length)
Dim decStream As New CryptoStream(ms, des.CreateDecryptor(), CryptoStreamMode.Write)
decStream.Write(encryptedBytes, 0, encryptedBytes.Length)
decStream.FlushFinalBlock()
Dim plainBytes As Byte() = New Byte(ms.Length - 1) {}
ms.Position = 0
ms.Read(plainBytes, 0, CInt(ms.Length))
decStream.Close()
ms.Close()
Return Encoding.UTF8.GetString(plainBytes)
End Function
'set the text of a control in a thread safe manner
Private Delegate Sub SetTextCallback(ByVal l As Label, ByVal t As String, ByVal offset As Integer)
Private Delegate Sub SetColorCallback(ByVal l As Control, ByVal c As Color)
Private Sub SetText(ByVal l As Label, ByVal t As String, ByVal offset As Integer)
If l.InvokeRequired Then
Dim d As New SetTextCallback(AddressOf SetText)
Try
Me.Invoke(d, New [Object]() {l, t, offset})
Catch e As ObjectDisposedException
Console.WriteLine(e.ToString())
End Try
Else
If ClientSize.Width > 40 AndAlso ClientSize.Height > 40 Then
WLength = ClientSize.Width
WHeight = ClientSize.Height
End If
Dim font_adjust As Integer = 0
If Not font_small.Checked Then
font_adjust = 1
End If
If WLength > 125 Then
If font_large.Checked Then
l.Font = New Font("MS Serif", 7 + font_adjust, FontStyle.Bold)
Else
l.Font = New Font("MS Serif", 7 + font_adjust, FontStyle.Regular)
End If
l.TextAlign = ContentAlignment.TopLeft
l.Location = New Point(10 + offset, WHeight - 14)
ElseIf WLength > 95 Then
If font_large.Checked Then
l.Font = New Font("MS Serif", 6 + font_adjust, FontStyle.Bold)
Else
l.Font = New Font("MS Serif", 6 + font_adjust, FontStyle.Regular)
End If
l.TextAlign = ContentAlignment.MiddleLeft
l.Location = New Point(10 + offset, WHeight - 14)
Else
If font_large.Checked Then
l.Font = New Font("MS Serif", 5 + font_adjust, FontStyle.Bold)
Else
l.Font = New Font("MS Serif", 5 + font_adjust, FontStyle.Regular)
End If
l.TextAlign = ContentAlignment.MiddleLeft
l.Location = New Point(10 + offset, WHeight - 14)
End If
l.Text = t
End If
End Sub
Private Sub SetColor(ByVal l As Control, ByVal c As Color)
If l.InvokeRequired Then
Dim d As New SetColorCallback(AddressOf SetColor)
Me.Invoke(d, New [Object]() {l, c})
Else
l.BackColor = c
End If
End Sub
' MAIN - if already running notify, otherwise run the main form
<STAThread()> _
Private Shared Sub Main()
Try
Dim RunningProcesses As Process() = Process.GetProcessesByName("FreeMeter")
If RunningProcesses.Length = 1 Then
Application.EnableVisualStyles()
Application.Run(New Form1())
ElseIf RunningProcesses.Length = 2 Then
If RunningProcesses(0).StartTime > RunningProcesses(1).StartTime Then
RunningProcesses(1).Kill()
Else
RunningProcesses(0).Kill()
End If
Application.EnableVisualStyles()
Application.Run(New Form1())
Else
MessageBox.Show("I'm Already Running!", "!")
End If
Catch ex As Exception
If Not Debugger.IsAttached Then
Dim err As New ErrorForm(ex)
err.ShowDialog()
Else
Throw ex
End If
End Try
End Sub
Private Sub ShowTotalsLog_Click(ByVal sender As [Object], ByVal e As EventArgs)
logs_form.Show(Me)
End Sub
Private Shared Function InlineAssignHelper(Of T)(ByRef target As T, ByVal value As T) As T
target = value
Return value
End Function
End Class
Public Class MailServer
Friend Enabled As Boolean
Friend Host As String
Friend User As String
Friend Pass As String
Friend Type As String
Friend OldMsgCount As Integer
End Class
' The NetworkMonitor class monitors network speed for each network adapter on the computer,
' using classes for Performance counter in .NET library.
Public Class NetworkMonitor
Private m_adapters As ArrayList
Public monitoredAdapters As ArrayList
Public Sub New()
Me.m_adapters = New ArrayList()
Me.monitoredAdapters = New ArrayList()
EnumerateNetworkAdapters()
End Sub
Private Sub EnumerateNetworkAdapters()
Dim category As New PerformanceCounterCategory("Network Interface")
For Each name As String In category.GetInstanceNames()
If name = "MS TCP Loopback interface" Then
Continue For
End If
Dim adapter As New NetworkAdapter(name)
adapter.dlCounter = New PerformanceCounter("Network Interface", "Bytes Received/sec", name)
adapter.ulCounter = New PerformanceCounter("Network Interface", "Bytes Sent/sec", name)
Me.m_adapters.Add(adapter)
adapter.init()
Next
End Sub
Public ReadOnly Property Adapters() As NetworkAdapter()
Get
Return DirectCast(Me.m_adapters.ToArray(GetType(NetworkAdapter)), NetworkAdapter())
End Get
End Property
End Class
' Represents a network adapter installed on the machine.
' Properties of this class can be used to obtain current network speed.
Public Class NetworkAdapter
' Instances of this class are supposed to be created only in an NetworkMonitor.
Friend Sub New(ByVal name As String)
Me.m_name = name
End Sub
Private dlSpeed As Long, ulSpeed As Long
Private dlValue As Long, ulValue As Long
Private dlValueOld As Long, ulValueOld As Long
Friend m_name As String
Friend dlCounter As PerformanceCounter, ulCounter As PerformanceCounter
Friend Enabled As Boolean
Friend Sub init()
Me.dlValueOld = Me.dlCounter.NextSample().RawValue
Me.ulValueOld = Me.ulCounter.NextSample().RawValue
Me.Enabled = True
End Sub
' Obtain new sample from performance counters, and refresh the values saved in dlSpeed, ulSpeed, etc.
' This method is supposed to be called only in NetworkMonitor, one time every second.
Friend Sub refresh()
Me.dlValue = Me.dlCounter.NextSample().RawValue
Me.ulValue = Me.ulCounter.NextSample().RawValue
' Calculates download and upload speed.
Me.dlSpeed = Me.dlValue - Me.dlValueOld
Me.ulSpeed = Me.ulValue - Me.ulValueOld
Me.dlValueOld = Me.dlValue
Me.ulValueOld = Me.ulValue
End Sub
' Overrides method to return the name of the adapter.
Public Overloads Overrides Function ToString() As String
Return Me.m_name
End Function
Public ReadOnly Property Name() As String
Get
Return Me.m_name
End Get
End Property
' Current download speed in bytes per second.
Public Function DownloadSpeed(ByVal Interval As Integer) As Long
Return Me.dlSpeed * 1000 / Interval
End Function
' Current upload speed in bytes per second.
Public Function UploadSpeed(ByVal Interval As Integer) As Long
Return Me.ulSpeed * 1000 / Interval
End Function
End Class
'classes for dealing with pop and imap email
Public Class POP3
Private POPServer As String
Private user As String
Private pwd As String
Public ErrMsg As String = ""
Private ns As NetworkStream
Private sr As StreamReader
Private sender As TcpClient
Public Sub New()
End Sub
Public Sub New(ByVal server As String, ByVal _user As String, ByVal _pwd As String)
POPServer = server
user = _user
pwd = _pwd
End Sub
Private Function Connect() As String
Try
sender = New TcpClient(POPServer, 110)
Catch e As SocketException
Return e.Message
End Try
Dim outbytes As [Byte]()
Dim input As String
Try
ns = sender.GetStream()
sr = New StreamReader(ns)
sr.ReadLine()
input = "user " & user & vbCr & vbLf
outbytes = System.Text.Encoding.ASCII.GetBytes(input.ToCharArray())
ns.Write(outbytes, 0, outbytes.Length)
sr.ReadLine()
input = "pass " & pwd & vbCr & vbLf
outbytes = System.Text.Encoding.ASCII.GetBytes(input.ToCharArray())
ns.Write(outbytes, 0, outbytes.Length)
Dim resp As String = sr.ReadLine()
Dim tokens As String() = resp.Split(New [Char]() {" "c})
If tokens(0).ToLower() = "-err" Then
Return "Login Failed"
End If
Catch e As InvalidOperationException
Return e.Message
End Try
Return Nothing
End Function
Private Sub Disconnect()
Dim input As String = "quit" & vbCr & vbLf
Dim outbytes As [Byte]() = System.Text.Encoding.ASCII.GetBytes(input.ToCharArray())
ns.Write(outbytes, 0, outbytes.Length)
sr.Dispose()
ns.Close()
sender.Close()
End Sub
Public Function GetNumberOfMessages() As Integer
Dim outbytes As [Byte]()
Dim input As String
Try
Dim msg As String = Connect()
If msg IsNot Nothing Then
Me.ErrMsg = msg
Return -1
End If
input = "stat" & vbCr & vbLf
outbytes = System.Text.Encoding.ASCII.GetBytes(input.ToCharArray())
If ns Is Nothing Then
Me.ErrMsg = "NetworkStream not connected"
Return -1
End If
ns.Write(outbytes, 0, outbytes.Length)
Dim resp As String = sr.ReadLine()
Dim tokens As String() = resp.Split(New [Char]() {" "c})
Disconnect()
If tokens(0).ToLower() = "-err" Then
Me.ErrMsg = "Invalid command"
Return -1
Else
Return Convert.ToInt32(tokens(1))
End If
Catch e As InvalidOperationException
Me.ErrMsg = e.Message
Return -1
End Try
End Function
End Class
Public Class IMAP
Private IMAPServer As String
Private user As String
Private pwd As String
Public ErrMsg As String = ""
Private ns As NetworkStream
Private sr As StreamReader
Private sender As TcpClient
Public Sub New()
End Sub
Public Sub New(ByVal server As String, ByVal _user As String, ByVal _pwd As String)
IMAPServer = server
user = _user
pwd = _pwd
End Sub
Private Function Connect() As String
Try
sender = New TcpClient(IMAPServer, 143)
Catch e As SocketException
Return e.Message
End Try
Dim outbytes As [Byte]()
Dim input As String
Try
ns = sender.GetStream()
sr = New StreamReader(ns)
sr.ReadLine()
input = ("a001 login " & user & " ") + pwd & vbCr & vbLf
outbytes = System.Text.Encoding.ASCII.GetBytes(input.ToCharArray())
ns.Write(outbytes, 0, outbytes.Length)
Dim resp As String = sr.ReadLine()
Dim tokens As String() = resp.Split(New [Char]() {" "c})
If tokens(1).ToLower() = "no" Then
Return "Login Failed"
End If
Catch e As InvalidOperationException
Return e.Message
Catch eio As IOException
Return eio.Message
End Try
Return Nothing
End Function
Private Sub Disconnect()
Dim input As String = "a003 logout" & vbCr & vbLf
Dim outbytes As [Byte]() = System.Text.Encoding.ASCII.GetBytes(input.ToCharArray())
ns.Write(outbytes, 0, outbytes.Length)
sr.Dispose()
ns.Close()
sender.Close()
End Sub
Public Function GetNumberOfMessages() As Integer
Dim outbytes As [Byte]()
Dim input As String
Try
Dim msg As String = Connect()
If msg IsNot Nothing Then
Me.ErrMsg = msg
Return -1
End If
input = "a002 select inbox" & vbCr & vbLf
outbytes = System.Text.Encoding.ASCII.GetBytes(input.ToCharArray())
If ns Is Nothing Then
Me.ErrMsg = "NetworkStream not connected"
Return -1
End If
ns.Write(outbytes, 0, outbytes.Length)
Dim found As Boolean = False
Dim tokens As String() = Nothing
While Not found
Dim resp As String = sr.ReadLine()
tokens = resp.Split(New [Char]() {" "c})
If tokens(1).ToLower() = "no" Then
Me.ErrMsg = "Invalid command"
Return -1
ElseIf tokens(2).ToLower() = "exists" Then
found = True
End If
End While
Disconnect()
Return Convert.ToInt32(tokens(1))
Catch e As InvalidOperationException
Me.ErrMsg = e.Message
Return -1
Catch e As IOException
Me.ErrMsg = e.Message
Return -1
End Try
End Function
End Class
Public Class EmailSettings_Form
Inherits System.Windows.Forms.Form
Public MyParentForm As Form1
Private comboBox1 As ComboBox
Private comboBox2 As ComboBox
Private textBox1 As TextBox
Private textBox2 As TextBox
Private textBox3 As TextBox
Private numericUpDown1 As NumericUpDown
Private checkBox1 As CheckBox
Private label1 As Label
Private labelt As Label
Private label2 As Label
Private label3 As Label
Private label4 As Label
Private label5 As Label
Private label6 As Label
Private button1 As Button
Private button2 As Button
Private button3 As Button
Private button4 As Button
Private groupBox1 As GroupBox
Public ReadOnly Property Server() As String
Get
Return comboBox1.SelectedItem.ToString()
End Get
End Property
Public ReadOnly Property User() As String
Get
Return textBox2.Text
End Get
End Property
Public ReadOnly Property Pass() As String
Get
Return textBox3.Text
End Get
End Property
Public ReadOnly Property Time() As Integer
Get
Return CInt(numericUpDown1.Value)
End Get
End Property
Public Sub New()
comboBox1 = New ComboBox()
comboBox2 = New ComboBox()
textBox1 = New TextBox()
textBox2 = New TextBox()
textBox3 = New TextBox()
numericUpDown1 = New NumericUpDown()
checkBox1 = New CheckBox()
label1 = New Label()
labelt = New Label()
label2 = New Label()
label3 = New Label()
label4 = New Label()
label5 = New Label()
label6 = New Label()
button1 = New Button()
button2 = New Button()
button3 = New Button()
button4 = New Button()
groupBox1 = New GroupBox()
' comboBox1
comboBox1.FormattingEnabled = True
comboBox1.Location = New Point(103, 9)
comboBox1.Name = "comboBox1"
comboBox1.Size = New Size(153, 20)
comboBox1.TabIndex = 0
AddHandler comboBox1.SelectedIndexChanged, AddressOf comboBox1_SelectedIndexChanged
comboBox1.DropDownStyle = ComboBoxStyle.DropDownList
' comboBox2
comboBox2.FormattingEnabled = True
comboBox2.Location = New Point(103, 33)
comboBox2.Name = "comboBox2"
comboBox2.Size = New Size(60, 20)
comboBox2.TabIndex = 1
AddHandler comboBox2.SelectedIndexChanged, AddressOf comboBox2_SelectedIndexChanged
comboBox2.DropDownStyle = ComboBoxStyle.DropDownList
comboBox2.Items.Add("POP3")
comboBox2.Items.Add("IMAP")
' textBox1
textBox1.Location = New Point(103, 57)
textBox1.Name = "textBox1"
textBox1.Size = New Size(133, 20)
textBox1.TabIndex = 2
AddHandler textBox1.TextChanged, AddressOf textBox1_TextChanged
' textBox2
textBox2.Location = New Point(103, 81)
textBox2.Name = "textBox2"
textBox2.Size = New Size(100, 20)
textBox2.TabIndex = 3
AddHandler textBox2.TextChanged, AddressOf textBox2_TextChanged
' textBox3
textBox3.Location = New Point(103, 105)
textBox3.Name = "textBox3"
textBox3.Size = New Size(100, 20)
textBox3.TabIndex = 4
textBox3.UseSystemPasswordChar = True
AddHandler textBox3.TextChanged, AddressOf textBox3_TextChanged
' checkbox1
checkBox1.Location = New Point(103, 127)
checkBox1.Name = "checkbox1"
checkBox1.TabIndex = 5
AddHandler checkBox1.CheckedChanged, AddressOf checkBox1_CheckedChanged
' numericUpDown1
numericUpDown1.Location = New Point(145, 168)
numericUpDown1.Maximum = New Decimal(New Integer() {60, 0, 0, 0})
numericUpDown1.Minimum = New Decimal(New Integer() {1, 0, 0, 0})
numericUpDown1.Name = "numericUpDown1"
numericUpDown1.Size = New Size(40, 20)
numericUpDown1.TabIndex = 6
numericUpDown1.Value = New Decimal(New Integer() {1, 0, 0, 0})
' label1
label1.Location = New Point(3, 12)
label1.Name = "label1"
label1.Font = New Font("Tahoma", 8)
label1.Size = New Size(95, 13)
label1.Text = "Display Name"
label1.TextAlign = ContentAlignment.MiddleRight
label1.BackColor = Color.White
' labelt
labelt.Location = New Point(3, 36)
labelt.Name = "labelt"
labelt.Font = New Font("Tahoma", 8)
labelt.Size = New Size(95, 13)
labelt.Text = "Server Type"
labelt.TextAlign = ContentAlignment.MiddleRight
labelt.BackColor = Color.White
' label2
label2.Location = New Point(3, 60)
label2.Name = "label2"
label2.Font = New Font("Tahoma", 8)
label2.Size = New Size(95, 13)
label2.Text = "Server Host"
label2.TextAlign = ContentAlignment.MiddleRight
label2.BackColor = Color.White
' label3
label3.Location = New Point(3, 84)
label3.Name = "label3"
label3.Font = New Font("Tahoma", 8)
label3.Size = New Size(95, 13)
label3.Text = "Username"
label3.TextAlign = ContentAlignment.MiddleRight
label3.BackColor = Color.White
' label4
label4.Location = New Point(3, 108)
label4.Name = "label4"
label4.Font = New Font("Tahoma", 8)
label4.Size = New Size(95, 13)
label4.Text = "Password"
label4.TextAlign = ContentAlignment.MiddleRight
label4.BackColor = Color.White
' label5
label5.Location = New Point(3, 132)
label5.Name = "label5"
label5.Font = New Font("Tahoma", 8)
label5.Size = New Size(95, 13)
label5.Text = "Enabled"
label5.TextAlign = ContentAlignment.MiddleRight
label5.BackColor = Color.White
' label6
label6.Location = New Point(17, 171)
label6.Name = "label6"
label6.Font = New Font("Tahoma", 8)
label6.Size = New Size(125, 13)
label6.Text = "Check Email Every (min)"
label6.TextAlign = ContentAlignment.MiddleRight
' add button (button4)
button4.Location = New Point(20, 196)
button4.Name = "button3"
button4.Size = New Size(60, 17)
button4.TabIndex = 7
button4.Text = "Add New"
AddHandler button4.Click, AddressOf button4_Click
' button1
button1.DialogResult = DialogResult.OK
button1.Location = New Point(85, 196)
button1.Name = "button1"
button1.Size = New Size(55, 17)
button1.TabIndex = 8
button1.Text = "Save"
' button2
button2.DialogResult = DialogResult.Cancel
button2.Location = New Point(145, 196)
button2.Name = "button2"
button2.Size = New Size(55, 17)
button2.TabIndex = 9
button2.Text = "Cancel"
' button3
button3.Location = New Point(205, 196)
button3.Name = "button3"
button3.Size = New Size(55, 17)
button3.TabIndex = 10
button3.Text = "Delete"
AddHandler button3.Click, AddressOf button3_Click
' groupBox1
groupBox1.Location = New Point(10, 6)
groupBox1.Name = "groupBox1"
groupBox1.Size = New System.Drawing.Size(260, 154)
groupBox1.TabStop = False
groupBox1.Text = ""
groupBox1.SendToBack()
' EmailSettings_Form
CancelButton = button2
ClientSize = New Size(280, 224)
ControlBox = False
groupBox1.Controls.AddRange(New Control() {label1, labelt, label2, label3, label4, label5, _
comboBox1, comboBox2, textBox1, textBox2, textBox3, checkBox1})
Controls.AddRange(New Control() {groupBox1, label6, numericUpDown1, button4, button1, button2, _
button3})
FormBorderStyle = FormBorderStyle.FixedToolWindow
MaximizeBox = False
MinimizeBox = False
Name = "EmailSettings_Form"
ShowIcon = False
ShowInTaskbar = False
StartPosition = FormStartPosition.CenterScreen
Text = "Email Server Settings"
AddHandler Load, AddressOf EmailSettings_Form_Load
End Sub
'comboBox fuctionality and events to synch data to main form
Public har As New ArrayList()
Public uar As New ArrayList()
Public par As New ArrayList()
Public ear As New ArrayList()
Public tar As New ArrayList()
Private Sub comboBox1_SelectedIndexChanged(ByVal sender As Object, ByVal e As EventArgs)
If comboBox1.SelectedIndex > -1 Then
textBox1.Text = har(comboBox1.SelectedIndex).ToString()
textBox2.Text = uar(comboBox1.SelectedIndex).ToString()
textBox3.Text = par(comboBox1.SelectedIndex).ToString()
If tar(comboBox1.SelectedIndex).ToString() = "1" Then
comboBox2.SelectedIndex = 1
Else
comboBox2.SelectedIndex = 0
End If
checkBox1.Checked = CBool(ear(comboBox1.SelectedIndex))
Else
textBox1.Clear()
textBox2.Clear()
textBox3.Clear()
End If
End Sub
Private Sub comboBox2_SelectedIndexChanged(ByVal sender As Object, ByVal e As EventArgs)
tar(comboBox1.SelectedIndex) = comboBox2.SelectedIndex
End Sub
Private Sub textBox1_TextChanged(ByVal sender As Object, ByVal e As EventArgs)
har(comboBox1.SelectedIndex) = textBox1.Text
comboBox1.Items(comboBox1.SelectedIndex) = textBox1.Text
End Sub
Private Sub textBox2_TextChanged(ByVal sender As Object, ByVal e As EventArgs)
uar(comboBox1.SelectedIndex) = textBox2.Text
End Sub
Private Sub textBox3_TextChanged(ByVal sender As Object, ByVal e As EventArgs)
par(comboBox1.SelectedIndex) = textBox3.Text
End Sub
Private Sub checkBox1_CheckedChanged(ByVal sender As Object, ByVal e As EventArgs)
ear(comboBox1.SelectedIndex) = checkBox1.Checked
End Sub
'delete mail server
Private Sub button3_Click(ByVal sender As Object, ByVal e As EventArgs)
If comboBox1.Items.Count > 1 Then
har.RemoveAt(comboBox1.SelectedIndex)
uar.RemoveAt(comboBox1.SelectedIndex)
par.RemoveAt(comboBox1.SelectedIndex)
ear.RemoveAt(comboBox1.SelectedIndex)
tar.RemoveAt(comboBox1.SelectedIndex)
comboBox1.Items.RemoveAt(comboBox1.SelectedIndex)
comboBox1.SelectedIndex = 0
Else
MessageBox.Show("Zero is not enough for me!" & vbLf & vbLf & "If you don't want to use me, then just" & vbLf & "uncheck Email Notify in the main menu.", "Cannot remove only entry.")
End If
End Sub
'add mail server
Private Sub button4_Click(ByVal sender As Object, ByVal e As EventArgs)
If comboBox1.Items.Count < 5 Then
har.Add("mail.exampleserver.com")
uar.Add("username")
par.Add("password")
ear.Add(True)
tar.Add(0)
Me.comboBox1.Items.Add("mail.exampleserver.com")
Me.comboBox1.SelectedIndex = comboBox1.Items.Count - 1
Me.comboBox2.SelectedIndex = 0
Else
MessageBox.Show("Five is enough for me!" & vbLf & vbLf & "I can't display more in a balloon tip.", "Reached Maximum Entries.")
End If
End Sub
Private Sub EmailSettings_Form_Load(ByVal sender As Object, ByVal e As System.EventArgs)
For Each s As MailServer In DirectCast(MyParentForm, Form1).MailServers
har.Add(s.Host)
uar.Add(s.User)
par.Add(s.Pass)
ear.Add(s.Enabled)
tar.Add(s.Type)
Me.comboBox1.Items.Add(s.Host)
Next
Me.comboBox1.SelectedIndex = 0
Me.numericUpDown1.Value = New Decimal(New Integer() {(DirectCast(MyParentForm, Form1).MailTimer.Interval / 60 / 1000), 0, 0, 0})
End Sub
End Class
'Just a simple about form to be called like AboutForm.ShowAboutForm(this);
Public Class AboutForm
Inherits System.Windows.Forms.Form
Private IconBox1 As PictureBox
Private IconBox2 As PictureBox
Private IconBox3 As PictureBox
Private TextArea As Label
Private Legend As Label
Private dl As Label
Private ul As Label
Private du As Label
Private link As LinkLabel
Private OKButton As Button
Private LButton As Button
Private Sub New()
IconBox1 = New PictureBox()
IconBox2 = New PictureBox()
IconBox3 = New PictureBox()
TextArea = New Label()
Legend = New Label()
dl = New Label()
ul = New Label()
du = New Label()
link = New LinkLabel()
OKButton = New Button()
LButton = New Button()
' IconBoxes
IconBox1.Location = New Point(12, 25)
IconBox1.Name = "IconBox1"
IconBox1.Size = New Size(16, 16)
IconBox2.Location = New Point(12, 43)
IconBox2.Name = "IconBox2"
IconBox2.Size = New Size(16, 16)
IconBox3.Location = New Point(12, 61)
IconBox3.Name = "IconBox3"
IconBox3.Size = New Size(16, 16)
' Legend
Legend.Location = New Point(4, 10)
Legend.Name = "Legend"
Legend.Size = New Size(50, 13)
Legend.Text = "Legend:"
Legend.Font = New Font("Tahoma", 8)
dl.Location = New Point(32, 25)
dl.Name = "dl"
dl.Size = New Size(60, 13)
dl.Text = "Download"
dl.Font = New Font("Tahoma", 8)
ul.Location = New Point(32, 43)
ul.Name = "ul"
ul.Size = New Size(50, 13)
ul.Text = "Upload"
ul.Font = New Font("Tahoma", 8)
du.Location = New Point(32, 61)
du.Name = "du"
du.Size = New Size(50, 13)
du.Text = "Both"
du.Font = New Font("Tahoma", 8)
'link
link.Location = New Point(50, 102)
link.Name = "link"
link.Size = New Size(210, 13)
link.LinkBehavior = LinkBehavior.HoverUnderline
link.LinkColor = Color.Navy
link.Font = New Font("Tahoma", 8)
link.Text = "http://freemeter.sourceforge.net/"
AddHandler link.LinkClicked, AddressOf link_Clicked
' TextArea
TextArea.Location = New Point(96, 10)
TextArea.Name = "TextArea"
TextArea.Size = New Size(208, 86)
TextArea.Text = "label1"
TextArea.TextAlign = ContentAlignment.MiddleLeft
TextArea.Font = New Font("Tahoma", 8)
' OKButton
OKButton.Location = New Point(96, 120)
OKButton.Size = New Size(55, 17)
OKButton.Name = "OKButton"
OKButton.TabIndex = 0
OKButton.Text = "OK"
AddHandler OKButton.Click, AddressOf OKButton_Click
'License Button
LButton.Location = New Point(155, 120)
LButton.Size = New Size(55, 17)
LButton.Name = "LButton"
LButton.TabIndex = 1
LButton.Text = "License"
AddHandler LButton.Click, AddressOf LButton_Click
' AboutForm
StartPosition = FormStartPosition.CenterScreen
AcceptButton = OKButton
ClientSize = New Size(280, 150)
Controls.AddRange(New Control() {OKButton, LButton, TextArea, Legend, dl, ul, _
du, link, IconBox1, IconBox2, IconBox3})
FormBorderStyle = FormBorderStyle.FixedToolWindow
ShowInTaskbar = False
ShowIcon = False
ControlBox = False
MaximizeBox = False
MinimizeBox = False
Name = "AboutForm"
Text = "About: "
AddHandler Load, AddressOf AboutForm_Load
End Sub
Private Sub AboutForm_Load(ByVal sender As Object, ByVal e As System.EventArgs)
Dim ThisAssembly As Assembly = Assembly.GetExecutingAssembly()
Dim ThisAssemblyName As AssemblyName = ThisAssembly.GetName()
Me.Icon = Owner.Icon
IconBox1.Image = Owner.Icon.ToBitmap()
Dim s As Stream = ThisAssembly.GetManifestResourceStream("FreeMeter.lr.ico")
Dim lr As New Icon(s)
s = ThisAssembly.GetManifestResourceStream("FreeMeter.ly.ico")
Dim ly As New Icon(s)
IconBox2.Image = lr.ToBitmap()
IconBox3.Image = ly.ToBitmap()
lr.Dispose()
ly.Dispose()
s.Close()
Dim lastmodified As DateTime = File.GetLastWriteTime(Application.ExecutablePath)
Dim FriendlyVersion As String = (((ThisAssemblyName.Version.Major & ".") + ThisAssemblyName.Version.Minor & ".") + ThisAssemblyName.Version.Build & vbLf & "Built ") + lastmodified.ToString()
Dim Attributes As Array = ThisAssembly.GetCustomAttributes(False)
Dim Title As String = "Unknown Application"
Dim Copyright As String = "Unknown Copyright"
For Each o As Object In Attributes
If TypeOf o Is AssemblyTitleAttribute Then
Title = DirectCast(o, AssemblyTitleAttribute).Title
ElseIf TypeOf o Is AssemblyCopyrightAttribute Then
Copyright = DirectCast(o, AssemblyCopyrightAttribute).Copyright
End If
Next
Me.Text = "About " & Title
TextArea.Text = ((Title & " v") + FriendlyVersion & vbLf & vbLf) + Copyright
End Sub
Private Sub OKButton_Click(ByVal sender As Object, ByVal e As EventArgs)
Close()
End Sub
Private Sub LButton_Click(ByVal sender As Object, ByVal e As EventArgs)
MessageBox.Show("Copyright © 2005-2007, David Schultz, Mieszko Lassota All rights reserved." & vbLf & vbLf & "Check http://freemeter.sourceforge.net/ for latest version and contact info." & vbLf & vbLf & "Redistribution and use in source and binary forms, with or without " & "modification," & vbLf & "are permitted provided that the following conditions " & "are met:" & vbLf & vbLf & "- Redistributions of source code must retain the above copyright " & "notice, this list" & vbLf & "of conditions and the following disclaimer." & vbLf & vbLf & "- Neither the name of the owner, nor the names of its " & "contributors may be used" & vbLf & "to endorse or promote products " & "derived from this software without specific prior" & vbLf & "written " & "permission." & vbLf & vbLf & "This software is provided by the copyright holders and contributors " & """as is"" and" & vbLf & "any express or implied warranties, including, but not " & "limited to, the implied" & vbLf & "warranties of merchantability and fitness " & "for a particular purpose are disclaimed." & vbLf & "In no event shall the " & "copyright owner or contributors be liable for any direct," & vbLf & "indirect, " & "incidental, special, exemplary, or consequential damages including, " & "but" & vbLf & "not limited to, procurement of substitute goods or services; " & "loss of use, data, or" & vbLf & "profits; or business interruption) however " & "caused and on any theory of liability," & vbLf & "whether in contract, strict " & "liability, or tort (including negligence or otherwise)" & vbLf & "arising in " & "any way out of the use of this software, even if advised of the " & "possibility" & vbLf & "of such damage.", "FreeMeter GPL License")
End Sub
Private Sub link_Clicked(ByVal sender As Object, ByVal e As LinkLabelLinkClickedEventArgs)
Process.Start("http://freemeter.sourceforge.net/")
End Sub
Friend Shared Sub ShowAboutForm(ByVal Owner As IWin32Window)
Dim form As New AboutForm()
form.ShowDialog(Owner)
End Sub
End Class
Public Class AdvPing
Inherits Form
Public MyParentForm As Form1
Private Shared hostbox As TextBox, databox As TextBox, databox2 As TextBox, databox3 As TextBox, results As TextBox
Private Shared df As CheckBox
Private Shared pinger As Thread
Private sendit As New Button()
Private stopit As New Button()
Private sentcount As Integer = 0, recvcount As Integer = 0
Private times As New ArrayList()
Private PingTarget As String
Private pinging As Boolean = False
Public Sub New()
Text = "FreeMeter Ping Utility"
Size = New Size(400, 284)
FormBorderStyle = FormBorderStyle.FixedToolWindow
MinimizeBox = True
MaximizeBox = False
ControlBox = True
ShowIcon = False
AddHandler Load, AddressOf AdvPing_Load
Dim label1 As New Label()
label1.Parent = Me
label1.Text = "Host:"
label1.Font = New Font("Tahoma", 8)
label1.Size = New Size(30, 13)
label1.Location = New Point(3, 5)
hostbox = New TextBox()
hostbox.Parent = Me
hostbox.Size = New Size(227, 13)
hostbox.Location = New Point(35, 3)
hostbox.TabIndex = 0
results = New TextBox()
results.Parent = Me
results.Multiline = True
results.TabIndex = 8
results.Size = New Size(388, 213)
results.Location = New Point(3, 25)
results.BorderStyle = BorderStyle.FixedSingle
results.BackColor = Color.Black
results.ForeColor = Color.Silver
results.Font = New Font("Tahoma", 8)
results.ScrollBars = System.Windows.Forms.ScrollBars.Vertical
results.WordWrap = False
Dim label2 As New Label()
label2.Parent = Me
label2.Text = "Size(bytes)"
label2.Font = New Font("Tahoma", 8)
label2.Size = New Size(58, 13)
label2.Location = New Point(3, 242)
databox = New TextBox()
databox.Parent = Me
databox.Text = "32"
databox.TabIndex = 1
databox.Location = New Point(64, 241)
databox.MaximumSize = New Size(38, 16)
Dim label3 As New Label()
label3.Parent = Me
label3.Text = "Interval(ms)"
label3.Font = New Font("Tahoma", 8)
label3.Size = New Size(64, 13)
label3.Location = New Point(105, 242)
databox2 = New TextBox()
databox2.Parent = Me
databox2.Text = "1000"
databox2.TabIndex = 2
databox2.Location = New Point(171, 241)
databox2.MaximumSize = New Size(38, 16)
Dim label4 As New Label()
label4.Parent = Me
label4.Text = "Timeout(ms)"
label4.Font = New Font("Tahoma", 8)
label4.Size = New Size(66, 13)
label4.Location = New Point(211, 242)
databox3 = New TextBox()
databox3.Parent = Me
databox3.Text = "3000"
databox3.TabIndex = 3
databox3.Location = New Point(277, 241)
databox3.MaximumSize = New Size(38, 16)
Dim label5 As New Label()
label5.Parent = Me
label5.Text = "DF"
label5.Font = New Font("Tahoma", 8)
label5.Size = New Size(17, 13)
label5.Location = New Point(318, 242)
df = New CheckBox()
df.Parent = Me
df.TabIndex = 4
df.Location = New Point(335, 242)
df.Size = New Size(16, 16)
sendit.Parent = Me
sendit.Size = New Size(40, 20)
sendit.Text = "Start"
sendit.TabIndex = 5
sendit.Location = New Point(265, 3)
AddHandler sendit.Click, AddressOf ButtonSendOnClick
stopit.Parent = Me
stopit.Size = New Size(40, 20)
stopit.Text = "Stop"
stopit.TabIndex = 6
stopit.Location = New Point(308, 3)
AddHandler stopit.Click, AddressOf ButtonStopOnClick
stopit.Enabled = False
Dim clearit As New Button()
clearit.Parent = Me
clearit.Size = New Size(40, 20)
clearit.Text = "Clear"
clearit.TabIndex = 7
clearit.Location = New Point(351, 3)
AddHandler clearit.Click, AddressOf ButtonClearOnClick
Dim closeit As New Button()
closeit.Parent = Me
closeit.Size = New Size(42, 20)
closeit.TabIndex = 9
closeit.Text = "Close"
closeit.Location = New Point(351, 239)
AddHandler closeit.Click, AddressOf ButtonCloseOnClick
End Sub
Private Sub AdvPing_Load(ByVal sender As Object, ByVal e As EventArgs)
Try
If MyParentForm.ClipData.Length < 64 Then
hostbox.Text = MyParentForm.ClipData
End If
Catch
End Try
End Sub
Private Sub ButtonSendOnClick(ByVal obj As Object, ByVal ea As EventArgs)
sendit.Enabled = False
stopit.Enabled = True
pinging = True
If hostbox.Text.Trim() = "" Then
hostbox.Text = Dns.GetHostName()
End If
pinger = New Thread(New ThreadStart(AddressOf sendPing))
pinger.IsBackground = False
pinger.Start()
End Sub
Private Sub ButtonStopOnClick(ByVal obj As Object, ByVal ea As EventArgs)
sendit.Enabled = True
stopit.Enabled = False
pinging = False
Try
pinger.Abort()
Catch e As NullReferenceException
results.AppendText(vbCr & vbLf & e.Message)
End Try
results.AppendText(vbCr & vbLf)
If sentcount > 0 Then
results.AppendText(vbCr & vbLf & "Ping statistics for " & PingTarget & ":" & vbCr & vbLf)
results.AppendText((((" Sent: " & sentcount & " Received: ") + recvcount & " Lost: ") + (sentcount - recvcount) & " (") + (100 - CDbl(recvcount) / CDbl(sentcount) * 100).ToString("F1") & "% loss)" & vbCr & vbLf)
results.AppendText("Approximate round trip times in milli-seconds:" & vbCr & vbLf)
results.AppendText(((" Minimum = " & Min(times) & "ms Maximum = ") + Max(times) & "ms Average = ") + Avg(times).ToString("F1") & "ms")
End If
sentcount = InlineAssignHelper(recvcount, 0)
times = New ArrayList()
End Sub
Private Sub ButtonClearOnClick(ByVal obj As Object, ByVal ea As EventArgs)
results.Text = ""
End Sub
Private Sub ButtonCloseOnClick(ByVal obj As Object, ByVal ea As EventArgs)
Try
pinger.Abort()
Catch e As NullReferenceException
results.AppendText(vbCr & vbLf & e.Message)
End Try
Close()
End Sub
Private Sub sendPing()
Dim pingSender As New Ping()
Dim options As New PingOptions()
If df.Checked Then
options.DontFragment = True
End If
Dim IPs As IPAddress() = Nothing
Try
IPs = Dns.GetHostEntry(hostbox.Text.Trim()).AddressList
Catch e As SocketException
Update_Button(sendit, True)
Update_Button(stopit, False)
SetText(results, e.Message)
Exit Sub
End Try
Dim timeout As Integer = 0, interval As Integer = 0, datasize As Integer = 0
Try
timeout = Convert.ToInt32(databox3.Text.Trim())
interval = Convert.ToInt32(databox2.Text.Trim())
datasize = Convert.ToInt32(databox.Text.Trim())
Catch e As FormatException
Update_Button(sendit, True)
Update_Button(stopit, False)
SetText(results, e.Message)
Exit Sub
End Try
PingTarget = Nothing
For j As Integer = 0 To IPs.Length - 1
PingTarget += IPs(j).ToString() & " "
Next
Dim i As Integer = 1
Dim data As New StringBuilder()
For j As Integer = 0 To datasize - 1
data.Append("#")
Next
Dim buffer As Byte() = Encoding.ASCII.GetBytes(data.ToString())
SetText(results, (("-----------------------------------" & vbCr & vbLf & "Pinging " & hostbox.Text.Trim() & " [") & IPs(0).ToString() & "] with ") + data.Length & " bytes of data")
While pinging
Dim reply As PingReply = Nothing
Try
reply = pingSender.Send(hostbox.Text.Trim(), timeout, buffer, options)
sentcount += 1
Catch e As PingException
Update_Button(sendit, True)
Update_Button(stopit, False)
Console.WriteLine(e.ToString())
Exit Sub
Catch e As ArgumentException
Update_Button(sendit, True)
Update_Button(stopit, False)
SetText(results, e.Message)
Console.WriteLine(e.ToString())
Exit Sub
End Try
If reply.Status = IPStatus.Success Then
recvcount += 1
times.Add(reply.RoundtripTime)
SetText(results, ((((" " & reply.Buffer.Length & " bytes from: ") + reply.Address.ToString() & ", seq: ") + i & ", time = ") + reply.RoundtripTime & "ms, ttl: ") + reply.Options.Ttl + (If((reply.Options.DontFragment), " DF", "")))
Else
SetText(results, " " & reply.Status.ToString())
End If
i += 1
Dim time_ms As Integer = CInt((interval - reply.RoundtripTime))
If time_ms > 0 Then
Thread.Sleep(time_ms)
End If
End While
Update_Button(sendit, True)
Update_Button(stopit, False)
pingSender.Dispose()
End Sub
'set the shit in a control in a thread safe manner
Private Delegate Sub SetTextCallback(ByVal l As TextBox, ByVal t As String)
Private Sub SetText(ByVal l As TextBox, ByVal t As String)
If Not l.IsDisposed Then
If l.InvokeRequired Then
Dim d As New SetTextCallback(AddressOf SetText)
Me.Invoke(d, New [Object]() {l, t})
Else
l.AppendText(vbCr & vbLf & t)
End If
End If
End Sub
Private Delegate Sub SetButtonCallback(ByVal l As Button, ByVal t As Boolean)
Private Sub Update_Button(ByVal l As Button, ByVal t As Boolean)
If l.InvokeRequired Then
Dim d As New SetButtonCallback(AddressOf Update_Button)
Me.Invoke(d, New [Object]() {l, t})
Else
l.Enabled = t
End If
End Sub
Private Shared Function Avg(ByVal num As ArrayList) As Double
Dim sum As Double = 0.0R
For i As Integer = 0 To num.Count - 1
sum = sum + Convert.ToDouble(num(i))
Next
Return sum / Convert.ToDouble(num.Count)
End Function
Private Shared Function Max(ByVal A As ArrayList) As Double
If A.Count > 0 Then
Dim maxVal As Double = Convert.ToDouble(A(0))
For i As Integer = 0 To A.Count - 1
If Convert.ToDouble(A(i)) > maxVal Then
maxVal = Convert.ToDouble(A(i))
End If
Next
Return maxVal
Else
Return 0
End If
End Function
Private Shared Function Min(ByVal A As ArrayList) As Double
If A.Count > 0 Then
Dim minVal As Double = Convert.ToDouble(A(0))
For i As Integer = 0 To A.Count - 1
If Convert.ToDouble(A(i)) < minVal Then
minVal = Convert.ToDouble(A(i))
End If
Next
Return minVal
Else
Return 0
End If
End Function
Private Shared Function InlineAssignHelper(Of T)(ByRef target As T, ByVal value As T) As T
target = value
Return value
End Function
End Class
Public Class AdvTrace
Inherits Form
Public MyParentForm As Form1
Private Shared hostbox As TextBox, databox As TextBox, databox2 As TextBox, results As TextBox
Private Shared databox3 As CheckBox
Private Shared tracer As Thread
Private sendit As New Button()
Private stopit As New Button()
'private string TraceTarget;
Private traceing As Boolean = False
Public Sub New()
Text = "FreeMeter Traceroute Utility"
Size = New Size(400, 284)
FormBorderStyle = FormBorderStyle.FixedToolWindow
MinimizeBox = True
MaximizeBox = False
ControlBox = True
ShowIcon = False
AddHandler Load, AddressOf AdvTrace_Load
Dim label1 As New Label()
label1.Parent = Me
label1.Text = "Host:"
label1.Font = New Font("Tahoma", 8)
label1.Size = New Size(30, 13)
label1.Location = New Point(3, 5)
hostbox = New TextBox()
hostbox.Parent = Me
hostbox.Size = New Size(227, 13)
hostbox.Location = New Point(35, 3)
hostbox.TabIndex = 0
results = New TextBox()
results.Parent = Me
results.Multiline = True
results.TabIndex = 7
results.Size = New Size(388, 213)
results.Location = New Point(3, 25)
results.BorderStyle = BorderStyle.FixedSingle
results.BackColor = Color.Black
results.ForeColor = Color.Silver
results.Font = New Font("Tahoma", 8)
results.ScrollBars = System.Windows.Forms.ScrollBars.Vertical
results.WordWrap = False
Dim label2 As New Label()
label2.Parent = Me
label2.Text = "Max hops"
label2.Font = New Font("Tahoma", 8)
label2.Size = New Size(50, 13)
label2.Location = New Point(3, 242)
databox = New TextBox()
databox.Parent = Me
databox.Text = "30"
databox.TabIndex = 1
databox.Location = New Point(56, 241)
databox.MaximumSize = New Size(30, 16)
Dim label3 As New Label()
label3.Parent = Me
label3.Text = "Timeout(ms)"
label3.Font = New Font("Tahoma", 8)
label3.Size = New Size(66, 13)
label3.Location = New Point(92, 242)
databox2 = New TextBox()
databox2.Parent = Me
databox2.Text = "3000"
databox2.TabIndex = 2
databox2.Location = New Point(158, 241)
databox2.MaximumSize = New Size(38, 16)
Dim label4 As New Label()
label4.Parent = Me
label4.Text = "Resolve names"
label4.Font = New Font("Tahoma", 8)
label4.Size = New Size(77, 13)
label4.Location = New Point(202, 242)
databox3 = New CheckBox()
databox3.Parent = Me
databox3.TabIndex = 3
databox3.Location = New Point(280, 242)
databox3.Size = New Size(16, 16)
sendit.Parent = Me
sendit.Size = New Size(40, 20)
sendit.Text = "Start"
sendit.TabIndex = 4
sendit.Location = New Point(265, 3)
AddHandler sendit.Click, AddressOf ButtonSendOnClick
stopit.Parent = Me
stopit.Size = New Size(40, 20)
stopit.Text = "Stop"
stopit.TabIndex = 5
stopit.Location = New Point(308, 3)
AddHandler stopit.Click, AddressOf ButtonStopOnClick
stopit.Enabled = False
Dim clearit As New Button()
clearit.Parent = Me
clearit.Size = New Size(40, 20)
clearit.Text = "Clear"
clearit.TabIndex = 6
clearit.Location = New Point(351, 3)
AddHandler clearit.Click, AddressOf ButtonClearOnClick
Dim closeit As New Button()
closeit.Parent = Me
closeit.Size = New Size(42, 20)
closeit.TabIndex = 8
closeit.Text = "Close"
closeit.Location = New Point(351, 239)
AddHandler closeit.Click, AddressOf ButtonCloseOnClick
End Sub
Private Sub AdvTrace_Load(ByVal sender As Object, ByVal e As EventArgs)
Try
If MyParentForm.ClipData.Length < 64 Then
hostbox.Text = MyParentForm.ClipData
End If
Catch
End Try
End Sub
Private Sub ButtonSendOnClick(ByVal obj As Object, ByVal ea As EventArgs)
sendit.Enabled = False
stopit.Enabled = True
traceing = True
If hostbox.Text.Trim() = "" Then
hostbox.Text = Dns.GetHostName()
End If
tracer = New Thread(New ThreadStart(AddressOf sendTrace))
tracer.IsBackground = False
tracer.Start()
End Sub
Private Sub ButtonStopOnClick(ByVal obj As Object, ByVal ea As EventArgs)
sendit.Enabled = True
stopit.Enabled = False
traceing = False
Try
tracer.Abort()
Catch e As NullReferenceException
results.AppendText(vbCr & vbLf & e.Message)
End Try
End Sub
Private Sub ButtonClearOnClick(ByVal obj As Object, ByVal ea As EventArgs)
results.Text = ""
End Sub
Private Sub ButtonCloseOnClick(ByVal obj As Object, ByVal ea As EventArgs)
Try
tracer.Abort()
Catch e As NullReferenceException
results.AppendText(vbCr & vbLf & e.Message)
End Try
Close()
End Sub
'set the shit in a control in a thread safe manner
Private Delegate Sub SetTextCallback(ByVal l As TextBox, ByVal t As String)
Private Sub SetText(ByVal l As TextBox, ByVal t As String)
If Not l.IsDisposed Then
If l.InvokeRequired Then
Dim d As New SetTextCallback(AddressOf SetText)
Me.Invoke(d, New [Object]() {l, t})
Else
l.AppendText(t)
End If
End If
End Sub
Private Delegate Sub SetButtonCallback(ByVal l As Button, ByVal t As Boolean)
Private Sub Update_Button(ByVal l As Button, ByVal t As Boolean)
If l.InvokeRequired Then
Dim d As New SetButtonCallback(AddressOf Update_Button)
Me.Invoke(d, New [Object]() {l, t})
Else
l.Enabled = t
End If
End Sub
Private Sub sendTrace()
Dim pingSender As New Ping()
Dim options As New PingOptions()
Dim ttl As Integer = 1
options.DontFragment = True
Dim IPs As IPAddress() = Nothing
Try
IPs = Dns.GetHostEntry(hostbox.Text.Trim()).AddressList
Catch e As SocketException
Update_Button(sendit, True)
Update_Button(stopit, False)
SetText(results, e.Message & vbCr & vbLf)
Exit Sub
End Try
Dim hops As Integer = 0, timeout As Integer = 0
Try
hops = Convert.ToInt32(databox.Text.Trim())
timeout = Convert.ToInt32(databox2.Text.Trim())
Catch e As FormatException
Update_Button(sendit, True)
Update_Button(stopit, False)
SetText(results, e.Message & vbCr & vbLf)
Exit Sub
End Try
SetText(results, ("-----------------------------------" & vbCr & vbLf & "Tracing route to " & hostbox.Text & " [") & IPs(0).ToString() & "]" & vbCr & vbLf)
While traceing AndAlso ttl <= hops
Dim reply As PingReply = Nothing
options.Ttl = ttl
Try
reply = pingSender.Send(hostbox.Text.Trim(), timeout, New Byte(-1) {}, options)
Catch e As PingException
Update_Button(sendit, True)
Update_Button(stopit, False)
'SetText(results, " Interrupted\r\n");
Console.WriteLine(e.Message)
Exit Sub
End Try
If reply.Status = IPStatus.Success Then
traceing = False
End If
SetText(results, " " & ttl.ToString())
Try
Dim timing As PingReply = pingSender.Send(reply.Address, timeout, New Byte(31) {}, New PingOptions(128, True))
SetText(results, If((timing.Status = IPStatus.Success), vbTab & timing.RoundtripTime.ToString() & "ms", vbTab & "*"))
timing = pingSender.Send(reply.Address, timeout, New Byte(31) {}, New PingOptions(128, True))
SetText(results, If((timing.Status = IPStatus.Success), vbTab & timing.RoundtripTime.ToString() & "ms", vbTab & "*"))
timing = pingSender.Send(reply.Address, timeout, New Byte(31) {}, New PingOptions(128, True))
SetText(results, If((timing.Status = IPStatus.Success), vbTab & timing.RoundtripTime.ToString() & "ms", vbTab & "*"))
Catch e As PingException
Update_Button(sendit, True)
Update_Button(stopit, False)
SetText(results, " Interrupted" & vbCr & vbLf)
Console.WriteLine(e.Message)
Exit Sub
Catch e As ArgumentNullException
'SetText(results, "\t\t");
Console.WriteLine(e.Message)
End Try
Dim hostName As String = Nothing
If databox3.Checked Then
Try
Dim hostEntry As IPHostEntry = Dns.GetHostEntry(reply.Address)
If hostEntry.HostName IsNot Nothing AndAlso hostEntry.HostName <> String.Empty Then
hostName = hostEntry.HostName
End If
Catch e As ArgumentNullException
hostName = reply.Status.ToString()
Console.WriteLine(e.Message)
Catch e As SocketException
hostName = reply.Address.ToString()
Console.WriteLine(e.Message)
End Try
Else
Try
hostName = reply.Address.ToString()
Catch e As NullReferenceException
hostName = reply.Status.ToString()
Console.WriteLine(e.Message)
End Try
End If
SetText(results, vbTab & hostName & vbCr & vbLf)
ttl += 1
End While
SetText(results, (If((Not traceing), "Trace complete" & vbCr & vbLf, "Trace Stopped, ttl expired" & vbCr & vbLf)))
pingSender.Dispose()
Update_Button(sendit, True)
Update_Button(stopit, False)
End Sub
End Class
Public Class frmUPnP
Inherits Form
Public MyParentForm As Form1
Private label1 As New Label()
Private label2 As New Label()
Private label3 As New Label()
Private label4 As New Label()
Private results As New TextBox()
Private port As New TextBox()
Private address As New TextBox()
Private comboBox1 As New ComboBox()
Private refresh1 As New Button()
Private add As New Button()
Private delete As New Button()
Private nat As New _UPnPNat()
Public Sub New()
Text = "FreeMeter UPnP NAT Utility"
Size = New Size(392, 278)
FormBorderStyle = FormBorderStyle.FixedToolWindow
MinimizeBox = True
MaximizeBox = False
ControlBox = True
ShowIcon = False
AddHandler Load, AddressOf frmUPnP_Load
label1.Parent = Me
label1.Text = "Current UPnP NAT Mappings:"
label1.Font = New Font("Tahoma", 8)
label1.Size = New Size(300, 13)
label1.Location = New Point(3, 5)
refresh1.Parent = Me
refresh1.Text = "Refresh"
refresh1.TabIndex = 6
refresh1.Font = New Font("Tahoma", 8)
refresh1.Size = New Size(50, 20)
refresh1.Location = New Point(334, 2)
AddHandler refresh1.Click, AddressOf RefreshClick
label2.Parent = Me
label2.Text = "Port"
label2.Font = New Font("Tahoma", 8)
label2.Size = New Size(25, 13)
label2.Location = New Point(3, 235)
port.Parent = Me
port.Font = New Font("Tahoma", 8)
port.TabIndex = 1
port.MaximumSize = New Size(40, 16)
port.MaxLength = 5
port.Location = New Point(28, 234)
label3.Parent = Me
label3.Text = "Fwd to"
label3.Font = New Font("Tahoma", 8)
label3.Size = New Size(38, 13)
label3.Location = New Point(76, 235)
address.Parent = Me
address.Font = New Font("Tahoma", 8)
address.TabIndex = 2
address.MaximumSize = New Size(95, 16)
address.MaxLength = 15
address.Location = New Point(113, 234)
label4.Parent = Me
label4.Text = "Proto"
label4.Font = New Font("Tahoma", 8)
label4.Size = New Size(32, 13)
label4.Location = New Point(214, 235)
comboBox1.FormattingEnabled = True
comboBox1.Font = New Font("Small Fonts", 6)
comboBox1.Location = New Point(247, 234)
comboBox1.Size = New Size(40, 12)
comboBox1.TabIndex = 3
comboBox1.DropDownStyle = ComboBoxStyle.DropDownList
comboBox1.Items.Add("TCP")
comboBox1.Items.Add("UDP")
Me.Controls.Add(comboBox1)
comboBox1.SelectedIndex = 0
add.Parent = Me
add.Size = New Size(40, 20)
add.Text = "Add"
add.TabIndex = 4
add.Location = New Point(302, 233)
AddHandler add.Click, AddressOf ButtonAddOnClick
delete.Parent = Me
delete.Size = New Size(40, 20)
delete.Text = "Rem"
delete.TabIndex = 5
delete.Location = New Point(344, 233)
AddHandler delete.Click, AddressOf ButtonDeleteOnClick
results.Parent = Me
results.Multiline = True
results.TabIndex = 7
results.Size = New Size(380, 207)
results.Location = New Point(3, 24)
results.BorderStyle = BorderStyle.FixedSingle
results.BackColor = Color.Black
results.ForeColor = Color.Silver
results.Font = New Font("Tahoma", 8)
results.ScrollBars = System.Windows.Forms.ScrollBars.Vertical
results.WordWrap = False
End Sub
Private Sub enumerate_mappings(ByVal sender As Object, ByVal e As DoWorkEventArgs)
For Each info As PortMappingInfo In nat.PortMappings
SetText(results, ((((info.Description & " - ") + info.ExternalPort & " -> ") + info.InternalHostName & ":") + info.InternalPort & " ") + info.Protocol & vbCr & vbLf)
Next
End Sub
Private Sub frmUPnP_Load(ByVal sender As Object, ByVal e As EventArgs)
Dim nater As New BackgroundWorker()
nater.WorkerReportsProgress = False
AddHandler nater.DoWork, AddressOf enumerate_mappings
nater.RunWorkerAsync()
nater.Dispose()
End Sub
Private Sub RefreshClick(ByVal obj As Object, ByVal ea As EventArgs)
results.Text = ""
Dim nater As New BackgroundWorker()
nater.WorkerReportsProgress = False
AddHandler nater.DoWork, AddressOf enumerate_mappings
nater.RunWorkerAsync()
nater.Dispose()
End Sub
Private Sub ButtonAddOnClick(ByVal obj As Object, ByVal ea As EventArgs)
Dim ret As IPAddress
If address.Text.Trim() <> "" AndAlso port.Text.Trim() <> "" Then
If IPAddress.TryParse(address.Text.Trim(), ret) Then
Try
Dim pmi As New PortMappingInfo("FreeMeter", comboBox1.SelectedItem.ToString(), ret.ToString(), Integer.Parse(port.Text), Nothing, Integer.Parse(port.Text), _
True)
nat.AddPortMapping(pmi)
results.Text = "Successfully Added..." & vbCr & vbLf & vbCr & vbLf
Dim nater As New BackgroundWorker()
nater.WorkerReportsProgress = False
AddHandler nater.DoWork, AddressOf enumerate_mappings
nater.RunWorkerAsync()
nater.Dispose()
Catch generatedExceptionName As FormatException
results.AppendText("Input was not formatted correctly." & vbCr & vbLf)
Catch e As COMException
results.AppendText((("Port " & port.Text.Trim() & " ") + comboBox1.SelectedItem.ToString() & " was unavailble: ") + e.Message & vbCr & vbLf)
Catch generatedExceptionName As ArgumentException
results.AppendText("Value was out of range (e.g. ports are 0-65535)." & vbCr & vbLf)
End Try
Else
results.AppendText("Fwd to must be an IP address (e.g. 192.168.0.2)." & vbCr & vbLf)
End If
Else
results.AppendText("Input was blank." & vbCr & vbLf)
End If
End Sub
Private Sub ButtonDeleteOnClick(ByVal obj As Object, ByVal ea As EventArgs)
If port.Text.Trim() <> "" Then
Try
Dim pmi As New PortMappingInfo("FreeMeter", comboBox1.SelectedItem.ToString(), Nothing, Integer.Parse(port.Text), Nothing, Integer.Parse(port.Text), _
True)
nat.RemovePortMapping(pmi)
results.Text = "Successfully Removed..." & vbCr & vbLf & vbCr & vbLf
Dim nater As New BackgroundWorker()
nater.WorkerReportsProgress = False
AddHandler nater.DoWork, AddressOf enumerate_mappings
nater.RunWorkerAsync()
nater.Dispose()
Catch generatedExceptionName As FormatException
results.AppendText("Input was not formatted correctly." & vbCr & vbLf)
Catch generatedExceptionName As FileNotFoundException
results.AppendText("No such mapping to remove." & vbCr & vbLf)
Catch generatedExceptionName As ArgumentException
results.AppendText("Value was out of range (e.g. ports are 0-65535)." & vbCr & vbLf)
Catch e As COMException
results.AppendText((("Error removing Port " & port.Text.Trim() & " ") + comboBox1.SelectedItem.ToString() & ": ") + e.Message & vbCr & vbLf)
End Try
Else
results.AppendText("Input was blank." & vbCr & vbLf)
End If
End Sub
'set the text of a control in a threadsafe manner
Private Delegate Sub SetTextCallback(ByVal l As TextBox, ByVal t As String)
Private Sub SetText(ByVal l As TextBox, ByVal t As String)
If Not l.IsDisposed Then
If l.InvokeRequired Then
Dim d As New SetTextCallback(AddressOf SetText)
Try
Me.Invoke(d, New [Object]() {l, t})
Catch e As ObjectDisposedException
Console.WriteLine(e.ToString())
End Try
Else
l.AppendText(t)
End If
End If
End Sub
End Class
Public Class PortMappingInfo
Private m_enabled As Boolean
Private m_description As String
Private m_internalHostName As String
Private m_internalPort As Integer
Private m_externalIPAddress As IPAddress
Private m_externalPort As Integer
Private m_protocol As String
Public Sub New(ByVal description As String, ByVal protocol As String, ByVal internalHostName As String, ByVal internalPort As Integer, ByVal externalIPAddress As IPAddress, ByVal externalPort As Integer, _
ByVal enabled As Boolean)
Me.m_enabled = enabled
Me.m_description = description
Me.m_internalHostName = internalHostName
Me.m_internalPort = internalPort
Me.m_externalIPAddress = externalIPAddress
Me.m_externalPort = externalPort
Me.m_protocol = protocol
End Sub
Public ReadOnly Property InternalHostName() As String
Get
Return m_internalHostName
End Get
End Property
Public ReadOnly Property InternalPort() As Integer
Get
Return m_internalPort
End Get
End Property
Public ReadOnly Property ExternalIPAddress() As IPAddress
Get
Return m_externalIPAddress
End Get
End Property
Public ReadOnly Property ExternalPort() As Integer
Get
Return m_externalPort
End Get
End Property
Public ReadOnly Property Protocol() As String
Get
Return m_protocol
End Get
End Property
Public ReadOnly Property Enabled() As Boolean
Get
Return m_enabled
End Get
End Property
Public ReadOnly Property Description() As String
Get
Return m_description
End Get
End Property
End Class
Public Class _UPnPNat
Private upnp As UPnPNAT
Public Sub New()
Try
Dim nat As New UPnPNAT()
If nat.NATEventManager IsNot Nothing AndAlso nat.StaticPortMappingCollection IsNot Nothing Then
upnp = nat
End If
Catch
End Try
If upnp Is Nothing Then
' No configurable UPNP NAT is available.
Throw New NotSupportedException()
End If
End Sub
Public ReadOnly Property PortMappings() As PortMappingInfo()
Get
Dim portMappings1 As New ArrayList()
' Enumerates the ports without using the foreach statement (causes the interop to fail).
Dim count As Integer = upnp.StaticPortMappingCollection.Count
Dim enumerator As IEnumerator = upnp.StaticPortMappingCollection.GetEnumerator()
enumerator.Reset()
For i As Integer = 0 To count
Dim mapping As IStaticPortMapping = Nothing
Try
If enumerator.MoveNext() Then
mapping = DirectCast(enumerator.Current, IStaticPortMapping)
End If
Catch
End Try
If mapping IsNot Nothing Then
portMappings1.Add(New PortMappingInfo(mapping.Description, mapping.Protocol.ToUpper(), mapping.InternalClient, mapping.InternalPort, IPAddress.Parse(mapping.ExternalIPAddress), mapping.ExternalPort, _
mapping.Enabled))
End If
Next
' copies the ArrayList to an array of PortMappingInfo.
Dim portMappingInfos As PortMappingInfo() = New PortMappingInfo(portMappings1.Count - 1) {}
portMappings1.CopyTo(portMappingInfos)
Return portMappingInfos
End Get
End Property
Public Sub AddPortMapping(ByVal portMapping As PortMappingInfo)
upnp.StaticPortMappingCollection.Add(portMapping.ExternalPort, portMapping.Protocol, portMapping.InternalPort, portMapping.InternalHostName, portMapping.Enabled, portMapping.Description)
End Sub
Public Sub RemovePortMapping(ByVal portMapping As PortMappingInfo)
upnp.StaticPortMappingCollection.Remove(portMapping.ExternalPort, portMapping.Protocol)
End Sub
End Class
Didn't get back to this one today...maybe tomorrow!
ASKER
ok thanks
You posted 4,000+ lines of code and it doesn't have everything necessary to compile/run. Not going to manually decipher that...
If you post YOUR code that you used to make the picture in your last post:
https://www.experts-exchange.com/questions/26516398/VB-NET-Draw-a-graph-using-current-upload-download-speed.html#33816891
...then perhaps I can modify it to make smooth lines?
If you post YOUR code that you used to make the picture in your last post:
https://www.experts-exchange.com/questions/26516398/VB-NET-Draw-a-graph-using-current-upload-download-speed.html#33816891
...then perhaps I can modify it to make smooth lines?
ASKER
This is the complete solution of that form. Take a look.
http://www.e3mc.net/FreeMasterVB.zip
The code that I've used to get that picture:
http://www.e3mc.net/FreeMasterVB.zip
The code that I've used to get that picture:
Dim adapter As NetworkAdapter = Me.adapters(Me.ListAdapters.SelectedIndex)
CurrentValue = [String].Format("{0:n}", adapter.DownloadSpeedKbps)
'CurrentValue = CurrentValue + IIf(R.Next(0, 2) = 0, -1, 1)
If CurrentValue < 0 Then
CurrentValue = 0
End If
If CurrentValue > PictureBox1.Height Then
CurrentValue = PictureBox1.Height
End If
Static xCounter As Integer = 0
xCounter = xCounter + 1
Dim bmp As New Bitmap(PictureBox1.ClientRectangle.Width, PictureBox1.ClientRectangle.Height)
Using G As Graphics = Graphics.FromImage(bmp)
G.Clear(Color.Black)
For y As Integer = 0 To bmp.Height Step GridSize
G.DrawLine(Pens.Green, bmp.Width - 1, y, bmp.Width, y)
Next
G.DrawImage(PictureBox1.Image, -1, 0) ' <-- draw everything in the PictureBox ONE pixel to the Left of where it is now
If xCounter = 25 Then
xCounter = 0
G.DrawLine(Pens.Green, bmp.Width - 1, 0, bmp.Width - 1, bmp.Height)
End If
G.DrawRectangle(Pens.LightGreen, New Rectangle(bmp.Width - 1, CurrentValue, 1, 1)) ' <-- draw the new "current" value at the right edge of the bitmap
End Using
PictureBox1.Image = bmp
ASKER
download speed values are from 0 - xxxxx like up to 10000 or something depends on the internet connection so it should be able to draw that line.
ASKER
Idle_Mind are you still working on this?
ASKER
This is getting nowhere.
Sorry anggry....been very busy this week. =\
ASKER
But you will still get back to this, right?
Approximately how long in between updates for new values of the upload/download speeds?
ASKER
1 sec
K...and do you want the graph to move every second then?...or move faster and just have the same value for several moves?
ASKER
user should be able to select how fast he wan't it to move.. but default can be every second.
Basically you need to store the last value and draw a line connecting the last value to the new value.
Here's the basic example again but implementing the connecting line...note that the graph is moving faster than the values are being generated, but there are no gaps:
Here's the basic example again but implementing the connecting line...note that the graph is moving faster than the values are being generated, but there are no gaps:
Public Class Form1
Private CurrentValue As Integer
Private LastValue As Integer
Private GridSize As Integer = 25
Private WithEvents tmrScroll As New Timer
Private R As New Random
Private WithEvents tmrNewValue As New Timer
Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
CurrentValue = PictureBox1.Height / 2
LastValue = CurrentValue
Dim bmp As New Bitmap(PictureBox1.ClientRectangle.Width, PictureBox1.ClientRectangle.Height)
Using G As Graphics = Graphics.FromImage(bmp)
G.Clear(Color.Black)
End Using
PictureBox1.Image = bmp
tmrScroll.Interval = 250 ' four times as fast as the updates in "current value"
tmrScroll.Start()
tmrNewValue.Interval = 1000 ' new value every second
tmrNewValue.Start()
End Sub
Private Sub tmrScroll_Tick(ByVal sender As Object, ByVal e As System.EventArgs) Handles tmrScroll.Tick
Static xCounter As Integer = 0
xCounter = xCounter + 1
Dim bmp As New Bitmap(PictureBox1.ClientRectangle.Width, PictureBox1.ClientRectangle.Height)
Using G As Graphics = Graphics.FromImage(bmp)
G.Clear(Color.Black)
For y As Integer = 0 To bmp.Height Step GridSize
G.DrawLine(Pens.Green, bmp.Width - 1, y, bmp.Width, y)
Next
G.DrawImage(PictureBox1.Image, -1, 0) ' <-- draw everything in the PictureBox ONE pixel to the Left of where it is now
If xCounter = 25 Then
xCounter = 0
G.DrawLine(Pens.Green, bmp.Width - 1, 0, bmp.Width - 1, bmp.Height)
End If
G.DrawLine(Pens.LightGreen, bmp.Width - 2, LastValue, bmp.Width - 1, CurrentValue) ' draw a line from the last value to the current value
G.DrawRectangle(Pens.LightGreen, New Rectangle(bmp.Width - 1, CurrentValue, 1, 1)) ' <-- draw the new "current" value at the right edge of the bitmap
End Using
Dim prevBmp As Bitmap = PictureBox1.Image
PictureBox1.Image = bmp
If Not IsNothing(prevBmp) Then
prevBmp.Dispose()
End If
LastValue = CurrentValue
End Sub
Private Sub tmrNewValue_Tick(ByVal sender As Object, ByVal e As System.EventArgs) Handles tmrNewValue.Tick
Dim jump As Integer = R.Next(0, 25)
CurrentValue = CurrentValue + IIf(R.Next(0, 2) = 0, -jump, jump)
If CurrentValue < 0 Then
CurrentValue = 0
End If
If CurrentValue > PictureBox1.Height Then
CurrentValue = PictureBox1.Height
End If
End Sub
End ClassASKER
I is drawing a graph but how what I have to change in order to get this working with current download speed..
Current download speed is:..
Download speed is :
Dim adapter As NetworkAdapter = Me.adapters(Me.ListAdapter
val1 = [String].Format("{0:n}", adapter.DownloadSpeedKbps)
VAL1 will be current dl speed
Current download speed is:..
Download speed is :
Dim adapter As NetworkAdapter = Me.adapters(Me.ListAdapter
val1 = [String].Format("{0:n}", adapter.DownloadSpeedKbps)
VAL1 will be current dl speed
ASKER
also, how to make graph to draw values from the bottom of the graph no from the middle
ASKER
So the bottom is 0.
In the last example, "CurrentValue" is what is being graphed so:
Dim adapter As NetworkAdapter = Me.adapters(Me.ListAdapter
CurrentValue = adapter.DownloadSpeedKbps
*But you'll have to SCALE the value first to make it make sense for the height of your PictureBox.
To make things draw from the bottom up you'd just subtract the value (after scaling) from the PictureBox.Height.
Dim adapter As NetworkAdapter = Me.adapters(Me.ListAdapter
CurrentValue = adapter.DownloadSpeedKbps
*But you'll have to SCALE the value first to make it make sense for the height of your PictureBox.
To make things draw from the bottom up you'd just subtract the value (after scaling) from the PictureBox.Height.
ASKER
I have no idea how to do that.
*sigh*
ASKER
idd.
In a nutshell...
Pick an arbitray "max" value for your data...something that you don't think your current value will go over. Let's say its 500,00 doomahicky units. Now represent your current value as a percentage of the max value. If your current value was 100,00 then it would be:
curPercentage = 100,000 / 500,00 = 0.2
Now use that percentage to scale it down to the height of your picturebox:
curScaledValue = PictureBox1.Height * curPercentage
If the PictureBox was 150 pixels high then you would have:
curScaledValue = 150 * 0.2 = 30
Thus 100,00 in real units equals 30 pixels in your PictureBox.
Finally, subtract that 30 from the Height of the PictureBox to draw the line 30 pixels above the bottom of the PictureBox...thus making the bottom "zero":
e.Graphics.DrawLine(Pens.R
That would draw a red horizontal line across the PictureBox at the "30" mark using the bottom of the PictureBox as zero.
Hopefully that makes sense... =)
Pick an arbitray "max" value for your data...something that you don't think your current value will go over. Let's say its 500,00 doomahicky units. Now represent your current value as a percentage of the max value. If your current value was 100,00 then it would be:
curPercentage = 100,000 / 500,00 = 0.2
Now use that percentage to scale it down to the height of your picturebox:
curScaledValue = PictureBox1.Height * curPercentage
If the PictureBox was 150 pixels high then you would have:
curScaledValue = 150 * 0.2 = 30
Thus 100,00 in real units equals 30 pixels in your PictureBox.
Finally, subtract that 30 from the Height of the PictureBox to draw the line 30 pixels above the bottom of the PictureBox...thus making the bottom "zero":
e.Graphics.DrawLine(Pens.R
That would draw a red horizontal line across the PictureBox at the "30" mark using the bottom of the PictureBox as zero.
Hopefully that makes sense... =)
ASKER
It makes sense.. but I get some horrible output in graph.
Private Sub tmrScroll_Tick(ByVal sender As Object, ByVal e As System.EventArgs) Handles tmrScroll.Tick
Dim adapter As NetworkAdapter = Me.adapters(Me.ListAdapters.SelectedIndex)
Dim curPercentage As Integer
Dim curScaledValue As Integer
curPercentage = [String].Format("{0:n}", adapter.DownloadSpeedKbps) / 50000
curScaledValue = PictureBox1.Height * curPercentage
Static xCounter As Integer = 0
xCounter = xCounter + 1
Dim bmp As New Bitmap(PictureBox1.ClientRectangle.Width, PictureBox1.ClientRectangle.Height)
Using G As Graphics = Graphics.FromImage(bmp)
G.Clear(Color.Black)
For y As Integer = 0 To bmp.Height Step GridSize
G.DrawLine(Pens.Green, bmp.Width - 1, y, bmp.Width, y)
Next
G.DrawImage(PictureBox1.Image, -1, 0) ' <-- draw everything in the PictureBox ONE pixel to the Left of where it is now
If xCounter = 25 Then
xCounter = 0
G.DrawLine(Pens.Green, bmp.Width - 1, 0, bmp.Width - 1, bmp.Height)
End If
'G.DrawLine(Pens.LightGreen, bmp.Width - 2, LastValue, bmp.Width - 1, CurrentValue) ' draw a line from the last value to the current value
G.DrawRectangle(Pens.LightGreen, New Rectangle(bmp.Width - 1, CurrentValue, 1, 1)) ' <-- draw the new "current" value at the right edge of the bitmap
G.DrawLine(Pens.Red, 0, PictureBox1.Height - curScaledValue, PictureBox1.Width, PictureBox1.Height - curScaledValue)
End Using
Dim prevBmp As Bitmap = PictureBox1.Image
PictureBox1.Image = bmp
If Not IsNothing(prevBmp) Then
prevBmp.Dispose()
End If
LastValue = CurrentValue
End Sub
You're not drawing the line connecting the previous value to the new value:
G.DrawLine(Pens.LightGreen
It was line #45 back here:
https://www.experts-exchange.com/questions/26516398/VB-NET-Draw-a-graph-using-current-upload-download-speed.html#33869187
G.DrawLine(Pens.LightGreen
It was line #45 back here:
https://www.experts-exchange.com/questions/26516398/VB-NET-Draw-a-graph-using-current-upload-download-speed.html#33869187
ASKER
yeah, that fixed the problem but it is still drawing stuff from top to bottom
Line #26:
G.DrawLine(Pens.Red, 0, PictureBox1.Height - curScaledValue, PictureBox1.Width, PictureBox1.Height - curScaledValue)
This was simply an EXAMPLE to go along with the DESCRIPTION of how to scale the value back here:
https://www.experts-exchange.com/questions/26516398/VB-NET-Draw-a-graph-using-current-upload-download-speed.html#33871748
"That would draw a red horizontal line across the PictureBox at the "30" mark using the bottom of the PictureBox as zero."
Do you really want a red horizontal line all the way across your picturebox?... (not very graph like!)
Get rid of Line #26.
Change Line #25, instead, so that it uses the scaled value AND draws from the bottom of the picturebox:
G.DrawRectangle(Pens.Light
G.DrawLine(Pens.Red, 0, PictureBox1.Height - curScaledValue, PictureBox1.Width, PictureBox1.Height - curScaledValue)
This was simply an EXAMPLE to go along with the DESCRIPTION of how to scale the value back here:
https://www.experts-exchange.com/questions/26516398/VB-NET-Draw-a-graph-using-current-upload-download-speed.html#33871748
"That would draw a red horizontal line across the PictureBox at the "30" mark using the bottom of the PictureBox as zero."
Do you really want a red horizontal line all the way across your picturebox?... (not very graph like!)
Get rid of Line #26.
Change Line #25, instead, so that it uses the scaled value AND draws from the bottom of the picturebox:
G.DrawRectangle(Pens.Light
ASKER
With the code below, it is still drawing the graph from the top to the bottom and when current dl speed is above 1xx then it just draws that line outside the picturebox... grid in the pictruebox is moving forward but there is no graphline as it it is somewhere beyond it.
ASKER
Private Sub tmrScroll_Tick(ByVal sender As Object, ByVal e As System.EventArgs) Handles tmrScroll.Tick
Dim adapter As NetworkAdapter = Me.adapters(Me.ListAdapter
Dim curPercentage As Integer
Dim curScaledValue As Integer
curPercentage = [String].Format("{0:n}", adapter.DownloadSpeedKbps)
curScaledValue = PictureBox1.Height * curPercentage
Static xCounter As Integer = 0
xCounter = xCounter + 1
Dim bmp As New Bitmap(PictureBox1.ClientR
Using G As Graphics = Graphics.FromImage(bmp)
G.Clear(Color.Black)
For y As Integer = 0 To bmp.Height Step GridSize
G.DrawLine(Pens.Green, bmp.Width - 1, y, bmp.Width, y)
Next
G.DrawImage(PictureBox1.Im
If xCounter = 25 Then
xCounter = 0
G.DrawLine(Pens.Green, bmp.Width - 1, 0, bmp.Width - 1, bmp.Height)
End If
G.DrawLine(Pens.LightGreen
G.DrawRectangle(Pens.Light
End Using
Dim prevBmp As Bitmap = PictureBox1.Image
PictureBox1.Image = bmp
If Not IsNothing(prevBmp) Then
prevBmp.Dispose()
End If
LastValue = CurrentValue
End Sub
Dim adapter As NetworkAdapter = Me.adapters(Me.ListAdapter
Dim curPercentage As Integer
Dim curScaledValue As Integer
curPercentage = [String].Format("{0:n}", adapter.DownloadSpeedKbps)
curScaledValue = PictureBox1.Height * curPercentage
Static xCounter As Integer = 0
xCounter = xCounter + 1
Dim bmp As New Bitmap(PictureBox1.ClientR
Using G As Graphics = Graphics.FromImage(bmp)
G.Clear(Color.Black)
For y As Integer = 0 To bmp.Height Step GridSize
G.DrawLine(Pens.Green, bmp.Width - 1, y, bmp.Width, y)
Next
G.DrawImage(PictureBox1.Im
If xCounter = 25 Then
xCounter = 0
G.DrawLine(Pens.Green, bmp.Width - 1, 0, bmp.Width - 1, bmp.Height)
End If
G.DrawLine(Pens.LightGreen
G.DrawRectangle(Pens.Light
End Using
Dim prevBmp As Bitmap = PictureBox1.Image
PictureBox1.Image = bmp
If Not IsNothing(prevBmp) Then
prevBmp.Dispose()
End If
LastValue = CurrentValue
End Sub
ASKER
this is so dead..
The connecting line should also be drawn from the bottom by subtracting from PictureBox1.Height:
G.DrawLine(Pens.LightGreen
G.DrawRectangle(Pens.Light
I feel like I've already given you all the tools you need to build a graph my friend...
G.DrawLine(Pens.LightGreen
G.DrawRectangle(Pens.Light
I feel like I've already given you all the tools you need to build a graph my friend...
ASKER
only one last thing. How to fix the thing circled on the image.
Private Sub tmrScroll_Tick(ByVal sender As Object, ByVal e As System.EventArgs) Handles tmrScroll.Tick
Dim adapter As NetworkAdapter = Me.adapters(Me.ListAdapters.SelectedIndex)
Dim curPercentage As Integer
Dim curScaledValue As Integer
Dim curPercentage2 As Integer
Dim curScaledValue2 As Integer
curPercentage = [String].Format("{0:n}", adapter.DownloadSpeedKbps) / 50000
curScaledValue = PictureBox1.Height * curPercentage
curPercentage2 = [String].Format("{0:n}", adapter.UploadSpeedKbps) / 50000
curScaledValue2 = PictureBox1.Height * curPercentage2
Static xCounter As Integer = 0
xCounter = xCounter + 1
Dim bmp As New Bitmap(PictureBox1.ClientRectangle.Width, PictureBox1.ClientRectangle.Height)
Using G As Graphics = Graphics.FromImage(bmp)
G.Clear(Color.Transparent)
For y As Integer = 0 To bmp.Height Step GridSize
G.DrawLine(Pens.Transparent, bmp.Width - 1, y, bmp.Width, y)
Next
G.DrawImage(PictureBox1.Image, -1, 0)
If xCounter = 25 Then
xCounter = 0
G.DrawLine(Pens.Transparent, bmp.Width - 1, 0, bmp.Width - 1, bmp.Height)
End If
G.DrawLine(Pens.ForestGreen, bmp.Width - 2, PictureBox1.Height - LastValue, bmp.Width - 1, PictureBox1.Height - CurrentValue)
G.DrawRectangle(Pens.ForestGreen, New Rectangle(bmp.Width - 1, PictureBox1.Height - curScaledValue, 1, 1))
G.DrawLine(Pens.Firebrick, bmp.Width - 2, PictureBox1.Height - LastValue2, bmp.Width - 1, PictureBox1.Height - CurrentValue2)
G.DrawRectangle(Pens.Firebrick, New Rectangle(bmp.Width - 1, PictureBox1.Height - curScaledValue2, 1, 1))
End Using
Dim prevBmp As Bitmap = PictureBox1.Image
PictureBox1.Image = bmp
If Not IsNothing(prevBmp) Then
prevBmp.Dispose()
End If
LastValue = CurrentValue
LastValue2 = CurrentValue2
End Sub
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER
Many thanks.
You may want to check this question out.
https://www.experts-exchange.com/questions/26544478/VB-NET-Custom-Graph-Design.html?anchorAnswerId=33907228#a33907228
You may want to check this question out.
https://www.experts-exchange.com/questions/26544478/VB-NET-Custom-Graph-Design.html?anchorAnswerId=33907228#a33907228
ASKER
Open in new window