Text Only | Text with Attachments

QB64.org Forum

Active Forums => Programs => Topic started by: SierraKen on January 02, 2021, 03:35:28 pm

Title: Mantel Clock Mini
Post by: SierraKen on January 02, 2021, 03:35:28 pm
This is pretty much the same as my regular Mantel Clock, except I cut the size of it all in half. It uses a 400 x 300 window so you can keep it running and watch it while doing other work on your computer. I also had to decrease the font size of the Roman Numerals. I cut everything in half down to the widths of the hands. I'll probably use this one a lot more than my original one. That is why I made a new topic for it, so nobody passes it up. It also uses the new way of the hour hand moving between hours as the minutes go, as I just added to the original one a couple days ago. Plus of course it does the same chiming song of the famous Westminster Quarters song that Dav helped me with. Thanks again Dav! I also kept the ability to hear it at any time using the Space Bar. I hope you all get this one because I'm sure you will want to use it more often than the large one. Oh, I also had to move a couple of the hours over so they wouldn't go over the white circles.

Code: QB64: [Select]
  1. 'Mantel Clock Mini by SierraKen with help for Westminster Quarters hourly song by Dav on the QB64.org forum.
  2. 'Created on 1-2-2020
  3. 'This is made from my regular Mantel Clock.
  4. 'I made this so you can keep it running and away from your other computer work.
  5. SCREEN _NEWIMAGE(400, 300, 32)
  7. _TITLE "Mantel Clock Mini - Space Bar plays chimes."
  10.     _LIMIT 50
  11.     a = _KEYHIT
  12.     IF a = 27 THEN END
  13.     IF a = 32 THEN song = 1: a = 0: _DELAY 1
  14.     CX = 200: CY = 150: R = 150: C = _RGB32(0, 78, 0)
  15.     fillCircle CX, CY, R, C
  16.     LINE (50, 150)-(350, 300), C, BF
  17.     CX = 200: CY = 150: R = 100: C = _RGB32(183, 139, 100)
  18.     fillCircle CX, CY, R, C
  19.     FOR lines = .25 TO 5 STEP .1
  20.         CIRCLE (200, 150), 125 + lines, _RGB32(0, 55, 0), 2 * _PI, _PI
  21.     NEXT lines
  22.     LINE (70, 150)-(75, 380), _RGB32(0, 55, 0), BF
  23.     LINE (325, 150)-(330, 380), _RGB32(0, 55, 0), BF
  24.  
  25.     FOR sc = 1 TO 60
  26.         ss = (60 - sc) * 6 + 180
  27.         x2 = INT(SIN(ss / 180 * 3.141592) * 70) + 200
  28.         y2 = INT(COS(ss / 180 * 3.141592) * 70) + 150
  29.         CIRCLE (x2, y2), 1, _RGB32(230, 230, 230)
  30.         n2 = (60 - sc) * 6 + 180
  31.         x3 = INT(SIN(n2 / 180 * 3.141592) * 80) + 195
  32.         y3 = INT(COS(n2 / 180 * 3.141592) * 80) + 147.5
  33.         COLOR _RGB32(0, 0, 0), _RGB32(183, 139, 100)
  34.         IF sc = 5 THEN _PRINTSTRING (x3, y3), "I"
  35.         IF sc = 10 THEN _PRINTSTRING (x3, y3), "II"
  36.         IF sc = 15 THEN _PRINTSTRING (x3, y3), "III"
  37.         IF sc = 20 THEN _PRINTSTRING (x3, y3), "IV"
  38.         IF sc = 25 THEN _PRINTSTRING (x3, y3), "V"
  39.         IF sc = 30 THEN _PRINTSTRING (x3, y3), "VI"
  40.         IF sc = 35 THEN _PRINTSTRING (x3, y3), "VII"
  41.         IF sc = 40 THEN _PRINTSTRING (x3 - 14, y3), "VIII"
  42.         IF sc = 45 THEN _PRINTSTRING (x3 - 2, y3), "IX"
  43.         IF sc = 50 THEN _PRINTSTRING (x3, y3), "X"
  44.         IF sc = 55 THEN _PRINTSTRING (x3, y3), "XI"
  45.         IF sc = 60 THEN _PRINTSTRING (x3 - 4, y3), "XII"
  46.     NEXT sc
  47.     COLOR , _RGB32(0, 0, 0)
  48.     clock song
  49.     CX = 200: CY = 150: R = 5: C = _RGB32(0, 0, 0)
  50.     fillCircle CX, CY, R, C
  51.     _DISPLAY
  52.     CLS
  54.  
  55. 'from Steve Gold standard
  56. SUB fillCircle (CX AS INTEGER, CY AS INTEGER, R AS INTEGER, C AS _UNSIGNED LONG)
  57.     DIM Radius AS INTEGER, RadiusError AS INTEGER
  58.     DIM X AS INTEGER, Y AS INTEGER
  59.     Radius = ABS(R): RadiusError = -Radius: X = Radius: Y = 0
  60.     IF Radius = 0 THEN PSET (CX, CY), C: EXIT SUB
  61.     LINE (CX - X, CY)-(CX + X, CY), C, BF
  62.     WHILE X > Y
  63.         RadiusError = RadiusError + Y * 2 + 1
  64.         IF RadiusError >= 0 THEN
  65.             IF X <> Y + 1 THEN
  66.                 LINE (CX - Y, CY - X)-(CX + Y, CY - X), C, BF
  67.                 LINE (CX - Y, CY + X)-(CX + Y, CY + X), C, BF
  68.             END IF
  69.             X = X - 1
  70.             RadiusError = RadiusError - X * 2
  71.         END IF
  72.         Y = Y + 1
  73.         LINE (CX - X, CY - Y)-(CX + X, CY - Y), C, BF
  74.         LINE (CX - X, CY + Y)-(CX + X, CY + Y), C, BF
  75.     WEND
  77.  
  78. SUB clock (song)
  79.     hours = (TIMER \ 3600)
  80.     minutes = TIMER \ 60 - hours * 60
  81.     seconds = (TIMER - hours * 3600 - minutes * 60)
  82.     hours = hours + (minutes / 60) 'Code added to make hour hand move between numbers.
  83.     ho$ = LEFT$(TIME$, 2): hou = VAL(ho$)
  84.     min$ = MID$(TIME$, 4, 2): minu = VAL(min$)
  85.     seco$ = RIGHT$(TIME$, 2): secon = VAL(seco$)
  86.  
  87.     'Seconds
  88.     s = (60 - seconds) * 6 + 180
  89.     x = INT(SIN(s / 180 * 3.141592) * 60) + 200
  90.     y = INT(COS(s / 180 * 3.141592) * 60) + 150
  91.     FOR b = -2.5 TO 2.5 STEP .1
  92.         LINE (200 + b, 150)-(x, y), _RGB32(255, 255, 128)
  93.         LINE (200, 150 + b)-(x, y), _RGB32(255, 255, 128)
  94.     NEXT b
  95.     'Minutes
  96.     m = 180 - minutes * 6
  97.     xx = INT(SIN(m / 180 * 3.141592) * 60) + 200
  98.     yy = INT(COS(m / 180 * 3.141592) * 60) + 150
  99.     FOR b = -2.5 TO 2.5 STEP .1
  100.         LINE (200 + b, 150)-(xx, yy), _RGB32(0, 0, 0)
  101.         LINE (200, 150 + b)-(xx, yy), _RGB32(0, 0, 0)
  102.     NEXT b
  103.     'Hours
  104.     h = 360 - hours * 30 + 180
  105.     xxx = INT(SIN(h / 180 * 3.141592) * 45) + 200
  106.     yyy = INT(COS(h / 180 * 3.141592) * 45) + 150
  107.     FOR b = -2.5 TO 2.5 STEP .1
  108.         LINE (200 + b, 150)-(xxx, yyy), _RGB32(0, 0, 0)
  109.         LINE (200, 150 + b)-(xxx, yyy), _RGB32(0, 0, 0)
  110.     NEXT b
  111.     'Chimes
  112.     IF (minu = 0 AND secon = 0) OR song = 1 THEN
  113.         song = 0
  114.  
  115.         'note frequencies
  116.         FOR notes = 1 TO 20
  117.             IF notes = 1 THEN note = 311.13 'D#
  118.             IF notes = 2 THEN note = 246.94 'B
  119.             IF notes = 3 THEN note = 277.18 'C#
  120.             IF notes = 4 THEN note = 185.00 'F#
  121.             IF notes = 5 THEN note = 0
  122.             IF notes = 6 THEN note = 185.00 'F#
  123.             IF notes = 7 THEN note = 277.18 'C#
  124.             IF notes = 8 THEN note = 311.13 'D#
  125.             IF notes = 9 THEN note = 246.94 'B
  126.             IF notes = 10 THEN note = 0
  127.             IF notes = 11 THEN note = 311.13 'D#
  128.             IF notes = 12 THEN note = 277.18 'C3
  129.             IF notes = 13 THEN note = 246.94 'B
  130.             IF notes = 14 THEN note = 185.00 'F#
  131.             IF notes = 15 THEN note = 0
  132.             IF notes = 16 THEN note = 185.00 'F#
  133.             IF notes = 17 THEN note = 277.18 'C#
  134.             IF notes = 18 THEN note = 311.13 'D#
  135.             IF notes = 19 THEN note = 246.94 'B
  136.             IF notes = 20 THEN note = 0
  137.  
  138.             DO
  139.                 'queue some sound
  140.                 DO WHILE _SNDRAWLEN < 0.5 'you may wish to adjust this
  141.                     sample = SIN(ttt * note * ATN(1) * 8) '340Hz sine wave (ttt * 440 * 2p)
  142.                     sample = sample * EXP(-ttt * 3) 'fade out eliminates clicks after sound
  143.                     _SNDRAW sample
  144.                     ttt = ttt + 1 / _SNDRATE 'sound card sample frequency determines time
  145.                 LOOP
  146.                 'do other stuff, but it may interrupt sound
  147.             LOOP WHILE ttt < 1 'play for 1 second
  148.             DO WHILE _SNDRAWLEN > 0 'Finish any left over queued sound!
  149.             LOOP
  150.             ttt = 0
  151.         NEXT notes
  152.         hour2 = hou
  153.         IF hour2 > 12 THEN hour2 = hour2 - 12
  154.         IF hour2 = 0 THEN hour2 = 12
  155.         FOR chimes = 1 TO hour2
  156.             ttt = 0
  157.             DO
  158.                 'queue some sound
  159.                 DO WHILE _SNDRAWLEN < 0.1 'you may wish to adjust this
  160.                     sample = SIN(ttt * 240 * ATN(1) * 8) '340Hz sine wave (ttt * 440 * 2p)
  161.                     sample = sample * EXP(-ttt * 3) 'fade out eliminates clicks after sound
  162.                     _SNDRAW sample
  163.                     ttt = ttt + 1 / _SNDRATE 'sound card sample frequency determines time
  164.                 LOOP
  165.                 'do other stuff, but it may interrupt sound
  166.             LOOP WHILE ttt < 2 'play for 2 seconds
  167.             DO WHILE _SNDRAWLEN > 0 'Finish any left over queued sound!
  168.             LOOP
  169.         NEXT chimes
  170.     END IF
  171.     two:
  173.  

Text Only | Text with Attachments