Here's a metronome that you can see as well as hear. With a large visual display it's easy to see which beat you’re own. The screen will briefly flash on beat 1, and each beat is represented by circles around a big circle, so even if you can't hear it you can see the beats. This would be a good metronome for a drummer who wouldn't be able to hear ticks, but can use a display to follow along.
Right now it does meters 2/4, 3/4, 4/4, 5/4, 6/4, 7/4.
Press 2 to use 2/4, press 3 to use 3/4, press 4 to use 4/4, etc.
Use +/- keys to change the tempo.
ESC quits.
- Dav
Warning: A flashing screen is used in this program.
Right now it does meters 2/4, 3/4, 4/4, 5/4, 6/4, 7/4.
Press 2 to use 2/4, press 3 to use 3/4, press 4 to use 4/4, etc.
Use +/- keys to change the tempo.
ESC quits.
- Dav
Warning: A flashing screen is used in this program.
Code: (Select All)
'===================
'VisualMetronome.bas v1.1
'===================
'Metronome with a visual representation of beats.
'Coded by Dav, SEP/2024 for QB64 Phoenix Edition.
'Press 2 to use 2/4 meter
'Press 3 to use 3/4 meter
'press 4 to use 4/4 meter
'....and so on
'Press +/- to increase/decrease tempo.
'Press ENTER to reset tempo to 60.
'ESC ends.
Dim Shared BPM
Screen _NewImage(800, 800, 32)
'set defaults
BPM = 60 'tempo
meter = 4 'using 4/4 meter (4 beats per measure)
flashing = 1 'screen flashes on down beat (beat 1)
soundon = 1 'you will hear ticks
delayval# = 60 / BPM
Do
For beat = 1 To meter
If soundon = 1 Then
If beat = 1 Then
Play "mbt200l32o5c"
Else
Play "mbt200l32o4c"
End If
End If
If flashing = 1 Then
'flash on beat 1
If beat = 1 Then
flashed = 1
Line (0, 0)-(_Width, _Height), _RGBA(255, 255, 0, 150), BF
_Display
_Delay .015 'add a small delay to flash screen
End If
End If
DrawBeats meter, beat
'metronome loop using a timed delay
intime# = Timer
Do
If flashing = 1 Then
'if we flashed then deduct that time
If flashed = 1 Then
intime# = intime# - .015: flashed = 0
End If
End If
key$ = InKey$
If key$ = "+" Then
BPM = BPM + 1: If BPM > 300 Then BPM = 300
delayval# = 60 / BPM
DrawBeats meter, beat 'update
End If
If key$ = "-" Then
BPM = BPM - 1: If BPM < 30 Then BPM = 30
delayval# = 60 / BPM
DrawBeats meter, beat 'update
End If
If key$ = "2" Then '2/4
meter = 2: beat = 1: Exit For
End If
If key$ = "3" Then '3/4
meter = 3: beat = 1: Exit For
End If
If key$ = "4" Then '4/4
meter = 4: beat = 1: Exit For
End If
If key$ = "5" Then '5/4
meter = 5: beat = 1: Exit For
End If
If key$ = "6" Then '6/4
meter = 6: beat = 1: Exit For
End If
If key$ = "7" Then '7/4
meter = 7: beat = 1: Exit For
End If
'enter resets tempo to 60
If key$ = Chr$(13) Then
BPM = 60: delayval# = 60 / BPM
beat = 1
Exit For
End If
If key$ = Chr$(27) Then End
Loop Until (Timer - intime#) >= delayval#
Next
Loop
Sub DrawBeats (meter, beat)
'meter: 4 = 4/4, 3 = 3/4, etc...
'beat: which beat we're on
Cls
w = _Width / 2: h = _Height / 2
_PrintString (110, _Height - 24), "2=2/4 3=3/4 4=4/4 5=5/4 6=6/4 7=7/4 Use +/- to change tempo"
'draw big circle
fc w, h, 250, _RGB(100, 100, 100), 0
fc w, h, 225, _RGB(0, 0, 0), 0
'print BMP & meter on screen
bp$ = _Trim$(Str$(BPM)): If Len(bp$) = 2 Then wb = w - 30 Else wb = w - 80
PPRINT wb, h - 90, 100, _RGB(255, 255, 255), 0, bp$
If meter = 7 Then mtr$ = "7/4"
If meter = 6 Then mtr$ = "6/4"
If meter = 5 Then mtr$ = "5/4"
If meter = 4 Then mtr$ = "4/4"
If meter = 3 Then mtr$ = "3/4"
If meter = 2 Then mtr$ = "2/4"
PPRINT w - 50, h + 20, 50, _RGB(200, 200, 200), 0, mtr$
'draw beats circles based on meter
Select Case meter
Case 2
For i = 0 To 1
angle = (i * (360 / 2) - 90) * (3.14159 / 180)
x = w + Cos(angle) * 235
y = h + Sin(angle) * 235
fc x, y, 60, _RGB(255, 255, 255), 0
If beat = i + 1 Then
fc x, y, 55, _RGB(255, 255, 255), 0
Else
fc x, y, 55, _RGB(0, 0, 0), 0
End If
Next
Case 3
For i = 0 To 2
angle = (i * (360 / 3) - 90) * (3.14159 / 180)
x = w + Cos(angle) * 235
y = h + Sin(angle) * 235
fc x, y, 60, _RGB(255, 255, 255), 0
If beat = i + 1 Then
fc x, y, 55, _RGB(255, 255, 255), 0
Else
fc x, y, 55, _RGB(0, 0, 0), 0
End If
Next
Case 5
For i = 0 To 4
angle = (i * (360 / 5) - 90) * (3.14159 / 180)
x = w + Cos(angle) * 235
y = h + Sin(angle) * 235
fc x, y, 60, _RGB(255, 255, 255), 0
If beat = i + 1 Then
fc x, y, 55, _RGB(255, 255, 255), 0
Else
fc x, y, 55, _RGB(0, 0, 0), 0
End If
Next
Case 6
For i = 0 To 5
angle = (i * (360 / 6) - 90) * (3.14159 / 180)
x = w + Cos(angle) * 235
y = h + Sin(angle) * 235
fc x, y, 60, _RGB(255, 255, 255), 0
If beat = i + 1 Then
fc x, y, 55, _RGB(255, 255, 255), 0
Else
fc x, y, 55, _RGB(0, 0, 0), 0
End If
Next
Case 7
For i = 0 To 6
angle = (i * (360 / 7) - 90) * (3.14159 / 180)
x = w + Cos(angle) * 235
y = h + Sin(angle) * 235
fc x, y, 60, _RGB(255, 255, 255), 0
If beat = i + 1 Then
fc x, y, 55, _RGB(255, 255, 255), 0
Else
fc x, y, 55, _RGB(0, 0, 0), 0
End If
Next
Case Else 'defaults to 4/4
For i = 0 To 3
angle = (i * (360 / 4) - 90) * (3.14159 / 180)
x = w + Cos(angle) * 235
y = h + Sin(angle) * 235
fc x, y, 60, _RGB(255, 255, 255), 0
If beat = i + 1 Then
fc x, y, 55, _RGB(255, 255, 255), 0
Else
fc x, y, 55, _RGB(0, 0, 0), 0
End If
Next
End Select
_Display
End Sub
Sub fc (cx, cy, radius, clr~&, grad)
If radius < 1 Then Exit Sub 'a safety bail (thanks bplus!)
If grad = 1 Then
red = _Red32(clr~&)
grn = _Green32(clr~&)
blu = _Blue32(clr~&)
alpha = _Alpha32(clr~&)
End If
r2 = radius * radius
For y = -radius To radius
x = Sqr(Abs(r2 - y * y))
' If doing gradient
If grad = 1 Then
For i = -x To x
dis = Sqr(i * i + y * y) / radius
red2 = red * (1 - dis) + (red / 2) * dis
grn2 = grn * (1 - dis) + (grn / 2) * dis
blu2 = blu * (1 - dis) + (blu / 2) * dis
clr2~& = _RGBA(red2, grn2, blu2, alpha)
Line (cx + i, cy + y)-(cx + i, cy + y), clr2~&, BF
Next
Else
Line (cx - x, cy + y)-(cx + x, cy + y), clr~&, BF
End If
Next
End Sub
Sub PPRINT (x, y, size, clr&, trans&, text$)
'This sub outputs to the current _DEST set
'It makes trans& the transparent color
'x/y is where to print text
'size is the font size to use
'clr& is the color of your text
'trans& is the background transparent color
'text$ is the string to print
'=== get users current write screen
orig& = _Dest
'=== if you are using an 8 or 32 bit screen
bit = 32: If _PixelSize(0) = 1 Then bit = 256
'=== step through your text
For t = 0 To Len(text$) - 1
'=== make a temp screen to use
pprintimg& = _NewImage(16, 16, bit)
_Dest pprintimg&
'=== set colors and print text
Cls , trans&: Color clr&
Print Mid$(text$, t + 1, 1);
'== make background color the transprent one
_ClearColor _RGB(0, 0, 0), pprintimg&
'=== go back to original screen to output
_Dest orig&
'=== set it and forget it
x1 = x + (t * size): x2 = x1 + size
y1 = y: y2 = y + size
_PutImage (x1 - (size / 2), y1)-(x2, y2 + (size / 3)), pprintimg&
_FreeImage pprintimg&
Next
End Sub