Scroll Bar

[Erum]

Respected QB64 team,
I have created a software on QB64 that will analyse temperature and pH of soil and tell which plants can be grown there, along with conditions they need for a national science fair. (I used QB64 as I am a ninth grader and this software is easy to use.) Even though I managed to increase screen size but I need a scroll bar so all my data can fit neatly.
I also want to add colours, for example if I write like this:
English oak:
Water: ABC
Fertiliser:DEF
Distance:GHI  Temperature:XYZ and so on....
For this, I want the heading to be a different colour and each line to be a different colour. How can I do this?
P.S: I am not very advanced in all this but I am deeply interested to know. If any one can help me, I will be infinitely obliged.
Regards.

[Petr]

Maybe this help you. Use A/Z/Enter.

Code: QB64: [Select]

1. SCREEN _NEWIMAGE(500, 600, 256)
2. DIM Text(20) AS STRING * 15
3. FOR N = 0 TO 20
4.     Text(N) = "Value: " + STR$(N)
5. NEXT
6.  
7.  
8. height = 5 'list to 5 rows
9.  
10. DO
11.     i$ = UCASE$(INKEY$)
12.     IF i$ = "A" THEN b = b - 1: ch = ch - 1
13.     IF i$ = "Z" THEN b = b + 1: ch = ch + 1
14.  
15.     IF b > UBOUND(Text) THEN b = UBOUND(Text)
16.     IF b < LBOUND(Text) THEN b = LBOUND(Text)
17.     e = b + height '1 row height
18.     IF e > UBOUND(Text) THEN e = UBOUND(Text): b = e - height
19.     IF e < LBOUND(text) THEN e = LBOUND(Text)
20.  
21.     IF ch < LBOUND(text) THEN ch = LBOUND(text)
22.     IF ch > UBOUND(text) THEN ch = UBOUND(text)
23.  
24.     R = 10 'list start on row 10
25.     FOR scroll = b TO e
26.         LOCATE R, 30: PRINT Text(scroll)
27.         IF scroll = ch THEN LOCATE R, 5: PRINT "->" ELSE LOCATE R, 5: PRINT "  "
28.         COLOR R, 0 'set foreground color    , 0 for background color (black)
29.         R = R + 1
30.     NEXT
31.     IF i$ = CHR$(13) THEN PRINT "Choice:"; ch: END
32. LOOP
33.  

It just depends on how you organize the items in the text box. Color set using COLOR foreground, background. Be aware of the screen mode used. Use RGBA32 unsigned long colors for 32-bit displays and standard COLOR 0 to 255 for 8-bit displays. Also try _PRINTMODE _KEEPBACKGROUND and _PRINTMODE _FILLBACKGROUND.

I'm going to sleep, me look at your answer tomorrow.

[Bert22306]

Welcome, Erum. I'm not sure if you are asking simply how to change the color of the type or of the background, or something more complicated. The code here creates initially a screen with dull white background, and types different lines with different colors on that screen.

Then, it creates separate background colors, for each line of type.

You can play around with the effects in many ways. But for example, when the pH comes out with a certain value, to can create an IF statement that sets the type or the background colors, to different values?

Code: [Select]

SCREEN _NEWIMAGE(120, 43, 0)
COLOR 7, 7
CLS
COLOR 0, 7
PRINT "This is black."
COLOR 4, 7
PRINT "This is red."
COLOR 1, 7
PRINT "This is blue."
COLOR 14, 7
PRINT "This is bright yellow."
PRINT
COLOR 15, 0
PRINT "This has bright white type over a black background."
COLOR 7, 0
PRINT "This has dull white type on a black bachground."
COLOR 1, 4
PRINT "This has blue type on a red background."
END


[bplus]

Use mouse wheel to scroll through an array of colored strings::

Code: QB64: [Select]

