This is an old one written a few years ago, but still a favourite. It's an International Times and major currencies converter. Internally it uses two datatables, one which is currency rates downloaded from the European Central Bank, and the other contains TimeZone information and the dominant currency for each geographical area. These two datatables are used extensively throughout the application.
The application consists of three international timezone clocks, each of which has a ComboBox linked to it allowing changing Timezone (which also changes currency displayed).The clocks can display time for any timezone and also have a Daylight Saving Time indicator.These clocks are analog and show hour, minute, and second, and have an optional alarm which is also displayed in an analog fashion as a red alarm hand.There is a calculator for converting specific amounts from one currency unit to another.
Animating these clocks is achieved through three timers, each with a 250 millisecond interval, which draw the background of the clock (i.e. the legend, timezone region, the date, DST indicator, and a digital representation of the time in 24 hour format), then call the Shared procedures in the clockWorks class - checkAlarm, drawAlarmHand, drawHands. These methods sound the alarm at the appropriate time, and complete the drawing of the clock face.
This contains three Shared methods for checking and sounding alarms, and drawing hands on the analog clocks:
Public Class clockWorks '' global alarms list Public Shared alarms As New List(Of alarm) Public Shared clock1AlarmForm As Form Public Shared clock2AlarmForm As Form Public Shared clock3AlarmForm As Form Public Shared minutePic As Bitmap = New Bitmap(My.Resources.MINUTE1) Public Shared secondPic As Bitmap = New Bitmap(My.Resources.SECOND1) Public Shared hourPic As Bitmap = New Bitmap(My.Resources.HOUR1) Public Shared centerPic As Bitmap = New Bitmap(My.Resources.CENTRE) Public Shared Sub checkAlarm(ByVal placeName As String, ByVal code As String, ByVal alarmTime As TimeSpan, ByVal timeOffset As DateTimeOffset, ByRef clock As Form) '"hh:mm tt" Dim alarm As alarm = alarms.Where(Function(a) a.placeName = placeName AndAlso a.code = code).FirstOrDefault If alarmTime.Hours = timeOffset.Hour AndAlso alarmTime.Minutes = timeOffset.Minute Then alarms(alarms.FindIndex(Function(a) a Is alarm)).alarmSounded = True clock = New aFrm1(placeName.Substring(5), timeOffset.ToString("hh:mm tt")) clock.ShowDialog() End If End Sub Public Shared Sub drawAlarmHand(ByVal g As Graphics, ByVal alarmTime As TimeSpan) g.SmoothingMode = Drawing2D.SmoothingMode.HighQuality g.InterpolationMode = Drawing2D.InterpolationMode.HighQualityBicubic Dim redPen1 As New Pen(Color.Red, 1) Dim redPen3 As New Pen(Color.Red, 3) Dim redPen5 As New Pen(Color.Red, 5) Dim angleDegHour As Single Dim angleRadHour As Single Dim lineX2 As Single Dim lineY2 As Single '' the alarm hand is 3 different thickness lines '' rather than a picture like the other hands angleDegHour = CSng((alarmTime.Hours * 30) + (alarmTime.Minutes * 0.5)) 'Turn degrees to radians (because of the sin and cos operations) angleRadHour = CSng(Math.PI * angleDegHour / 180) 'Calculate X2 and Y2 lineX2 = CSng(96 + Math.Sin(angleRadHour) * 60) lineY2 = CSng(96 - Math.Cos(angleRadHour) * 60) 'draw the line (5 pixel thickness, 60 pixels long) g.DrawLine(redPen5, 96, 96, lineX2, lineY2) 'Calculate X2 and Y2 lineX2 = CSng(96 + Math.Sin(angleRadHour) * 63) lineY2 = CSng(96 - Math.Cos(angleRadHour) * 63) 'draw the line (3 pixel thickness, 63 pixels long) g.DrawLine(redPen3, 96, 96, lineX2, lineY2) 'Calculate X2 and Y2 lineX2 = CSng(96 + Math.Sin(angleRadHour) * 65) lineY2 = CSng(96 - Math.Cos(angleRadHour) * 65) 'draw the line (1 pixel thickness, 65 pixels long) g.DrawLine(redPen1, 96, 96, lineX2, lineY2) End Sub Public Shared Sub drawHands(ByVal g As Graphics, ByVal timeOffset As DateTimeOffset) g.SmoothingMode = Drawing2D.SmoothingMode.HighQuality g.InterpolationMode = Drawing2D.InterpolationMode.HighQualityBicubic '' draw the hour hand g.RotateTransform(CSng(-90 + ((timeOffset.Hour * 30) + (timeOffset.Minute * 0.5)))) g.DrawImage(hourPic, -2, -2) g.ResetTransform() '' draw the minute hand g.TranslateTransform(96, 96) g.RotateTransform(CSng(-90 + (((timeOffset.Minute * 60) + timeOffset.Second) * 0.1))) g.DrawImage(minutePic, -2, -2) g.ResetTransform() '' draw the second hand g.TranslateTransform(96, 96) g.RotateTransform(-90 + (timeOffset.Second * 6)) g.DrawImage(secondPic, -2, -2) g.ResetTransform() End Sub End Class
This contains just one Shared function that downloads currency rates and creates and returns that as a Datatable. These currency rates are published daily by the European Central Bank in an online xml file:
Imports <xmlns:alias="http://www.ecb.int/vocabulary/2002-08-01/eurofxref Jump "> Public Class getCurrencyRates Public Shared Function getRatesAsDatatable() As DataTable Dim xml As XDocument = XDocument.Load("http://www.ecb.int/stats/eurofxref/eurofxref-daily.xml Jump ") Dim dt As New DataTable Dim items = From node In xml...<alias:Cube>...<alias:Cube>...<alias:Cube> _ Select New With { _ .code = node.@currency, _ .rate = node.@rate} dt.Columns.Add("code") dt.Columns.Add("EUR") For Each i In items dt.Columns.Add(i.code) Next Dim dr As DataRow Dim firstRow As Boolean = True For Each i In items Dim columns() As String If firstRow Then dr = dt.NewRow ReDim columns(dt.Columns.Count - 1) columns(0) = "EUR" columns(1) = (1).ToString dr.ItemArray = columns dt.Rows.Add(dr) firstRow = False End If ReDim columns(dt.Columns.Count - 1) columns(0) = i.code columns(1) = i.rate dr = dt.NewRow dr.ItemArray = columns dt.Rows.Add(dr) Next firstRow = True For Each row As DataRow In dt.Rows If firstRow Then dt.Rows(0).Item(dt.Rows(0).Item(0).ToString) = 1 firstRow = False Else dt.Rows(0).Item(row.Item(0).ToString) = 1 / CDbl(row.Item(1).ToString) row.Item(row.Item(0).ToString) = 1 End If Next For c As Integer = 2 To dt.Columns.Count - 1 For r As Integer = 1 To dt.Rows.Count - 1 dt.Rows(r).Item(dt.Columns(c).ColumnName) = CDbl(dt.Rows(0).Item(dt.Columns(c).ColumnName)) / CDbl(dt.Rows(0).Item(dt.Rows(r).Item("code").ToString)) Next Next Return dt End Function End Class
This creates and returns a Datatable containing all international TimeZones:
Public Class timeZones Public Shared Function GetSystemTimeZones() As DataTable Dim linesByCountry() As String = My.Resources._2DigitCountryCodes.Split(New String() {Environment.NewLine}, StringSplitOptions.None) Dim dt As New DataTable dt.Columns.Add("region") dt.Columns.Add("tzID") dt.Columns.Add("cc") Dim dr As DataRow Dim lines() As String = My.Resources.CCbyCity.Split(New String() {Environment.NewLine}, StringSplitOptions.None) For Each tz As TimeZoneInfo In TimeZoneInfo.GetSystemTimeZones If Not tz.ToString.Contains("Coordinated Universal Time") AndAlso Not tz.ToString.Contains("International Date Line West") Then Dim parts() As String = tz.ToString.Split(New String() {") "}, StringSplitOptions.None) Dim regions() As String = parts(1).Split(New String() {", "}, StringSplitOptions.None) For Each r As String In regions If r = "Mid-Atlantic" Then Continue For Dim cc() As String Dim line As String = lines.Where(Function(s) s.StartsWith(r) OrElse s.Contains(r)).FirstOrDefault If line = Nothing Then Continue For Else cc = line.Split(","c) End If If cc.Count > 1 Then r = linesByCountry.FirstOrDefault(Function(s) s.Substring(5) = r) If r Is Nothing OrElse r.Trim = "" Then Continue For r = r.Trim dr = dt.NewRow dr.ItemArray = New String() {r, tz.Id, cc(1)} dt.Rows.Add(dr) If r.Contains("(US & Canada)") Then dr = dt.NewRow dr.ItemArray = New String() {"CA - " & r.Substring(5).Trim, tz.Id, "CAD"} dt.Rows.Add(dr) End If End If Next End If Next Return dt End Function End Class
The extended ComboBoxes allow country names to be displayed in the ToolStripStatusLabels below the ComboBox as you move the mouse over the dropped down list. The ComboBox needs to be subclassed to get a Handle to the dropdown window which is used to create a NativeWindow class where the WM_MOUSEMOVE message is used to identify the item below the mousepointer and display the related country name in the ToolStripStatusLabel below the ComboBox.
Imports System.Runtime.InteropServices Public Class comboboxEx Inherits ComboBox Private Const WM_CTLCOLORLISTBOX As Integer = &H134 Dim label As ToolStripStatusLabel Public Sub setUpLabels(ByVal lbl As ToolStripStatusLabel) label = lbl End Sub Protected Overrides Sub WndProc(ByRef m As System.Windows.Forms.Message) MyBase.WndProc(m) If m.Msg = WM_CTLCOLORLISTBOX Then Dim n As New nWindow(Me, label) n.AssignHandle(m.LParam) End If End Sub Protected Overrides Sub OnDropDownClosed(ByVal e As System.EventArgs) label.Text = "" MyBase.OnDropDownClosed(e) End Sub End Class Public Class nWindow Inherits NativeWindow Private combo As comboboxEx Private countries() As String Dim label As ToolStripStatusLabel Public Sub New(ByVal cb As comboboxEx, ByVal lbl As ToolStripStatusLabel) combo = cb countries = My.Resources.countries.Split(New String() {Environment.NewLine}, StringSplitOptions.None) label = lbl End Sub Public Declare Function GetScrollInfo Lib "user32" Alias "GetScrollInfo" (ByVal hWnd As IntPtr, _ ByVal n As Integer, <MarshalAs(UnmanagedType.Struct)> ByRef lpScrollInfo As SCROLLINFO) As Integer <StructLayout(LayoutKind.Sequential)> _ Public Structure SCROLLINFO Public cbSize As Integer Public fMask As Integer Public nMin As Integer Public nMax As Integer Public nPage As Integer Public nPos As Integer Public nTrackPos As Integer End Structure Private Const SB_ENDSCROLL As Integer = 8 Const SBS_VERT As Integer = 1 Const SIF_RANGE As Integer = 1 Const SIF_PAGE As Integer = 2 Const SIF_POS As Integer = 4 Const SIF_TRACKPOS As Integer = 10 Const SIF_ALL As Integer = (SIF_RANGE Or SIF_PAGE Or SIF_POS Or SIF_TRACKPOS) Private Const WM_MOUSEMOVE As Integer = &H200 Private lastIndex As Integer = -1 Protected Overrides Sub WndProc(ByRef m As System.Windows.Forms.Message) If m.Msg = WM_MOUSEMOVE Then Dim itemHeight As Integer = combo.GetItemHeight(0) Dim si As New SCROLLINFO si.fMask = SIF_ALL si.cbSize = Marshal.SizeOf(si) GetScrollInfo(Me.Handle, SBS_VERT, si) Dim newIndex As Integer = si.nPos + (New Point(m.LParam.ToInt32).Y \ itemHeight) If lastIndex <> newIndex And newIndex <= combo.Items.Count - 1 And newIndex >= 0 Then lastIndex = newIndex Dim newItem As DataRowView = DirectCast(combo.Items(lastIndex), DataRowView) label.Text = countries.First(Function(s) s.Substring(0, 2) = newItem.Item(0).ToString.Substring(0, 2)).Substring(5) End If End If MyBase.WndProc(m) End Sub End Class