Petr's Script program in QB64

[Petr]

Hi guys.

This is a small program I'm working on right now. Its purpose is simply to display lyrics, subtitles, comments and / or pictures, play sounds and it's all time-controlled. It can also pause the execution and stop the presentation time. It is a very simple solution. The main goal is to make it easier to shoot videos about QB64 on YouTube - of course, subtitles can also be added there, but this solution, without the need for further editing, seemed better to me. So now all you have to do is download non-copyrighted music, take a few screenshots, translate the comments and it can be fun to create. The amazing thing about Open Source is that it can be shared like this. You will definitely have suggestions on what to add. I gradually want to do it. In the evening, I will use this program to create a presentation about why I haven't been here for a long time and then publish it on my Youtube channel.

You need the attached ZIP file to try it out. When started, the program will ask for the file name. Write there "kuci" - it is script file name, this file is also in zip file. Look in kuci file and see how it is all done.

Code: QB64: [Select]

1. $NoPrefix
2. Title "QB64 Script"
3. Type Content
4.     Time As Single
5.     Statement As String
6. End Type
7.  
8.  
9. ReDim Shared Images(0) As Long, imgI
10. ReDim Sounds(0) As Long
11. ReDim Videos(0) As String
12. ReDim Fonts(0) As Long
13. ReDim My(0) As Content
14. ReDim Clrs(2) As Unsigned Byte
15. ReDim Shared PassE(0) As Integer
16.  
17. Input "Input text script file name:"; script$
18. If FileExists(script$) Then
19.     FF = FreeFile
20.     Open script$ For Input As #FF
21.     While Not EOF(FF)
22.         Line Input #FF, s$
23.  
24.  
25.         '-------------------------------------- LOAD TO MEMORY AND CHECK ALL FILES IF EXISTS [STEP 1/3] ----------------------------------------------------------
26.         'ziskat cas
27.         sep = InStr(s$, " ")
28.         Tim$ = Mid$(s$, 1, sep - 1)
29.         sep = InStr(Tim$, ":")
30.         Min = Val(Mid$(Tim$, 2, sep))
31.         Tim$ = Mid$(Tim$, sep + 1)
32.         Secs = Val(Mid$(Tim$, 1, sep))
33.         sep = InStr(Tim$, ":")
34.         Tim$ = Mid$(Tim$, sep + 1)
35.         Set = Val(Mid$(Tim$, 1, sep))
36.  
37.         'cas: Min, Sec, Set
38.         Time = (Min * 60) + Secs + (Set / 100)
39.         My(record).Time = Time
40.  
41.  
42.  
43.         'ziskat prikaz (cmd$)
44.         sep = InStr(s$, " ")
45.         s$ = Mid$(s$, sep + 1)
46.         My(record).Statement = (s$)
47.  
48.  
49.  
50.         sep = InStr(s$, " ")
51.         cmd$ = Left$(s$, sep - 1)
52.  
53.         Select Case UCase$(cmd$)
54.             Case "SCRN" '                                                        Screen settings
55.                 'ziskat ResX
56.                 s$ = Mid$(s$, sep + 1)
57.                 sep = InStr(s$, " ")
58.                 ResX = Val(Mid$(s$, 1, sep - 1))
59.  
60.                 'ziskat ResY
61.                 s$ = Mid$(s$, sep + 1)
62.                 sep = InStr(s$, " ")
63.                 ResY = Val(Mid$(s$, sep + 1))
64.  
65.             Case "SIMG" '                                                       Load images to array (in my mind is already upgrade for it)
66.                 FileName$ = Mid$(s$, sep + 1)
67.                 If FileExists(FileName$) Then
68.                     iU = UBound(Images)
69.                     Images(iU) = _LoadImage(FileName$, 32)
70.                     If Images(iU) = -1 Then Print "Error: Image file "; FileName$; " is in unsupported format.": Sleep 3: End
71.                     ReDim Preserve Images(iU + 1) As Long
72.                 Else
73.                     Print "SIMG File "; FileName$; " not found. (Record nr."; record; ")": Sleep 3: End
74.                 End If
75.  
76.             Case "PASS"
77.                 '                                                              Load images to array as SIMG statement, but PASS is for other use than SIMG (look again)
78.  
79.                 s$ = Mid$(s$, sep + 1)
80.                 sep = InStr(s$, " ")
81.                 PhotoA$ = Mid$(s$, sep + 1)
82.  
83.                 sep = InStr(s$, " ")
84.                 s$ = Mid$(s$, sep + 1)
85.                 sep2 = InStrRev(s$, " ")
86.  
87.                 s$ = Mid$(s$, sep2)
88.                 Effect = Val(s$)
89.  
90.                 PassE(psI) = Effect
91.                 psI = psI + 1
92.                 ReDim Preserve PassE(psI) As Integer
93.  
94.                 If FileExists(PhotoA$) Then
95.                     iU = UBound(Images)
96.                     Images(iU) = _LoadImage(PhotoA$, 32)
97.                     If Images(iU) = -1 Then Print "Error: Image file "; PhotoA$; " is in unsupported format.": Sleep 3: End
98.                     ReDim Preserve Images(iU + 1) As Long
99.                 Else
100.                     Print "PASS File "; PhotoA$; " not found. (Record nr."; record; ")": Sleep 3: End
101.                 End If
102.  
103.             Case "SNDL", "SNDP" '                                                Load sounds to array
104.                 FileName$ = Mid$(s$, sep + 1)
105.                 If FileExists(FileName$) Then
106.                     sU = UBound(Sounds)
107.                     Sounds(sU) = SndOpen(FileName$)
108.                     If Sounds(sU) = 0 Then Print "Error: Sound file: "; FileName$; " is in unsupported format,": Sleep 3: End
109.                     ReDim Preserve Sounds(sU + 1) As Long
110.                 Else
111.                     Print "Sound file "; FileName$; " not found.": Sleep 3: End
112.                 End If
113.  
114.             Case "SVID" '                                                       Load video file names (if file exists) to array as string (will be used later with Windows Media Player)
115.                 FileName$ = Mid$(s$, sep + 1)
116.                 If FileExists(FileName$) Then
117.                     vU = UBound(Videos)
118.                     Videos(vU) = FileName$
119.                     ReDim Preserve Videos(vU + 1) As String
120.                 Else
121.                     Print "Video file "; FileName$; " not found.": Sleep 3: End
122.                 End If
123.  
124.             Case "FONT" '                                                       Load font TTF, OTF file
125.                 sep = InStr(s$, " ")
126.                 sep2 = InStrRev(s$, " ")
127.                 FontName$ = Mid$(s$, sep + 1, sep2 - sep)
128.                 FontSize = Val(Mid$(s$, sep2 + 1))
129.                 fU = UBound(Fonts)
130.                 Fonts(fU) = LoadFont(FontName$, FontSize, "MONOSPACE")
131.                 If Fonts(fU) = 0 Then Print "Error loading font "; FontName$: Sleep 3: End
132.                 ReDim Preserve Fonts(fU + 1) As Long
133.         End Select
134.         record = record + 1
135.         ReDim Preserve My(record) As Content
136.     Wend
137. Else
138.     Print "Error: Script text file "; script$; " not exists."
139.     End
140. End If
141.  
142. ' -------------------------------------  RUN OWN PRESENTATION [STEP 2/3]  -------------------------------------------------------------------------------
143. NullTime = Timer
144. Close FF
145.  
146. If ResX > 0 And ResY > 0 Then Screen NewImage(ResX, ResY, 32) Else Print "Text mode!"
147.  
148. R = 0
149.  
150. Do Until k& = 27
151.     k& = _KeyHit
152.     'time is calculated from TIMER
153.     If Timer < NullTime Then NullTime = Timer - P_time 'midnight overflow check / not tested
154.  
155.  
156.     'this is console developing window, it show presentation time for us. If presentation time is the same as in your script file, then it run again, otherwise program wait.
157.  
158.     P_time = Timer - NullTime
159.  
160.     Do Until P_time > My(R).Time
161.         P_time = Timer - NullTime
162.  
163.         $Console
164.         Dest Console
165.         Echo Str$(P_time): Echo Str$(My(R).Time)
166.         Delay .01
167.         Dest 0
168.  
169.     Loop
170.  
171.  
172.     Statement$ = UCase$(Left$(My(R).Statement, 4))
173.  
174.     'od 05-02-2022
175.     Select Case Statement$
176.         Case "SIMG" '                        command: Show Image (accept ratio)
177.             If PixelSize = 4 Then '          works just if SCRN stetement for setting graphic screen is in text file used before SIMG statement, otherwise is this skipped!
178.                 GetImageRatio LUX, LUY, RUX, RUY, imgI
179.                 _PutImage (LUX, LUY)-(RUX, RUY), Images(imgI)
180.                 imgI = imgI + 1
181.             End If
182.         Case "SNDL"
183.             If SndPlaying(Sounds(SoundsI)) = 1 Then SndStop Sounds(SoundsI) 'Play sound in loop
184.             SndLoop Sounds(SoundsI)
185.             SoundsI = SoundsI + 1
186.         Case "SNDP"
187.             If SndPlaying(Sounds(SoundsI)) = 1 Then SndStop Sounds(SoundsI) 'Play sound once
188.             SndPlay Sounds(SoundsI)
189.             SoundsI = SoundsI + 1
190.         Case "SNDS"
191.             SndStop Sounds(SoundsI)
192.         Case "PASS" '                         insert a transition between photos / videos 'parameter is OPTIONAL!
193.             Parameter = PassE(passI)
194.             passI = passI + 1
195.             InsertTransmission Parameter
196.         Case "DELA" '                                        DELA statement is the same as SLEEP, it also stop time in presentation
197.             Parameter = Val(Mid$(My(R).Statement, 5))
198.  
199.             StopTime = Timer - NullTime
200.             NullTime = StopTime
201.             If Parameter Then Sleep Parameter Else Sleep
202.             NullTime = Timer - StopTime
203.  
204.         Case "SVID" '                                       For future version - PlayVideo in this version is empty SUB, in future it use SpriggsySpriggs libraries for call Windows Media Player
205.             VideoName$ = Videos(VideoI)
206.             VideoI = VideoI + 1
207.             PlayVideo VideoName$
208.         Case "FONT" '                                       View FONT. Use in file: ú[00:00:10] FONT Arial.ttf 40  <---- in step 1/3 it loads and in step 2/3 it view all text using Arial font size 40
209.             Font Fonts(FontI)
210.             FontI = FontI + 1
211.         Case "STIT"
212.             Text$ = Mid$(My(R).Statement, 5) '              Print SUBTITLE to screen (just one row in this version) use in file is: [01:00:97] STIT This is subtitle
213.             InsertText Text$
214.         Case "CLRS"
215.             Cls , RGB32(Clrs(0), Clrs(1), Clrs(2)) '                 clear screen using color sets for foreground or for background color
216.         Case "COLF" '                                                set foreground color for subtitles (STIT statement)
217.             ReDim Clrs(2) As _Unsigned _Byte
218.             n$ = Mid$(My(R).Statement, 5)
219.             'Print n$
220.             For T = 0 To 2
221.                 sep = InStr(n$, " ") + 1
222.                 nr$ = Mid$(n$, sep, 3)
223.                 control = InStr(nr$, " ")
224.                 If control Then Clrs(T) = Val(Mid$(nr$, 1, control)) Else Clrs(T) = Val(nr$)
225.                 n$ = Mid$(n$, sep + 1)
226.             Next
227.  
228.             Color RGB32(Clrs(0), Clrs(1), Clrs(2))
229.  
230.         Case "COLB" '                                                set background color
231.             ReDim Clrs(2) As _Unsigned _Byte
232.             n$ = Mid$(My(R).Statement, 5)
233.             'Print n$
234.             For T = 0 To 2
235.                 sep = InStr(n$, " ") + 1
236.                 nr$ = Mid$(n$, sep, 3)
237.                 control = InStr(nr$, " ")
238.                 If control Then Clrs(T) = Val(Mid$(nr$, 1, control)) Else Clrs(T) = Val(nr$)
239.                 n$ = Mid$(n$, sep + 1)
240.             Next
241.  
242.             Color , RGB32(Clrs(0), Clrs(1), Clrs(2))
243.  
244.         Case "TEXT" '                                                      Print centered text to screen. Use in file: [02:00:99] TEXT Here place long text which is then centered and printed to screen
245.             n$ = Mid$(My(R).Statement, 5)
246.             LongText n$
247.  
248.         Case "FSCR"
249.             FullScreen
250.         Case "CLSS"
251.             Cls
252.  
253.     End Select
254.     R = R + 1
255.     If R > record Then Exit Do 'skip to phase 3 - erasing RAM and quit.
256. Loop
257.  
258. '-------------------------------------- Erase RAM, delete images and sounds from memory and then end [Step 3/3] -----------------------------------------
259.  
260.  
261. For C1 = LBound(Images) To UBound(Images) - 1
262.     FreeImage Images(C1)
263. Next
264.  
265. For C2 = LBound(Sounds) To UBound(Sounds) - 1
266.     SndClose Sounds(C2)
267. Next
268.  
269. Erase Images
270. Erase Sounds
271. Erase Videos
272. Erase Fonts
273. Erase My
274. Erase Clrs
275. Erase PassE
276.  
277. System
278.  
279.  
280.  
281.  
282.  
283.  
284.  
285.  
286.  
287.  
288.  
289.  
290.  
291. Sub InsertText (T$)
292.     TextLenght = PrintWidth(T$)
293.     Middle = Width \ 2 - TextLenght \ 2
294.     PrintMode KeepBackground
295.     PrintString (Middle, Height - FontHeight - 10), T$
296. End Sub
297.  
298.  
299. Sub LongText (t As String)
300.     TextMax = Width \ FontWidth
301.     Rows = Len(t) \ TextMax
302.     y = Height / 2 - (FontHeight * Rows / 2)
303.     Tr = 1
304.     t$ = t$ + " "
305.     Do Until LastSpace = Len(t)
306.         Word$ = Mid$(t, Tr, TextMax)
307.         LastSpace = InStrRev(Word$, " ")
308.         S$ = Mid$(Word$, 1, LastSpace)
309.         Center = Width / 2 - PrintWidth(S$) / 2
310.         PrintString (Center, y), S$
311.         y = y + FontHeight
312.         t$ = Mid$(t$, LastSpace + 1)
313.     Loop
314. End Sub
315.  
316.  
317.  
318.  
319. Sub InsertTransmission (Value As Integer)
320.     'prechody fotek, 0 = nahodny
321.     Old = CopyImage(0, 32)
322.     New = NewImage(Width, Height, 32)
323.     GetImageRatio lux, luy, rdx, rdy, imgI
324.     _PutImage (lux, luy)-(rdx, rdy), Images(imgI), New
325.     imgI = imgI + 1
326.     If Value = 0 Then Value = 1 + 10 * Rnd
327.     s = 0
328.     centerX = Width \ 2
329.     centerY = Height \ 2
330.  
331.     Select Case Value
332.         Case 1 'old image shift up, new is shift from bottom
333.             Do Until s <= -Height
334.                 PutImage (0, s), Old, 0
335.                 PutImage (0, s + Height), New, 0
336.                 s = s - 10
337.             Loop
338.  
339.         Case 2 'old photo go down, new is shift from ceil
340.             Do Until s >= Height
341.                 PutImage (0, s), Old, 0
342.                 PutImage (0, s - Height), New, 0
343.                 s = s + 10
344.             Loop
345.  
346.         Case 3 'old photo is shifted to right, new is comming from left
347.             Do Until s >= Width
348.                 PutImage (s, 0), Old, 0
349.                 PutImage (s - Width, 0), New, 0
350.                 s = s + 10
351.             Loop
352.  
353.         Case 4 'old photo is shifted to left and new photo is comming from right
354.             Do Until s <= -Width
355.                 PutImage (s, 0), Old, 0
356.                 PutImage (s + Width, 0), New, 0
357.                 s = s + 10
358.             Loop
359.  
360.         Case 5 'old photo is rewrited by circle contains new photo
361.             Do Until s > _Pi(2)
362.                 x1 = centerX + Cos(s) * Width
363.                 y1 = centerY + Sin(s) * Width
364.                 x2 = centerX + Cos(s + .2) * Width
365.                 y2 = centerY + Sin(s + .2) * Width
366.                 MapTriangle (centerX, centerY)-(x1, y1)-(x2, y2), New To(centerX, centerY)-(x1, y1)-(x2, y2), 0
367.                 s = s + .01
368.                 Display
369.             Loop
370.             Delay .2
371.             AutoDisplay
372.  
373.         Case 6 ' new photo is zoomed from middle the screen as rectangle with this image
374.  
375.             Stp = Width / 100
376.             Stp2 = Height / 100
377.             x1 = centerX + Sin(3.925) * k
378.             Do Until x1 <= 0
379.                 x1 = centerX + Sin(3.925) * k
380.                 y1 = centerY + Cos(3.925) * k2
381.                 x3 = centerX + Sin(0.785) * k
382.                 y3 = centerY + Cos(0.785) * k2
383.                 PutImage (x1, y1)-(x3, y3), New, 0
384.                 k = k + Stp
385.                 k2 = k2 + Stp2
386.                 kk = kk + 1
387.                 Delay .01
388.             Loop
389.  
390.         Case 7 'new photo is inserted as rectnagles from left to right and from ceiling to bottom
391.  
392.             sx = Width / 10
393.             sy = Height / 10
394.             For y = 0 To Height Step sy
395.                 For x = 0 To Width Step sx
396.                     PutImage (x, y), New, 0, (x, y)-(x + sx, y + sy)
397.                     Delay .02
398.             Next x, y
399.  
400.         Case 8 'vice versa as Case 7
401.  
402.             sx = Width / 10
403.             sy = Height / 10
404.  
405.             For x = 0 To Width Step sx
406.                 For y = 0 To Height Step sy
407.                     PutImage (x, y), New, 0, (x, y)-(x + sx, y + sy)
408.                     Delay .02
409.             Next y, x
410.  
411.         Case 9 'photo is displayed using quarter circle effect
412.             c = _Pi / 2
413.             Do Until s > _Pi(2) / 4
414.                 x1 = centerX + Cos(s) * Width
415.                 y1 = centerY + Sin(s) * Width
416.                 x2 = centerX + Cos(s + .01) * Width
417.                 y2 = centerY + Sin(s + .01) * Width
418.  
419.                 x3 = centerX + Cos(s + c) * Width
420.                 y3 = centerY + Sin(s + c) * Width
421.                 x4 = centerX + Cos(s + .01 + c) * Width
422.                 y4 = centerY + Sin(s + .01 + c) * Width
423.  
424.                 x5 = centerX + Cos(s + 2 * c) * Width
425.                 y5 = centerY + Sin(s + 2 * c) * Width
426.                 x6 = centerX + Cos(s + .01 + 2 * c) * Width
427.                 y6 = centerY + Sin(s + .01 + 2 * c) * Width
428.  
429.                 x7 = centerX + Cos(s + 3 * c) * Width
430.                 y7 = centerY + Sin(s + 3 * c) * Width
431.                 x8 = centerX + Cos(s + .01 + 3 * c) * Width
432.                 y8 = centerY + Sin(s + .01 + 3 * c) * Width
433.  
434.  
435.                 MapTriangle (centerX, centerY)-(x1, y1)-(x2, y2), New To(centerX, centerY)-(x1, y1)-(x2, y2), 0
436.                 MapTriangle (centerX, centerY)-(x3, y3)-(x4, y4), New To(centerX, centerY)-(x3, y3)-(x4, y4), 0
437.                 MapTriangle (centerX, centerY)-(x5, y5)-(x6, y6), New To(centerX, centerY)-(x5, y5)-(x6, y6), 0
438.                 MapTriangle (centerX, centerY)-(x7, y7)-(x8, y8), New To(centerX, centerY)-(x7, y7)-(x8, y8), 0
439.  
440.                 s = s + .01
441.                 Display
442.                 Delay .01
443.             Loop
444.             Delay .2
445.             AutoDisplay
446.  
447.         Case 10 'The image is divided into stripes in the Y axis, odd go to the right, even go to the left. So the old one is comming out and a new image arrives at the screen.
448.             ReDim Ys(1 To 10) As Integer
449.             ReDim Xs(1 To 10) As Integer
450.             d = Height / 10
451.             XSpd = Width / 100 'shift speed in X axis is WIDTH/100 pixels per loop
452.             For Yf = 1 To 10
453.                 Ys(Yf) = (Yf - 1) * d
454.             Next
455.             PCopy 0, 1
456.             Do Until done >= Width
457.                 PCopy 1, 0
458.                 For s = 1 To 10
459.                     If s Mod 2 = 0 Then
460.                         Xs(s) = Xs(s) - XSpd
461.                         PutImage (Xs(s), Ys(s)), Old, 0, (0, Ys(s))-(Width, Ys(s) + d)
462.                         PutImage (Xs(s) + Width, Ys(s)), New, 0, (0, Ys(s))-(Width, Ys(s) + d)
463.                     Else
464.                         Xs(s) = Xs(s) + XSpd
465.                         PutImage (Xs(s), Ys(s)), Old, 0, (0, Ys(s))-(Width, Ys(s) + d)
466.                         PutImage (Xs(s) - Width, Ys(s)), New, 0, (0, Ys(s))-(Width, Ys(s) + d)
467.                     End If
468.                 Next s
469.                 done = done + XSpd
470.                 Display
471.                 Delay .01
472.             Loop
473.             Delay .02
474.             AutoDisplay
475.  
476.         Case 11 'vice versa as Case 10
477.             ReDim Ys(1 To 10) As Integer
478.             ReDim Xs(1 To 10) As Integer
479.             d = Height / 10
480.             XSpd = Width / 100 'shift speed in X axis is WIDTH/100 pixels per loop
481.             For Yf = 1 To 10
482.                 Ys(Yf) = (Yf - 1) * d
483.             Next
484.             PCopy 0, 1
485.             Do Until done >= Width
486.                 PCopy 1, 0
487.                 For s = 1 To 10
488.                     If s Mod 2 = 0 Then
489.                         Xs(s) = Xs(s) + XSpd
490.                         PutImage (Xs(s), Ys(s)), Old, 0, (0, Ys(s))-(Width, Ys(s) + d)
491.                         PutImage (Xs(s) - Width, Ys(s)), New, 0, (0, Ys(s))-(Width, Ys(s) + d)
492.                     Else
493.                         Xs(s) = Xs(s) - XSpd
494.                         PutImage (Xs(s), Ys(s)), Old, 0, (0, Ys(s))-(Width, Ys(s) + d)
495.                         PutImage (Xs(s) + Width, Ys(s)), New, 0, (0, Ys(s))-(Width, Ys(s) + d)
496.                     End If
497.                 Next s
498.                 done = done + XSpd
499.                 Display
500.                 Delay .01
501.             Loop
502.             Delay .02
503.             AutoDisplay
504.     End Select
505.     FreeImage Old
506.     FreeImage New
507. End Sub
508.  
509. Sub PlayVideo (Video As String)
510.     'is my work for next weekend...
511.  
512.  
513. End Sub
514.  
515. Sub GetImageRatio (LeftUpperX, LeftUpperY, RightDownX, RightDownY, handle)
516.     W = Width(Images(handle))
517.     H = Height(Images(handle))
518.     sW = Width '                    Screen Width
519.     sH = Height '                   Screen Height
520.  
521.     RatioX = sW / W
522.     RatioY = sH / H
523.  
524.     Ratio = 1 '                     if RatioX = RatioY
525.     If RatioX < RatioY Then Ratio = RatioX
526.     If RatioY < RatioX Then Ratio = RatioY
527.  
528.     N_I_W = W * Ratio '             New _ Image _ Width
529.     N_I_H = H * Ratio '             New _ Image _ Height
530.  
531.     LeftUpperX = (sW - N_I_W) \ 2
532.     RightDownX = sW - LeftUpperX
533.     LeftUpperY = (sH - N_I_H) \ 2
534.     RightDownY = sH - LeftUpperY
535. End Sub
536.  

Edit: After creating window press any key to start, i forgot DELA statement in script file (is used before screen recording)