1. _TITLE "Colored Lines scroller" 'B+ 2019-09-17
2. TYPE ColoredLines
3.     s AS STRING
4.     c AS INTEGER
5. END TYPE
6.  
7. DIM cl(1 TO 100) AS ColoredLines
8.  
9. 'This is just a quick fill of an array of strings with random colors
10. 'to have something to show, insert your real text and colors into an array.
11. FOR i = 1 TO 100
12.     cl(i).c = INT(RND * 15) + 1
13.     cl(i).s = "This is line number" + STR$(i)
14. NEXT
15.  
16. show cl()
17.  
18.  
19. SUB show (arr() AS ColoredLines)
20.     DIM lb AS LONG, ub AS LONG, top AS LONG, i AS LONG, row AS LONG, prevrow AS LONG, n AS LONG
21.     lb = LBOUND(arr): ub = UBOUND(arr)
22.     IF ub - lb + 1 < 21 THEN top = ub ELSE top = lb + 19
23.     CLS
24.     COLOR 0, 15
25.     PRINT "press any key to quit scroller..."
26.     COLOR 15, 0
27.     LOCATE 2, 1
28.     FOR i = lb TO top
29.         COLOR arr(i).c
30.         PRINT arr(i).s
31.     NEXT
32.     DO
33.         IF ub - lb + 1 > 20 THEN
34.             DO WHILE _MOUSEINPUT
35.                 IF row >= lb THEN row = row + _MOUSEWHEEL ELSE row = lb 'prevent under scrolling
36.                 IF row > ub - 19 THEN row = ub - 19 'prevent over scrolling
37.                 IF prevrow <> row THEN 'look for a change in row value
38.                     IF row >= lb AND row <= ub - 19 THEN
39.  
40.                         CLS
41.                         COLOR 0, 15: PRINT "press any key to quit scroller..."
42.                         COLOR 15, 0
43.                         LOCATE 2, 1
44.                         FOR n = row TO row + 19
45.                             COLOR arr(n).c
46.                             PRINT arr(n).s
47.                         NEXT
48.                     END IF
49.                 END IF
50.                 prevrow = row 'store previous row value
51.             LOOP
52.         END IF
53.     LOOP UNTIL INKEY$ > ""
54. END SUB
55.  
56.  

[bplus]

A mod of last reply:

Code: QB64: [Select]

1. _TITLE "Colored Lines scroller Ink and Paper Mod" 'B+ 2019-09-17
2. TYPE ColoredLines
3.     s AS STRING
4.     ink AS INTEGER
5.     paper AS INTEGER
6. END TYPE
7.  
8. DIM cl(1 TO 100) AS ColoredLines
9.  
10. FOR i = 1 TO 100
11.     cl(i).ink = INT(RND * 16)
12.     r = INT(RND * 8)
13.     WHILE r = cl(i).ink
14.         r = INT(RND * 8)
15.     WEND
16.     cl(i).paper = r
17.     cl(i).s = LEFT$("Line #" + STR$(i) + ", This is " + sayColor$(cl(i).ink) + " ink on " + sayColor$(cl(i).paper) + " paper." + SPACE$(_WIDTH), _WIDTH)
18. NEXT
19. show cl()
20.  
21. FUNCTION sayColor$ (n)
22.     SELECT CASE n
23.         CASE 0: sayColor$ = "Black"
24.         CASE 1: sayColor$ = "Dark Blue"
25.         CASE 2: sayColor$ = "Dark Green"
26.         CASE 3: sayColor$ = "Dark Cyan"
27.         CASE 4: sayColor$ = "Dark Red"
28.         CASE 5: sayColor$ = "Dark Purple"
29.         CASE 6: sayColor$ = "Dirty Dark Yellow"
30.         CASE 7: sayColor$ = "Dark White"
31.         CASE 8: sayColor$ = "Light Black"
32.         CASE 9: sayColor$ = "Blue"
33.         CASE 10: sayColor$ = "Green"
34.         CASE 11: sayColor$ = "Cyan"
35.         CASE 12: sayColor$ = "Red"
36.         CASE 13: sayColor$ = "Purple"
37.         CASE 14: sayColor$ = "Yellow"
38.         CASE 15: sayColor$ = "White"
39.     END SELECT
40. END FUNCTION
41.  
42. SUB show (arr() AS ColoredLines)
43.     DIM lb AS LONG, ub AS LONG, top AS LONG, i AS LONG, row AS LONG, prevrow AS LONG, n AS LONG
44.     lb = LBOUND(arr): ub = UBOUND(arr)
45.     IF ub - lb + 1 < 21 THEN top = ub ELSE top = lb + 19
46.     COLOR 15, 0
47.     CLS
48.     COLOR 0, 15
49.     PRINT "press any key to quit scroller..."
50.     COLOR 15, 0
51.     LOCATE 2, 1
52.     FOR i = lb TO top
53.         COLOR arr(i).ink, arr(i).paper
54.         PRINT arr(i).s
55.     NEXT
56.     DO
57.         IF ub - lb + 1 > 20 THEN
58.             DO WHILE _MOUSEINPUT
59.                 IF row >= lb THEN row = row + _MOUSEWHEEL ELSE row = lb 'prevent under scrolling
60.                 IF row > ub - 19 THEN row = ub - 19 'prevent over scrolling
61.                 IF prevrow <> row THEN 'look for a change in row value
62.                     IF row >= lb AND row <= ub - 19 THEN
63.                         COLOR 15, 0
64.                         CLS
65.                         COLOR 0, 15: PRINT "press any key to quit scroller..."
66.                         COLOR 15, 0
67.                         LOCATE 2, 1
68.                         FOR n = row TO row + 19
69.                             COLOR arr(n).ink, arr(n).paper
70.                             PRINT arr(n).s
71.                         NEXT
72.                     END IF
73.                 END IF
74.                 prevrow = row 'store previous row value
75.             LOOP
76.         END IF
77.     LOOP UNTIL INKEY$ > ""
78. END SUB
79.  

  [ You are not allowed to view this attachment ]  

