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