Ok, here's the deal. My friend gave me class, but for the life of me I can't seem to include it into my project.
AFAIK, the steps should be (after opening a new project)
Project -> Add Class
Then adding the new class inside the project.
To reference the class, I would use
new clsGuitarTuner() in the default form.
I am using VS2003 so if I did anything wrong, please let me know. I'm not too experience using VB yet..
Thanks a lot guys...
Below here is the code for the class (I'm not sure which VS it was written in)
AFAIK, the steps should be (after opening a new project)
Project -> Add Class
Then adding the new class inside the project.
To reference the class, I would use
new clsGuitarTuner() in the default form.
I am using VS2003 so if I did anything wrong, please let me know. I'm not too experience using VB yet..
Thanks a lot guys...
Below here is the code for the class (I'm not sure which VS it was written in)
VB.NET:
Imports System.Runtime.InteropServices
Imports System.Maths
'clsGuitarTuner.vb
'This class creates and displays a window which tells you what note is being played
'into the preferred line in device.
'My main source of information is the MSDN.
'http://msdn.microsoft.com/library/en-us/multimed/htm/_win32_multimedia_functions.asp?frame=true
Class clsGuitarTuner
'Constants...
'------------------------------------------------------------------
'We'll use one-channel PCM format. This is just one of the formats
'Available for wave audio.
Const WAVE_FORMAT_PCM As Integer = 1
'This specifies that we want to use the preferred audio device,
'rather than select one ourselves.
Const WAVE_MAPPER As Integer = -1
'This specifies that we want to use a callback function. Other
'options include callback event, callback thread, callback window...
Const CALLBACK_FUNCTION As Integer = &H30000
'This specifies that the type of message sent to the callback
'is one containing wave audio data.
Public Const WIM_DATA As Integer = &H3C0
'This is the size of each buffer. Feel free to change this, but there
'should be no need.
Const BUFFER_SIZE As Integer = 8192
'This is how many buffers we will use. Double buffering should be
'plenty.
Dim NUMBER_OF_BUFFERS As Integer = 2
'How many samples we take per second. This is CD quality...
Const SAMPLES_PER_SEC As Integer = 44100
Const TUNER_X As Integer = 17
Const TUNER_Y As Integer = 20
Const TUNER_WIDTH As Integer = 455
Const TUNER_HEIGHT As Integer = 160
'API Declarations - Google for information on these if you need to...
'------------------------------------------------------------------
Declare Function waveInOpen Lib "winmm.dll" Alias "waveInOpen" (ByRef hWaveIn As Int32, ByVal uDeviceID As Int32, ByRef lpFormat As WAVEFORMATEX, ByVal dwCallback As waveCallbackProc, ByVal dwInstance As UInt32, ByVal dwFlags As Int32) As Int32
Declare Function waveInStart Lib "winmm.dll" Alias "waveInStart" (ByVal hWaveIn As Int32) As Int32
Declare Function waveInStop Lib "winmm.dll" Alias "waveInStop" (ByVal hWaveIn As Int32) As Int32
Declare Function waveInClose Lib "winmm.dll" Alias "waveInClose" (ByVal hWaveIn As Int32) As Int32
Declare Function waveInReset Lib "winmm.dll" (ByVal hWaveIn As Integer) As Integer
Declare Function waveInAddBuffer Lib "winmm.dll" Alias "waveInAddBuffer" (ByVal hWaveIn As Int32, ByRef lpWaveInHdr As WAVEHDR, ByVal uSize As UInt32) As Int32
Declare Function waveInGetNumDevs Lib "winmm.dll" Alias "waveInGetNumDevs" () As Integer
Declare Function waveInGetDevCaps Lib "winmm.dll" Alias "waveInGetDevCapsA" (ByVal uDeviceID As Integer, ByRef lpCaps As WAVEINCAPS, ByVal uSize As Integer) As Integer
Declare Function waveInPrepareHeader Lib "winmm.dll" Alias "waveInPrepareHeader" (ByVal hWaveIn As Int32, ByRef lpWaveInHdr As WAVEHDR, ByVal uSize As UInt32) As Int32
Declare Function GlobalAlloc Lib "kernel32" (ByVal wFlags As Integer, ByVal dwBytes As Integer) As Integer
Declare Function GlobalLock Lib "kernel32" (ByVal addr As Integer) As Integer
Declare Function GlobalFree Lib "kernel32" (ByVal addr As Integer) As Integer
Declare Function waveInGetErrorText Lib "winmm.dll" Alias "waveInGetErrorTextA" (ByVal err As Integer, ByVal lpText As String, ByVal uSize As Integer) As Integer
Declare Function waveInUnprepareHeader Lib "winmm.dll" (ByVal hWaveIn As Integer, ByVal lpWaveInHdr As WAVEHDR, ByVal uSize As Integer) As Integer
'API Structures...
'------------------------------------------------------------------
Structure WAVEFORMATEX
Dim wFormatTag As Int16
Dim nChannels As Int16
Dim nSamplesPerSec As Int32
Dim nAvgBytesPerSec As Int32
Dim nBlockAlign As Int16
Dim wBitsPerSample As Int16
Dim cbSize As Int16
End Structure
Structure WAVEINCAPS
Dim wMid As Int16
Dim wPid As Int16
Dim vDriverVersion As Int64
<MarshalAs(UnmanagedType.ByValArray, SizeConst:=32)> Dim szpName() As Char 'String of length 32
Dim dwFormats As Int32
Dim wChannels As Int16
Dim wReserved1 As Int16
End Structure
Public Structure WAVEHDR
Dim lpData As Int32
Dim dwBufferLength As Int32
Dim dwBytesRecorded As Int32
Dim dwUser As Int32
Dim dwFlags As Int32
Dim dwLoops As Int32
Dim reserved As Int32
Dim lpNext As Int32
End Structure
'Variables...
'------------------------------------------------------------------
'Store a reference to a bitmap object for drawing, so that we don't
'draw directly to the window, which causes heinous flickering...
Private bmp As Bitmap
'Reference to the graphics object created by the window...
Dim gfx As Graphics
'Create a number of WAVEHDRs for n-tuple buffering...
'One will be processed while another is being filled.
Dim waveHeader(NUMBER_OF_BUFFERS - 1) As WAVEHDR
'Store the handle to the waveIn device we are using...
Dim waveInHandle As Integer
'This array of bytes will store the current chunk of wave data...
Dim bytes(BUFFER_SIZE - 1) As Byte
'This array will store a modified version of the bytes array above.
'(-128 to 127) as opposed to (0-255)
Dim Doubles(BUFFER_SIZE) As Double
'This array stores the address in memory of each buffer...
Dim bufferAddress(NUMBER_OF_BUFFERS - 1) As Integer
'Declare the main window...
Dim frmForm As New frmGuitarTuner
'Define the signature of our callback procedure...
Public Delegate Sub waveCallbackProc(ByVal hwi As Int32, ByVal uMsg As UInt32, ByVal dwInstance As Int32, ByRef dwParam1 As WAVEHDR, ByVal dwparam2 As Int32)
'Define the callback procedure...
Dim pCallback As waveCallbackProc = AddressOf waveInProc
'Functions
'------------------------------------------------------------------
'Constructor. Just calls openWaveDevice...
Public Sub New()
openWaveDevice(WAVE_MAPPER)
End Sub
'This procedure opens the given wave device and starts waveIn on it...
Private Sub openWaveDevice(ByVal devName As Integer)
'create a new bitmap...
bmp = New Bitmap(frmForm.Width, frmForm.Height, frmForm.CreateGraphics())
'create a graphics object from the bitmap...
gfx = Graphics.FromImage(bmp)
'a variable to store the result of APIs...
Dim result As UInt32
'Create a wave format object and set it up for 8bit 44khz stereo...
Dim waveFormat As WAVEFORMATEX
waveFormat.wFormatTag = WAVE_FORMAT_PCM
waveFormat.nChannels = 1
waveFormat.nSamplesPerSec = SAMPLES_PER_SEC
waveFormat.wBitsPerSample = 8
waveFormat.nBlockAlign = waveFormat.nChannels * (waveFormat.wBitsPerSample / 8)
waveFormat.nAvgBytesPerSec = waveFormat.nSamplesPerSec * waveFormat.nBlockAlign
waveFormat.cbSize = 0
'Try to open the preferred device...
result = waveInOpen(waveInHandle, WAVE_MAPPER, waveFormat, pCallback, 0, CALLBACK_FUNCTION)
handlePotentialError(result)
'Set up each waveHdr...
Dim i As Integer
For i = 0 To NUMBER_OF_BUFFERS - 1
'Store the address of the current buffer in the address array...
bufferAddress(i) = GlobalAlloc(&H40, BUFFER_SIZE)
'Store the address in the wavehdr object itself...
waveHeader(i).lpData = GlobalLock(bufferAddress(i))
'Store the length of the buffer...
waveHeader(i).dwBufferLength = BUFFER_SIZE
'Flags must be zero, Loops not really relevant here...
waveHeader(i).dwFlags = 0
waveHeader(i).dwLoops = 0
Next
'Try to prepare and add each buffer...
For i = 0 To NUMBER_OF_BUFFERS - 1
result = waveInPrepareHeader(waveInHandle, waveHeader(i), Len(waveHeader(i)))
handlePotentialError(result)
result = waveInAddBuffer(waveInHandle, waveHeader(i), Len(waveHeader(i)))
handlePotentialError(result)
Next
'Show and size the window...
frmForm.Show()
frmForm.Width = TUNER_WIDTH + TUNER_X * 2
frmForm.Height = TUNER_HEIGHT + TUNER_Y * 2
'Try to start waveIn...
result = waveInStart(waveInHandle)
handlePotentialError(result)
End Sub
'This procedure stops waveIn...
Private Sub stopWaveIn()
Dim result As Integer
'Reset...
result = waveInReset(waveInHandle)
handlePotentialError(result)
'Stop...
result = waveInStop(waveInHandle)
handlePotentialError(result)
Dim i As Integer
For i = 0 To NUMBER_OF_BUFFERS - 1
'Unprepare each buffer...
result = waveInUnprepareHeader(waveInHandle, waveHeader(i), Len(waveHeader(i)))
handlePotentialError(result)
'Free the memory associated with each buffer...
GlobalFree(bufferAddress(i))
Next
'Close the device...
waveInClose(waveInHandle)
End Sub
'This procedure takes the result of a wave API and displays an error
'message if indeed there was an error. It also gives the option of
'quitting if an error occurs.
Private Sub handlePotentialError(ByVal result As Integer)
'If there was an error...
If result <> 0 Then
'Get and display the error message.
Dim msg As String = ""
waveInGetErrorText(result, msg, Len(msg))
MsgBox(msg, MsgBoxStyle.Exclamation, "Error")
'Present the option to quit.
Dim choice As MsgBoxResult = MsgBox("Quit?", MsgBoxStyle.YesNo)
'Quit if it is the choice.
If choice = MsgBoxResult.Yes Then End
End If
End Sub
'Here's the callback. If it were being called, we'd get a messagebox. but we dont.
Public Sub waveInProc(ByVal hwi As Int32, ByVal uMsg As UInt32, ByVal dwInstance As Int32, ByRef dwParam1 As WAVEHDR, ByVal dwparam2 As Int32)
'If we've received data...
If uMsg = WIM_DATA Then
'Copy the current buffer into the bytes array...
Marshal.Copy(dwParam1.lpData, bytes, 0, BUFFER_SIZE)
'Try to requeue the buffer...
Dim result As Integer = waveInAddBuffer(waveInHandle, dwParam1, Marshal.SizeOf(dwParam1))
handlePotentialError(result)
'Start analysis...
StartFFT()
End If
'Enable this to slow down the drawing...
' Threading.Thread.CurrentThread.Sleep(100)
End Sub
'Lists wave devices. Not used in this example, but useful for device selection...
Public Sub listWaveDevices()
Dim wic As WAVEINCAPS
ReDim wic.szpName(32)
'Get number of devices...
Dim iNumDevs As ULong
iNumDevs = waveInGetNumDevs()
'MsgBox each devices' name...
Dim i As ULong
For i = 0 To iNumDevs
If (waveInGetDevCaps(i, wic, Marshal.SizeOf(wic)) = 0) Then
MsgBox(wic.szpName)
End If
Next
End Sub
'Arrays representing complex numbers, used in the FFT routines.
Dim yi(16384) As Double, yimax As Double 'imaginary
Dim yr(16384) As Double, yrmax As Double 'real
Dim ymod(16384) As Double, ymodmax As Double 'vector
'This procedure starts the FFT analysis.
Private Sub StartFFT()
'Create a graphics object
gfx = frmForm.CreateGraphics
'Each sample is (0-255), for a graph we want
'-128 to 127, so we will store these numbers
'in a double array...
Dim i As Integer
For i = 1 To BUFFER_SIZE - 1
Doubles(i) = CDbl(bytes(i) - 128)
Next i
'Call the real FFT procedure...
Dim N As Long
N = BUFFER_SIZE / 2
RealFFT(N, 1)
'Call the graph FFT procedure...
GraphFFT(N)
End Sub
'Method for adjusting a color's component RGB values by a numeric value. Returns the adjusted color
Public Function adjustColor(ByVal cColor As System.Drawing.Color, ByVal adjust As Integer) As System.Drawing.Color
Dim returnColor As System.Drawing.Color
returnColor = Color.FromArgb(min(max(cColor.R + adjust, 0), 255), min(max(cColor.G + adjust, 0), 255), min(max(cColor.B + adjust, 0), 255))
Return returnColor
End Function
Sub RealFFT(ByVal N As Long, ByVal Isign As Integer)
Dim wr As Double, wi As Double, wpr As Double
Dim PIsin As Double, TmpW As Double, CalcA As Double
Dim c1 As Double, c2 As Double
Dim PB As Long, Paul As Long, i As Long
Dim i1 As Long, i2 As Long, i3 As Long, i4 As Long
Dim wrs As Single, wis As Single
Dim h1r As Double, h1i As Double
Dim h2r As Double, h2i As Double
PB = 2 * N
CalcA = 3.14159265358979 / CDbl(N)
c1 = 0.5
If Isign = 1 Then
c2 = -0.5
PlotIt(N, 1)
Else
c2 = 0.5
CalcA = -CalcA
End If
wpr = -2.0# * Math.Sin(0.5 * CalcA) ^ 2
PIsin = Math.Sin(CalcA)
wr = 1.0# + wpr
wi = PIsin
Paul = 2 * N + 3
For i = 2 To N / 2 + 1
i1 = 2 * i - 1
i2 = i1 + 1
i3 = Paul - i2
i4 = i3 + 1
wrs = CSng(wr)
wis = CSng(wi)
h1r = c1 * (Doubles(i1) + Doubles(i3))
h1i = c1 * (Doubles(i2) - Doubles(i4))
h2r = -c2 * (Doubles(i2) + Doubles(i4))
h2i = c2 * (Doubles(i1) - Doubles(i3))
Doubles(i1) = h1r + wrs * h2r - wis * h2i
Doubles(i2) = h1i + wrs * h2i + wis * h2r
Doubles(i3) = h1r - wrs * h2r + wis * h2i
Doubles(i4) = -h1i + wrs * h2i + wis * h2r
TmpW = wr
wr = wr * wpr - wi * PIsin + wr
wi = wi * wpr + TmpW * PIsin + wi
Next i
If Isign = 1 Then
h1r = Doubles(1)
Doubles(1) = h1r + Doubles(2)
Doubles(2) = h1r - Doubles(2)
Else
h1r = Doubles(1)
Doubles(1) = c1 * (h1r + Doubles(2))
Doubles(2) = c1 * (h1r - Doubles(2))
PlotIt(N, -1)
End If
End Sub
Sub PlotIt(ByVal PB As Long, ByVal Isign As Integer)
Dim N As Long, i As Long, j As Long
Dim m As Long, mmax As Long, istep As Long
Dim TmpR As Double, TmpI As Double
Dim wr As Double, wi As Double, wpr As Double
Dim PIsin As Double, TmpW As Double, CalcA As Double
N = 2 * PB
j = 1
For i = 1 To N Step 2
If j > i Then
TmpR = Doubles(j)
TmpI = Doubles(j + 1)
Doubles(j) = Doubles(i)
Doubles(j + 1) = Doubles(i + 1)
Doubles(i) = TmpR
Doubles(i + 1) = TmpI
End If
m = N / 2
1: If (m >= 2 And j > m) Then
j = j - m
m = m / 2
GoTo 1
End If
j = j + m
Next i
mmax = 2
2: If N > mmax Then
istep = 2 * mmax
CalcA = 6.28318530717959 / (Isign * mmax)
wpr = -2 * Math.Sin(0.5 * CalcA) ^ 2
PIsin = Math.Sin(CalcA)
wr = 1
wi = 0
For m = 1 To mmax Step 2
For i = m To N Step istep
j = i + mmax
TmpR = CSng(wr) * Doubles(j) - CSng(wi) * Doubles(j + 1)
TmpI = CSng(wr) * Doubles(j + 1) + CSng(wi) * Doubles(j)
Doubles(j) = Doubles(i) - TmpR
Doubles(j + 1) = Doubles(i + 1) - TmpI
Doubles(i) = Doubles(i) + TmpR
Doubles(i + 1) = Doubles(i + 1) + TmpI
Next i
TmpW = wr
wr = wr * wpr - wi * PIsin + wr
wi = wi * wpr + TmpW * PIsin + wi
Next m
mmax = istep
GoTo 2
End If
End Sub
'Graph Draing
Sub GraphFFT(ByVal CurSamp As Long)
Dim g As Long
'Separate real from imaginary; save; calculate vector; save;
'and finally find maximum values for each case
yimax = 0
yrmax = 0
ymodmax = 0
For g = 0 To CurSamp - 1
yr(g + 1) = Doubles(g * 2 + 1)
If Math.Abs(yr(g + 1)) > yrmax Then
yrmax = Math.Abs(yr(g + 1))
End If
yi(g + 1) = Doubles(g * 2 + 2)
If Math.Abs(yi(g + 1)) > yimax Then
yimax = Math.Abs(yi(g + 1))
End If
ymod(g + 1) = ((yr(g + 1)) ^ 2 + (yi(g + 1)) ^ 2) ^ (1 / 2)
If ymod(g + 1) > ymodmax Then
ymodmax = ymod(g + 1)
End If
Next g
Dim N As Long
Dim mm As Double = CurSamp * 2 / SAMPLES_PER_SEC
Const XZERO As Double = 0.964615822 'Hz
Const X440 As Double = 15900 / 15 'twips become pixels
Dim yzero As Double = gfx.VisibleClipBounds.Height * 2 / 3
Dim ymaxgraf As Double = gfx.VisibleClipBounds.Height / 8
Dim xmult As Double = X440 / Math.Log(440 / XZERO)
Dim xmax As Double = 7362 / 15 '150 twips for each logical note
Dim ymult As Double = (yzero - ymaxgraf) / ymodmax
'By calculating the x position and y position
'of each coordinate in the spectrum analysis graph,
'I calculate that with the least Y position. This corresponds to the
'highest peak in the graph, and so I assume this to be the note that
'is being played and use calculations to find this note.
'Coordinates...
Dim xX As Single
Dim yY As Single
'The current smallest Y value...
Dim smallestY As Double = 30000
'And it's X position...
Dim pos As Double = 0
'For each sample?
For N = 1 To CurSamp - 1
'Find the coordinates...
xX = (Math.Log(N / (mm * XZERO)) * xmult)
yY = (yzero - (ymod(N + 1)) * ymult)
'If the y value is lower than any we've encountered,
'store it and it's x position...
If yY < smallestY Then
smallestY = yY
pos = xX
End If
Next N
'If we encountered anything...
If smallestY < 30000 Then
'Get and display the note...
findNote(pos * 15)
Else
'Else just clear the canvas...
' gfx.Clear(SystemColors.ButtonFace)
End If
End Sub
'This procedure finds information regarding the note corresponding to the passed X value.
Public Sub findNote(ByVal X As Double)
Dim Pn As Integer
Dim PNot As Single, PNotBas As Single
Dim Octave As Integer, PNotInt As Integer
Dim Note As String = ""
Dim XNotPlay As Double
Dim midiNoteNumber As String 'The note number as it would be in a MIDI system.
Dim exact As Boolean 'Whether or not the note is exact.
Pn = (X - 15900) / 15
PNot = Pn / 10
'Note whether or not this corresponds exactly to a note...
If Math.Abs(PNot - Int(PNot)) < 0.001 Then
exact = True
Else
exact = False
End If
'find the note and octave
PNotBas = PNot
Octave = 5
PNotInt = Int(PNotBas)
If PNotBas - PNotInt >= 0.5 Then
PNotInt = PNotInt + 1
End If
XNotPlay = PNotInt * 10 * 15 + 15900
midiNoteNumber = PNotInt + 69 'note played
Do While PNotInt < 0
PNotInt = PNotInt + 12
Octave = Octave - 1
Loop
Do While PNotInt >= 12
PNotInt = PNotInt - 12
Octave = Octave + 1
Loop
If PNotInt < 3 Then 'It is A, A# or B of the next octave
Octave = Octave - 1
End If
Select Case PNotInt
Case 0 : Note = "A"
Case 12 : Note = "A"
Case 1 : Note = "A# (Bb)"
Case 2 : Note = "B"
Case 3 : Note = "C"
Case 4 : Note = "C# (Db)"
Case 5 : Note = "D"
Case 6 : Note = "D# (Eb)"
Case 7 : Note = "E"
Case 8 : Note = "F"
Case 9 : Note = "F# (Gb)"
Case 10 : Note = "G"
Case 11 : Note = "G# (Ab)"
End Select
'Calculate the deviance. I believe this calculation is slightly incorrect.
'What i want is a value from -0.5 to +0.5, stating the deviance from
'the note. So if we are completely in tune, it will be 0.
Dim d As Double
d = CDbl(PNot - Int(PNot)) - 0.5D
'Draw the tuner.
Const DISPLAY_X As Integer = TUNER_X + 20
Const DISPLAY_Y As Integer = TUNER_Y + 15
Const DISPLAY_WIDTH As Integer = TUNER_WIDTH - 80
Const DISPLAY_HEIGHT As Integer = 50
Const NOTENAME_X As Integer = DISPLAY_X + 10
Const NOTENAME_Y As Integer = DISPLAY_Y + 5
Const METER_X As Integer = DISPLAY_X + 10
Const METER_Y As Integer = DISPLAY_Y + 25
Const METER_WIDTH As Integer = DISPLAY_WIDTH - 20
Const BIG_TICK_HEIGHT As Integer = 20
Const SMALL_TICK_HEIGHT As Integer = 10
Dim c As Color = SystemColors.ControlLight
'Main tuner body...
gfx.FillRectangle(New SolidBrush(c), New Rectangle(TUNER_X, TUNER_Y, TUNER_WIDTH, TUNER_HEIGHT))
'light line
gfx.DrawLine(New Pen(adjustColor(c, 50), 2), TUNER_X, TUNER_Y, TUNER_X + TUNER_WIDTH, TUNER_Y)
gfx.DrawLine(New Pen(adjustColor(c, 50), 2), TUNER_X, TUNER_Y, TUNER_X, TUNER_Y + TUNER_HEIGHT)
'dark line
gfx.DrawLine(New Pen(adjustColor(c, -30), 2), TUNER_X, TUNER_Y + TUNER_HEIGHT, TUNER_X + TUNER_WIDTH, TUNER_Y + TUNER_HEIGHT)
gfx.DrawLine(New Pen(adjustColor(c, -30), 2), TUNER_X + TUNER_WIDTH, TUNER_Y, TUNER_X + TUNER_WIDTH, TUNER_Y + TUNER_HEIGHT)
'display...
c = Color.FromArgb(77, 115, 77)
c = adjustColor(SystemColors.Highlight, 70)
gfx.FillRectangle(New SolidBrush(c), New Rectangle(DISPLAY_X, DISPLAY_Y, DISPLAY_WIDTH, DISPLAY_HEIGHT))
'light line
gfx.DrawLine(New Pen(adjustColor(c, -30), 1), DISPLAY_X, DISPLAY_Y, DISPLAY_X + DISPLAY_WIDTH, DISPLAY_Y)
gfx.DrawLine(New Pen(adjustColor(c, -30), 1), DISPLAY_X, DISPLAY_Y, DISPLAY_X, DISPLAY_Y + DISPLAY_HEIGHT)
'dark line
gfx.DrawLine(New Pen(adjustColor(c, 50), 1), DISPLAY_X, DISPLAY_Y + DISPLAY_HEIGHT, DISPLAY_X + DISPLAY_WIDTH, DISPLAY_Y + DISPLAY_HEIGHT)
gfx.DrawLine(New Pen(adjustColor(c, 50), 1), DISPLAY_X + DISPLAY_WIDTH, DISPLAY_Y, DISPLAY_X + DISPLAY_WIDTH, DISPLAY_Y + DISPLAY_HEIGHT)
Dim xm As Single = METER_X + (METER_WIDTH / 2)
Dim xa As Single = xm + CDbl(d * METER_WIDTH)
Dim xr As Single = METER_X + METER_WIDTH
Dim xl As Single = METER_X
Dim foreColor As Color
foreColor = adjustColor(SystemColors.Highlight, 30)
gfx.DrawLine(New Pen(foreColor), xl, METER_Y, xl, METER_Y + BIG_TICK_HEIGHT)
gfx.DrawLine(New Pen(foreColor), xr, METER_Y, xr, METER_Y + BIG_TICK_HEIGHT)
gfx.DrawLine(New Pen(foreColor), xm, METER_Y, xm, METER_Y + BIG_TICK_HEIGHT)
'draw some lines either side
Const NUMBER_OF_LINES As Integer = 40
Dim interval As Single = METER_WIDTH / NUMBER_OF_LINES
Dim i As Integer
For i = 0 To NUMBER_OF_LINES
gfx.DrawLine(New Pen(foreColor), METER_X + (i * interval), METER_Y + (BIG_TICK_HEIGHT - SMALL_TICK_HEIGHT), METER_X + (i * interval), METER_Y + BIG_TICK_HEIGHT)
Next
If Octave > 2 Then
gfx.DrawLine(Pens.Red, xa, METER_Y, xa, METER_Y + BIG_TICK_HEIGHT)
Dim f As New Font(frmForm.Font.FontFamily, 14, FontStyle.Regular, GraphicsUnit.Pixel)
foreColor = adjustColor(SystemColors.Highlight, -30)
'Simple information...
gfx.DrawString(Note & Octave, f, New SolidBrush(foreColor), NOTENAME_X, NOTENAME_Y)
'Use this one for more verbose information...
'gfx.DrawString(Note & Octave & " (" & midiNoteNumber & ") Exact=" & exact & " deviance=" & d, f, New SolidBrush(foreColor), NOTENAME_X, NOTENAME_Y)
End If
End Sub
End Class
or yet better