[SMcNeill]

And here's a rather fancy example which does everything you mentioned, and more!

Code: QB64: [Select]

1. DIM SHARED WorkScreen AS LONG, DisplayScreen AS LONG
2. $RESIZE:ON
3.  
4. WorkScreen = _NEWIMAGE(3600, 2400, 32) ' a nice large screen so we can scroll like crazy
5. DisplayScreen = _NEWIMAGE(640, 480, 32) 'a nice small display screen
6.  
7. SCREEN DisplayScreen
8. _DEST WorkScreen
9. PRINT "Let's print all sorts of stuff on our workscreen, and make certain that it's more than long enough so that it'll scroll quite a ways across from the normal screen."
10. PRINT
11. PRINT
12. LINE (400, 400)-(3000, 1200), &HFFFFFF00, BF
13. FOR i = 1 TO 145
14.     COLOR _RGB32(RND * 256, RND * 256, RND * 256), 0 'various colors for each line
15.     PRINT "LINE #"; i; ".  This is just a bunch of junk for testing purposes only.  As you can see, if you want to read all the text from this line, you're going to have to scroll to see it all."
16. NEXT
17.  
18.  
19.  
20.  
21.  
22. StartX = 0: StartY = 0: W = _WIDTH(DisplayScreen): H = _HEIGHT(DisplayScreen)
23. _DEST DisplayScreen
24. DO
25.     IF _RESIZE THEN
26.         temp = _NEWIMAGE(_RESIZEWIDTH, _RESIZEHEIGHT, 32)
27.         SCREEN temp
28.         _FREEIMAGE DisplayScreen
29.         DisplayScreen = temp
30.         W = _WIDTH(DisplayScreen): H = _HEIGHT(DisplayScreen)
31.         _DELAY .25
32.         junk = _RESIZE 'clear the resize flag after manually setting the screen to the size we specified.
33.     END IF
34.     _LIMIT 30
35.     CLS
36.     PRINT StartX, StartY
37.     ScrollBar StartX, 2
38.     ScrollBar StartY, 1
39.  
40.     k = _KEYHIT
41.     SELECT CASE k
42.         CASE ASC("A"), ASC("a"): StartX = StartX - 10: IF StartX < 0 THEN StartX = 0
43.         CASE ASC("S"), ASC("s"): StartY = StartY + 10: IF StartY > _HEIGHT(WorkScreen) - H THEN StartY = _HEIGHT(WorkScreen) - H
44.         CASE ASC("D"), ASC("d"): StartX = StartX + 10: IF StartX > _WIDTH(WorkScreen) - W THEN StartX = _WIDTH(WorkScreen) - W
45.         CASE ASC("W"), ASC("w"): StartY = StartY - 10: IF StartY < 0 THEN StartY = 0
46.     END SELECT
47.     _PUTIMAGE (0, 0)-(W - 20, H - 20), WorkScreen, DisplayScreen, (StartX, StartY)-STEP(W, H)
48.     _DISPLAY
49. LOOP
50.  
51.  
52.  
53.  
54.  
55. SUB ScrollBar (Start, Direction)
56.     D = _DEST: _DEST DisplayScreen 'our scrollbars show on the display
57.     Min = 0
58.     MaxH = _HEIGHT(DisplayScreen)
59.     MaxW = _WIDTH(DisplayScreen)
60.     H = _HEIGHT(WorkScreen)
61.     W = _WIDTH(WorkScreen)
62.     IF Direction = 1 THEN 'up/down bar
63.         Box MaxW - 20, 0, 20, MaxH - 20, &HFF777777, &HFFFFFFFF
64.         Box MaxW - 19, Start / H * MaxH, 18, MaxH / H * MaxH - 20, &HFFFF0000, 0 'Red with transparent
65.     ELSE 'left/right bar
66.         Box Min, MaxH - 20, MaxW - 20, 20, &HFF777777, &HFFFFFFFF 'Gray with white border
67.         Box Start / W * MaxW, MaxH - 19, MaxW / W * MaxW - 20, 18, &HFFFF0000, 0 'Red with transparent
68.     END IF
69.     _DEST D
70. END SUB
71.  
72.  
73. SUB Box (x, y, wide, high, kolor AS _UNSIGNED LONG, border AS _UNSIGNED LONG)
74.     LINE (x, y)-STEP(wide, high), kolor, BF
75.     LINE (x, y)-STEP(wide, high), border, B
76. END SUB

