Author Topic: Steve's Calendar Creator  (Read 3205 times)

0 Members and 1 Guest are viewing this topic.

Offline SMcNeill

  • QB64 Developer
  • Forum Resident
  • Posts: 3972
    • View Profile
    • Steve’s QB64 Archive Forum
Steve's Calendar Creator
« on: January 09, 2020, 06:17:17 pm »
Code: QB64: [Select]
  1. SCREEN _NEWIMAGE(850, 1100, 32)
  2.  
  3. _TITLE "Steve's Calendar Creator"
  4.  
  5. CONST PhotoFolder = ".\National Geographic\"
  6. DIM SHARED PhotoCount, Year
  7. 'IF _FILEEXISTS(PhotoFolder + "PhotoList.txt") = 0 THEN
  8. cwd$ = _CWD$
  9. CHDIR PhotoFolder
  10. IF _FILEEXISTS("PhotoList.txt") = 0 THEN 'create a listing of the directory.
  11.     PhotoList$ = "*.jpg *.png " 'add more extensions if you want to add GIF/PNG files and such
  12.     SHELL "DIR " + PhotoList$ + "/b /s /a-d >PhotoList.txt"
  13. CHDIR cwd$
  14.  
  15. OPEN PhotoFolder + "PhotoList.txt" FOR BINARY AS #1
  16.     LINE INPUT #1, junk$
  17.     PhotoCount = PhotoCount + 1
  18.  
  19. SEEK #1, 1 'back to the beginning
  20.  
  21. DIM SHARED FileList(PhotoCount) AS STRING
  22. FOR i = 1 TO PhotoCount
  23.     LINE INPUT #1, FileList(i)
  24.     FileList(i) = FileList(i) + CHR$(0)
  25.  
  26. DIM SHARED Notes(20) AS STRING
  27. Notes(0) = "1) Steve 555-5555"
  28. Notes(1) = "2) Lori 555-5555"
  29. FOR i = 2 TO 20
  30.     Notes(i) = _TRIM$(STR$(i)) + ")"
  31.  
  32.  
  33. Year = VAL(MID$(DATE$, 7))
  34.  
  35. DrawCalander
  36.  
  37. SUB DrawCalander
  38.  
  39.     W = _WIDTH - 1 'width
  40.     H = W 'height
  41.     L = 5 'line thickness
  42.     '    Kolor = _RGB32(127, 107, 0) 'color of lines
  43.     Kolor = _RGBA32(0, 0, 0, 128) 'color of lines
  44.     F64 = _LOADFONT("OLDENGL.ttf", 64)
  45.     F32 = _LOADFONT("OLDENGL.ttf", 32)
  46.     Day = VAL(MID$(DATE$, 4, 2))
  47.  
  48.     FOR k = 1 TO 12
  49.         CLS , _RGB32(255, 255, 255)
  50.  
  51.         DO
  52.             PicNum = INT(RND * PhotoCount) + 1
  53.             Pic = _LOADIMAGE(FileList(PicNum), 32)
  54.         LOOP UNTIL Pic <> -1
  55.  
  56.         IF _WIDTH(Pic) > W THEN
  57.             x1 = (_WIDTH(Pic) - W) \ 2
  58.             x2 = x1 + W
  59.         ELSE
  60.             x1 = 0
  61.             x2 = _WIDTH(Pic)
  62.         END IF
  63.  
  64.         IF _HEIGHT(Pic) > H THEN
  65.             y1 = (_HEIGHT(Pic) - H) \ 2
  66.             y2 = y1 + H
  67.         ELSE
  68.             y1 = 0
  69.             y2 = _HEIGHT(Pic)
  70.         END IF
  71.         _PUTIMAGE (0, 0)-(W, H), Pic, 0, (x1, y1)-(x2, y2)
  72.         COLOR _RGB32(255, 255, 255), 0
  73.  
  74.  
  75.         FOR i = 0 TO L: LINE (0 + i, 0 + i)-(W - i, H - i), Kolor, B: NEXT 'Outer frame first
  76.         FOR i = 1 TO 6: LINE (i * W \ 7 - L \ 2, 0)-(i * W \ 7 + L \ 2, W), Kolor, BF: NEXT 'inner lines next
  77.         FOR i = 1 TO 6: LINE (0, i * W \ 7 - L \ 2)-(W, i * W \ 7 + L \ 2), Kolor, BF: NEXT
  78.         LINE (L + 1, L + 1)-(W - L - 1, W \ 7 - L \ 2), Blue, BF 'Top Box for month
  79.         _FONT F64
  80.         pw = _PRINTWIDTH(Month$(k) + STR$(Year))
  81.         _PRINTSTRING ((W - pw) \ 2, (W \ 7 - _FONTHEIGHT) \ 2), Month$(k) + STR$(Year)
  82.         _FONT F32
  83.  
  84.         FirstDay = GetDay(k, 1, Year)
  85.         count = 0
  86.         FOR y = 1 TO 6 'weeks
  87.             FOR x = 1 TO 7 'days
  88.                 IF (y - 1) * 7 + x >= FirstDay THEN
  89.                     count = count + 1
  90.                     IF count <= DaysInMonth(k) THEN
  91.                         T$ = _TRIM$(STR$(count))
  92.                         pw = _PRINTWIDTH(T$)
  93.                         _PRINTSTRING (x * W \ 7 - pw - L \ 2, y * W \ 7), T$
  94.  
  95.                     END IF
  96.                 END IF
  97.             NEXT
  98.         NEXT
  99.         T$ = Month$(k) + STR$(Year)
  100.         pw = _PRINTWIDTH("NOTES")
  101.         COLOR _RGB32(0, 0, 0)
  102.         _PRINTSTRING ((W - pw) \ 2, W + 1), "NOTES"
  103.         ly = W + 2 + _FONTHEIGHT
  104.         _FONT 8
  105.         FOR i = 0 TO 20
  106.             LINE (0, ly + 10 * i)-STEP(W, 10), _RGB32(0, 0, 0), B
  107.             _PRINTSTRING (0, ly + 10 * i + 2), Notes(i)
  108.         NEXT
  109.         SLEEP
  110.     NEXT
  111.  
  112. FUNCTION GetDay (m, d, y) 'use 4 digit year
  113.     'From Zeller's congruence: https://en.wikipedia.org/wiki/Zeller%27s_congruence
  114.     mm = m: dd = d: yyyy = y
  115.     IF mm < 3 THEN mm = mm + 12: yyyy = yyyy - 1
  116.     century = yyyy MOD 100
  117.     zerocentury = yyyy \ 100
  118.     result = (dd + INT(13 * (mm + 1) / 5) + century + INT(century / 4) + INT(zerocentury / 4) + 5 * zerocentury) MOD 7
  119.     IF result = 0 THEN
  120.         GetDay = 7
  121.     ELSE
  122.         GetDay = result
  123.     END IF
  124.     'Function changed to return a numeric value instead of a string for this program
  125.     '    SELECT CASE result
  126.     '        CASE 7: GetDay$ = "Saturday"
  127.     '        CASE 1: GetDay$ = "Sunday"
  128.     '        CASE 2: GetDay$ = "Monday"
  129.     '        CASE 3: GetDay$ = "Tuesday"
  130.     '        CASE 4: GetDay$ = "Wednesday"
  131.     '        CASE 5: GetDay$ = "Thursday"
  132.     '        CASE 6: GetDay$ = "Friday"
  133.     '    END SELECT
  134.  
  135. FUNCTION DaysInMonth (M)
  136.     SELECT CASE M
  137.         CASE 1, 3, 5, 7, 8, 10, 12
  138.             DaysInMonth = 31
  139.         CASE 2
  140.             DaysInMonth = 28
  141.             IF Year MOD 4 = 0 THEN DaysInMonth = 29 'leap year until 2100 -- and I'll be deaded by then, so who cares.  :P
  142.         CASE 4, 6, 9, 11
  143.             DaysInMonth = 30
  144.     END SELECT
  145.  
  146. FUNCTION Month$ (M)
  147.     SELECT CASE M
  148.         CASE 1: Month$ = "January"
  149.         CASE 2: Month$ = "February"
  150.         CASE 3: Month$ = "March"
  151.         CASE 4: Month$ = "April"
  152.         CASE 5: Month$ = "May"
  153.         CASE 6: Month$ = "June"
  154.         CASE 7: Month$ = "July"
  155.         CASE 8: Month$ = "August"
  156.         CASE 9: Month$ = "September"
  157.         CASE 10: Month$ = "October"
  158.         CASE 11: Month$ = "November"
  159.         CASE 12: Month$ = "December"
  160.     END SELECT

