Scrolling messages in a programs title bar

[Dav]

I was playing around with @SierraKen scrolling thing he posted recently and it got me thinking that a scrolling message would be neat to put in a programs title bar - maybe grab headlines off the web, or other information.   I haven't added webpage info grabbing, but here's the titlebar scrolling method....

- Dav

Code: QB64: [Select]

1.  
2. 'TITLEBARTICKER.BAS
3. 'Example of scrolling text in the title bar.
4. 'You can use it as a news ticker, stock data, or other info.
5. 'by Dav, JULY/2020
6.  
7. SCREEN _NEWIMAGE(500, 1, 256)
8.  
9. 'You could grab your headlines here from a website instead.
10. 'I just used some random headlines from actual newspapers below.....really...
11.  
12. 'you could also add a Winows API to allow always stay on top of other windows.
13.  
14. txt$ = "...BREAKING NEWS....DOCS SAY BREATHING OXYGEN LINKED TO STAYING ALIVE.........."
15. txt$ = txt$ + "....NEW POLL SAYS MAJORITY OF AMERICANS (4 OUT OF 10) HATE MATH..........."
16. txt$ = txt$ + "....STUDY SHOWS TEEN PREGNANCY DROPS OFF SIGNIFICANTLY AFTER AGE 25......."
17. txt$ = txt$ + "....NOW BREAKING....WORLD BANK SAYS THE POOR NEED MORE MONEY.............."
18. txt$ = txt$ + "....MISSIPPI'S LITERACY PROGRAM STARTING TO SHOW IMPROVEMENT.............."
19. txt$ = txt$ + "....BREAKING: NORTHFIELD SAYS THEY PLAN TO PLAN A STRATEGIC PLAN.........."
20. txt$ = txt$ + "....SCIENTISTS SAY GREENLAND METEORITE MAY BE FROM OUTER SPACE............"
21. txt$ = txt$ + "....2 YEAR STUDY SUGGESTS MOST EARTHQUAKE DAMAGE CAUSED BY SHAKING........"
22. txt$ = txt$ + "....WA SCIENTISTS DECIDE TO KILL DUCKS TO SEE WHY THEY ARE DYING.........."
23. txt$ = txt$ + "....PRISONER SERVING 2000 YEAR SENTANCE COULD FACE MORE TIME.............."
24.  
25.  
26. txtlen = LEN(txt$)
27.  
28. chars = 60 'number of characters to show in title bar...
29.  
30. starttime = TIMER 'start a timer...
31.  
32. DO
33.  
34.     IF TIMER - starttime > .15 THEN GOSUB TitleScroll
35.     _LIMIT 30
36.  
37. LOOP UNTIL INKEY$ = CHR$(27)
38.  
39. END
40.  
41.  
42.  
43. '===========
44. TitleScroll: 'Ahhh! A GOSUB routine!!  RUN!!!
45. '===========
46. c = c + 1: IF c >= txtlen THEN c = 1
47. t2$ = RIGHT$(txt$, txtlen - 1) + LEFT$(txt$, 1)
48. txt$ = t2$: _TITLE LEFT$(txt$, chars)
49. starttime = TIMER
50. RETURN
51.  

[FellippeHeitor]

My previous experience with frequent _TITLE changes in Windows was that there is a limit. Have you run this long enough it crashed? I tried a while back, so swapping compilers may have fixed something.

[Dav]

I haven't ran it for extended periods of time -- but I will now.  It hasn't crashed on me so far.  Thanks for the heads up.

- Dav

[SMcNeill]

I'm willing to bet that any issue with _TITLE is probably due to the difference in BASIC strings and C strings.  If it acts up with you, null terminate your title string and see if that doesn't correct the issue.

txt$ = t2$: _TITLE LEFT$(txt$, chars) + CHR$(0)

[bplus]

"....NEW POLL SAYS MAJORITY OF AMERICANS (4 OUT OF 10) HATE MATH..........."

LOL