[Erum]

Thank you all so much for the helpful and quick responses,
You all really helped me out. I will try each of the methods you mentioned and see which one works best for me.

[TempodiBasic]

very fine Steve
at start I was stucked, no mouse, no arrow then I read code and I found ASDW
and I got this

  [ You are not allowed to view this attachment ]  

sorry Steve
I have added mouse (Left click to move left, right click to move right, upwheel to move up, downwheel to move down) and arrow keys

Code: QB64: [Select]

1.     k = _KEYHIT
2.     WHILE _MOUSEINPUT
3.         IF _MOUSEBUTTON(1) THEN k = ASC("A")
4.         IF _MOUSEBUTTON(2) THEN k = ASC("d")
5.         IF _MOUSEWHEEL < 0 THEN k = ASC("w") ELSE IF _MOUSEWHEEL > 0 THEN k = ASC("s")
6.     WEND
7.     SELECT CASE k
8.         CASE ASC("A"), ASC("a"), 19200: StartX = StartX - 10: IF StartX < 0 THEN StartX = 0
9.         CASE ASC("S"), ASC("s"), 20480: StartY = StartY + 10: IF StartY > _HEIGHT(WorkScreen) - H THEN StartY = _HEIGHT(WorkScreen) - H
10.         CASE ASC("D"), ASC("d"), 19712: StartX = StartX + 10: IF StartX > _WIDTH(WorkScreen) - W THEN StartX = _WIDTH(WorkScreen) - W
11.         CASE ASC("W"), ASC("w"), 18432: StartY = StartY - 10: IF StartY < 0 THEN StartY = 0
12.     END SELECT

[TempodiBasic]

Hi Bplus
 do you like manage only mouse wheel into your example!

  [ You are not allowed to view this attachment ]  
no keys no horizonthal scrolling... but so many colors!

[TempodiBasic]

Hi Petr

I find you idea very interesting but I need to make a question...

  [ You are not allowed to view this attachment ]  

why do you choose to move cursor (pointer to item of list) when you reach the end of the list and not at first? I find more often this last behaviour of cursor.

[bplus]

Hi Bplus
 do you like manage only mouse wheel into your example!

 (attachment=1,msg109613)
no keys no horizonthal scrolling... but so many colors!

Yes, just the mouse wheel for just displaying information, is what I like, who likes having to deal with horizontal scroll for reading a presentation?

Of course this is just a demo and all those colors and line numbers would be far too gaudy for a presentation of information. But color coding is a fine idea for the displaying of information and why I played off Bert22306's idea of testing fore and back colors to give a range of what is possible.

[Petr]

TempodiBasic wrote:

