Text Only | Text with Attachments

QB64.org Forum

Active Forums => Programs => Topic started by: Dav on July 26, 2020, 02:24:27 pm

Title: Scrolling messages in a programs title bar
Post by: Dav on July 26, 2020, 02:24:27 pm
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.  
  33.  
  34.     IF TIMER - starttime > .15 THEN GOSUB TitleScroll
  35.     _LIMIT 30
  36.  
  38.  
  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
  51.  
Title: Re: Scrolling messages in a programs title bar
Post by: FellippeHeitor on July 26, 2020, 02:25:49 pm
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.
Title: Re: Scrolling messages in a programs title bar
Post by: Dav on July 26, 2020, 02:28:39 pm
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
Title: Re: Scrolling messages in a programs title bar
Post by: SMcNeill on July 26, 2020, 02:36:42 pm
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)
Title: Re: Scrolling messages in a programs title bar
Post by: bplus on July 26, 2020, 03:48:15 pm
Quote
"....NEW POLL SAYS MAJORITY OF AMERICANS (4 OUT OF 10) HATE MATH..........."

LOL
Title: Re: Scrolling messages in a programs title bar
Post by: SpriggsySpriggs on July 26, 2020, 03:49:39 pm
@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.  
  12.  
  13.     IF TIMER - starttime > .15 THEN GOSUB TitleScroll
  14.     _LIMIT 30
  15.  
  17.  
  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
  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
  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
  87.  
  89.     FUNCTION URLDownloadToFileA (BYVAL pCaller AS LONG, szURL AS STRING, szFileName AS STRING, BYVAL dwReserved AS LONG, BYVAL lpfnCB AS LONG)
  91.  
  92. FUNCTION API_request (URL AS STRING, File AS STRING)
  93.     API_request = URLDownloadToFileA(0, URL + CHR$(0), File + CHR$(0), 0, 0)
Title: Re: Scrolling messages in a programs title bar
Post by: Dav on July 26, 2020, 04:29:58 pm
Quote from: SpriggsySpriggs on July 26, 2020, 03:49:39 pm
@Dav Perhaps something like this?

That's it! 

Thanks!

- Dav
Title: Re: Scrolling messages in a programs title bar
Post by: SpriggsySpriggs on July 26, 2020, 04:54:23 pm
Quote from: FellippeHeitor on July 26, 2020, 02:25:49 pm
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.
Title: Re: Scrolling messages in a programs title bar
Post by: SierraKen on July 26, 2020, 06:28:20 pm
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. :)
Title: Re: Scrolling messages in a programs title bar
Post by: Ashish on July 27, 2020, 01:14:28 am
This is cool! Thanks for sharing this.
Title: Re: Scrolling messages in a programs title bar
Post by: SpriggsySpriggs on July 29, 2020, 09:38:31 pm
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.  
  12.  
  13.     IF TIMER - starttime > .10 THEN GOSUB TitleScroll
  14.     _LIMIT 30
  15.  
  17.  
  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
  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
  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
  78.  
  80.     FUNCTION URLDownloadToFileA (BYVAL pCaller AS LONG, szURL AS STRING, szFileName AS STRING, BYVAL dwReserved AS LONG, BYVAL lpfnCB AS LONG)
  82.  
  83. FUNCTION API_request (URL AS STRING, File AS STRING)
  84.     API_request = URLDownloadToFileA(0, URL + CHR$(0), File + CHR$(0), 0, 0)
  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
  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
  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$
Text Only | Text with Attachments