[SpriggsySpriggs]

@Dav Perhaps something like this?

Code: QB64: [Select]

1. SCREEN _NEWIMAGE(500, 1, 256)
2.  
3. txt$ = GetNews("2020-07-25", "2020-07-26", "north korea")
4.  
5. txtlen = LEN(txt$)
6.  
7. chars = 60 'number of characters to show in title bar...
8.  
9. starttime = TIMER 'start a timer...
10.  
11. DO
12.  
13.     IF TIMER - starttime > .15 THEN GOSUB TitleScroll
14.     _LIMIT 30
15.  
16. LOOP UNTIL INKEY$ = CHR$(27)
17.  
18. END
19.  
20.  
21.  
22. '===========
23. TitleScroll: 'Ahhh! A GOSUB routine!!  RUN!!!
24. '===========
25. c = c + 1: IF c >= txtlen THEN c = 1
26. t2$ = RIGHT$(txt$, txtlen - 1) + LEFT$(txt$, 1)
27. txt$ = t2$: _TITLE LEFT$(txt$, chars)
28. starttime = TIMER
29. RETURN
30.  
31. FUNCTION GetNews$ (startdate AS STRING, enddate AS STRING, topic AS STRING)
32.     DIM URL AS STRING
33.     DIM URLFile AS STRING
34.     DIM newsrequest AS STRING
35.     DIM a%
36.     URLFile = "newsrequest"
37.     URL = "http://newsapi.org/v2/everything?q=" + FormatAsHTTP(topic) + "&from=" + startdate + "&to=" + enddate + "&sortBy=popularity&apiKey=8509ac8ea3b14cadbb1cafc08cacf1cd"
38.     a% = API_request(URL, URLFile)
39.     DIM U AS INTEGER
40.     U = FREEFILE
41.     OPEN URLFile FOR BINARY AS #U
42.     IF LOF(U) <> 0 THEN
43.         newsrequest = SPACE$(LOF(U))
44.         GET #U, , newsrequest
45.         CLOSE #U
46.         KILL URLFile
47.     ELSE
48.         CLOSE #U
49.         KILL URLFile
50.         GetNews = ""
51.         EXIT FUNCTION
52.     END IF
53.     DIM headlines(0) AS STRING
54.     DIM journals(0) AS STRING
55.     DIM x AS INTEGER
56.     DO
57.         x = x + 1
58.         REDIM _PRESERVE headlines(x) AS STRING
59.         REDIM _PRESERVE journals(x) AS STRING
60.         headlines(x) = MID$(newsrequest, INSTR(newsrequest, "title" + CHR$(34) + ":") + 8)
61.         headlines(x) = LEFT$(headlines(x), INSTR(headlines(x), CHR$(34) + "," + CHR$(34)) - 1)
62.  
63.         journals(x) = MID$(newsrequest, INSTR(newsrequest, "name" + CHR$(34) + ":") + 7)
64.         journals(x) = LEFT$(journals(x), INSTR(journals(x), CHR$(34)) - 1)
65.         newsrequest = MID$(newsrequest, INSTR(newsrequest, "title" + CHR$(34) + ":") + 8)
66.     LOOP UNTIL INSTR(newsrequest, "title" + CHR$(34) + ":") = 0
67.     newsrequest = ""
68.     FOR x = 2 TO UBOUND(headlines)
69.         newsrequest = newsrequest + "....From " + journals(x - 1) + ": " + headlines(x) + " "
70.     NEXT
71.     GetNews = newsrequest
72. END FUNCTION
73.  
74. FUNCTION FormatAsHTTP$ (Request AS STRING)
75.     DIM start%
76.     DIM position%
77.     start% = 1
78.     DO
79.         position% = INSTR(start%, Request, " ")
80.         IF position% THEN
81.             MID$(Request, position%, 1) = "+"
82.             start% = position% + 1
83.         END IF
84.     LOOP UNTIL position% = 0
85.     FormatAsHTTP = Request
86. END FUNCTION
87.  
88. DECLARE DYNAMIC LIBRARY "urlmon"
89.     FUNCTION URLDownloadToFileA (BYVAL pCaller AS LONG, szURL AS STRING, szFileName AS STRING, BYVAL dwReserved AS LONG, BYVAL lpfnCB AS LONG)
90. END DECLARE
91.  
92. FUNCTION API_request (URL AS STRING, File AS STRING)
93.     API_request = URLDownloadToFileA(0, URL + CHR$(0), File + CHR$(0), 0, 0)
94. END FUNCTION