why do you choose to move cursor (pointer to item of list) when you reach the end of the list and not at first? I find more often this last behaviour of cursor.

Hi Tempo, it was just a fast-paced program. Yeah you're right. You know what? I'll do the upgrade!

[Petr]

TempodiBasic,

Here it is. Notice the possibility of using the mouse wheel or a specific item with the mouse if you move the mouse into the item column. Keyboard control has been retained + added arrows, PgUp, PgDn, Home and End controls. The program has been redesigned as a function for better usability.

Code: QB64: [Select]

1. SCREEN _NEWIMAGE(500, 600, 256)
2. DIM Text(20) AS STRING
3. FOR N = 0 TO 20
4.     Text(N) = "Value: " + STR$(N)
5. NEXT
6.  
7.  
8. height = 15 'list to 15 rows
9. TXT_Lenght = 17
10. XPosition = 30
11. YPosition = 10
12.  
13.  
14. DO UNTIL Value
15.     Value = ScrollBar(Text(), XPosition, YPosition, TXT_Lenght, height)
16. LOOP
17. PRINT "Selected:"; Value
18.  
19.  
20.  
21. FUNCTION ScrollBar (Text() AS STRING, Xposition, Yposition, TXT_Lenght, Height)
22.     SHARED e, b, ch
23.     i$ = UCASE$(INKEY$)
24.     WHILE _MOUSEINPUT
25.         mwh = _MOUSEWHEEL
26.         ch = ch + mwh
27.         IF mwh THEN EXIT WHILE
28.  
29.         Fx = _FONTWIDTH
30.         Fy = _FONTHEIGHT
31.         IF _MOUSEX >= Fx * Xposition AND _MOUSEX <= Fx * (Xposition + TXT_Lenght) THEN
32.             IF _MOUSEY >= Fy * Yposition AND _MOUSEY <= Fy * (Yposition + Height) THEN
33.                 IF mwh = 0 THEN
34.                     ch = b + _CEIL((_MOUSEY - (Yposition * Fy)) / Fy)
35.                 END IF
36.             END IF
37.         END IF
38.         IF _MOUSEBUTTON(1) THEN i$ = CHR$(13)
39.     WEND
40.  
41.     IF i$ = "A" OR i$ = CHR$(0) + CHR$(72) THEN ch = ch - 1 '+Up
42.     IF i$ = "Z" OR i$ = CHR$(0) + CHR$(80) THEN ch = ch + 1 '+Dn
43.     IF i$ = CHR$(0) + CHR$(73) THEN ch = ch - Height 'PgUP
44.     IF i$ = CHR$(0) + CHR$(81) THEN ch = ch + Height 'PgDN
45.     IF i$ = CHR$(0) + CHR$(71) THEN ch = LBOUND(text) 'HOME
46.     IF i$ = CHR$(0) + CHR$(79) THEN ch = UBOUND(text) 'END
47.  
48.     IF ch > Height + b THEN b = b + 1: e = e + 1
49.     IF ch < e - Height THEN b = b - 1: e = e - 1
50.  
51.  
52.     IF b > UBOUND(Text) THEN b = UBOUND(Text)
53.     IF b < LBOUND(Text) THEN b = LBOUND(Text)
54.     e = b + Height
55.     IF e > UBOUND(Text) THEN e = UBOUND(Text): b = e - Height
56.     IF e < LBOUND(text) THEN e = LBOUND(Text)
57.  
58.     IF ch < LBOUND(text) THEN ch = LBOUND(text)
59.     IF ch > UBOUND(text) THEN ch = UBOUND(text)
60.  
61.     R = Yposition
62.     FOR scroll = b TO e
63.         IF scroll = ch THEN bckc = 94 ELSE bckc = 0
64.         COLOR R, bckc
65.         IF LEN(Text(scroll)) > TXT_Lenght THEN t$ = LEFT$(Text(scroll), TXT_Lenght - 3) + "..." ELSE t$ = Text(scroll)
66.         LOCATE R, Xposition: PRINT t$
67.         R = R + 1
68.     NEXT
69.     IF i$ = CHR$(13) THEN ScrollBar = ch: EXIT FUNCTION
70. END FUNCTION
71.  

[bplus]

Petr, that looks like great code for item selection from an array.

