QB64.org Forum

Active Forums => Programs => Topic started by: SMcNeill on January 09, 2020, 06:17:17 pm

Title: Steve's Calendar Creator
Post by: SMcNeill on January 09, 2020, 06:17:17 pm

Code: QB64: [Select]

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

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.

Title: Re: Steve's Calendar Creator
Post by: Petr on January 10, 2020, 12:00:00 pm

Very nice work, Steve!

Text Only | Text with Attachments