[Dav]

@Dav Perhaps something like this?

That's it! 

Thanks!

- Dav

[SpriggsySpriggs]

My previous experience with frequent _TITLE changes in Windows was that there is a limit. Have you run this long enough it crashed? I tried a while back, so swapping compilers may have fixed something.

I've seen that before too. I think usually for me it was due to changes happening too quickly.

[SierraKen]

That's really cool guys! I thought of this also when I made my giant text scroller but didn't know _TITLE could do it or not. :)

[Ashish]

This is cool! Thanks for sharing this.

[SpriggsySpriggs]

Updated my source code for the "News Ticker Tape" program using my better functions that way I can more reliably return all the values for the headlines and publishers. Works much better now:

Code: QB64: [Select]

1. SCREEN _NEWIMAGE(500, 1, 256)
2.  
3. txt$ = GetNews("2020-07-28", "2020-07-30", "brexit")
4.  
5. txtlen = LEN(txt$)
6.  
7. chars = 60 'number of characters to show in title bar...
8.  
9. starttime = TIMER 'start a timer...
10.  
11. DO
12.  
13.     IF TIMER - starttime > .10 THEN GOSUB TitleScroll
14.     _LIMIT 30
15.  
16. LOOP UNTIL INKEY$ = CHR$(27)
17.  
18. END
19.  
20.  
21.  
22. '===========
23. TitleScroll: 'Ahhh! A GOSUB routine!!  RUN!!!
24. '===========
25. c = c + 1: IF c >= txtlen THEN c = 1
26. t2$ = RIGHT$(txt$, txtlen - 1) + LEFT$(txt$, 1)
27. txt$ = t2$: _TITLE LEFT$(txt$, chars)
28. starttime = TIMER
29. RETURN
30.  
31. FUNCTION GetNews$ (startdate AS STRING, enddate AS STRING, topic AS STRING)
32.     DIM URL AS STRING
33.     DIM URLFile AS STRING
34.     DIM newsrequest AS STRING
35.     DIM a%
36.     URLFile = "newsrequest"
37.     URL = "http://newsapi.org/v2/everything?q=" + FormatAsHTTP(topic) + "&from=" + startdate + "&to=" + enddate + "&sortBy=popularity&apiKey=8509ac8ea3b14cadbb1cafc08cacf1cd"
38.     a% = API_request(URL, URLFile)
39.     DIM U AS INTEGER
40.     U = FREEFILE
41.     OPEN URLFile FOR BINARY AS #U
42.     IF LOF(U) <> 0 THEN
43.         newsrequest = SPACE$(LOF(U))
44.         GET #U, , newsrequest
45.         CLOSE #U
46.         KILL URLFile
47.     ELSE
48.         CLOSE #U
49.         KILL URLFile
50.         GetNews = ""
51.         EXIT FUNCTION
52.     END IF
53.     REDIM headlines(0) AS STRING
54.     REDIM journals(0) AS STRING
55.     DIM x AS INTEGER
56.     GetAllKey "name", newsrequest, journals()
57.     GetAllKey "title", newsrequest, headlines()
58.     newsrequest = ""
59.     FOR x = 1 TO UBOUND(journals)
60.         newsrequest = newsrequest + "....From " + journals(x) + ": " + headlines(x) + "  "
61.     NEXT
62.     GetNews = newsrequest
63. END FUNCTION
64.  
65. FUNCTION FormatAsHTTP$ (Request AS STRING)
66.     DIM start%
67.     DIM position%
68.     start% = 1
69.     DO
70.         position% = INSTR(start%, Request, " ")
71.         IF position% THEN
72.             MID$(Request, position%, 1) = "+"
73.             start% = position% + 1
74.         END IF
75.     LOOP UNTIL position% = 0
76.     FormatAsHTTP = Request
77. END FUNCTION
78.  
79. DECLARE DYNAMIC LIBRARY "urlmon"
80.     FUNCTION URLDownloadToFileA (BYVAL pCaller AS LONG, szURL AS STRING, szFileName AS STRING, BYVAL dwReserved AS LONG, BYVAL lpfnCB AS LONG)
81. END DECLARE
82.  
83. FUNCTION API_request (URL AS STRING, File AS STRING)
84.     API_request = URLDownloadToFileA(0, URL + CHR$(0), File + CHR$(0), 0, 0)
85. END FUNCTION
86.  
87. FUNCTION GetKey$ (keyname AS STRING, JSON AS STRING)
88.     DIM jkey AS STRING
89.     IF INSTR(JSON, CHR$(34) + keyname + CHR$(34)) THEN
90.         jkey = MID$(JSON, INSTR(JSON, CHR$(34) + keyname + CHR$(34)) + LEN(keyname))
91.         jkey = MID$(jkey, INSTR(jkey, ":") + 1)
92.         jkey = String.Replace(jkey, "\" + CHR$(34), "'")
93.         IF MID$(jkey, 1, 1) = CHR$(34) THEN
94.             jkey = MID$(jkey, 2)
95.         END IF
96.         jkey = MID$(jkey, 1, INSTR(jkey, CHR$(34)) - 1)
97.         IF RIGHT$(jkey, 1) = "," THEN
98.             jkey = MID$(jkey, 1, LEN(jkey) - 1)
99.         END IF
100.     ELSE
101.         GetKey = ""
102.     END IF
103.     GetKey = jkey
104. END FUNCTION
105.  
106. SUB GetAllKey (keyname AS STRING, JSON AS STRING, ParseKey() AS STRING)
107.     DIM unchangejson AS STRING
108.     DIM jkey AS STRING
109.     DIM x
110.     unchangejson = JSON
111.     DO
112.         IF INSTR(unchangejson, CHR$(34) + keyname + CHR$(34)) THEN
113.             x = x + 1
114.             REDIM _PRESERVE ParseKey(x) AS STRING
115.             unchangejson = MID$(unchangejson, INSTR(unchangejson, CHR$(34) + keyname + CHR$(34)) + LEN(keyname))
116.             jkey = unchangejson
117.             jkey = MID$(jkey, INSTR(jkey, ":") + 1)
118.             jkey = String.Replace(jkey, "\" + CHR$(34), "'")
119.             IF MID$(jkey, 1, 1) = CHR$(34) THEN
120.                 jkey = MID$(jkey, 2)
121.             END IF
122.             jkey = MID$(jkey, 1, INSTR(jkey, CHR$(34)) - 1)
123.             IF RIGHT$(jkey, 1) = "," THEN
124.                 jkey = MID$(jkey, 1, LEN(jkey) - 1)
125.             END IF
126.             ParseKey(x) = jkey
127.         END IF
128.     LOOP UNTIL INSTR(unchangejson, CHR$(34) + keyname + CHR$(34)) = 0
129. END SUB
130.  
131. FUNCTION String.Replace$ (a AS STRING, b AS STRING, c AS STRING)
132.     j = INSTR(a, b)
133.     IF j > 0 THEN
134.         r$ = LEFT$(a, j - 1) + c + String.Replace(RIGHT$(a, LEN(a) - j + 1 - LEN(b)), b, c)
135.     ELSE
136.         r$ = a
137.     END IF
138.     String.Replace = r$
139. END FUNCTION