I would say perfect if it had easy method to color lines.

[Petr]

Hm, yes. This is solution for standard 2 colored scroll bar:

Code: QB64: [Select]

1. SCREEN _NEWIMAGE(500, 600, 256)
2. DIM Text(20) AS STRING
3. FOR N = 0 TO 20
4.     Text(N) = "Value: " + STR$(N)
5. NEXT
6.  
7.  
8. height = 15 'list to 15 rows
9. TXT_Lenght = 20
10. XPosition = 10
11. YPosition = 7
12.  
13.  
14.  
15. Value = ScrollBar(Text(), XPosition, YPosition, TXT_Lenght, height, 99, 127)
16. PRINT "Selected:"; Value
17.  
18.  
19.  
20. FUNCTION ScrollBar (Text() AS STRING, Xposition, Yposition, TXT_Lenght, Height, ForegroundColor~&, BackgroundColor~&)
21.     DO UNTIL ScrollBar
22.         i$ = UCASE$(INKEY$)
23.         WHILE _MOUSEINPUT
24.             mwh = _MOUSEWHEEL
25.             ch = ch + mwh
26.             IF mwh THEN EXIT WHILE
27.  
28.             Fx = _FONTWIDTH
29.             Fy = _FONTHEIGHT
30.             IF _MOUSEX >= Fx * Xposition AND _MOUSEX <= Fx * (Xposition + TXT_Lenght) THEN
31.                 IF _MOUSEY >= Fy * Yposition AND _MOUSEY <= Fy * (Yposition + Height) THEN
32.                     IF mwh = 0 THEN
33.                         ch = b + _CEIL((_MOUSEY - (Yposition * Fy)) / Fy)
34.                     END IF
35.                 END IF
36.             END IF
37.             IF _MOUSEBUTTON(1) THEN i$ = CHR$(13)
38.         WEND
39.  
40.         IF i$ = "A" OR i$ = CHR$(0) + CHR$(72) THEN ch = ch - 1 '+Up
41.         IF i$ = "Z" OR i$ = CHR$(0) + CHR$(80) THEN ch = ch + 1 '+Dn
42.         IF i$ = CHR$(0) + CHR$(73) THEN ch = ch - Height 'PgUP
43.         IF i$ = CHR$(0) + CHR$(81) THEN ch = ch + Height 'PgDN
44.         IF i$ = CHR$(0) + CHR$(71) THEN ch = LBOUND(text) 'HOME
45.         IF i$ = CHR$(0) + CHR$(79) THEN ch = UBOUND(text) 'END
46.  
47.         IF ch > Height + b THEN b = b + 1: e = e + 1
48.         IF ch < e - Height THEN b = b - 1: e = e - 1
49.  
50.  
51.         IF b > UBOUND(Text) THEN b = UBOUND(Text)
52.         IF b < LBOUND(Text) THEN b = LBOUND(Text)
53.         e = b + Height
54.         IF e > UBOUND(Text) THEN e = UBOUND(Text): b = e - Height
55.         IF e < LBOUND(text) THEN e = LBOUND(Text)
56.  
57.         IF ch < LBOUND(text) THEN ch = LBOUND(text)
58.         IF ch > UBOUND(text) THEN ch = UBOUND(text)
59.  
60.         R = Yposition
61.         FOR scroll = b TO e
62.             IF scroll = ch THEN bckc~& = ForegroundColor~&: fore~& = BackgroundColor~& ELSE bckc~& = BackgroundColor~&: fore~& = ForegroundColor~&
63.             COLOR fore~&, bckc~&
64.             IF LEN(Text(scroll)) > TXT_Lenght THEN t$ = LEFT$(Text(scroll), TXT_Lenght - 3) + "..." ELSE t$ = Text(scroll)
65.             t$ = t$ + SPACE$(TXT_Lenght - LEN(t$))
66.             IF LEN(t$) > TXT_Lenght THEN t$ = LEFT$(t$, LEN(t$) - 3) + "..."
67.             LOCATE R, Xposition: PRINT t$
68.             R = R + 1
69.         NEXT
70.         IF i$ = CHR$(13) THEN ScrollBar = ch
71.     LOOP
72. END FUNCTION
73.  
74.  
75.  
76.  
77.