QB64.org Forum

Active Forums => QB64 Discussion => Topic started by: Petr on May 12, 2019, 10:01:09 am

Title: Mother's day theme
Post by: Petr on May 12, 2019, 10:01:09 am

Thematic Video for mother´s day:

Code: QB64: [Select]

1. CONST W = 728
2. CONST H = 663
3. SCREEN _NEWIMAGE(W, H, 32)
4.  
5. CLS , _RGB32(127, 127, 127)
6. TYPE p
7.     x AS _UNSIGNED INTEGER
8.     y AS _UNSIGNED INTEGER
9. END TYPE
10.  
11. _TITLE "Happy mothers day!"
12. DO UNTIL _KEYHIT = 32: LOOP 'for screen recorder init
13.  
14. REDIM p AS p
15. REDIM p2 AS p
16. DIM lenght AS LONG
17.  
18. OPEN "srdce.bin" FOR BINARY AS #1
19. GET #1, , lenght
20. REDIM p(lenght) AS p
21. GET #1, , p()
22.  
23. OPEN "napis.bin" FOR BINARY AS #2
24. GET #2, , lenght
25. REDIM p2(lenght) AS p
26. GET #2, , p2()
27.  
28.  
29.  
30. DIM Frame(10) AS LONG
31. videopicture& = _LOADIMAGE("fxfire1.jpg", 32)
32. x = 1: y = 1
33. FOR VideoFramesLoad = 1 TO 10
34.     Frame&(VideoFramesLoad) = _NEWIMAGE(64, 64, 32)
35.     _PUTIMAGE (0, 0), videopicture&, Frame&(VideoFramesLoad), (x, y)-(x + 64, y + 64)
36.     _SETALPHA 0, _RGB32(0, 0, 0) TO _RGB32(100, 150, 160), Frame&(VideoFramesLoad)
37.     x = x + 64: IF x > 3 * 64 THEN x = 1: y = y + 64
38. NEXT VideoFramesLoad
39. tl = TIMER
40. hi = 0
41. DO
42.     VideoPlay = VideoPlay + 1
43.     IF VideoPlay > 10 THEN VideoPlay = 1
44.     WHILE _MOUSEINPUT
45.         Mx = _MOUSEX
46.         My = _MOUSEY
47.         Mw = _MOUSEWHEEL(1)
48.         zoom = zoom + (Mw * 2)
49.     WEND
50.     CLS , _RGB32(128, 128, 128)
51.  
52.     IF TIMER > delay THEN
53.         in = in + 1: IF in > UBOUND(p) THEN in = UBOUND(p): faze2 = 1
54.         IF faze2 THEN in2 = in2 + 1
55.         IF in2 > UBOUND(p2) THEN in2 = UBOUND(p2)
56.         delay = TIMER + .1
57.         ' PRINT in: _DISPLAY
58.     END IF
59.  
60.  
61.     FOR sh = 0 TO in - 1 STEP 3
62.         _PUTIMAGE (p(sh).x - 32, p(sh).y - 32)-(p(sh).x + 32 + zoom, p(sh).y + 32 + zoom), Frame&(VideoPlay) '
63.     NEXT
64.  
65.     IF faze2 THEN
66.         FOR sh2 = 0 TO in2 - 1 STEP 1
67.             _PUTIMAGE (p2(sh2).x - 8, p2(sh2).y - 8)-(p2(sh2).x + 8 + zoom, p2(sh2).y + 8 + zoom), Frame&(VideoPlay) '
68.         NEXT
69.     END IF
70.  
71.  
72.     IF TIMER > tl + 45 THEN
73.         hi = hi + 1
74.         LINE (0, 0)-(W, H), _RGBA32(0, 0, 0, hi), BF
75.     END IF
76.     _DISPLAY
77.     _LIMIT 10
78. LOOP UNTIL hi > 250
79.  
80. CLOSE #1
81. CLOSE #2
82. i = 0
83. REDIM src(0) AS STRING
84. OPEN "srdce1.bas" FOR INPUT AS #3
85. DO UNTIL EOF(3)
86.     LINE INPUT #3, src(i)
87.     i = i + 1
88.     REDIM _PRESERVE src(i) AS STRING
89. LOOP
90. _AUTODISPLAY
91. LOCATE 1, 1: PRINT "Source code for this video:"
92. FOR s = LBOUND(src) TO UBOUND(src)
93.     PRINT src(s)
94.     _DELAY .1
95. NEXT s
96. SLEEP 3
97. CLS
98. t:
99. _PRINTSTRING (W - 480, H / 2), "Visit QB64.ORG for more... :-D"
100. SLEEP 3
101.  
102.  

Title: Re: Mother's day theme
Post by: bplus on May 12, 2019, 11:08:47 am

Hi Petr,

Nice! Your mom should be proud.

Title: Re: Mother's day theme
Post by: Petr on May 12, 2019, 12:17:10 pm

Thank you, Bplus :-D

Text Only | Text with Attachments