A few quick notes and explanations for things here:

CONST PhotoFolder = ".\National Geographic\"   <-- This is where a folder of images are located, which you'd want to use to create a calendar with.

The following is where you can put some notes at the bottom of each page, to have a handy little list of notes hanging up on your wall for the month/year.
Code: [Select]
DIM SHARED Notes(20) AS STRING
Notes(0) = "1) Steve 555-5555"
Notes(1) = "2) Lori 555-5555"
FOR i = 2 TO 20
    Notes(i) = _TRIM$(STR$(i)) + ")"
NEXT

Here, I just select some pictures from that list at random.  There may be some duplicates in there, as there's no check to see if the images are duplicated.  Personally, I think just choosing 12 images from your drive, putting them in a folder just by themselves, and then loading them all once would be a better way to do things -- but I just wanted to showcase this as a demo so people could tweak it to suit their own needs.
Code: [Select]
        DO
            PicNum = INT(RND * PhotoCount) + 1
            Pic = _LOADIMAGE(FileList(PicNum), 32)
        LOOP UNTIL Pic <> -1

This is set at a 8.5 x 11, 100dpi resolution, so it should print with _PRINTIMAGE just fine (simply change the SLEEP to a printimage statement if you want to print out a page).  What you see on your monitor should be almost a perfect match for what you see on your printer.  (Some may auto-resize a little to leave room for a border which they don't print to, but the printer should scale for that automatically, if needed.)

A screenshot of one of the calendar pages which I've created for my own personal use is below.

* National Geographic.7z (Filesize: 3.36 MB, Downloads: 209)
Steve's Calander Creator_2020-01-09_18-14-49.jpg
* Steve's Calander Creator_2020-01-09_18-14-49.jpg (Filesize: 159.37 KB, Dimensions: 856x1135, Views: 231)
https://github.com/SteveMcNeill/Steve64 — A github collection of all things Steve!

Offline Petr

  • Forum Resident
  • Posts: 1720
  • The best code is the DNA of the hops.
    • View Profile
Re: Steve's Calendar Creator
« Reply #1 on: January 10, 2020, 12:00:00 pm »
Very nice work, Steve!