Text Only | Text with Attachments

QB64.org Forum

Active Forums => QB64 Discussion => Topic started by: Erum on September 16, 2019, 03:28:05 pm

Title: Scroll Bar
Post by: Erum on September 16, 2019, 03:28:05 pm
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.
Title: Re: Scroll Bar
Post by: Petr on September 16, 2019, 05:16:09 pm
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)
  6.  
  7.  
  8. height = 5 'list to 5 rows
  9.  
  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
  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.
Title: Re: Scroll Bar
Post by: Bert22306 on September 16, 2019, 05:20:44 pm
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
Title: Re: Scroll Bar
Post by: bplus on September 17, 2019, 12:02:51 am
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
  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)
  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$ > ""
  55.  
  56.  
Title: Re: Scroll Bar
Post by: bplus on September 17, 2019, 01:02:42 am
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
  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)
  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
  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$ > ""
  79.  

  [ This attachment cannot be displayed inline in 'Print Page' view ]  
Title: Re: Scroll Bar
Post by: SMcNeill on September 17, 2019, 02:12:57 am
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
  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."
  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."
  17.  
  18.  
  19.  
  20.  
  21.  
  22. StartX = 0: StartY = 0: W = _WIDTH(DisplayScreen): H = _HEIGHT(DisplayScreen)
  23. _DEST DisplayScreen
  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
  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
  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
Title: Re: Scroll Bar
Post by: Erum on September 17, 2019, 07:09:30 am
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.
Title: Re: Scroll Bar
Post by: TempodiBasic on September 20, 2019, 08:04:14 am
very fine Steve
at start I was stucked, no mouse, no arrow then I read code and I found ASDW
and I got this

  [ This attachment cannot be displayed inline in 'Print Page' view ]  

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
  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
Title: Re: Scroll Bar
Post by: TempodiBasic on September 20, 2019, 08:08:48 am
Hi Bplus
 do you like manage only mouse wheel into your example!

  [ This attachment cannot be displayed inline in 'Print Page' view ]  
no keys no horizonthal scrolling... but so many colors!
Title: Re: Scroll Bar
Post by: TempodiBasic on September 20, 2019, 08:18:21 am
Hi Petr

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

  [ This attachment cannot be displayed inline in 'Print Page' view ]  

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.
Title: Re: Scroll Bar
Post by: bplus on September 20, 2019, 09:05:51 am
Quote from: TempodiBasic on September 20, 2019, 08:08:48 am
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.
Title: Re: Scroll Bar
Post by: Petr on September 20, 2019, 11:30:31 am
Quote
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!
Title: Re: Scroll Bar
Post by: Petr on September 20, 2019, 12:50:22 pm
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)
  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)
  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$)
  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
  71.  
Title: Re: Scroll Bar
Post by: bplus on September 20, 2019, 01:43:57 pm
Petr, that looks like great code for item selection from an array.

I would say perfect if it had easy method to color lines.
Title: Re: Scroll Bar
Post by: Petr on September 20, 2019, 02:58:17 pm
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)
  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
  73.  
  74.  
  75.  
  76.  
  77.  
Title: Re: Scroll Bar
Post by: bplus on September 20, 2019, 04:57:21 pm
Well I was thinking more like this:
Code: QB64: [Select]
  1.  
  2. TYPE ColoredLines
  3.     s AS STRING
  4.     ink AS INTEGER
  5.     paper AS INTEGER
  7.  
  8. BoxHeight = 15 'list to 15 rows
  9. TXT_Lenght = 60
  10. XPosition = 10
  11. YPosition = 7
  12.  
  13. DIM text(1 TO 100) AS ColoredLines
  14. FOR i = 1 TO 100
  15.     text(i).ink = INT((i - 1) / 10) + 1
  16.     text(i).paper = (text(i).ink + 7) MOD 8
  17.     text(i).s = LEFT$("Line #" + STR$(i) + ", This is " + sayColor$(text(i).ink) + " ink on " + sayColor$(text(i).paper) + " paper." + SPACE$(TXT_Lenght), TXT_Lenght)
  19.  
  20.  
  21. Value = ScrollBar(text(), XPosition, YPosition, TXT_Lenght, BoxHeight)
  22. COLOR 15, 0: LOCATE 2, 10: PRINT "Selected:"; Value
  23.  
  24. FUNCTION ScrollBar (Text() AS ColoredLines, Xposition, Yposition, TXT_Lenght, Height)
  25.     DO UNTIL ScrollBar
  26.         i$ = UCASE$(INKEY$)
  27.         WHILE _MOUSEINPUT
  28.             mwh = _MOUSEWHEEL
  29.             ch = ch + mwh
  30.             IF mwh THEN EXIT WHILE
  31.  
  32.             Fx = _FONTWIDTH
  33.             Fy = _FONTHEIGHT
  34.             IF _MOUSEX >= Fx * Xposition AND _MOUSEX <= Fx * (Xposition + TXT_Lenght) THEN
  35.                 IF _MOUSEY >= Fy * Yposition AND _MOUSEY <= Fy * (Yposition + Height) THEN
  36.                     IF mwh = 0 THEN
  37.                         ch = b + _CEIL((_MOUSEY - (Yposition * Fy)) / Fy)
  38.                     END IF
  39.                 END IF
  40.             END IF
  41.             IF _MOUSEBUTTON(1) THEN i$ = CHR$(13)
  42.         WEND
  43.  
  44.         IF i$ = "A" OR i$ = CHR$(0) + CHR$(72) THEN ch = ch - 1 '+Up
  45.         IF i$ = "Z" OR i$ = CHR$(0) + CHR$(80) THEN ch = ch + 1 '+Dn
  46.         IF i$ = CHR$(0) + CHR$(73) THEN ch = ch - Height 'PgUP
  47.         IF i$ = CHR$(0) + CHR$(81) THEN ch = ch + Height 'PgDN
  48.         IF i$ = CHR$(0) + CHR$(71) THEN ch = LBOUND(text) 'HOME
  49.         IF i$ = CHR$(0) + CHR$(79) THEN ch = UBOUND(text) 'END
  50.  
  51.         IF ch > Height + b THEN b = b + 1: e = e + 1
  52.         IF ch < e - Height THEN b = b - 1: e = e - 1
  53.  
  54.  
  55.         IF b > UBOUND(Text) THEN b = UBOUND(Text)
  56.         IF b < LBOUND(Text) THEN b = LBOUND(Text)
  57.         e = b + Height
  58.         IF e > UBOUND(Text) THEN e = UBOUND(Text): b = e - Height
  59.         IF e < LBOUND(text) THEN e = LBOUND(Text)
  60.  
  61.         IF ch < LBOUND(text) THEN ch = LBOUND(text)
  62.         IF ch > UBOUND(text) THEN ch = UBOUND(text)
  63.  
  64.         R = Yposition
  65.         FOR scroll = b TO e
  66.             IF scroll = ch THEN bckc~& = 15: fore~& = 0 ELSE bckc~& = Text(scroll).paper: fore~& = Text(scroll).ink
  67.             COLOR fore~&, bckc~&
  68.             'IF LEN(Text(scroll)) > TXT_Lenght THEN t$ = LEFT$(Text(scroll), TXT_Lenght - 3) + "..." ELSE t$ = Text(scroll)
  69.             't$ = t$ + SPACE$(TXT_Lenght - LEN(t$))
  70.             'IF LEN(t$) > TXT_Lenght THEN t$ = LEFT$(t$, LEN(t$) - 3) + "..."
  71.             LOCATE R, Xposition: PRINT Text(scroll).s
  72.             R = R + 1
  73.         NEXT
  74.         IF i$ = CHR$(13) THEN ScrollBar = ch
  75.     LOOP
  77.  
  78. FUNCTION sayColor$ (n)
  79.     SELECT CASE n
  80.         CASE 0: sayColor$ = "Black"
  81.         CASE 1: sayColor$ = "Dark Blue"
  82.         CASE 2: sayColor$ = "Dark Green"
  83.         CASE 3: sayColor$ = "Dark Cyan"
  84.         CASE 4: sayColor$ = "Dark Red"
  85.         CASE 5: sayColor$ = "Dark Purple"
  86.         CASE 6: sayColor$ = "Dirty Dark Yellow"
  87.         CASE 7: sayColor$ = "Dark White"
  88.         CASE 8: sayColor$ = "Light Black"
  89.         CASE 9: sayColor$ = "Blue"
  90.         CASE 10: sayColor$ = "Green"
  91.         CASE 11: sayColor$ = "Cyan"
  92.         CASE 12: sayColor$ = "Red"
  93.         CASE 13: sayColor$ = "Purple"
  94.         CASE 14: sayColor$ = "Yellow"
  95.         CASE 15: sayColor$ = "White"
  96.     END SELECT
  98.  
  99.  

  [ This attachment cannot be displayed inline in 'Print Page' view ]  
Title: Re: Scroll Bar
Post by: TempodiBasic on September 20, 2019, 05:52:35 pm
Hi Petr

I find your examples good

  [ This attachment cannot be displayed inline in 'Print Page' view ]  

cool the combo of keys and mouse....

I got a glitch that I'm not able to recognize in the code! Doing different attempts I get nothing .

Scrolling by wheel of mouse works well when mouse's cursor is not in action on the scrollingbox.
When cursor of mouse is on the scrollingbox the wheel of mouse works only if user points on the first line of scrolling...
nothing happens if cursor of mouse points to another item of the list of scrolling...


Thanks for sharing
Title: Re: Scroll Bar
Post by: Petr on September 20, 2019, 06:02:11 pm
Hello. Yeah, the wheel only works outside the dump column, because if the mouse is in the dump column, it has priority to calculate the mouse position and thus determine the selection from the list. As for the colors (this is a note for BPlus), then I think it is enough to extend the text field with a flag and choose a color according to the flag. For example, when I return to the original topic, add the water temperature flag and set the text colors according to the water temperature... (or other)
Title: Re: Scroll Bar
Post by: TempodiBasic on September 20, 2019, 06:09:06 pm
Hi Bplus

in this your mod of Petr function for scrolling  you have set off the selection/highlight by pointer of the item pointed by cursor of mouse.

I find in wiki this example of scrolling with wheel of mouse that works like your mod, you must add just color to screen output and the selection highlighting

Code: QB64: [Select]
  1.  
  2. 'Code by Ted Weissgerber
  3. DIM Array$(100)
  4. LINE INPUT "Enter a file name with 100 or more lines of text: ", file$
  5. OPEN file$ FOR INPUT AS #1
  7.   inputcount = inputcount + 1
  8.   LINE INPUT #1, Array$(inputcount)
  9.   IF inputcount = 100 THEN EXIT DO
  11. FOR n = 1 TO 21: PRINT Array$(n): NEXT
  15.     IF row >= 0 THEN row = row + _MOUSEWHEEL ELSE row = 0  'prevent under scrolling
  16.     IF row > inputcount - 20 THEN row = inputcount - 20    'prevent over scrolling
  17.     IF prevrow <> row THEN 'look for a change in row value
  18.       IF row > 0 AND row <= inputcount - 20 THEN
  19.         CLS: LOCATE 2, 1
  20.         FOR n = row TO row + 20
  21.           PRINT Array$(n)
  22.         NEXT
  23.       END IF
  24.     END IF
  25.     prevrow = row 'store previous row value
  26.   LOOP
  27. LOOP UNTIL INKEY$ > ""  
  28.  

you can find it here http://qb64.org/wiki/MOUSEWHEEL (http://qb64.org/wiki/MOUSEWHEEL)

Title: Re: Scroll Bar
Post by: TempodiBasic on September 20, 2019, 06:17:22 pm
Hi Petr
sorry for my bad communication

about this
Quote
Hello. Yeah, the wheel only works outside the dump column, because if the mouse is in the dump column, it has priority to calculate the mouse position and thus determine the selection from the list
mouse wheel works also when you point with mouse on the first item showed into the scrollingBox...
so if I point to item 1 and move mouseWheel  the item highlighted moves down until it is item 15, then scrolling again the items scroll down. Well now it says that as last item showed there is at the bottom item 18 and I point by cursor of mouse this last it will be highlighted, now if I move mousewheel up or down i get scrolling the item HighLighted, the same i get if i point by cursor of mouse the first item showed in the listbox. Oe exception is if I point by mouse cursor the item 20!
Thanks to read
Title: Re: Scroll Bar
Post by: Petr on September 20, 2019, 06:23:34 pm
Hi.

Yeah, the wheel only works outside the dump column, because if the mouse is in the dump column, it has priority to calculate the mouse position and thus determine the selection from the list. As for the colors (this is a note for BPlus), then I think it is enough to extend the text field with a flag and choose a color according to the flag. For example, when I return to the original topic, add the water temperature flag and set the text colors according to the water temperature... (or other)...


Code: QB64: [Select]
  1. SCREEN _NEWIMAGE(500, 600, 256)
  2.  
  4.     Text AS STRING * 30
  5.     Water AS _UNSIGNED _BYTE
  7.  
  8.  
  9.  
  10. DIM Text(200) AS E
  11. FOR N = 0 TO 200
  12.     temperature = RND * 100
  13.     Text(N).Text = "Water temperature: " + STR$(temperature)
  14.     Text(N).Water = temperature
  16.  
  17.  
  18. height = 15 'list to 15 rows
  19. TXT_Lenght = 30
  20. XPosition = 10
  21. YPosition = 7
  22.  
  23.  
  24.  
  25. Value = ScrollBar(Text(), XPosition, YPosition, TXT_Lenght, height)
  26. PRINT "Selected:"; Value
  27.  
  28.  
  29.  
  30. FUNCTION ScrollBar (Text() AS E, Xposition, Yposition, TXT_Lenght, Height)
  31.     DO UNTIL ScrollBar
  32.         i$ = UCASE$(INKEY$)
  33.         WHILE _MOUSEINPUT
  34.             mwh = _MOUSEWHEEL
  35.             ch = ch + mwh
  36.             IF mwh THEN EXIT WHILE
  37.  
  38.             Fx = _FONTWIDTH
  39.             Fy = _FONTHEIGHT
  40.             IF _MOUSEX >= Fx * Xposition AND _MOUSEX <= Fx * (Xposition + TXT_Lenght) THEN
  41.                 IF _MOUSEY >= Fy * Yposition AND _MOUSEY <= Fy * (Yposition + Height) THEN
  42.                     IF mwh = 0 THEN
  43.                         ch = b + _CEIL((_MOUSEY - (Yposition * Fy)) / Fy)
  44.                     END IF
  45.                 END IF
  46.             END IF
  47.             IF _MOUSEBUTTON(1) THEN i$ = CHR$(13)
  48.         WEND
  49.  
  50.         IF i$ = "A" OR i$ = CHR$(0) + CHR$(72) THEN ch = ch - 1 '+Up
  51.         IF i$ = "Z" OR i$ = CHR$(0) + CHR$(80) THEN ch = ch + 1 '+Dn
  52.         IF i$ = CHR$(0) + CHR$(73) THEN ch = ch - Height 'PgUP
  53.         IF i$ = CHR$(0) + CHR$(81) THEN ch = ch + Height 'PgDN
  54.         IF i$ = CHR$(0) + CHR$(71) THEN ch = LBOUND(text) 'HOME
  55.         IF i$ = CHR$(0) + CHR$(79) THEN ch = UBOUND(text) 'END
  56.  
  57.         IF ch > Height + b THEN b = b + 1: e = e + 1
  58.         IF ch < e - Height THEN b = b - 1: e = e - 1
  59.  
  60.  
  61.         IF b > UBOUND(Text) THEN b = UBOUND(Text)
  62.         IF b < LBOUND(Text) THEN b = LBOUND(Text)
  63.         e = b + Height
  64.         IF e > UBOUND(Text) THEN e = UBOUND(Text): b = e - Height
  65.         IF e < LBOUND(text) THEN e = LBOUND(Text)
  66.  
  67.         IF ch < LBOUND(text) THEN ch = LBOUND(text)
  68.         IF ch > UBOUND(text) THEN ch = UBOUND(text)
  69.  
  70.         R = Yposition
  71.         BackgroundColor~& = 0
  72.  
  73.  
  74.         FOR scroll = b TO e
  75.             SELECT CASE Text(scroll).Water
  76.                 CASE 0 TO 20: ForegroundColor~& = 32
  77.                 CASE 20 TO 40: ForegroundColor~& = 52
  78.                 CASE 40 TO 60: ForegroundColor~& = 46
  79.                 CASE 60 TO 80: ForegroundColor~& = 36
  80.                 CASE IS > 80: ForegroundColor~& = 40
  81.             END SELECT
  82.  
  83.             IF scroll = ch THEN bckc~& = 9: fore~& = ForegroundColor~& ELSE bckc~& = BackgroundColor~&: fore~& = ForegroundColor~&
  84.             COLOR fore~&, bckc~&
  85.             IF LEN(Text(scroll).Text) > TXT_Lenght THEN t$ = LEFT$(Text(scroll).Text, TXT_Lenght - 3) + "..." ELSE t$ = Text(scroll).Text
  86.             t$ = t$ + SPACE$(TXT_Lenght - LEN(t$))
  87.             IF LEN(t$) > TXT_Lenght THEN t$ = LEFT$(t$, LEN(t$) - 3) + "..."
  88.             LOCATE R, Xposition: PRINT t$
  89.             R = R + 1
  90.         NEXT
  91.         IF i$ = CHR$(13) THEN ScrollBar = ch
  92.     LOOP
  94.  
Title: Re: Scroll Bar
Post by: TempodiBasic on September 20, 2019, 06:52:11 pm
Hi Petr
also this last code that you have posted shows on my Pc the same strange behaviour, but reading again your affirmation
Quote
Yeah, the wheel only works outside the dump column,
I can suppose that it is linked to the calculation of the position of the cursor of mouse  because it appears only if I point to the first row and the last row of ScrollingBox!
Title: Re: Scroll Bar
Post by: bplus on September 20, 2019, 07:52:14 pm
Quote from: TempodiBasic on September 20, 2019, 06:09:06 pm
Hi Bplus

in this your mod of Petr function for scrolling  you have set off the selection/highlight by pointer of the item pointed by cursor of mouse.

I find in wiki this example of scrolling with wheel of mouse that works like your mod, you must add just color to screen output and the selection highlighting

Code: QB64: [Select]
  1.  
  2. 'Code by Ted Weissgerber
  3. DIM Array$(100)
  4. LINE INPUT "Enter a file name with 100 or more lines of text: ", file$
  5. OPEN file$ FOR INPUT AS #1
  7.   inputcount = inputcount + 1
  8.   LINE INPUT #1, Array$(inputcount)
  9.   IF inputcount = 100 THEN EXIT DO
  11. FOR n = 1 TO 21: PRINT Array$(n): NEXT
  15.     IF row >= 0 THEN row = row + _MOUSEWHEEL ELSE row = 0  'prevent under scrolling
  16.     IF row > inputcount - 20 THEN row = inputcount - 20    'prevent over scrolling
  17.     IF prevrow <> row THEN 'look for a change in row value
  18.       IF row > 0 AND row <= inputcount - 20 THEN
  19.         CLS: LOCATE 2, 1
  20.         FOR n = row TO row + 20
  21.           PRINT Array$(n)
  22.         NEXT
  23.       END IF
  24.     END IF
  25.     prevrow = row 'store previous row value
  26.   LOOP
  27. LOOP UNTIL INKEY$ > ""  
  28.  

you can find it here http://qb64.org/wiki/MOUSEWHEEL (http://qb64.org/wiki/MOUSEWHEEL)

Hi TempodiBasic,

Reply #15 IS a mod of Petr's code, I added the ColoredLine Type and SayColor function and modified the display part in Petr's. And the code I first posted could have come from a mod of the Wiki example by Ted for mouse wheel.
Title: Re: Scroll Bar
Post by: Petr on September 21, 2019, 03:18:40 am
Hi TempodiBasic. Here is a slightly modified version, which I think will clearly show why it behaves so in the previous version. Here is added condition IF _MOUSEBUTTON (1), which ensures that the recalculation of the selection position is done only after left-clicking. Therefore, in this version, the mouse wheel responds throughout the list column range:
See row 42, 44.

Code: QB64: [Select]
  1. SCREEN _NEWIMAGE(500, 600, 256)
  2.  
  4.     Text AS STRING * 30
  5.     Water AS _UNSIGNED _BYTE
  7.  
  8.  
  9.  
  10. DIM Text(200) AS E
  11. FOR N = 0 TO 200
  12.     temperature = RND * 100
  13.     Text(N).Text = "Water temperature: " + STR$(temperature)
  14.     Text(N).Water = temperature
  16.  
  17.  
  18. height = 15 'list to 15 rows
  19. TXT_Lenght = 30
  20. XPosition = 10
  21. YPosition = 7
  22.  
  23.  
  24.  
  25. Value = ScrollBar(Text(), XPosition, YPosition, TXT_Lenght, height)
  26. PRINT "Selected:"; Value
  27.  
  28.  
  29.  
  30. FUNCTION ScrollBar (Text() AS E, Xposition, Yposition, TXT_Lenght, Height)
  31.     DO UNTIL DONE
  32.         i$ = UCASE$(INKEY$)
  33.         WHILE _MOUSEINPUT
  34.             mwh = _MOUSEWHEEL
  35.             ch = ch + mwh
  36.  
  37.  
  38.             Fx = _FONTWIDTH
  39.             Fy = _FONTHEIGHT
  40.             IF _MOUSEX >= Fx * Xposition AND _MOUSEX <= Fx * (Xposition + TXT_Lenght) THEN
  41.                 IF _MOUSEY >= Fy * Yposition AND _MOUSEY <= Fy * (Yposition + Height) THEN
  42.                     IF _MOUSEBUTTON(1) THEN '                                                                   THIS CONDITION
  43.                         ch = b + _CEIL((_MOUSEY - (Yposition * Fy)) / Fy)
  44.                     END IF '                                                                                     --------------
  45.                 END IF
  46.             END IF
  47.             IF _MOUSEBUTTON(1) THEN i$ = CHR$(13)
  48.         WEND
  49.  
  50.         IF i$ = "A" OR i$ = CHR$(0) + CHR$(72) THEN ch = ch - 1 '+Up
  51.         IF i$ = "Z" OR i$ = CHR$(0) + CHR$(80) THEN ch = ch + 1 '+Dn
  52.         IF i$ = CHR$(0) + CHR$(73) THEN ch = ch - Height 'PgUP
  53.         IF i$ = CHR$(0) + CHR$(81) THEN ch = ch + Height 'PgDN
  54.         IF i$ = CHR$(0) + CHR$(71) THEN ch = LBOUND(text) 'HOME
  55.         IF i$ = CHR$(0) + CHR$(79) THEN ch = UBOUND(text) 'END
  56.  
  57.         IF ch > Height + b THEN b = b + 1: e = e + 1
  58.         IF ch < e - Height THEN b = b - 1: e = e - 1
  59.  
  60.  
  61.         IF b > UBOUND(Text) THEN b = UBOUND(Text)
  62.         IF b < LBOUND(Text) THEN b = LBOUND(Text)
  63.         e = b + Height
  64.         IF e > UBOUND(Text) THEN e = UBOUND(Text): b = e - Height
  65.         IF e < LBOUND(text) THEN e = LBOUND(Text)
  66.  
  67.         IF ch < LBOUND(text) THEN ch = LBOUND(text)
  68.         IF ch > UBOUND(text) THEN ch = UBOUND(text)
  69.  
  70.         R = Yposition
  71.         BackgroundColor~& = 0
  72.  
  73.  
  74.         FOR Scroll = b TO e
  75.             SELECT CASE Text(Scroll).Water
  76.                 CASE 0 TO 20: ForegroundColor~& = 32
  77.                 CASE 20 TO 40: ForegroundColor~& = 52
  78.                 CASE 40 TO 60: ForegroundColor~& = 46
  79.                 CASE 60 TO 80: ForegroundColor~& = 36
  80.                 CASE IS > 80: ForegroundColor~& = 40
  81.             END SELECT
  82.  
  83.             IF Scroll = ch THEN bckc~& = 9: fore~& = ForegroundColor~& ELSE bckc~& = BackgroundColor~&: fore~& = ForegroundColor~&
  84.             COLOR fore~&, bckc~&
  85.             IF LEN(Text(Scroll).Text) > TXT_Lenght THEN t$ = LEFT$(Text(Scroll).Text, TXT_Lenght - 3) + "..." ELSE t$ = Text(Scroll).Text
  86.             t$ = t$ + SPACE$(TXT_Lenght - LEN(t$))
  87.             IF LEN(t$) > TXT_Lenght THEN t$ = LEFT$(t$, LEN(t$) - 3) + "..."
  88.             LOCATE R, Xposition: PRINT t$
  89.             R = R + 1
  90.         NEXT
  91.         IF i$ = CHR$(13) THEN ScrollBar = ch: DONE = 1
  92.     LOOP
  94.  
Title: Re: Scroll Bar
Post by: TempodiBasic on September 21, 2019, 06:33:10 am
Hi Petr
Yes I can affirm that this version has no conflict between pointer and wheel of mouse and
IMHO it is a great present to whom need a such performed task!

Thanks to share
Title: Re: Scroll Bar
Post by: Erum on September 21, 2019, 08:12:57 am
OK, I will make my question more clear.
You see, as I am a beginner with no special knowledge, my program is very basic with something like this:

CLS
myscreen$= _NEWIMAGE(1600, 800, 32)
SCREEN= myscreen$
INPUT "ENTER pH OF SOIL"; p
INPUT "ENTER TEMPERATURE IN FAHRENHEIT"; T
IF p >= 1 AND p < 4.5 AND T > 113 AND T < 134 THEN
    PRINT "pH IS TOO LOW AND TEMPERATURE IS TOO HIGH. CONTROL pH WITH HYDRATED LIMESTONE OR WOOD ASH (0.5 POUNDS OF HYDRATED LIMESTONE EVERY TEN SQUARE FOOT CAN INCREASE pH BY APPROXIMATELY ONE POINT.)"
ELSEIF p >= 1 AND p < 4.5 AND T < 32 THEN
    PRINT "BOTH pH AND TEMPERATURE ARE TOO LOW. CONTROL pH WITH HYDRATED LIMESTONE OR WOOD ASH (0.5 POUNDS OF HYDRATED LIMESTONE EVERY TEN SQUARE FOOT CAN INCREASE pH BY APPROXIMATELY ONE POINT.)"
ELSEIF p > 8.4 AND p <= 14 AND T > 113 AND T <= 134 THEN
    PRINT "BOTH pH AND TEMPERATURE ARE TOO HIGH. CONTROL pH WITH ORGANIC MATTER ( PEAT MOSS), ALUMINIUM SULPHATE, OR SULPHUR (1.2 POUNDS OF ALUMINIUM SULPHATE OR 0.2 POUNDS OF SULPHUR EVERY TEN SQUARE FOOT CAN LOWER pH BY APPROXIMATELY ONE POINT.)"
ELSEIF p > 8.4 AND p < 14 AND T < 32 THEN
    PRINT "pH IS TOO HIGH AND TEMPERATURE IS TOO LOW. CONTROL pH WITH ORAGNIC MATTER LIKE PEAT MOSS, ALUMINIUM SULPHATE, OR SULPHUR (1.2 POUNDS OF ALUMINIUM SULPHATE OR 0.2 POUNDS OF SULPHUR EVRY TEN SQUARE FOOT CAN LOWER pH BY APPROXIMATELY ONE POINT.)"
ELSEIF p >= 4.5 AND p <= 8.4 AND T > 113 AND T < 134 THEN
    PRINT "TEMPERATURE IS TOO HIGH."
ELSEIF p >= 4.5 AND p <= 8.4 AND T < 32 THEN
    PRINT "TEMPERATURE IS TOO LOW."
ELSEIF p <= 14 AND p > 8.4 AND T >= 32 AND T <= 113 THEN
    PRINT "pH IS TOO HIGH. CONTROL IT USING HYDRATED LIMESTONE OR WOOD ASH. (0.5 POUNDS OF HYDRATED LIMESTONE EVERY TEN SQUARE FOOT WILL INCREASE pH BY APPROXIMATELY ONE POINT.)"
ELSEIF p >= 1 AND p < 4.5 AND T >= 32 AND T < 134 THEN
    PRINT "pH IS TOO LOW. CONTROL pH USING HYDRATED LIMETONE OR WOOD ASH (0.5 POUNDS OF HYDRATED LIMESTONE EVERY TEN SQUARE FOOT WILL INCREASE pH BY APPROXIMATELY ONE POINT.)"
ELSEIF p < 1 OR p > 14 AND T > 134 THEN
    PRINT "PLEASE ENTER VALID VALUES."
ELSEIF p >= 1 AND p <= 14 AND T > 134 THEN
    PRINT "ENTER VALID TEMPERATURE VALUE."
ELSEIF p < 1 OR p > 14 AND T <= 134 THEN
    PRINT "ENTER VALID pH VALUE."
ELSEIF T >= 32 AND T <= 50 AND p >= 4.5 AND p <= 5 THEN
    PRINT "PLANTS THAT WILL GROW BEST IN THESE CONDITIONS:"
    PRINT "1.ENGLISH OAK (TREE):"
    PRINT "WATER: SEEDLING:KEEP SOIL WET. YOUNG:1.5 GALLONS A DAY. MATURE:CAN DRAW 50 GALLONS."
    PRINT "FERTILIZER: DON'T USE TILL 2 YEARS OLD. WHEN MATURE, USE 12-6-6 OR 12-4-8 FERTILIZER ANNUALLY (16.6 POUNDS EVERY 1000 SQUARE FEET.)"
    PRINT "DISTANCE: PLANT 25 FEET APART. TEMPERATURE: 32-92 F. pH:4.5-5.0."
    PRINT "SUNLIGHT:HIGH(6-8 HOURS A DAY). MOISTURE PERCENT: MODERATE (21-40%)"
    PRINT
    PRINT "2.PAPER BIRCH (TREE):"
    PRINT "WATER: YOUNG: LET WATER RUN FROM HOSE FOR 30 SEC EVERY 2 WEEKS. MATURE:KEEP SOIL WET 10INCH DEEP."
    PRINT "FERTILIZER: USE 11-22-22 FERTILIZER ANNUALLY AND COVER SOIL WELL. WHEN MATURE, FERTILIZE ONLY WHEN DEFFIECENCY NOTED."
    PRINT "DISTANCE:PLANT 25 FT APART. TEMPERATURE:32-113 F pH:4.5-8.4"
    PRINT "SUNLIGHT: HIGH (6-8 HOURS A DAY). MOISTURE PERCENT: MODERATE (21-40%)"
    PRINT
    PRINT "3.AZALEAS (FLOWERS):"
    PRINT "WATER:4 GALLONS PER SQUARE METRE EVERY 2 WEEKS."
    PRINT "FERTILIZER:USE 10-10-10 FERTILIZER 2-3 TIMES A YEAR."
    PRINT "DISTANCE:PLANT 2 FEET APART. TEMPERATURE:32-76 F. pH:4.5-5.0."
    PRINT "SUNLIGHT: SUNNY TO PARTIAL (HIGH-MED). MOISTURE PERCENT: OPTIMUM 41-60%"
    PRINT
    PRINT "NOTE 1. FERTILIZER FORMULAS STATED SHOW THE PROPORTION OF NITROGEN-PHOSPHORUS-POTASSIUM RESPECTIVELY."
    PRINT "NOTE 2:PLANTS NEED WELL DRAINING AND NOURISHED SOIL AND BEST CO2 AMOUNT FOR THEM IS 1000-1500 PPM (PARTS PER MILLION)"
    PRINT "NOTE 3:INSTEAD OF NPK FERTILIZER YOU CAN USE THESE IN THE PROPORTION YOU REQUIRE:"
    PRINT "COFFEE GROUNDS,BLOOD MEAL, AND COTTON SEED MEAL FOR NITROGEN"
    PRINT "FISH BONE MEAL, STEAMED BONE MEAL, AND ROCK DUST FOR PHOSPHORUS"
    PRINT "KELP MEAL, HARDWOOD ASH, AND GREEN ORGANIC MATERIAL FOR POTASSIUM"

You see, I want to add colours to my program on each line that is printed (each line must have a different background and foreground colour). The colour statements on each line are not working when nested in if-then-else statements., so I want to ask if there is another way of doing this. Also, in some conditions, the amount of best suited plants is quite large, and they all are not fitting on the screen. For that, I need a scroll bar.
Hope you all clearly understand and will do an immense favour by helping me again.
Regards.
Title: Re: Scroll Bar
Post by: TempodiBasic on September 21, 2019, 08:21:50 am
Hi Bplus

you're showing complete Reference pages of your posts!
while I was thinking that I had found a third way to do scrolling in wiki page and to not appear to be mine that code I put as first line the author.
I need better glasses !

Title: Re: Scroll Bar
Post by: bplus on September 21, 2019, 09:28:15 am
Hi Erum,

You can CLS and control COLOR before each and every PRINT statement even when they are inside an IF block.

If you have a block of text to present that does not fit your screen then the little scroller I showed would work fine, you need to set up an array to hold the text, lets call it tempText$() how many lines? 50?

DIM tempText$(1 to 50)
tempText$(1) = "This is line #1 of tempText$()."
tempText$(2) = "This is second line to display."...
continue on to fill up tempText

another way is to put all the lines in DATA statements and READ the lines into tempText$()


Oh heck here is your code rewritten:
Code: QB64: [Select]
  1.  
  2. SCREEN _NEWIMAGE(800, 700, 32) ' <<<< 32 here means you are using RGB and aplha colors _RGB32(red , green, blue)
  3.  
  4. 'set color then CLS so entire background is same
  5. COLOR _RGB32(100, 100, 255), _RGB32(0, 0, 120) ' <<< light blueish ink on dark blue paper
  6. CLS 'so now entire background is dark blue paper
  7.  
  8. INPUT "ENTER pH OF SOIL"; p
  9. INPUT "ENTER TEMPERATURE IN FAHRENHEIT"; T
  10.  
  11. IF p >= 1 AND p < 4.5 AND T > 113 AND T < 134 THEN
  12.     PRINT "pH IS TOO LOW AND TEMPERATURE IS TOO HIGH. CONTROL pH WITH HYDRATED LIMESTONE OR WOOD ASH (0.5 POUNDS OF HYDRATED LIMESTONE EVERY TEN SQUARE FOOT CAN INCREASE pH BY APPROXIMATELY ONE POINT.)"
  13. ELSEIF p >= 1 AND p < 4.5 AND T < 32 THEN
  14.     PRINT "BOTH pH AND TEMPERATURE ARE TOO LOW. CONTROL pH WITH HYDRATED LIMESTONE OR WOOD ASH (0.5 POUNDS OF HYDRATED LIMESTONE EVERY TEN SQUARE FOOT CAN INCREASE pH BY APPROXIMATELY ONE POINT.)"
  15. ELSEIF p > 8.4 AND p <= 14 AND T > 113 AND T <= 134 THEN
  16.     PRINT "BOTH pH AND TEMPERATURE ARE TOO HIGH. CONTROL pH WITH ORGANIC MATTER ( PEAT MOSS), ALUMINIUM SULPHATE, OR SULPHUR (1.2 POUNDS OF ALUMINIUM SULPHATE OR 0.2 POUNDS OF SULPHUR EVERY TEN SQUARE FOOT CAN LOWER pH BY APPROXIMATELY ONE POINT.)"
  17. ELSEIF p > 8.4 AND p < 14 AND T < 32 THEN
  18.     PRINT "pH IS TOO HIGH AND TEMPERATURE IS TOO LOW. CONTROL pH WITH ORAGNIC MATTER LIKE PEAT MOSS, ALUMINIUM SULPHATE, OR SULPHUR (1.2 POUNDS OF ALUMINIUM SULPHATE OR 0.2 POUNDS OF SULPHUR EVRY TEN SQUARE FOOT CAN LOWER pH BY APPROXIMATELY ONE POINT.)"
  19. ELSEIF p >= 4.5 AND p <= 8.4 AND T > 113 AND T < 134 THEN
  20.     PRINT "TEMPERATURE IS TOO HIGH."
  21. ELSEIF p >= 4.5 AND p <= 8.4 AND T < 32 THEN
  22.     PRINT "TEMPERATURE IS TOO LOW."
  23. ELSEIF p <= 14 AND p > 8.4 AND T >= 32 AND T <= 113 THEN
  24.     PRINT "pH IS TOO HIGH. CONTROL IT USING HYDRATED LIMESTONE OR WOOD ASH. (0.5 POUNDS OF HYDRATED LIMESTONE EVERY TEN SQUARE FOOT WILL INCREASE pH BY APPROXIMATELY ONE POINT.)"
  25. ELSEIF p >= 1 AND p < 4.5 AND T >= 32 AND T < 134 THEN
  26.     PRINT "pH IS TOO LOW. CONTROL pH USING HYDRATED LIMETONE OR WOOD ASH (0.5 POUNDS OF HYDRATED LIMESTONE EVERY TEN SQUARE FOOT WILL INCREASE pH BY APPROXIMATELY ONE POINT.)"
  27. ELSEIF p < 1 OR p > 14 AND T > 134 THEN
  28.     PRINT "PLEASE ENTER VALID VALUES."
  29. ELSEIF p >= 1 AND p <= 14 AND T > 134 THEN
  30.     PRINT "ENTER VALID TEMPERATURE VALUE."
  31. ELSEIF p < 1 OR p > 14 AND T <= 134 THEN
  32.     PRINT "ENTER VALID pH VALUE."
  33. ELSEIF T >= 32 AND T <= 50 AND p >= 4.5 AND p <= 5 THEN
  34.     PRINT "PLANTS THAT WILL GROW BEST IN THESE CONDITIONS:"
  35.     COLOR _RGB32(255, 255, 255)
  36.     PRINT "1.ENGLISH OAK (TREE):"
  37.     PRINT "WATER: SEEDLING:KEEP SOIL WET. YOUNG:1.5 GALLONS A DAY. MATURE:CAN DRAW 50 GALLONS."
  38.     PRINT "FERTILIZER: DON'T USE TILL 2 YEARS OLD. WHEN MATURE, USE 12-6-6 OR 12-4-8 FERTILIZER ANNUALLY (16.6 POUNDS EVERY 1000 SQUARE FEET.)"
  39.     PRINT "DISTANCE: PLANT 25 FEET APART. TEMPERATURE: 32-92 F. pH:4.5-5.0."
  40.     PRINT "SUNLIGHT:HIGH(6-8 HOURS A DAY). MOISTURE PERCENT: MODERATE (21-40%)"
  41.     PRINT
  42.     COLOR _RGB32(0, 180, 0)
  43.     PRINT "2.PAPER BIRCH (TREE):"
  44.     PRINT "WATER: YOUNG: LET WATER RUN FROM HOSE FOR 30 SEC EVERY 2 WEEKS. MATURE:KEEP SOIL WET 10INCH DEEP."
  45.     PRINT "FERTILIZER: USE 11-22-22 FERTILIZER ANNUALLY AND COVER SOIL WELL. WHEN MATURE, FERTILIZE ONLY WHEN DEFFIECENCY NOTED."
  46.     PRINT "DISTANCE:PLANT 25 FT APART. TEMPERATURE:32-113 F pH:4.5-8.4"
  47.     PRINT "SUNLIGHT: HIGH (6-8 HOURS A DAY). MOISTURE PERCENT: MODERATE (21-40%)"
  48.     PRINT
  49.     COLOR _RGB32(255, 255, 0)
  50.     PRINT "3.AZALEAS (FLOWERS):"
  51.     PRINT "WATER:4 GALLONS PER SQUARE METRE EVERY 2 WEEKS."
  52.     PRINT "FERTILIZER:USE 10-10-10 FERTILIZER 2-3 TIMES A YEAR."
  53.     PRINT "DISTANCE:PLANT 2 FEET APART. TEMPERATURE:32-76 F. pH:4.5-5.0."
  54.     PRINT "SUNLIGHT: SUNNY TO PARTIAL (HIGH-MED). MOISTURE PERCENT: OPTIMUM 41-60%"
  55.     PRINT
  56.     COLOR _RGB32(200, 0, 100)
  57.     PRINT "NOTE 1. FERTILIZER FORMULAS STATED SHOW THE PROPORTION OF NITROGEN-PHOSPHORUS-POTASSIUM RESPECTIVELY."
  58.     PRINT "NOTE 2:PLANTS NEED WELL DRAINING AND NOURISHED SOIL AND BEST CO2 AMOUNT FOR THEM IS 1000-1500 PPM (PARTS PER MILLION)"
  59.     PRINT "NOTE 3:INSTEAD OF NPK FERTILIZER YOU CAN USE THESE IN THE PROPORTION YOU REQUIRE:"
  60.     PRINT "COFFEE GROUNDS,BLOOD MEAL, AND COTTON SEED MEAL FOR NITROGEN"
  61.     PRINT "FISH BONE MEAL, STEAMED BONE MEAL, AND ROCK DUST FOR PHOSPHORUS"
  62.     PRINT "KELP MEAL, HARDWOOD ASH, AND GREEN ORGANIC MATERIAL FOR POTASSIUM"
  64.  
  65.  

To do scrolling = display of more that a screen worth of information, will take 'special knowledge' over and above basic CLS and COLOR statements because you will need mouse functions and arrays to hold text.

But if you could limit all info pages to one screen size or less, you could offer a menu to each page and then come back to main menu to allow selection of another page. All the commands you would need are CLS, COLOR, PRINT, and INPUT, you could use an IF THEN ELSEIF ENDIF block or SELECT CASE block. Maybe just your level of coding.
Title: Re: Scroll Bar
Post by: Erum on September 21, 2019, 10:20:55 am
Respected bplus,
Could you please tell me the code for just a scroll bar? That would be a big help. I would do a detailed study on that code later.
Regards.
Title: Re: Scroll Bar
Post by: TempodiBasic on September 21, 2019, 10:33:16 am
Hi Erum
about your issue I think you have so many to evaluate and then to adapt to your specific goal.

Quote
' Today more than yesterday programming is problem solving so
' a good programmer is a good problem solver that speaks some programming languages
so before write QB64code  you must plan the structure of the program, you must define the items or the objects of the program and how they interact among themselves or what is their behaviour, just after this  you can think how to translate all these things into a programming language (just QB64 here). IMHO only the translation depends about how you know of that language and tips for that language.

Here my little feedback about your piece of code:
IF data to show are a mess maybe that you can manage well the data to show using files. So , if you need, you can change also the data without rewrite the program! (see Bplus suggestions!)

you can build a SUB that works following your needs for printing using PRINT or _PRINTSTRING plus COLOR to set background (paper) and foreground (ink)
Bplus and Steve have made many example in the forum! Search and get solutions!

here  my mod for  more readably (I hope so ):
Code: QB64: [Select]
  1. ' Bplus suggestion
  2. SCREEN _NEWIMAGE(1600, 800, 32) ' <<<< 32 here means you are using RGB and aplha colors _RGB32(red , green, blue)
  3.  
  4. 'set color then CLS so entire background is same
  5. COLOR _RGB32(100, 100, 255), _RGB32(0, 0, 120) ' <<< light blueish ink on dark blue paper
  6. CLS 'so now entire background is dark blue paper
  7.  
  8. ' input data
  9. INPUT "ENTER pH OF SOIL"; p
  10. INPUT "ENTER TEMPERATURE IN FAHRENHEIT"; T
  11.  
  12. 'reducing the forest     TDB
  13. ' IF you use NESTED if..then..else..end if
  14. ' and not CHAINED if..then..else..end if
  15. ' the code can be more readable for humans :-)
  16. ' Today more than yesterday programming is problem solving so
  17. ' a good programmer is a good problem solver that speaks some programming languages
  18.  
  19. 'analizer  of input and giver of output
  20. IF p >= 1 AND p < 4.5 THEN
  21.     'p >= 1 AND p < 4.5 AND <-- seems the same
  22.     IF T > 113 AND T < 134 THEN
  23.         PRINT "pH IS TOO LOW AND TEMPERATURE IS TOO HIGH. CONTROL pH WITH HYDRATED LIMESTONE OR WOOD ASH (0.5 POUNDS OF HYDRATED LIMESTONE EVERY TEN SQUARE FOOT CAN INCREASE pH BY APPROXIMATELY ONE POINT.)"
  24.     ELSEIF T < 32 THEN
  25.         PRINT "BOTH pH AND TEMPERATURE ARE TOO LOW. CONTROL pH WITH HYDRATED LIMESTONE OR WOOD ASH (0.5 POUNDS OF HYDRATED LIMESTONE EVERY TEN SQUARE FOOT CAN INCREASE pH BY APPROXIMATELY ONE POINT.)"
  26.     ELSEIF T >= 32 AND T < 134 THEN
  27.         PRINT "pH IS TOO LOW. CONTROL pH USING HYDRATED LIMETONE OR WOOD ASH (0.5 POUNDS OF HYDRATED LIMESTONE EVERY TEN SQUARE FOOT WILL INCREASE pH BY APPROXIMATELY ONE POINT.)"
  28.     END IF
  29.     '    IF p >= 1 AND p < 4.5 AND is the same condition of previous IF
  30. ELSEIF p > 8.4 AND p <= 14 THEN
  31.     'IF p > 8.4 AND p < 14 AND <-- seems the same
  32.     ' p <= 14 AND p > 8.4 AND  <-- seems the same
  33.     IF T > 113 AND T <= 134 THEN
  34.         PRINT "BOTH pH AND TEMPERATURE ARE TOO HIGH. CONTROL pH WITH ORGANIC MATTER ( PEAT MOSS), ALUMINIUM SULPHATE, OR SULPHUR (1.2 POUNDS OF ALUMINIUM SULPHATE OR 0.2 POUNDS OF SULPHUR EVERY TEN SQUARE FOOT CAN LOWER pH BY APPROXIMATELY ONE POINT.)"
  35.     ELSEIF T < 32 THEN
  36.         PRINT "pH IS TOO HIGH AND TEMPERATURE IS TOO LOW. CONTROL pH WITH ORAGNIC MATTER LIKE PEAT MOSS, ALUMINIUM SULPHATE, OR SULPHUR (1.2 POUNDS OF ALUMINIUM SULPHATE OR 0.2 POUNDS OF SULPHUR EVRY TEN SQUARE FOOT CAN LOWER pH BY APPROXIMATELY ONE POINT.)"
  37.     ELSEIF T >= 32 AND T <= 113 THEN
  38.         PRINT "pH IS TOO HIGH. CONTROL IT USING HYDRATED LIMESTONE OR WOOD ASH. (0.5 POUNDS OF HYDRATED LIMESTONE EVERY TEN SQUARE FOOT WILL INCREASE pH BY APPROXIMATELY ONE POINT.)"
  39.     END IF
  40. ELSEIF p >= 4.5 AND p <= 8.4 THEN
  41.     'p >= 4.5 AND p <= 8.4 AND  <-- seems the same
  42.     IF T > 113 AND T < 134 THEN
  43.         PRINT "TEMPERATURE IS TOO HIGH."
  44.     ELSEIF T < 32 THEN
  45.         PRINT "TEMPERATURE IS TOO LOW."
  46.     END IF
  47.     'ELSEIF p < 1 OR p > 14 AND T > 134 THEN   <-- redundant
  48.     '    PRINT "PLEASE ENTER VALID VALUES."    <-- redundant
  49. ELSEIF T > 134 THEN
  50.     PRINT "ENTER VALID TEMPERATURE VALUE."
  51. ELSEIF p < 1 OR p > 14 THEN
  52.     PRINT "ENTER VALID pH VALUE."
  53. ELSEIF T >= 32 AND T <= 50 AND p >= 4.5 AND p <= 5 THEN ' this appears to be a subrange of the last range
  54.     PRINT "PLANTS THAT WILL GROW BEST IN THESE CONDITIONS:"
  55.     PRINT "1.ENGLISH OAK (TREE):"
  56.     PRINT "WATER: SEEDLING:KEEP SOIL WET. YOUNG:1.5 GALLONS A DAY. MATURE:CAN DRAW 50 GALLONS."
  57.     PRINT "FERTILIZER: DON'T USE TILL 2 YEARS OLD. WHEN MATURE, USE 12-6-6 OR 12-4-8 FERTILIZER ANNUALLY (16.6 POUNDS EVERY 1000 SQUARE FEET.)"
  58.     PRINT "DISTANCE: PLANT 25 FEET APART. TEMPERATURE: 32-92 F. pH:4.5-5.0."
  59.     PRINT "SUNLIGHT:HIGH(6-8 HOURS A DAY). MOISTURE PERCENT: MODERATE (21-40%)"
  60.     PRINT
  61.     PRINT "2.PAPER BIRCH (TREE):"
  62.     PRINT "WATER: YOUNG: LET WATER RUN FROM HOSE FOR 30 SEC EVERY 2 WEEKS. MATURE:KEEP SOIL WET 10INCH DEEP."
  63.     PRINT "FERTILIZER: USE 11-22-22 FERTILIZER ANNUALLY AND COVER SOIL WELL. WHEN MATURE, FERTILIZE ONLY WHEN DEFFIECENCY NOTED."
  64.     PRINT "DISTANCE:PLANT 25 FT APART. TEMPERATURE:32-113 F pH:4.5-8.4"
  65.     PRINT "SUNLIGHT: HIGH (6-8 HOURS A DAY). MOISTURE PERCENT: MODERATE (21-40%)"
  66.     PRINT
  67.     PRINT "3.AZALEAS (FLOWERS):"
  68.     PRINT "WATER:4 GALLONS PER SQUARE METRE EVERY 2 WEEKS."
  69.     PRINT "FERTILIZER:USE 10-10-10 FERTILIZER 2-3 TIMES A YEAR."
  70.     PRINT "DISTANCE:PLANT 2 FEET APART. TEMPERATURE:32-76 F. pH:4.5-5.0."
  71.     PRINT "SUNLIGHT: SUNNY TO PARTIAL (HIGH-MED). MOISTURE PERCENT: OPTIMUM 41-60%"
  72.     PRINT
  73.     PRINT "NOTE 1. FERTILIZER FORMULAS STATED SHOW THE PROPORTION OF NITROGEN-PHOSPHORUS-POTASSIUM RESPECTIVELY."
  74.     PRINT "NOTE 2:PLANTS NEED WELL DRAINING AND NOURISHED SOIL AND BEST CO2 AMOUNT FOR THEM IS 1000-1500 PPM (PARTS PER MILLION)"
  75.     PRINT "NOTE 3:INSTEAD OF NPK FERTILIZER YOU CAN USE THESE IN THE PROPORTION YOU REQUIRE:"
  76.     PRINT "COFFEE GROUNDS,BLOOD MEAL, AND COTTON SEED MEAL FOR NITROGEN"
  77.     PRINT "FISH BONE MEAL, STEAMED BONE MEAL, AND ROCK DUST FOR PHOSPHORUS"
  78.     PRINT "KELP MEAL, HARDWOOD ASH, AND GREEN ORGANIC MATERIAL FOR POTASSIUM"

For scrolling
you must load all strings to scroll into an array and pass it to the SUB/Function of scrolling!
Good Luck
Title: Re: Scroll Bar
Post by: bplus on September 21, 2019, 10:39:23 am
Quote from: Erum on September 21, 2019, 10:20:55 am
Respected bplus,
Could you please tell me the code for just a scroll bar? That would be a big help. I would do a detailed study on that code later.
Regards.

Steve posted code that uses actual scroll bars but I suspect it is way over your head, for some strange reason he does not use normal arrow keys, pg keys... and mouse wheel?

As TempodiBasic said,
Quote
For scrolling
you must load all strings to scroll into an array and pass it to the SUB/Function of scrolling!
Good Luck

Here is menu made from your code you might be able to understand, that sort of does what you want:

Code: QB64: [Select]
  1. SCREEN _NEWIMAGE(800, 700, 32) ' <<<< 32 here means you are using RGB and aplha colors _RGB32(red , green, blue)
  2.  
  4.     'set color then CLS so entire background is same
  5.     COLOR _RGB32(200, 200, 255), _RGB32(0, 0, 120) ' <<< light blueish ink on dark blue paper
  6.     CLS 'so now entire background is dark blue paper
  7.  
  8.     _KEYCLEAR ' need to clear last key press  so first input is not skipped
  9.  
  10.  
  11.     INPUT "ENTER pH OF SOIL"; p
  12.     INPUT "ENTER TEMPERATURE IN FAHRENHEIT"; T
  13.  
  14.     IF p >= 1 AND p < 4.5 AND T > 113 AND T < 134 THEN
  15.         PRINT "pH IS TOO LOW AND TEMPERATURE IS TOO HIGH. CONTROL pH WITH HYDRATED LIMESTONE OR WOOD ASH (0.5 POUNDS OF HYDRATED LIMESTONE EVERY TEN SQUARE FOOT CAN INCREASE pH BY APPROXIMATELY ONE POINT.)"
  16.         PRINT: PRINT "Press any to continue... ": SLEEP
  17.     ELSEIF p >= 1 AND p < 4.5 AND T < 32 THEN
  18.         PRINT "BOTH pH AND TEMPERATURE ARE TOO LOW. CONTROL pH WITH HYDRATED LIMESTONE OR WOOD ASH (0.5 POUNDS OF HYDRATED LIMESTONE EVERY TEN SQUARE FOOT CAN INCREASE pH BY APPROXIMATELY ONE POINT.)"
  19.         PRINT: PRINT "Press any to continue... ": SLEEP
  20.     ELSEIF p > 8.4 AND p <= 14 AND T > 113 AND T <= 134 THEN
  21.         PRINT "BOTH pH AND TEMPERATURE ARE TOO HIGH. CONTROL pH WITH ORGANIC MATTER ( PEAT MOSS), ALUMINIUM SULPHATE, OR SULPHUR (1.2 POUNDS OF ALUMINIUM SULPHATE OR 0.2 POUNDS OF SULPHUR EVERY TEN SQUARE FOOT CAN LOWER pH BY APPROXIMATELY ONE POINT.)"
  22.         PRINT: PRINT "Press any to continue... ": SLEEP
  23.     ELSEIF p > 8.4 AND p < 14 AND T < 32 THEN
  24.         PRINT "pH IS TOO HIGH AND TEMPERATURE IS TOO LOW. CONTROL pH WITH ORAGNIC MATTER LIKE PEAT MOSS, ALUMINIUM SULPHATE, OR SULPHUR (1.2 POUNDS OF ALUMINIUM SULPHATE OR 0.2 POUNDS OF SULPHUR EVRY TEN SQUARE FOOT CAN LOWER pH BY APPROXIMATELY ONE POINT.)"
  25.         PRINT: PRINT "Press any to continue... ": SLEEP
  26.     ELSEIF p >= 4.5 AND p <= 8.4 AND T > 113 AND T < 134 THEN
  27.         PRINT "TEMPERATURE IS TOO HIGH."
  28.         PRINT: PRINT "Press any to continue... ": SLEEP
  29.     ELSEIF p >= 4.5 AND p <= 8.4 AND T < 32 THEN
  30.         PRINT "TEMPERATURE IS TOO LOW."
  31.         PRINT: PRINT "Press any to continue... ": SLEEP
  32.     ELSEIF p <= 14 AND p > 8.4 AND T >= 32 AND T <= 113 THEN
  33.         PRINT "pH IS TOO HIGH. CONTROL IT USING HYDRATED LIMESTONE OR WOOD ASH. (0.5 POUNDS OF HYDRATED LIMESTONE EVERY TEN SQUARE FOOT WILL INCREASE pH BY APPROXIMATELY ONE POINT.)"
  34.         PRINT: PRINT "Press any to continue... ": SLEEP
  35.     ELSEIF p >= 1 AND p < 4.5 AND T >= 32 AND T < 134 THEN
  36.         PRINT "pH IS TOO LOW. CONTROL pH USING HYDRATED LIMETONE OR WOOD ASH (0.5 POUNDS OF HYDRATED LIMESTONE EVERY TEN SQUARE FOOT WILL INCREASE pH BY APPROXIMATELY ONE POINT.)"
  37.         PRINT: PRINT "Press any to continue... ": SLEEP
  38.     ELSEIF p < 1 OR p > 14 AND T > 134 THEN
  39.         PRINT "PLEASE ENTER VALID VALUES."
  40.         PRINT: PRINT "Press any to continue... ": SLEEP
  41.     ELSEIF p >= 1 AND p <= 14 AND T > 134 THEN
  42.         PRINT "ENTER VALID TEMPERATURE VALUE."
  43.         PRINT: PRINT "Press any to continue... ": SLEEP
  44.     ELSEIF p < 1 OR p > 14 AND T <= 134 THEN
  45.         PRINT "ENTER VALID pH VALUE."
  46.         PRINT: PRINT "Press any to continue... ": SLEEP
  47.     ELSEIF T >= 32 AND T <= 50 AND p >= 4.5 AND p <= 5 THEN
  48.         DO
  49.             'set color then CLS so entire background is same
  50.             COLOR _RGB32(200, 200, 255), _RGB32(0, 0, 120)
  51.             CLS
  52.             PRINT "PLANTS THAT WILL GROW BEST IN THESE CONDITIONS:"
  53.             PRINT "Menu:"
  54.             PRINT "1 ENGLISH OAK (TREE):"
  55.             PRINT "2 PAPER BIRCH (TREE):"
  56.             PRINT "3 AZALEAS (FLOWERS):"
  57.             PRINT "4 More Notes"
  58.             PRINT "5 Quit Menu"
  59.             PRINT
  60.             INPUT "Please enter your number choice "; choice
  61.             SELECT CASE choice
  62.                 CASE 1
  63.                     'set color then CLS so entire background is same
  64.                     COLOR _RGB32(128, 64, 32), _RGB32(255, 200, 100)
  65.                     CLS
  66.                     PRINT
  67.                     PRINT "1.ENGLISH OAK (TREE):"
  68.                     PRINT "WATER: SEEDLING:KEEP SOIL WET. YOUNG:1.5 GALLONS A DAY. MATURE:CAN DRAW 50 GALLONS."
  69.                     PRINT "FERTILIZER: DON'T USE TILL 2 YEARS OLD. WHEN MATURE, USE 12-6-6 OR 12-4-8 FERTILIZER ANNUALLY (16.6 POUNDS EVERY 1000 SQUARE FEET.)"
  70.                     PRINT "DISTANCE: PLANT 25 FEET APART. TEMPERATURE: 32-92 F. pH:4.5-5.0."
  71.                     PRINT "SUNLIGHT:HIGH(6-8 HOURS A DAY). MOISTURE PERCENT: MODERATE (21-40%)"
  72.                     PRINT
  73.                     PRINT "press any to continue... "
  74.                     SLEEP
  75.  
  76.                 CASE 2
  77.                     'set color then CLS so entire background is same
  78.                     COLOR _RGB32(0, 64, 0), _RGB32(100, 100, 255)
  79.                     CLS
  80.                     PRINT "2.PAPER BIRCH (TREE):"
  81.                     PRINT "WATER: YOUNG: LET WATER RUN FROM HOSE FOR 30 SEC EVERY 2 WEEKS. MATURE:KEEP SOIL WET 10INCH DEEP."
  82.                     PRINT "FERTILIZER: USE 11-22-22 FERTILIZER ANNUALLY AND COVER SOIL WELL. WHEN MATURE, FERTILIZE ONLY WHEN DEFFIECENCY NOTED."
  83.                     PRINT "DISTANCE:PLANT 25 FT APART. TEMPERATURE:32-113 F pH:4.5-8.4"
  84.                     PRINT "SUNLIGHT: HIGH (6-8 HOURS A DAY). MOISTURE PERCENT: MODERATE (21-40%)"
  85.                     PRINT
  86.                     PRINT "press any to continue... "
  87.                     SLEEP
  88.  
  89.                 CASE 3
  90.                     'set color then CLS so entire background is same
  91.                     COLOR _RGB32(255, 255, 0), _RGB32(0, 0, 100)
  92.                     CLS
  93.                     PRINT "3.AZALEAS (FLOWERS):"
  94.                     PRINT "WATER:4 GALLONS PER SQUARE METRE EVERY 2 WEEKS."
  95.                     PRINT "FERTILIZER:USE 10-10-10 FERTILIZER 2-3 TIMES A YEAR."
  96.                     PRINT "DISTANCE:PLANT 2 FEET APART. TEMPERATURE:32-76 F. pH:4.5-5.0."
  97.                     PRINT "SUNLIGHT: SUNNY TO PARTIAL (HIGH-MED). MOISTURE PERCENT: OPTIMUM 41-60%"
  98.                     PRINT
  99.                     PRINT "press any to continue... "
  100.                     SLEEP
  101.  
  102.                 CASE 4
  103.                     'set color then CLS so entire background is same
  104.                     COLOR _RGB32(200, 200, 255), _RGB32(60, 0, 60)
  105.                     CLS
  106.                     PRINT "NOTE 1. FERTILIZER FORMULAS STATED SHOW THE PROPORTION OF NITROGEN-PHOSPHORUS-POTASSIUM RESPECTIVELY."
  107.                     PRINT "NOTE 2:PLANTS NEED WELL DRAINING AND NOURISHED SOIL AND BEST CO2 AMOUNT FOR THEM IS 1000-1500 PPM (PARTS PER MILLION)"
  108.                     PRINT "NOTE 3:INSTEAD OF NPK FERTILIZER YOU CAN USE THESE IN THE PROPORTION YOU REQUIRE:"
  109.                     PRINT "COFFEE GROUNDS,BLOOD MEAL, AND COTTON SEED MEAL FOR NITROGEN"
  110.                     PRINT "FISH BONE MEAL, STEAMED BONE MEAL, AND ROCK DUST FOR PHOSPHORUS"
  111.                     PRINT "KELP MEAL, HARDWOOD ASH, AND GREEN ORGANIC MATERIAL FOR POTASSIUM"
  112.                     PRINT
  113.                     PRINT "press any to continue... "
  114.                     SLEEP
  115.  
  116.             END SELECT
  117.  
  118.         LOOP UNTIL choice = 5
  119.     END IF
  121.  
Title: Re: Scroll Bar
Post by: Erum on September 21, 2019, 10:41:13 am
Respected TempodiBasic,
I know I am annoying all the experts like you with my dumbness ;) Thank you for that kind and enlightening reply. I guess that coding for scroll bar is going to take a bit of studying and research. Thanks.
Regards.
Title: Re: Scroll Bar
Post by: Erum on September 21, 2019, 10:45:36 am
Respected bplus,
Thank you for that reply. You did a great job helping a dummy like me, as I said Iam a ninth grader and the only BASIC I learnt was from the chapter 'basics of BASIC." ;) I completely understand the select case syntax and I think I might use that. Thanks again.
Regards.
Title: Re: Scroll Bar
Post by: bplus on September 21, 2019, 10:58:13 am
Hi Erum,

I have some advice on the inputs of pH and temperature:

If you handle all the issues of pH First! and then only INPUT temperature after the pH is in range, it might be easier to code and follow the code, instead of having to handle all possible cases of pH AND temperature together.

Just advice take it or leave it :)
Title: Re: Scroll Bar
Post by: Petr on September 21, 2019, 02:00:27 pm
Hi Erum. I try writing for you something tomorrow. I thing, something easy as is PRINT use, but with output to screen area which allow text shift up/down/left/right. Here is psedocode + image how i think it, if it is, what you need:

PseudoCode:

BoxPrint "This is very long text, which i need shifting in text area on the screen and which not allow edit this text. This is very long text, which i need shifting in text area on the screen and which not allow edit this text. This is very long text, which i need shifting in text area on the screen and which not allow edit this text."

and excepted output is something as on image:

  [ This attachment cannot be displayed inline in 'Print Page' view ]  

But as I say. I'll start with it tomorrow, because I'm going to a beer. Is Saturday night...

Is this, what you need? I can do it for you, also color tags can be inserted to this boxes, if you need it. Then it can be something as TextBox "/color 15/ This is white text /color 1/ and this is blue text" I ask you for proposal for this TextBox SUB before i start programming it.




Title: Re: Scroll Bar
Post by: bplus on September 21, 2019, 02:38:42 pm
Petr, what you propose would make an excellent tool for all of us. I don't know why Steve hadn't connected his scroll bars to mouse? or normal arrow and pg keys.

I have an array selector too but no scroll bar to it, it uses mouse over and mouse wheel with arrow keys and pg keys, home, end... you can even type the item number and enter to select but it is also pretty complex for Erum.

Even with scroll bar code made for him, Erum would have another problem, getting large amounts of text into an array or arrays, think I will look into that.
Title: Re: Scroll Bar
Post by: Erum on September 21, 2019, 02:51:22 pm
Respected Petr and bplus,
Thank you for showing concern and for constantly helping me.
For Petr: Yes I think text boxes can be used instead. I will try them once you provide the guidelines.
For bplus: I do think that these things can be complex, but Iam sure I can figure them out once I study them in detail. P.S. I am a ‘she’, not a ‘he’ ;)
Regards.
Title: Re: Scroll Bar
Post by: bplus on September 21, 2019, 07:05:34 pm
Hi Erum,

I like your can do attitude and politeness :)

I took your text blocks and pasted then into a normal .txt file using a \ to mark the titles of smaller text blocks.
Filename: "test file.txt"
Code: QB64: [Select]
  1. \1. ENGLISH OAK (TREE):
  2.      WATER: SEEDLING:KEEP SOIL WET. YOUNG:1.5 GALLONS A DAY. MATURE:CAN DRAW 50 GALLONS.
  3. FERTILIZER: DON'T USE TILL 2 YEARS OLD. WHEN MATURE, USE 12-6-6 OR 12-4-8 FERTILIZER ANNUALLY (16.6 POUNDS EVERY 1000 SQUARE FEET.)
  4.   DISTANCE: PLANT 25 FEET APART. TEMPERATURE: 32-92 F. pH:4.5-5.0.
  5.   SUNLIGHT: HIGH(6-8 HOURS A DAY). MOISTURE PERCENT: MODERATE (21-40%)
  6. \2. PAPER BIRCH (TREE):
  7.      WATER: YOUNG: LET WATER RUN FROM HOSE FOR 30 SEC EVERY 2 WEEKS. MATURE:KEEP SOIL WET 10INCH DEEP.
  8.   DISTANCE: PLANT 25 FT APART. TEMPERATURE:32-113 F pH:4.5-8.4
  9.   SUNLIGHT: HIGH (6-8 HOURS A DAY). MOISTURE PERCENT: MODERATE (21-40%)
  10. \3. AZALEAS (FLOWERS):
  11.      WATER: 4 GALLONS PER SQUARE METRE EVERY 2 WEEKS.
  12. FERTILIZER: USE 10-10-10 FERTILIZER 2-3 TIMES A YEAR.
  13.   DISTANCE: PLANT 2 FEET APART. TEMPERATURE:32-76 F. pH:4.5-5.0.
  14.   SUNLIGHT: SUNNY TO PARTIAL (HIGH-MED). MOISTURE PERCENT: OPTIMUM 41-60%
  15. \4. Notes:
  16.  NOTE 1. FERTILIZER FORMULAS STATED SHOW THE PROPORTION OF NITROGEN-PHOSPHORUS-POTASSIUM RESPECTIVELY.
  17.  NOTE 2: PLANTS NEED WELL DRAINING AND NOURISHED SOIL AND BEST CO2 AMOUNT FOR THEM IS 1000-1500 PPM (PARTS PER MILLION)
  18.  NOTE 3: INSTEAD OF NPK FERTILIZER YOU CAN USE THESE IN THE PROPORTION YOU REQUIRE:
  19.          COFFEE GROUNDS,BLOOD MEAL, AND COTTON SEED MEAL FOR NITROGEN
  20.          FISH BONE MEAL, STEAMED BONE MEAL, AND ROCK DUST FOR PHOSPHORUS
  21. \
  22.  

When you have huge amounts of text it is likely more convenient to edit in a txt editor.

Then I put together or made some tools for loading the text file contents into an array and then more tools for picking out the titled sections for displaying in Petr's text scroller or one of our scrollers.

Here is the test code for our simple little 4 text blocks:

Code: QB64: [Select]
  2. _TITLE "Tool(s) for loading an array from a text file" 'B+ started 2019-09-21
  3.  
  4. DIM txtFile$, nFlines, j, i
  5.  
  6. 'test loading whole file
  7. REDIM test$(1 TO 1)
  8. txtFile$ = "test file.txt"
  9. nFlines = fLineCnt(txtFile$, test$())
  10. 'IF nFLines THEN
  11. '    FOR i = 1 TO nFLines
  12. '        PRINT i; ", "; test$(i)
  13. '        IF (i + 1) MOD 10 = 0 THEN PRINT "press any to continue...": SLEEP: CLS
  14. '    NEXT
  15. 'END IF
  16.  
  17. 'test loading sections of the file into temp$
  18. FOR j = 1 TO 4 'test 4 titles that start with number.
  19.     REDIM temp$(1 TO 1)
  20.     loadTitle test$(), _TRIM$(STR$(j)) + ". ", temp$()
  21.     FOR i = LBOUND(temp$) TO UBOUND(temp$)
  22.         PRINT temp$(i)
  23.     NEXT
  24.     PRINT " end of text... press any to continue..."
  25.     SLEEP
  27. PRINT "Test is done."
  28.  
  29. ' This SUB searches the source array for \+first part of title$ farthest left of source() strings.
  30. ' If a matching string is found, this SUB loads the given dynamic arr() starting at 1 with title string
  31. ' and keeps loading strings until it hits another \ or reaches the end of the file.
  32. SUB loadTitle (source() AS STRING, title$, arr() AS STRING)
  33.     DIM i AS INTEGER
  34.     FOR i = LBOUND(source) TO UBOUND(source)
  35.         IF UCASE$(LEFT$(source$(i), LEN("\" + title$))) = UCASE$("\" + title$) THEN
  36.             REDIM arr(1 TO 1) AS STRING
  37.             arr(1) = MID$(source(i), 2)
  38.             WHILE i + 1 <= UBOUND(source)
  39.                 i = i + 1
  40.                 IF LEFT$(source(i), 1) = "\" THEN 'done
  41.                     EXIT SUB
  42.                 ELSE
  43.                     sAppend arr(), source(i)
  44.                 END IF
  45.             WEND
  46.             EXIT FOR
  47.         END IF
  48.     NEXT
  50.  
  51. 'append to the string array the string item
  52. SUB sAppend (arr() AS STRING, item AS STRING)
  53.     REDIM _PRESERVE arr(LBOUND(arr) TO UBOUND(arr) + 1) AS STRING
  54.     arr(UBOUND(arr)) = item
  56.  
  57. ' This FUNCTION loads a file (using CR + LF between lines) contents into an base 1 array
  58. ' so the upper bound and line count match and returns the number of lines.
  59. ' Hence if 0 was returned the file was empty or not found. new 2019-09-21
  60. FUNCTION fLineCnt (txtFile$, arr() AS STRING)
  61.     DIM filecount%, b$
  62.     filecount% = 0
  63.     IF _FILEEXISTS(txtFile$) THEN
  64.         OPEN txtFile$ FOR BINARY AS #1
  65.         b$ = SPACE$(LOF(1))
  66.         GET #1, , b$
  67.         CLOSE #1
  68.         REDIM _PRESERVE arr(1 TO 1) AS STRING
  69.         Split b$, CHR$(13) + CHR$(10), arr()
  70.         filecount% = UBOUND(arr)
  71.     END IF
  72.     fLineCnt = filecount% 'this file returns the number of lines loaded, 0 means file did not exist
  74.  
  75. 'This SUB will take a given N delimited string, and delimiter$ and create an array of N+1 strings using the LBOUND of the given dynamic array to load.
  76. 'notes: the loadMeArray() needs to be dynamic string array and will not change the LBOUND of the array it is given.  rev 2019-08-27
  77. SUB Split (SplitMeString AS STRING, delim AS STRING, loadMeArray() AS STRING)
  78.     DIM curpos AS LONG, arrpos AS LONG, LD AS LONG, dpos AS LONG 'fix use the Lbound the array already has
  79.     curpos = 1: arrpos = LBOUND(loadMeArray): LD = LEN(delim)
  80.     dpos = INSTR(curpos, SplitMeString, delim)
  81.     DO UNTIL dpos = 0
  82.         loadMeArray(arrpos) = MID$(SplitMeString, curpos, dpos - curpos)
  83.         arrpos = arrpos + 1
  84.         IF arrpos > UBOUND(loadMeArray) THEN REDIM _PRESERVE loadMeArray(LBOUND(loadMeArray) TO UBOUND(loadMeArray) + 1000) AS STRING
  85.         curpos = dpos + LD
  86.         dpos = INSTR(curpos, SplitMeString, delim)
  87.     LOOP
  88.     loadMeArray(arrpos) = MID$(SplitMeString, curpos)
  89.     REDIM _PRESERVE loadMeArray(LBOUND(loadMeArray) TO arrpos) AS STRING 'get the ubound correct
  91.  

Summary:
Put the txt file in the same directory as the bas file. (And make sure under the RUN menu of IDE the Output EXE to Source Folder is bulleted.)

fLineCnt is a function, so it returns something, in this case the number of lines it loaded into the a dynamic string array you specify ie REDIM for Dynamic arrays (instead of DIM, Dynamic Arrays = Arrays you can change the size of, DIM arrays can't be resized so are called Static not Dynamic.)

Code: QB64: [Select]
  1. lineCount = fLineCnt("myLoadTxtFile.txt", myFileArr$())

if lineCnt = 0 you didn't get anything loaded, otherwise myFileArr$() is loaded with the contents of the txt file.



Now to get a titled section from myFileArr$():

Menus work off numbers so I used your numbers to mark the start of a text block, so once a number is chosen from menu that text block can be loaded into an array and if array is huge we can use a scroller to display the entire contents easily for user of your code.

To get an array ready for the scroller just make this call to sub, say 2 text block
REDIM tempTxt$(1 to1) ' setup container to hold the text block
LoadTitle myFileArr$(), "2. ", tempTxt$() 'this loads tempTxt$() array

now ready to display tempTxt$() in scroller!

Too much?




Title: Re: Scroll Bar
Post by: TempodiBasic on September 21, 2019, 07:13:39 pm
Hi Erum
glad to be useful
please focus your mind before on this
an attempt to analyze the issue that the program must solve.

structure of the program
what does your program?
as you have said in previous posts
1. it takes 2 parameters (pH and Temperature in FAHRENHEIT)
 2. it outputs informations as text on the screen on the basis of 2 parameters

moreover you should think that you manage
 3. the input from keyboard and/or mouse
 4. and the output to the screen
 5. and the storage of the informations (inner to the program or outer in files)
 6. and an interface for user (only text, an ASCII windowed, a graphic windowed)

going deeper
1. you need 2 variables for the 2 parameters... the type of variable used depens of type of data to get from keyboard.
see here for more infohttp://qb64.org/wiki/Variable_Types (http://qb64.org/wiki/Variable_Types)
From your code posted before I can think that pH has a range from 1 to 14 with decimal so in QB64 we can use single declared with ! suffix or none suffix, while for temperature there is a range from 32 or less to 134 , but you manage only integer, so you can use an integer variable declared with suffix %

2. in your code you share analysis of value pH and Temperature with Output to screen.
If you want a more flexible code it is useful to separate these two performances. So tomorrow you can modify only the part of program that you must adapt to new needs and not following the line of flow of the program in chained instructions.
  2.1
  you can make a grid of pH values and Temperature to manage the various cases... (if you do this on you code you can see that the
 case temperature T >= 32 AND T <= 113 is not managed in the range pH p > 8.4 AND p <= 14 so in this case your program
 stucks
 2.2 all strings for output must be loaded into an array of strings  (the string is text between 2 ") (array is a set of variables of the same type and with the same name and with an index to distinguish one from another one)  see here for more informations http://qb64.org/wiki/Arrays (http://qb64.org/wiki/Arrays)

3. input from keyboard
 3.1 you can use old INPUT (a semi editor of Qbasic) and you must control the values typed from user (as you do in your code)
 3.2 or the INKEY$ to accept only digit and . for get pH and temperature values
 3.3 or you can use the powerful _KEYHIT of QB64 at the same way of INKEY$ for your goal
 3.4 or you can use mouse (_MOUSEBUTTON(1) or _MOUSEBUTTON(2) or _MOUSEWHEEL) to set input for pH and Temperature
 3.5 or you can use mouse for interaction of user with a structured interface made in text or graphic mode

4. output to the screen
  4.1 choose the screen mode
        if it is good for you an interface  only text or window text based (ASCII screen) you can use SCREEN 0 and use 8 colors for
        paper color (background 0-7) and 31 ink colors (foreground 0-31, after 15 color is blinking)
        but if you prefer the graphic mode you can have so many graphic options to manage and use
  4.2 choose the interface that you must build it for using in your program see point 6 (for now you have used a line text interface)

5. storage of informations
   5.1  informations stored as strings into the program (the way that you have coded)
   5.2  informations stored as DATA into the program (blocks of DATA) see here for more info http://qb64.org/wiki/DATA (http://qb64.org/wiki/DATA)
   5.3  informations stored as TXT file that you load in the program in a set of variable of type of string called Array (OPEN FOR
          INPUT) see here for more info http://qb64.org/wiki/OPEN (http://qb64.org/wiki/OPEN). The real advantage to code in this way is that you can
          change or adapt the text editing the file with an editor of text from Notepad to OpenOffice Writer and you program gains
          adjourned informations without so many changes to the code.
6. an user interface
   6.1 a line text of interface (that you have coded)
   6.2 a text interface with prefixed space of screen for different actions
   6.3 a text ASCII interface with inputbox, button, listbox
   6.4 a graphic interface with inputbox, button, listbox

Good work and good luck

PS: all the answers that you have got until now is how to make a listbox in ASCII mode or in Graphic mode.
Wrong :-)  before the last Bplus 's post!


Title: Re: Scroll Bar
Post by: Erum on September 22, 2019, 05:37:48 am
Respected TempodiBasic and blpus,
Thnak you so much once again. I am gonna focus and try them and see which one works best.
Regards.
Title: Re: Scroll Bar
Post by: Petr on September 22, 2019, 01:16:57 pm
Hello. Does anyone know why my head hurts today? :) To the thread point. Here is the first version of the text shift in a long sentence. I will add two more things - color support, as promised, and the bottom bar for a quick shift. But I'm having trouble with the mousewheel. It doesn't work as swiftly as I want. Anyone want to look at it? Thanks.

Code: QB64: [Select]
  1. 'promise: Textbox with use as PRINT. NEED GRAPHIC SCREEN!
  2.  
  3. 'this is future "TextBox.BI"
  4.  
  5. TYPE TB
  6.     X AS INTEGER '   X position graphic coord
  7.     Y AS INTEGER '   Y position graphic coord
  8.     L AS INTEGER '   TextBox lenght
  9.     T AS STRING '    TextBox text
  10.     B AS INTEGER '   Text begin in textbox  (for shift)
  11.     Arrow AS LONG
  12.     D AS SINGLE 'for time delay between click to arrows
  14. REDIM SHARED TBA(0) AS TB
  15. TBA(0).Arrow = PutArrow&
  16. 'real textboxes starting from 1
  17.  
  18. 'end of future "TextBox.BI"
  19.  
  20. SCREEN _NEWIMAGE(800, 600, 32)
  21. DIM test(20) AS LONG
  22.  
  23. FOR t = 1 TO 20
  24.     test(t) = INITBOX(100 + 250 * RND, 30 * t - 27, "Hi, I'm working on it. This is the test text of the program for longitudinal scrolling in the window. Color capabilities will be added soon. The program uses arrays because program need to remember the shift values for more than one box.", 15 + RND * 40)
  26.  
  27.  
  29.  
  30.     FOR p = 1 TO 20
  31.         PRINTBOX p
  32.     NEXT
  33.  
  35.  
  36. 'this is future "TextBox.BM"
  37.  
  38. FUNCTION INITBOX (X AS INTEGER, Y AS INTEGER, Text AS STRING, BoxLenght AS INTEGER) 'X, Y are GRAPHIC coordinates
  39.     UTB = UBOUND(tba)
  40.     REDIM _PRESERVE TBA(UTB + 1) AS TB
  41.     TBA(UTB + 1).X = X
  42.     TBA(UTB + 1).Y = Y
  43.     TBA(UTB + 1).L = BoxLenght
  44.     TBA(UTB + 1).T = Text
  45.     TBA(UTB + 1).B = 1
  46.     INITBOX = UTB + 1
  48.  
  49.  
  50. SUB PRINTBOX (nr AS LONG)
  51.     IF nr < 1 OR nr > UBOUND(tba) THEN EXIT SUB 'subscript out of range prevention
  52.     TextBoxArrow& = TBA(0).Arrow
  53.     TextLenght = _PRINTWIDTH(TBA(nr).T)
  54.     B = TBA(nr).B
  55.     TextHeight = _FONTHEIGHT
  56.     X = TBA(nr).X
  57.     Y = TBA(nr).Y
  58.     BoxLenght = TBA(nr).L
  59.     T$ = MID$(TBA(nr).T, TBA(nr).B, TBA(nr).L) 'text loader
  60.  
  61.     FOR h = 1 TO 10
  62.         DO WHILE _MOUSEINPUT
  63.             IF _MOUSEX >= X - 30 AND _MOUSEX <= X + 30 + BoxLenght * _FONTWIDTH THEN
  64.                 IF _MOUSEY >= Y - 3 AND _MOUSEY <= Y + 3 + TextHeight THEN
  65.                     B = B + _MOUSEWHEEL
  66.                 END IF
  67.             END IF
  68.         LOOP
  69.     NEXT
  70.     '
  71.     MB1 = _MOUSEBUTTON(1)
  72.     MX = _MOUSEX
  73.     MY = _MOUSEY
  74.  
  75.  
  76.  
  77.     LINE (X - 30, Y - 3)-(X + 30 + BoxLenght * _FONTWIDTH, Y + 3 + TextHeight), , B
  78.     _PUTIMAGE (X + 15 + BoxLenght * _FONTWIDTH, Y + 1), TextBoxArrow&
  79.     _PUTIMAGE (X - 15, Y + 1)-(X - 26, Y + 12), TextBoxArrow&
  80.  
  81.     IF TIMER < 1 THEN TBA(nr).D = 0
  82.  
  83.     IF MX >= X + 15 + BoxLenght * _FONTWIDTH AND MX <= X + 15 + BoxLenght * _FONTWIDTH + 12 THEN
  84.         IF MY >= Y + 1 AND MY <= Y + 13 THEN
  85.             IF TBA(nr).D < TIMER THEN
  86.                 LINE (X + 15 + BoxLenght * _FONTWIDTH, Y + 1)-(X + 15 + BoxLenght * _FONTWIDTH + 11, Y + 12), &H44FFFFFF, BF
  87.                 IF MB1 THEN
  88.                     B = B + 1
  89.                 END IF
  90.                 TBA(nr).D = TIMER + .1
  91.             END IF
  92.         END IF
  93.     END IF
  94.  
  95.     IF MX >= X - 26 AND MX <= X - 15 THEN
  96.         IF MY >= Y + 1 AND MY <= Y + 13 THEN
  97.             IF TBA(nr).D < TIMER THEN
  98.                 LINE (X - 26, Y + 1)-(X - 15, Y + 12), &H44FFFFFF, BF
  99.                 IF MB1 THEN
  100.                     B = B - 1
  101.                 END IF
  102.                 TBA(nr).D = TIMER + .1
  103.             END IF
  104.         END IF
  105.     END IF
  106.     IF B < 1 THEN B = 1
  107.     IF B > LEN(TBA(nr).T) - TBA(nr).L + 1 THEN B = LEN(TBA(nr).T) - TBA(nr).L + 1
  108.     TBA(nr).B = B
  109.     _PRINTSTRING (X, Y), T$
  111.  
  112.  
  113. FUNCTION PutArrow& 'draw one arrow to virtual screen (so is not need external image)
  114.     PutArrow& = _NEWIMAGE(12, 12, 32)
  115.     D = _DEST
  116.     _DEST PutArrow&
  117.     CLS
  118.     LINE (1, 4)-(6, 4) '  ------------     up
  119.     LINE (1, 8)-(6, 8) '  ------------     down
  120.     LINE (1, 4)-(1, 8) '  I                arrow back
  121.     LINE (6, 4)-(6, 1)
  122.     LINE (6, 8)-(6, 11)
  123.     LINE (6, 11)-(11, 6)
  124.     LINE (6, 1)-(11, 6)
  125.     PAINT (6, 6), &HFF777777, &HFFFFFFFF
  126.     _DEST D
  128. 'End of future "TextBox.BM"
  129.  

  [ This attachment cannot be displayed inline in 'Print Page' view ]  
Title: Re: Scroll Bar
Post by: Petr on September 22, 2019, 04:41:45 pm
Small upgrade for previous code. Tomorrow i aply colors, replace it to BI and BM for higher clearity and start second box which use shift up/down.

Code: QB64: [Select]
  1. 'promise: Textbox with use as PRINT. NEED GRAPHIC SCREEN!
  2.  
  3. 'this is future "TextBox.BI"
  4.  
  5. TYPE TB
  6.     X AS INTEGER '   X position graphic coord
  7.     Y AS INTEGER '   Y position graphic coord
  8.     L AS INTEGER '   TextBox lenght
  9.     T AS STRING '    TextBox text
  10.     B AS INTEGER '   Text begin in textbox  (for shift)
  11.     Arrow AS LONG
  12.     D AS SINGLE 'for time delay between click to arrows
  14. REDIM SHARED TBA(0) AS TB
  15. TBA(0).Arrow = PutArrow&
  16. 'real textboxes starting from 1
  17.  
  18. 'end of future "TextBox.BI"
  19.  
  20. SCREEN _NEWIMAGE(800, 600, 32)
  21. DIM test(10) AS LONG
  22.  
  23. FOR t = 1 TO 10
  24.     test(t) = INITBOX(100 + 250 * RND, 40 * t - 27, "Hi, I'm working on it. This is the test text of the program for longitudinal scrolling in the window. Color capabilities will be added soon. The program uses arrays because program need to remember the shift values for more than one box.", 15 + RND * 40)
  26. Demo = INITBOX(150, 500, "This is small text", 9)
  27.  
  28.  
  30.  
  31.     FOR p = 1 TO 10
  32.         PRINTBOX p
  33.     NEXT
  34.     PRINTBOX Demo
  35.  
  36.     _DISPLAY
  38.  
  39. 'this is future "TextBox.BM"
  40.  
  41. FUNCTION INITBOX (X AS INTEGER, Y AS INTEGER, Text AS STRING, BoxLenght AS INTEGER) 'X, Y are GRAPHIC coordinates
  42.     UTB = UBOUND(tba)
  43.     REDIM _PRESERVE TBA(UTB + 1) AS TB
  44.     TBA(UTB + 1).X = X
  45.     TBA(UTB + 1).Y = Y
  46.     TBA(UTB + 1).L = BoxLenght
  47.     TBA(UTB + 1).T = Text
  48.     TBA(UTB + 1).B = 1
  49.     INITBOX = UTB + 1
  51.  
  52.  
  53. SUB PRINTBOX (nr AS LONG)
  54.     IF nr < 1 OR nr > UBOUND(tba) THEN EXIT SUB 'subscript out of range prevention
  55.     TextBoxArrow& = TBA(0).Arrow
  56.     TextLenght = _PRINTWIDTH(TBA(nr).T)
  57.     B = TBA(nr).B
  58.     TextHeight = _FONTHEIGHT
  59.     X = TBA(nr).X
  60.     Y = TBA(nr).Y
  61.     BoxLenght = TBA(nr).L
  62.     T$ = MID$(TBA(nr).T, TBA(nr).B, TBA(nr).L) 'text loader
  63.  
  64.     FOR h = 1 TO 10
  65.         DO WHILE _MOUSEINPUT
  66.             IF _MOUSEX >= X - 30 AND _MOUSEX <= X + 30 + BoxLenght * _FONTWIDTH THEN
  67.                 IF _MOUSEY >= Y - 3 AND _MOUSEY <= Y + 3 + TextHeight THEN
  68.                     B = B + _MOUSEWHEEL
  69.                 END IF
  70.             END IF
  71.         LOOP
  72.     NEXT
  73.     '
  74.     MB1 = _MOUSEBUTTON(1)
  75.     MX = _MOUSEX
  76.     MY = _MOUSEY
  77.  
  78.     LINE (X - 30, Y - 3)-(X + 30 + BoxLenght * _FONTWIDTH, Y + 12 + TextHeight), &HFF000000, BF
  79.  
  80.     LINE (X - 30, Y - 3)-(X + 30 + BoxLenght * _FONTWIDTH, Y + 12 + TextHeight), , B
  81.     LINE (X - 28, Y - 1)-(X + 28 + BoxLenght * _FONTWIDTH, Y + 3 + TextHeight), , B
  82.  
  83.  
  84.     LL = ((B + TBA(nr).L) / LEN(TBA(nr).T)) * 100
  85.     Full = BoxLenght * _FONTWIDTH + 15
  86.     OnePercent = Full / 100
  87.     Actual = LL * OnePercent
  88.  
  89.     LINE (X + Actual, Y + TextHeight + 5)-(Actual + 10 + X, Y + 10 + TextHeight), , BF
  90.     IF MX >= X + Actual AND MX <= Actual + 10 + X THEN
  91.         IF MY >= Y + TextHeight + 5 AND MY <= Y + 10 + TextHeight THEN
  92.             IF MB1 THEN
  93.                 omx = MX
  94.                 DO UNTIL _MOUSEX <> MX
  95.                     WHILE _MOUSEINPUT: WEND
  96.                     MB1 = _MOUSEBUTTON(1)
  97.                     B = B + _MOUSEX - omx
  98.                 LOOP
  99.             END IF
  100.         END IF
  101.     END IF
  102.  
  103.  
  104.     _PUTIMAGE (X + 15 + BoxLenght * _FONTWIDTH, Y + 1), TextBoxArrow&
  105.     _PUTIMAGE (X - 15, Y + 1)-(X - 26, Y + 12), TextBoxArrow&
  106.  
  107.     IF TIMER < 1 THEN TBA(nr).D = 0
  108.  
  109.     IF MX >= X + 15 + BoxLenght * _FONTWIDTH AND MX <= X + 15 + BoxLenght * _FONTWIDTH + 12 THEN
  110.         IF MY >= Y + 1 AND MY <= Y + 13 THEN
  111.             IF TBA(nr).D < TIMER THEN
  112.                 LINE (X + 15 + BoxLenght * _FONTWIDTH, Y + 1)-(X + 15 + BoxLenght * _FONTWIDTH + 11, Y + 12), &H44FFFFFF, BF
  113.                 IF MB1 THEN
  114.                     B = B + 1
  115.                 END IF
  116.                 TBA(nr).D = TIMER + .01
  117.             END IF
  118.         END IF
  119.     END IF
  120.  
  121.     IF MX >= X - 26 AND MX <= X - 15 THEN
  122.         IF MY >= Y + 1 AND MY <= Y + 13 THEN
  123.             IF TBA(nr).D < TIMER THEN
  124.                 LINE (X - 26, Y + 1)-(X - 15, Y + 12), &H44FFFFFF, BF
  125.                 IF MB1 THEN
  126.                     B = B - 1
  127.                 END IF
  128.                 TBA(nr).D = TIMER + .01
  129.             END IF
  130.         END IF
  131.     END IF
  132.     IF B < 1 THEN B = 1
  133.     IF B > LEN(TBA(nr).T) - TBA(nr).L + 1 THEN B = LEN(TBA(nr).T) - TBA(nr).L + 1
  134.     TBA(nr).B = B
  135.     'here will be add color block (and next sub, which calculate text lenght without color flags and other one, which return text string without color flags)
  136.     'future use: V = INITBOX (1, 1, "&HFFFFFFWhite text is here,&HFFFF0000and red text is here", 10)    --  or can be done as "/RED/ This is RED text /WHITE/ and this is white text" with Steve's color constants.
  137.  
  138.     _PRINTSTRING (X, Y), T$
  140.  
  141.  
  142. FUNCTION PutArrow& 'draw one arrow to virtual screen (so is not need external image)
  143.     PutArrow& = _NEWIMAGE(12, 12, 32)
  144.     D = _DEST
  145.     _DEST PutArrow&
  146.     CLS
  147.     LINE (1, 4)-(6, 4) '  ------------     up
  148.     LINE (1, 8)-(6, 8) '  ------------     down
  149.     LINE (1, 4)-(1, 8) '  I                arrow back
  150.     LINE (6, 4)-(6, 1)
  151.     LINE (6, 8)-(6, 11)
  152.     LINE (6, 11)-(11, 6)
  153.     LINE (6, 1)-(11, 6)
  154.     PAINT (6, 6), &HFF777777, &HFFFFFFFF
  155.     _DEST D
  157. 'End of future "TextBox.BM"
  158.  
Title: Re: Scroll Bar
Post by: TempodiBasic on September 22, 2019, 06:23:16 pm
Hi Petr

I think to have a fix for _mousewheel 
here code
Code: QB64: [Select]
  1. 'promise: Textbox with use as PRINT. NEED GRAPHIC SCREEN!
  2.  
  3. 'this is future "TextBox.BI"
  4.  
  5. TYPE TB
  6.     X AS INTEGER '   X position graphic coord
  7.     Y AS INTEGER '   Y position graphic coord
  8.     L AS INTEGER '   TextBox lenght
  9.     T AS STRING '    TextBox text
  10.     B AS INTEGER '   Text begin in textbox  (for shift)
  11.     Arrow AS LONG
  12.     D AS SINGLE 'for time delay between click to arrows
  14. REDIM SHARED TBA(0) AS TB
  15. TBA(0).Arrow = PutArrow&
  16. 'real textboxes starting from 1
  17.  
  18. 'end of future "TextBox.BI"
  19.  
  20. SCREEN _NEWIMAGE(800, 600, 32)
  21. DIM test(20) AS LONG
  22.  
  23. FOR t = 1 TO 20
  24.     test(t) = INITBOX(100 + 250 * RND, 30 * t - 27, "Hi, I'm working on it. This is the test text of the program for longitudinal scrolling in the window. Color capabilities will be added soon. The program uses arrays because program need to remember the shift values for more than one box.", 15 + RND * 40)
  26.  
  27.  
  29.  
  30.     FOR p = 1 TO 20
  31.         PRINTBOX p
  32.     NEXT
  33.  
  35.  
  36. 'this is future "TextBox.BM"
  37.  
  38. FUNCTION INITBOX (X AS INTEGER, Y AS INTEGER, Text AS STRING, BoxLenght AS INTEGER) 'X, Y are GRAPHIC coordinates
  39.     UTB = UBOUND(tba)
  40.     REDIM _PRESERVE TBA(UTB + 1) AS TB
  41.     TBA(UTB + 1).X = X
  42.     TBA(UTB + 1).Y = Y
  43.     TBA(UTB + 1).L = BoxLenght
  44.     TBA(UTB + 1).T = Text
  45.     TBA(UTB + 1).B = 1
  46.     INITBOX = UTB + 1
  48.  
  49.  
  50. SUB PRINTBOX (nr AS LONG)
  51.     IF nr < 1 OR nr > UBOUND(tba) THEN EXIT SUB 'subscript out of range prevention
  52.     TextBoxArrow& = TBA(0).Arrow
  53.     TextLenght = _PRINTWIDTH(TBA(nr).T)
  54.     B = TBA(nr).B
  55.     TextHeight = _FONTHEIGHT
  56.     X = TBA(nr).X
  57.     Y = TBA(nr).Y
  58.     BoxLenght = TBA(nr).L
  59.     T$ = MID$(TBA(nr).T, TBA(nr).B, TBA(nr).L) 'text loader
  60.  
  61.     '    FOR h = 1 TO 10   ' not need this focusing
  62.     DO
  63.         MW = _MOUSEWHEEL ' a variable to store value -1/+1
  64.         IF MW THEN EXIT DO ' we must exit because _mousewheel resets its value to 0 at each _mouseinput
  66.     '    NEXT
  67.     '
  68.     MB1 = _MOUSEBUTTON(1)
  69.     MX = _MOUSEX
  70.     MY = _MOUSEY
  71.  
  72.  
  73.  
  74.     LINE (X - 30, Y - 3)-(X + 30 + BoxLenght * _FONTWIDTH, Y + 3 + TextHeight), , B
  75.     _PUTIMAGE (X + 15 + BoxLenght * _FONTWIDTH, Y + 1), TextBoxArrow&
  76.     _PUTIMAGE (X - 15, Y + 1)-(X - 26, Y + 12), TextBoxArrow&
  77.  
  78.     IF TIMER < 1 THEN TBA(nr).D = 0
  79.  
  80.     IF MX >= X + 15 + BoxLenght * _FONTWIDTH AND MX <= X + 15 + BoxLenght * _FONTWIDTH + 12 THEN
  81.         IF MY >= Y + 1 AND MY <= Y + 13 THEN
  82.             IF TBA(nr).D < TIMER THEN
  83.                 LINE (X + 15 + BoxLenght * _FONTWIDTH, Y + 1)-(X + 15 + BoxLenght * _FONTWIDTH + 11, Y + 12), &H44FFFFFF, BF
  84.                 IF MB1 THEN
  85.                     B = B + 1
  86.                 END IF
  87.                 TBA(nr).D = TIMER + .1
  88.             END IF
  89.         END IF
  90.     END IF
  91.  
  92.     IF MX >= X - 26 AND MX <= X - 15 THEN
  93.         IF MY >= Y + 1 AND MY <= Y + 13 THEN
  94.             IF TBA(nr).D < TIMER THEN
  95.                 LINE (X - 26, Y + 1)-(X - 15, Y + 12), &H44FFFFFF, BF
  96.                 IF MB1 THEN
  97.                     B = B - 1
  98.                 END IF
  99.                 TBA(nr).D = TIMER + .1
  100.             END IF
  101.         END IF
  102.     END IF
  103.     ' Here the managment of the event _mousewheel
  104.     IF _MOUSEX >= X - 30 AND _MOUSEX <= X + 30 + BoxLenght * _FONTWIDTH THEN
  105.         IF _MOUSEY >= Y - 3 AND _MOUSEY <= Y + 3 + TextHeight THEN
  106.             B = B + MW
  107.             '  DO WHILE _MOUSEINPUT: LOOP  ' <-- this works
  108.             IF _MOUSEINPUT THEN REM   <----  also this works
  109.         END IF
  110.     END IF
  111.  
  112.     IF B < 1 THEN B = 1
  113.     IF B > LEN(TBA(nr).T) - TBA(nr).L + 1 THEN B = LEN(TBA(nr).T) - TBA(nr).L + 1
  114.     TBA(nr).B = B
  115.     _PRINTSTRING (X, Y), T$
  117.  
  118.  
  119. FUNCTION PutArrow& 'draw one arrow to virtual screen (so is not need external image)
  120.     PutArrow& = _NEWIMAGE(12, 12, 32)
  121.     D = _DEST
  122.     _DEST PutArrow&
  123.     CLS
  124.     LINE (1, 4)-(6, 4) '  ------------     up
  125.     LINE (1, 8)-(6, 8) '  ------------     down
  126.     LINE (1, 4)-(1, 8) '  I                arrow back
  127.     LINE (6, 4)-(6, 1)
  128.     LINE (6, 8)-(6, 11)
  129.     LINE (6, 11)-(11, 6)
  130.     LINE (6, 1)-(11, 6)
  131.     PAINT (6, 6), &HFF777777, &HFFFFFFFF
  132.     _DEST D
  134. 'End of future "TextBox.BM"
  135.  
  136.  

I hope it is portable to the final version....
Waiting  feedback
Goog Coding
Title: Re: Scroll Bar
Post by: TempodiBasic on September 22, 2019, 06:47:12 pm
Fine the presence of the bar under the text!

here mod for _mousewheel but after playing for a while with arrows, scroll bar and mouse wheel the program stucks.


Code: QB64: [Select]
  1. 'promise: Textbox with use as PRINT. NEED GRAPHIC SCREEN!
  2.  
  3. 'this is future "TextBox.BI"
  4.  
  5. TYPE TB
  6.     X AS INTEGER '   X position graphic coord
  7.     Y AS INTEGER '   Y position graphic coord
  8.     L AS INTEGER '   TextBox lenght
  9.     T AS STRING '    TextBox text
  10.     B AS INTEGER '   Text begin in textbox  (for shift)
  11.     Arrow AS LONG
  12.     D AS SINGLE 'for time delay between click to arrows
  14. REDIM SHARED TBA(0) AS TB
  15. TBA(0).Arrow = PutArrow&
  16. 'real textboxes starting from 1
  17.  
  18. 'end of future "TextBox.BI"
  19.  
  20. SCREEN _NEWIMAGE(800, 600, 32)
  21. DIM test(10) AS LONG
  22.  
  23. FOR t = 1 TO 10
  24.     test(t) = INITBOX(100 + 250 * RND, 40 * t - 27, "Hi, I'm working on it. This is the test text of the program for longitudinal scrolling in the window. Color capabilities will be added soon. The program uses arrays because program need to remember the shift values for more than one box.", 15 + RND * 40)
  26. Demo = INITBOX(150, 500, "This is small text", 9)
  27.  
  28.  
  30.  
  31.     FOR p = 1 TO 10
  32.         PRINTBOX p
  33.     NEXT
  34.     PRINTBOX Demo
  35.  
  36.     _DISPLAY
  38.  
  39. 'this is future "TextBox.BM"
  40.  
  41. FUNCTION INITBOX (X AS INTEGER, Y AS INTEGER, Text AS STRING, BoxLenght AS INTEGER) 'X, Y are GRAPHIC coordinates
  42.     UTB = UBOUND(tba)
  43.     REDIM _PRESERVE TBA(UTB + 1) AS TB
  44.     TBA(UTB + 1).X = X
  45.     TBA(UTB + 1).Y = Y
  46.     TBA(UTB + 1).L = BoxLenght
  47.     TBA(UTB + 1).T = Text
  48.     TBA(UTB + 1).B = 1
  49.     INITBOX = UTB + 1
  51.  
  52.  
  53. SUB PRINTBOX (nr AS LONG)
  54.     IF nr < 1 OR nr > UBOUND(tba) THEN EXIT SUB 'subscript out of range prevention
  55.     TextBoxArrow& = TBA(0).Arrow
  56.     TextLenght = _PRINTWIDTH(TBA(nr).T)
  57.     B = TBA(nr).B
  58.     TextHeight = _FONTHEIGHT
  59.     X = TBA(nr).X
  60.     Y = TBA(nr).Y
  61.     BoxLenght = TBA(nr).L
  62.     T$ = MID$(TBA(nr).T, TBA(nr).B, TBA(nr).L) 'text loader
  63.  
  64.     FOR h = 1 TO 10
  65.         DO
  66.             MW = _MOUSEWHEEL
  67.             IF MW THEN EXIT DO
  68.         LOOP WHILE _MOUSEINPUT
  69.     NEXT
  70.     '
  71.     MB1 = _MOUSEBUTTON(1)
  72.     MX = _MOUSEX
  73.     MY = _MOUSEY
  74.  
  75.     LINE (X - 30, Y - 3)-(X + 30 + BoxLenght * _FONTWIDTH, Y + 12 + TextHeight), &HFF000000, BF
  76.  
  77.     LINE (X - 30, Y - 3)-(X + 30 + BoxLenght * _FONTWIDTH, Y + 12 + TextHeight), , B
  78.     LINE (X - 28, Y - 1)-(X + 28 + BoxLenght * _FONTWIDTH, Y + 3 + TextHeight), , B
  79.  
  80.  
  81.     LL = ((B + TBA(nr).L) / LEN(TBA(nr).T)) * 100
  82.     Full = BoxLenght * _FONTWIDTH + 15
  83.     OnePercent = Full / 100
  84.     Actual = LL * OnePercent
  85.  
  86.     LINE (X + Actual, Y + TextHeight + 5)-(Actual + 10 + X, Y + 10 + TextHeight), , BF
  87.     IF MX >= X + Actual AND MX <= Actual + 10 + X THEN
  88.         IF MY >= Y + TextHeight + 5 AND MY <= Y + 10 + TextHeight THEN
  89.             IF MB1 THEN
  90.                 omx = MX
  91.                 DO UNTIL _MOUSEX <> MX
  92.                     WHILE _MOUSEINPUT: WEND
  93.                     MB1 = _MOUSEBUTTON(1)
  94.                     B = B + _MOUSEX - omx
  95.                 LOOP
  96.             END IF
  97.         END IF
  98.     END IF
  99.  
  100.  
  101.     _PUTIMAGE (X + 15 + BoxLenght * _FONTWIDTH, Y + 1), TextBoxArrow&
  102.     _PUTIMAGE (X - 15, Y + 1)-(X - 26, Y + 12), TextBoxArrow&
  103.  
  104.     IF TIMER < 1 THEN TBA(nr).D = 0
  105.  
  106.     IF MX >= X + 15 + BoxLenght * _FONTWIDTH AND MX <= X + 15 + BoxLenght * _FONTWIDTH + 12 THEN
  107.         IF MY >= Y + 1 AND MY <= Y + 13 THEN
  108.             IF TBA(nr).D < TIMER THEN
  109.                 LINE (X + 15 + BoxLenght * _FONTWIDTH, Y + 1)-(X + 15 + BoxLenght * _FONTWIDTH + 11, Y + 12), &H44FFFFFF, BF
  110.                 IF MB1 THEN
  111.                     B = B + 1
  112.                 END IF
  113.                 TBA(nr).D = TIMER + .01
  114.             END IF
  115.         END IF
  116.     END IF
  117.  
  118.     IF MX >= X - 26 AND MX <= X - 15 THEN
  119.         IF MY >= Y + 1 AND MY <= Y + 13 THEN
  120.             IF TBA(nr).D < TIMER THEN
  121.                 LINE (X - 26, Y + 1)-(X - 15, Y + 12), &H44FFFFFF, BF
  122.                 IF MB1 THEN
  123.                     B = B - 1
  124.                 END IF
  125.                 TBA(nr).D = TIMER + .01
  126.             END IF
  127.         END IF
  128.     END IF
  129.  
  130.     IF _MOUSEX >= X - 30 AND _MOUSEX <= X + 30 + BoxLenght * _FONTWIDTH THEN
  131.         IF _MOUSEY >= Y - 3 AND _MOUSEY <= Y + 3 + TextHeight THEN
  132.             B = B + MW
  133.             IF _MOUSEINPUT THEN REM
  134.         END IF
  135.     END IF
  136.  
  137.     IF B < 1 THEN B = 1
  138.     IF B > LEN(TBA(nr).T) - TBA(nr).L + 1 THEN B = LEN(TBA(nr).T) - TBA(nr).L + 1
  139.     TBA(nr).B = B
  140.     'here will be add color block (and next sub, which calculate text lenght without color flags and other one, which return text string without color flags)
  141.     'future use: V = INITBOX (1, 1, "&HFFFFFFWhite text is here,&HFFFF0000and red text is here", 10)    --  or can be done as "/RED/ This is RED text /WHITE/ and this is white text" with Steve's color constants.
  142.  
  143.     _PRINTSTRING (X, Y), T$
  145.  
  146.  
  147. FUNCTION PutArrow& 'draw one arrow to virtual screen (so is not need external image)
  148.     PutArrow& = _NEWIMAGE(12, 12, 32)
  149.     D = _DEST
  150.     _DEST PutArrow&
  151.     CLS
  152.     LINE (1, 4)-(6, 4) '  ------------     up
  153.     LINE (1, 8)-(6, 8) '  ------------     down
  154.     LINE (1, 4)-(1, 8) '  I                arrow back
  155.     LINE (6, 4)-(6, 1)
  156.     LINE (6, 8)-(6, 11)
  157.     LINE (6, 11)-(11, 6)
  158.     LINE (6, 1)-(11, 6)
  159.     PAINT (6, 6), &HFF777777, &HFFFFFFFF
  160.     _DEST D
  162. 'End of future "TextBox.BM"
  163.  
Title: Re: Scroll Bar
Post by: bplus on September 22, 2019, 10:21:16 pm
OK I throw my hat into the ring, colors, arrow keys, home and end, mouse-wheel, click or drag to string position.
Code: QB64: [Select]
  1. _TITLE "hScroller Array test" 'B+ start2019-09-22
  2. SCREEN _NEWIMAGE(800, 600, 32)
  3. _SCREENMOVE 300, 60
  4. TYPE hScroller
  5.     t AS STRING
  6.     x AS SINGLE
  7.     y AS SINGLE
  8.     w AS SINGLE 'in pixels
  9.     'h is constant 20
  10.     start AS INTEGER 'in textstring char
  11.     fC AS _UNSIGNED LONG
  12.     bC AS _UNSIGNED LONG
  14. nHscrollers = 5
  15. DIM SHARED testScroller(1 TO nHscrollers) AS hScroller
  16. S$ = "Here is an extremely long string to test the hSrcoller SUBs, I hope to add separate mouse and key control code either in main loop or in a sub for several kinds of controls not only a hScroll box."
  17. newScroller testScroller(1), S$, 100, 100, 20, &HFFFFFFFF, &HFF0000FF
  18. S$ = "A second long string for scroller #2, we are now testing an array of hScrollers."
  19. newScroller testScroller(2), S$, 300, 100, 10, &HFF99AAFF, &HFFFF0000
  20. S$ = "These scrollers are great! Use the left and right arrow keys to move the text home or end but be sure that the mouse pointer is over the scroller you want to read."
  21. newScroller testScroller(3), S$, 50, 200, 50, &HFF003300, &HFF00FF00
  22. S$ = "The home and end keys also work with these Hscrollers, home of course will take you to start of string and end to the end of course."
  23. newScroller testScroller(4), S$, 150, 300, 30, &HFF000055, &HFF00BBBB
  24. S$ = "The mouse action is the best part or these Hscrollers, the wheel will scroll from one end to the other and back and you cam either click a position in the text string or you can drag to any place of the string."
  25. newScroller testScroller(5), S$, 50, 400, 70, &HFF00FF55, &HFF330033
  26.  
  27. WHILE _KEYDOWN(27) = 0
  28.     CLS
  29.     FOR i = 1 TO nHscrollers
  30.         drawHScroller testScroller(i)
  31.     NEXT
  33.         mx = _MOUSEX: my = _MOUSEY
  34.         FOR i = 1 TO nHscrollers
  35.             maxStart = (LEN(testScroller(i).t) - (testScroller(i).w - 6) / 8) + 1
  36.             IF mx >= testScroller(i).x AND mx <= testScroller(i).x + testScroller(i).w THEN
  37.                 IF my >= testScroller(i).y - 10 AND my <= testScroller(i).y + 20 + 10 THEN
  38.                     mw = _MOUSEWHEEL: mb = _MOUSEBUTTON(1)
  39.                     IF testScroller(i).start + mw >= 1 AND testScroller(i).start + mw <= maxStart THEN
  40.                         testScroller(i).start = testScroller(i).start + mw
  41.                     END IF
  42.                     WHILE mb AND _MOUSEINPUT
  43.                         mx = _MOUSEX: my = _MOUSEY: mb = _MOUSEBUTTON(1)
  44.                         test = ((mx - testScroller(i).x) / testScroller(i).w)
  45.                         IF test >= 0 AND test <= 1 THEN
  46.                             testScroller(i).start = INT(test * maxStart)
  47.                         END IF
  48.                     WEND
  49.                 END IF
  50.             END IF
  51.         NEXT
  52.     WEND
  53.     kh& = _KEYHIT
  54.     IF kh& THEN
  55.         FOR i = 1 TO nHscrollers
  56.             maxStart = (LEN(testScroller(i).t) - (testScroller(i).w - 6) / 8) + 1
  57.             IF mx >= testScroller(i).x AND mx <= testScroller(i).x + testScroller(i).w THEN
  58.                 IF my >= testScroller(i).y - 10 AND my <= testScroller(i).y + 20 + 10 THEN
  59.                     SELECT CASE kh&
  60.                         CASE 19200: IF testScroller(i).start > 1 THEN testScroller(i).start = testScroller(i).start - 1
  61.                         CASE 19712: IF testScroller(i).start < maxStart THEN testScroller(i).start = testScroller(i).start + 1
  62.                         CASE 18176: testScroller(i).start = 1
  63.                         CASE 20224: testScroller(i).start = maxStart
  64.                     END SELECT
  65.                 END IF
  66.             END IF
  67.         NEXT
  68.     END IF
  69.     _DISPLAY
  70.     _LIMIT 100
  72. LOCATE 1, 1: PRINT "Done"
  73.  
  74. 'get stuff loaded into scoller variable for drawing, then for key and mouse control
  75. SUB newScroller (sharedHScroller AS hScroller, txt$, xPix, yPix, wChars, fore AS _UNSIGNED LONG, back AS _UNSIGNED LONG) 'start will be 1
  76.     sharedHScroller.t = txt$
  77.     sharedHScroller.x = xPix
  78.     sharedHScroller.y = yPix
  79.     sharedHScroller.w = wChars * 8 + 6
  80.     sharedHScroller.start = 1
  81.     sharedHScroller.fC = fore
  82.     sharedHScroller.bC = back
  84.  
  85. SUB drawHScroller (sharedHscroller AS hScroller)
  86.     dx = sharedHscroller.w * sharedHscroller.start / (LEN(sharedHscroller.t) - (sharedHscroller.w - 6) / 8 + 1)
  87.     FOR i = 5 TO 0 STEP -.25
  88.         LINE (sharedHscroller.x + dx - i, sharedHscroller.y - 2 * i)-STEP(2 * i, 20 + 4 * i), _RGB32(255 - i * 50, 255 - i * 50, 255 - i * 50), BF
  89.     NEXT
  90.     LINE (sharedHscroller.x, sharedHscroller.y)-STEP(sharedHscroller.w, 20), sharedHscroller.fC, B
  91.     LINE (sharedHscroller.x + 1, sharedHscroller.y + 1)-STEP(sharedHscroller.w - 2, 18), sharedHscroller.bC, BF
  92.     saveColorF = _DEFAULTCOLOR
  93.     saveColorB = _BACKGROUNDCOLOR
  94.     COLOR sharedHscroller.fC, sharedHscroller.bC
  95.     _PRINTSTRING (sharedHscroller.x + 4, sharedHscroller.y + 3), MID$(sharedHscroller.t, sharedHscroller.start, (sharedHscroller.w - 6) / 8)
  96.     COLOR saveColorF, saveColorB
  98.  
Title: Re: Scroll Bar
Post by: Erum on September 23, 2019, 11:57:29 am
To all the respected QB64 team,
Thank you for all those who helped me so much once again. However, I have one last dumb question.
I am done with the whole software, all I need is to add colours. My software is a bit crowded, so I thought adding colours would make the data vivid and easy to read.
I know how to add colours to each line using RGB mixing, but I want to know if it is possible to add more than one colour on one line (text colour only).
I would be grateful to anyone who takes precious time to answer this dumb question.
Regards.
Title: Re: Scroll Bar
Post by: bplus on September 23, 2019, 12:43:20 pm
Here is an example:
Code: QB64: [Select]
  1. SCREEN _NEWIMAGE(800, 600, 32) 'for _rgb32 colors
  2. _SCREENMOVE 300, 60 'to get the screen out of B+ title and tool bars
  3.  
  4. txt$ = "Hello world, let me show you a multi-colored string, in just one longish line."
  5.  
  6. 'the MID$ function takes portions of a string
  7. FOR i = 1 TO LEN(txt$) STEP 5 'print txt$ 5 chars at a time
  8.     'reset the ink of print
  9.     COLOR _RGB32(RND * 255, RND * 255, RND * 155 + 100)
  10.     PRINT MID$(txt$, i, 5);
  12.  
  13.  

PS It is not dumb to ask questions, neither dumb intellectually nor dumb in speech.
Title: Re: Scroll Bar
Post by: SMcNeill on September 23, 2019, 01:04:05 pm
Quote from: bplus on September 23, 2019, 12:43:20 pm
It is not dumb to ask questions, neither dumb intellectually nor dumb in speech.

I couldn’t agree more!  All software, and new experiences, require a learning curve.  By asking questions, and finding friendly folks who will take the time to answer them, you can reduce that learning curve immensely.  It’s not dumb to ask questions; and the only people who thinks it is, are the true idiots.  ;)
Title: Re: Scroll Bar
Post by: Erum on September 23, 2019, 02:37:00 pm
Respected QB64 members,
Thank you for making me feel confident for asking questions, you truly are friendly folks. As for the reply, I understood it, and I’ll use it. Thank you!
My queries are officially over. Thanks once more to everyone.
Regards.
Title: Re: Scroll Bar
Post by: TempodiBasic on September 23, 2019, 03:02:23 pm
about
Quote
PS It is not dumb to ask questions, neither dumb intellectually nor dumb in speech.

in my country there is a phrase from the XIX/XX century : "Chi tene a lengua va in Sardegna!"
translating from Dialect to Italian and from italian to English literally "if you have the tongue you can go to Sardegna !" but for the sense is better "You can go anywhere also to a difficult country to reach like the isle Sardegna if you  use your tongue to talk, to ask, to thank"

about developing a scrollbar function
what do you like to do? Complete or stop the developing?
Title: Re: Scroll Bar
Post by: Petr on September 23, 2019, 03:04:18 pm
Hi again.


Finally, I finished what I promised. So ... I tried it for 256 colors only, I will add support for truecolor hexadecimal colors (now must be writed as  unsigned long number) . So far, it works like this:

(Added support for PgUP, PgDn, Up, Dn)

Despite the fact that Erum will probably no use it, because as she write, is done, i add to this thread the promised second type of textbox + third with a shift in all axes. It will certainly be useful to someone later. (And I enjoy it).

Best joke from testing this program?  Hell, why is text not show? Why it works not if use colors? Yeah, man. 32 bit screen and used 8 bit colors...

Code: QB64: [Select]
  1. 'promise: Textbox with use as PRINT. NEED GRAPHIC SCREEN!
  2.  
  3. 'this is future "TextBox.BI"
  4. TYPE Colored
  5.     onpos AS INTEGER
  6.     clr AS _UNSIGNED LONG
  7.     flag AS INTEGER
  9. REDIM SHARED k(0) AS Colored
  10.  
  11. TYPE TB
  12.     X AS INTEGER '   X position graphic coord
  13.     Y AS INTEGER '   Y position graphic coord
  14.     L AS INTEGER '   TextBox lenght
  15.     T AS STRING '    TextBox text
  16.     B AS INTEGER '   Text begin in textbox  (for shift)
  17.     Arrow AS LONG
  18.     D AS SINGLE 'for time delay between click to arrows
  20. REDIM SHARED TBA(0) AS TB
  21. SCREEN _NEWIMAGE(800, 600, 256) 'screen must be initialized before PutArrow& is run.
  22.  
  23. TBA(0).Arrow = PutArrow&
  24. 'real textboxes starting from 1
  25.  
  26. 'end of future "TextBox.BI"
  27.  
  28.  
  29. DIM test(10) AS LONG
  30.  
  31. FOR t = 1 TO 10
  32.     test(t) = INITBOX(100 + 250 * RND, 40 * t - 27, "/5Hi, /14I'm working on it./1 This /2is the /15test/14 text/15 of the program for /78longitudinal scrolling /14in the /90window./14 Color capabilities will be added soon. /8The program uses arrays because program need to remember the shift values for more than one /50b/60o/20x.", 15 + RND * 40)
  34. Demo = INITBOX(150, 500, "/17T/18h/19i/20s /21i/22s/23 s/24m/25a/26l/27l /28t/29e/30x/31t", 9)
  35.  
  36.  
  38.  
  39.     FOR p = 1 TO 10
  40.         PRINTBOX p
  41.     NEXT
  42.     PRINTBOX Demo
  43.  
  44.     _DISPLAY
  46.  
  47. 'this is future "TextBox.BM"
  48.  
  49. FUNCTION INITBOX (X AS INTEGER, Y AS INTEGER, Text AS STRING, BoxLenght AS INTEGER) 'X, Y are GRAPHIC coordinates
  50.     UTB = UBOUND(tba)
  51.     REDIM _PRESERVE TBA(UTB + 1) AS TB
  52.     TBA(UTB + 1).X = X
  53.     TBA(UTB + 1).Y = Y
  54.     TBA(UTB + 1).L = BoxLenght
  55.     CString Text, text2$, k(), UTB + 1
  56.     k(UBOUND(k) - 1).flag = UTB + 1
  57.     TBA(UTB + 1).T = text2$
  58.     TBA(UTB + 1).B = 1
  59.     INITBOX = UTB + 1
  61.  
  62.  
  63. SUB PRINTBOX (nr AS LONG)
  64.     IF nr < 1 OR nr > UBOUND(tba) THEN EXIT SUB 'subscript out of range prevention
  65.     '256/32 color support:
  67.         CASE 0: BEEP: PRINT "Text mode not supported by PRINTBOX!": _DISPLAY: SLEEP 3: END
  68.         CASE 1
  69.             Black~& = 0
  70.             White~& = 15
  71.             Grey~& = 24
  72.             Grey2~& = 19
  73.         CASE 4
  74.             Black~& = &HFF000000
  75.             White~& = &HFFFFFFFF
  76.             Grey~& = &HFF6666666
  77.             Grey2~& = &HFF221122
  78.     END SELECT
  79.  
  80.  
  81.  
  82.  
  83.     TextBoxArrow& = TBA(0).Arrow
  84.     TextLenght = _PRINTWIDTH(TBA(nr).T)
  85.     B = TBA(nr).B
  86.     TextHeight = _FONTHEIGHT
  87.     X = TBA(nr).X
  88.     Y = TBA(nr).Y
  89.     BoxLenght = TBA(nr).L
  90.     T$ = MID$(TBA(nr).T, TBA(nr).B, TBA(nr).L) 'text loader
  91.  
  92.  
  94.         mwh = mwh + _MOUSEWHEEL
  95.         IF mwh THEN EXIT WHILE
  96.     WEND
  97.  
  98.     IF _MOUSEX >= X - 30 AND _MOUSEX <= X + 30 + BoxLenght * _FONTWIDTH THEN
  99.         IF _MOUSEY >= Y - 3 AND _MOUSEY <= Y + 3 + 2 * TextHeight THEN
  100.             B = B + mwh * 4
  101.         END IF
  102.     END IF
  103.  
  104.  
  105.     '
  106.     MB1 = _MOUSEBUTTON(1)
  107.     MX = _MOUSEX
  108.     MY = _MOUSEY
  109.  
  110.     LINE (X - 30, Y - 3)-(X + 30 + BoxLenght * _FONTWIDTH, Y + TextHeight * 2), Black~&, BF
  111.  
  112.  
  113.     LINE (X - 30, Y + TextHeight)-(X + 30 + BoxLenght * _FONTWIDTH, Y + TextHeight * 2), Grey~&, BF
  114.     LINE (X - 30, Y - 3)-(X + 30 + BoxLenght * _FONTWIDTH, Y + 2 * TextHeight), White~&, B
  115.  
  116.     LINE (X - 28, Y - 1)-(X + 28 + BoxLenght * _FONTWIDTH, Y + TextHeight), White~&, B
  117.  
  118.     TL = B / LEN(TBA(nr).T) * 100 'pocatecni poloha pruhu v procentech       begining position for bottom box (perecentually)
  119.     L = TBA(nr).L * _FONTWIDTH
  120.     Actual = _CEIL(X + (TL / 100 * L)) '                                     graphic position for bottom box
  121.     boxl = BoxLenght * _FONTWIDTH
  122.     BL = boxl / (TextLenght / 100) 'delka posuvneho boxiku  v procentech     box on bottom lenght
  123.     BBL = boxl / 100 * BL
  124.  
  125.     'posuvnik
  126.     LINE (Actual, Y + TextHeight + 5)-(Actual + BBL, Y + TextHeight * 2 - 3), White~&, BF
  127.     LINE (Actual, Y + TextHeight + 5)-(Actual + BBL, Y + TextHeight * 2 - 3), Grey2~&, B
  128.  
  129.  
  130.     IF MX >= Actual AND MX <= Actual + BBL THEN
  131.         IF MY >= Y + TextHeight + 5 AND MY <= Y + TextHeight * 2 - 3 THEN
  132.             IF MB1 THEN
  133.                 omx = MX
  134.                 DO UNTIL _MOUSEX <> MX
  135.                     WHILE _MOUSEINPUT: WEND
  136.                     MB1 = _MOUSEBUTTON(1)
  137.                     B = B + _MOUSEX - omx
  138.                 LOOP
  139.             END IF
  140.         END IF
  141.     END IF
  142.  
  143.  
  144.     _PUTIMAGE (X + 15 + BoxLenght * _FONTWIDTH, Y + TextHeight + 1), TextBoxArrow&
  145.     _PUTIMAGE (X - 15, Y + TextHeight + 1)-(X - 27, Y + TextHeight + 1 + 12), TextBoxArrow&
  146.  
  147.     IF TIMER < 1 THEN TBA(nr).D = 0
  148.  
  149.     IF MX >= X + 15 + BoxLenght * _FONTWIDTH AND MX <= X + 15 + BoxLenght * _FONTWIDTH + 12 THEN
  150.         IF MY >= Y + 1 + TextHeight AND MY <= Y + TextHeight * 2 THEN
  151.             IF TBA(nr).D < TIMER THEN
  152.                 IF _PIXELSIZE = 4 THEN
  153.                     LINE (X + 15 + BoxLenght * _FONTWIDTH, Y + TextHeight + 1)-(X + 15 + BoxLenght * _FONTWIDTH + 11, Y + TextHeight * 2), &H44FFFFFF, BF
  154.                 ELSE
  155.                     LINE (X + 15 + BoxLenght * _FONTWIDTH, Y + TextHeight + 1)-(X + 15 + BoxLenght * _FONTWIDTH + 11, Y + TextHeight * 2), 14, B
  156.                 END IF
  157.                 IF MB1 THEN
  158.                     B = B + 1
  159.                 END IF
  160.                 TBA(nr).D = TIMER + .01
  161.             END IF
  162.         END IF
  163.     END IF
  164.  
  165.     IF MX >= X - 26 AND MX <= X - 15 THEN
  166.         ' IF MY >= Y + 1 AND MY <= Y + 13 THEN
  167.         IF MY >= Y + 1 + TextHeight AND MY <= Y + TextHeight * 2 THEN
  168.  
  169.             SELECT CASE _KEYHIT
  170.                 CASE 18176: B = 1
  171.                 CASE 20224: B = LEN(TBA(nr).T) - TBA(nr).L + 1
  172.                 CASE 18688: B = B - TBA(nr).L
  173.                 CASE 20736: B = B + TBA(nr).L
  174.             END SELECT
  175.  
  176.  
  177.             IF TBA(nr).D < TIMER THEN
  178.                 IF _PIXELSIZE = 4 THEN
  179.                     LINE (X - 26, Y + TextHeight + 1)-(X - 15, Y + TextHeight * 2), &H44FFFFFF, BF
  180.                 ELSE
  181.                     LINE (X - 26, Y + TextHeight + 1)-(X - 15, Y + TextHeight * 2), 14, B
  182.                 END IF
  183.                 IF MB1 THEN
  184.                     B = B - 1
  185.                 END IF
  186.                 TBA(nr).D = TIMER + .01
  187.             END IF
  188.         END IF
  189.     END IF
  190.     IF B < 1 THEN B = 1
  191.     IF B > LEN(TBA(nr).T) - TBA(nr).L + 1 THEN B = LEN(TBA(nr).T) - TBA(nr).L + 1
  192.     TBA(nr).B = B
  193.  
  194.     IF _PIXELSIZE = 4 THEN COLOR &HFFFFFFFF ELSE COLOR 15
  195.  
  196.  
  197.     FOR V = 1 TO LEN(TBA(nr).T)
  198.         FOR t = LBOUND(k) + 1 TO UBOUND(k)
  199.             IF k(t).flag = nr THEN
  200.                 IF V = k(t).onpos + 1 THEN COLOR k(t).clr: EXIT FOR
  201.             END IF
  202.         NEXT
  203.  
  204.         IF V >= B AND V <= B + TBA(nr).L THEN
  205.             _PRINTSTRING (X + (W * _FONTWIDTH), Y), MID$(TBA(nr).T, V, 1)
  206.             W = W + 1
  207.         END IF
  208.     NEXT
  209.  
  211.  
  212.  
  213. FUNCTION PutArrow&
  214.     IF _PIXELSIZE = 4 THEN
  215.         PutArrow& = _NEWIMAGE(12, 12, 32)
  216.     ELSE
  217.         PutArrow& = _NEWIMAGE(12, 12, 256)
  218.     END IF
  219.  
  220.     D = _DEST
  221.     _DEST PutArrow&
  222.  
  223.     LINE (1, 4)-(6, 4) '  ------------     up
  224.     LINE (1, 8)-(6, 8) '  ------------     down
  225.     LINE (1, 4)-(1, 8) '  I                arrow back
  226.     LINE (6, 4)-(6, 1)
  227.     LINE (6, 8)-(6, 11)
  228.     LINE (6, 11)-(11, 6)
  229.     LINE (6, 1)-(11, 6)
  230.  
  231.     IF _PIXELSIZE(D) = 4 THEN PAINT (6, 6), &HFF777777, &HFFFFFFFF ELSE PAINT (6, 6), 10, 15
  232.     IF _PIXELSIZE(D) = 4 THEN _CLEARCOLOR &HFF000000, PutArrow& ELSE _CLEARCOLOR 0, PutArrow&
  233.     _DEST D
  235.  
  236. SUB CString (source AS STRING, text AS STRING, K() AS Colored, index AS INTEGER)
  237.     FOR S = 1 TO LEN(source$)
  238.         t$ = MID$(source$, S, 1)
  239.         IF ASC(t$) >= 48 AND ASC(t$) <= 57 AND incolor THEN colornr$ = colornr$ + t$
  240.         IF incolor AND ASC(t$) < 48 OR incolor AND ASC(t$) > 57 THEN K(kk).clr = VAL(colornr$): D = D + LEN(colornr$): colornr$ = "": incolor = 0
  241.         IF t$ = "/" THEN
  242.             D = D + 1
  243.             incolor = 1
  244.             REDIM _PRESERVE K(UBOUND(k) + 1) AS Colored
  245.             kk = UBOUND(k)
  246.             K(kk).onpos = S - D
  247.             K(kk).flag = index
  248.         END IF
  249.         IF incolor = 0 THEN text$ = text$ + t$
  250.     NEXT
  252.  
  253. 'End of future "TextBox.BM"
  254.  
  255.  
  256.  
  257.  

EDIT: Myself found critical bug: Colors from previous call was used also for next call, for next string. REPAIRED in this version. Now all strings use colors as expected. (Bug is also visible on attached image - word's "This" expected color was white. Now it is ok.


  [ This attachment cannot be displayed inline in 'Print Page' view ]  

Title: Re: Scroll Bar
Post by: TempodiBasic on September 23, 2019, 03:13:37 pm
Hi Bplus
I find your version of scrollbar fine and working.
  [ This attachment cannot be displayed inline in 'Print Page' view ]  

Hi Petr
very fine multicolor on the same raw of text...
Title: Re: Scroll Bar
Post by: bplus on September 23, 2019, 03:48:13 pm
Quote
about developing a scrollbar function
what do you like to do? Complete or stop the developing?

I am glad we could eventually help Erum. But she has sort of opened a can of worms with this scrollbar(s) thing.

Petr's and TempodiBasic's interest along with mine have been peaked, I think. I confess I was not particularly interested in a horizontal text scroller but having finished a pretty nice one, I am curious about doing text with a double scrollbar vertical and horizontal. Now Steve has sort of started that topic but also speaks of resizeable programs?? here https://www.qb64.org/forum/index.php?topic=1719.msg109557#msg109557
WTH resizeable programs??? I think he just tapped this section of code out of something bigger that makes more sense as a whole.

So I am wondering should we continue discussion here with the horizontal text conquered or should we move to Steve's thread and try and improve on his double scrollbars by connecting up mouse and normal keys arrows, home. end, pgUp, pgDn... mouse Clicks, mouse dragging, mouse wheel to the scrollers?

There is one other underlying issue to consider, the control of mouse and key inputs over the whole screen which might contain several scrollbars, mouse click or drag areas, say for buttons or lists or text boxes... going this far in thinking ahead, I see we have arrived at on InForm like GUI! (I arrived at this central mouse and key controller problem with Tiny Navigator trying to do 2 Lists to select from Files or Directories.) So now I wonder is it worth the time for working out double scrollbars for giant text which will likely mean a central controller for all mouse and key activity in order to actually use it in an app. ???

Now my head hurts ;-))

Well we are in the Discussion board, so let's continue discussion here if it pleases Petr and TempodiBasic and anyone else interested in this coding problem.




Title: Re: Scroll Bar
Post by: Bert22306 on September 23, 2019, 03:59:05 pm
Yeah, Bplus, Tempo, Steve, and Petr, this discussion started by Erum has been great. Very educational. Always nice to find ways to make QB64 programs look more modern and less DOS-like.
Title: Re: Scroll Bar
Post by: SMcNeill on September 23, 2019, 04:17:12 pm
An upgraded version of my scroll bar system, now that I have a few moments free to flesh it out:

Code: QB64: [Select]
  1. DIM SHARED WorkScreen AS LONG, DisplayScreen AS LONG
  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."
  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."
  17.  
  18.  
  19.  
  20.  
  21.  
  22. StartX = 0: StartY = 0: W = _WIDTH(DisplayScreen): H = _HEIGHT(DisplayScreen)
  23. _DEST DisplayScreen
  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.     ScrollBar StartX, 2
  37.     ScrollBar StartY, 1
  38.  
  39.     k = _KEYHIT
  40.     SELECT CASE k
  41.         CASE ASC("A"), ASC("a"), 19200: StartX = StartX - 10: IF StartX < 0 THEN StartX = 0
  42.         CASE ASC("S"), ASC("s"), 20480: StartY = StartY + 10: IF StartY > _HEIGHT(WorkScreen) - H THEN StartY = _HEIGHT(WorkScreen) - H
  43.         CASE ASC("D"), ASC("d"), 19712: StartX = StartX + 10: IF StartX > _WIDTH(WorkScreen) - W THEN StartX = _WIDTH(WorkScreen) - W
  44.         CASE ASC("W"), ASC("w"), 18432: StartY = StartY - 10: IF StartY < 0 THEN StartY = 0
  45.     END SELECT
  48.         IF _MOUSEX > W - 21 AND _MOUSEY < H - 20 THEN 'We're on a up/down scroll bar
  49.             StartY = _MOUSEY / _HEIGHT(DisplayScreen) * _HEIGHT(WorkScreen)
  50.             IF StartY > _HEIGHT(WorkScreen) - H THEN StartY = _HEIGHT(WorkScreen) - H
  51.         END IF
  52.         IF _MOUSEY > H - 21 AND _MOUSEX < W - 20 THEN 'we're on the left/right scroll bar
  53.             StartX = _MOUSEX / _WIDTH(DisplayScreen) * _WIDTH(WorkScreen)
  54.             IF StartX > _WIDTH(WorkScreen) - W THEN StartX = _WIDTH(WorkScreen) - W
  55.         END IF
  56.     END IF
  57.  
  58.     _PUTIMAGE (0, 0)-(W - 20, H - 20), WorkScreen, DisplayScreen, (StartX, StartY)-STEP(W, H)
  59.     _DISPLAY
  61.  
  62.  
  63.  
  64.  
  65.  
  66. SUB ScrollBar (Start, Direction)
  67.     D = _DEST: _DEST DisplayScreen 'our scrollbars show on the display
  68.     Min = 0
  69.     MaxH = _HEIGHT(DisplayScreen)
  70.     MaxW = _WIDTH(DisplayScreen)
  71.     H = _HEIGHT(WorkScreen)
  72.     W = _WIDTH(WorkScreen)
  73.     IF Direction = 1 THEN 'up/down bar
  74.         Box MaxW - 20, 0, 20, MaxH - 20, &HFF777777, &HFFFFFFFF
  75.         Box MaxW - 19, Start / H * MaxH, 18, MaxH / H * MaxH - 20, &HFFFF0000, 0 'Red with transparent
  76.     ELSE 'left/right bar
  77.         Box Min, MaxH - 20, MaxW - 20, 20, &HFF777777, &HFFFFFFFF 'Gray with white border
  78.         Box Start / W * MaxW, MaxH - 19, MaxW / W * MaxW - 20, 18, &HFFFF0000, 0 'Red with transparent
  79.     END IF
  80.     _DEST D
  82.  
  83.  
  84. SUB Box (x, y, wide, high, kolor AS _UNSIGNED LONG, border AS _UNSIGNED LONG)
  85.     LINE (x, y)-STEP(wide, high), kolor, BF
  86.     LINE (x, y)-STEP(wide, high), border, B
  88.  

Arrow keys scroll, and you can use the mouse to maneuver via the scroll bars if you hold the left mouse down while over one of them.  The window is also resizable, with the scroll bars automatically adjusting to the new window sizes.   Test it out, and see what you think of it.  ;)
Title: Re: Scroll Bar
Post by: Petr on September 23, 2019, 05:14:38 pm
I think about it the best. :) Good work, Steve.
Title: Re: Scroll Bar
Post by: bplus on September 23, 2019, 05:29:51 pm
Quote from: Petr on September 23, 2019, 05:14:38 pm
I think about it the best. :) Good work, Steve.

Well I wonder if Steve or anyone can put can put N text boxes up with double scrollers on the same screen like we were doing for text hScrollers with mouse wheel and other key presses also of course!  ;-))
Title: Re: Scroll Bar
Post by: SMcNeill on September 23, 2019, 05:38:32 pm
Quote from: bplus on September 23, 2019, 05:29:51 pm
Well I wonder if Steve or anyone can put can put N text boxes up with double scrollers on the same screen like we were doing for text hScrollers with mouse wheel and other key presses also of course!  ;-))

Sure.  Just make each scroll area independent, and assign them their own unique handle,  like with my little text frames routines.  All this demo needed was to make a screen adjustable/scrollable, but all you do is apply the same principle to any given screen regions — one screen of set size to draw/write on, a second screen to display a portion of it on via _PUTIMAGE, with the scroll bars just being X/Y incremental tools.  (Which is all they do above for us.)
Title: Re: Scroll Bar
Post by: TempodiBasic on September 23, 2019, 05:44:49 pm
about

Quote
So I am wondering should we continue discussion here with the horizontal text conquered or should we move to Steve's thread

Here my answer to unify the threads https://www.qb64.org/forum/index.php?topic=1719.msg109796#msg109796 (https://www.qb64.org/forum/index.php?topic=1719.msg109796#msg109796)

about this issue
Quote
So now I wonder is it worth the time for working out double scrollbars for giant text which will likely mean a central controller for all mouse and key activity in order to actually use it in an app. ???

IMHO when we go to think as objects or entities to use in our programs we have two option...
1.  centered managing of mouse and keyboard and other input ways  ,
      so we can think about it like a pyramid that has like apex the I/O routine to be directed to the right entity at bottom,
      or like a collection of areas to be activated by a flag (in Windows there are the messages among objects)
2. a plane or circular managing of I/O  in which the objects/entities have the own different action that is activated by the specific
    position of the mouse and by the specific comboKey

the substantial difference between them is that in the first the apex manages I/O and triggers entity's action, in the second there is a main loop in which each entity tests if position of mouse and combokey activate its action/s.

just as example about previous scrolling horizonthal
in the first kind of  multi entities  there is a main loop that catches I/O  and activate the single scrolling bar...
in the second kind of multi entities, one at time  each entity tests if it must react ot I/O so there is a main loop that cycles among all entities

so in the first kind each entity has a value or code to be activated and disactivated
while in the second kind each entity has an entry of parameters and a routine to activate itself.

Waiting your opinion
Thanks to read
Title: Re: Scroll Bar
Post by: Petr on September 23, 2019, 05:56:22 pm
Quote
Sure.  Just make each scroll area independent, and assign them their own unique handle,  like with my little text frames routines.  All this demo needed was to make a screen adjustable/scrollable, but all you do is apply the same principle to any given screen regions — one screen of set size to draw/write on, a second screen to display a portion of it on via _PUTIMAGE, with the scroll bars just being X/Y incremental tools.  (Which is all they do above for us.)


I'll do it differently. I'll do it with PRINTSTRING (none PUTIMAGE). Yeah, if I wanted to make a slider for pictures with text, that would be harder. To solve the text flow around the picture .... I can think of several possibilities, but I will stay with the text. Of course it will take a while, but it won't be a problem. Of course there will be an unlimited number (according to RAM) of these dialogs on the monitor. I think, i need 2 or 3 days for it (i have very limited time for programming now).


So far, I say goodbye because here is midnight.
Title: Re: Scroll Bar
Post by: Petr on September 23, 2019, 06:09:28 pm
OFFTOPIC - Steve your next video tutorial is in perfect quality! I see it tomorrow!
Title: Re: Scroll Bar
Post by: Petr on September 30, 2019, 04:40:03 pm
So it took a little longer, I didn't have so much time and finally I didn't want much ... and unfortunately I came across a STRING error again. A STRING error is resolved by adding * 10 in the TB2 field definition in the X / Y Slider. Thus, I understand the meaning of STRING * 10 for writing to a file, but I do not understand the meaning of STRING * 10 when writing to memory when the subsequent string is as long as you like. Well, if you remove * 10 from the field definition, you won't color the text and the program will start doing unexpected things. Perhaps we can find the reason for the error, this program is much simpler than the previous one, where the same error manifested itself differently.

So the programs. The XY slider creates a text box at the X, Y position, with the option of scrolling the X and Y axes and coloring the text in / 15 = white for a 256 color screen with the basic color palette, or / 4294967295 in 32bit screen for white color. The number of slider windows is unlimited. The only limit is the size of your RAM.

The slider X program is older and listed here (but the version above has some bugs that the new version no longer contains). It is a one-line slider for text only in the X axis, also with the same colored text option.


XY slider:

Code: QB64: [Select]
  1.  
  2.  
  3. 'this is future "TextBox.BI"
  4. TYPE Colored '                      This Array contains colors positions on text and color values. This array is created in SUB CString.
  5.     onpos AS INTEGER
  6.     clr AS _UNSIGNED LONG
  7.     flag AS INTEGER
  8.     row AS INTEGER
  10. REDIM SHARED k(0) AS Colored
  11.  
  12. TYPE TB2
  13.     X AS INTEGER '   X position graphic coord
  14.     Y AS INTEGER '   Y position graphic coord
  15.     L AS INTEGER '   TextBox lenght
  16.     H AS INTEGER '   Textbox HEIGHT                                            NEW
  17.     T AS STRING * 10 '    TextBox text                                                            AGAIN STRING BUG!!!!!! DELETE *10 and run this program for really unexpected outputs!
  18.     B AS INTEGER '   Text begin in textbox  (for shift), X axis
  19.     BH AS INTEGER '  Text begin in textbox  (for shift), Y axis                NEW
  20.  
  21.     D AS SINGLE '    for time delay between click to arrows
  22.     I_s AS INTEGER
  23.     I_e AS INTEGER
  24.     filter AS _BYTE 'new info flag for CString, which is needed just in the start, but not more.
  26.  
  27. REDIM SHARED TBA2(0) AS TB2
  28. REDIM SHARED GlobalText(0) AS STRING 'spolecne obrovske textove pole obsahujici texty pro vsechna okna vcetne udaju o barvach
  29. DIM SHARED Arrow0 AS LONG, Arrow1 AS LONG, Arrow2 AS LONG, Arrow3 AS LONG
  30.  
  31.  
  32. SCREEN _NEWIMAGE(800, 600, 256) 'screen must be initialized before PutArrow& is run.
  33. Arrow0 = PutArrow
  34. R90 Arrow0, Arrow1, Arrow2, Arrow3 'create four arrows in four directions from first source image
  35. 'end of future "TextBox.BI"
  36.  
  37.  
  38.  
  39.  
  40. DIM Text1(7) AS STRING
  41. DIM Text2(14) AS STRING
  42.  
  43. Text1(1) = "/14This is content /1for /2array /3Text1. Original and source text array content is in"
  44. Text1(2) = "/44array Text1. Because Petr can just 2 ways (first: MEM Pointer to array insert"
  45. Text1(3) = "/45to type), or second, easyest - all texts insert to one STRING SHARED array, and"
  46. Text1(4) = "/46writing informations about start and end index to TYPE, is now this text also"
  47. Text1(5) = "/47inserted to array named as GlobalText. Because this text contains 7 rows and "
  48. Text1(6) = "/48Text1 array is inserted as first, is this saved in indexes 0 to 6 in array"
  49. Text1(7) = "/49GlobalText. Info about this records are here saved to TBA2().I_s and TBA2().I_e"
  50.  
  51.  
  52.  
  53. Text2(1) = "                /14   Example for use:"
  54. Text2(2) = "/40 With '/40/' and then number you set colors. If you use _SCREEN _NEWIMAGE in 256 colors,"
  55. Text2(3) = "then use number from 0 to 256. But if you use 32 bit screen, then dont use &H values but"
  56. Text2(4) = "/50 number. This number can be returned using this easy source code:"
  57. Text2(5) = "/55 COLOR~& = &HFFFFFFFF  /60 or /55 COLOR~& = _RGBA32(255, 255, 255)"
  58. Text2(6) = "PRINT COLOR~&. /60 This is number, which you need for use to 32 bit screens with this"
  59. Text2(7) = "easy program. (i write soon automatic translator for it, but with my time....)/9"
  60. Text2(8) = "Program construction: - All strings are saved to array /14 GlobalText."
  61. Text2(9) = "                     /9 - Function /14R90/9 create 4 images which contains rows, rotated from 1"
  62. Text2(10) = "                       source image, which is created with Function /14PutArrow./9"
  63. Text2(11) = "                     - /14CString /9SUB create help array for colors used in text to array /14K/9."
  64. Text2(12) = "                     - /14MaximalRowLenght/9 Function return lenght of longest row in text array."
  65. Text2(13) = "                     - Function /14INITBOX2/9 write all needed records to program arrays and return record number."
  66. Text2(14) = "                     - /14XY_BOX /9SUB - own program. Study it /33yourself /40:-)"
  67.  
  68.  
  69. A = INITBOX2(100, 50, Text1(), 10, 8)
  70. B = INITBOX2(300, 50, Text1(), 30, 6)
  71. C = INITBOX2(100, 250, Text2(), 20, 15)
  72. D = INITBOX2(350, 180, Text2(), 50, 26)
  73.  
  74.  
  75.  
  77.     XY_BOX A
  78.     XY_BOX B
  79.     XY_BOX C
  80.     XY_BOX D
  81.     _DISPLAY
  82.     _LIMIT 60
  84.  
  85.  
  86.  
  87. 'this is future "TextBox.BM"
  88. FUNCTION INITBOX2 (X AS INTEGER, Y AS INTEGER, Text() AS STRING, BoxLenght AS INTEGER, BoxHeight AS INTEGER) 'X, Y are GRAPHIC coordinates
  89.     UTB = UBOUND(tba2)
  90.     REDIM _PRESERVE TBA2(UTB + 1) AS TB2
  91.     TBA2(UTB + 1).X = X
  92.     TBA2(UTB + 1).Y = Y
  93.     TBA2(UTB + 1).L = BoxLenght
  94.     TBA2(UTB + 1).H = BoxHeight
  95.  
  96.  
  97.  
  98.  
  99.     TBA2(UTB + 1).T = ""
  100.     U1 = UBOUND(globaltext)
  101.     U2 = UBOUND(text)
  102.  
  103.     TBA2(UTB + 1).I_s = U1
  104.     TBA2(UTB + 1).I_e = U1 + U2
  105.  
  106.     REDIM _PRESERVE GlobalText(U1 + U2 + 1) AS STRING
  107.  
  108.     FOR insert = U1 TO U1 + U2
  109.         GlobalText(insert) = Text(t)
  110.         t = t + 1
  111.     NEXT
  112.  
  113.     TBA2(UTB + 1).BH = U1 + 1 'after first start: first row (BH is shift in Y, B is shift in X axis)
  114.     TBA2(UTB + 1).B = 1 'and first column
  115.     INITBOX2 = UTB + 1
  117.  
  118.  
  119. SUB XY_BOX (nr AS LONG)
  120.     '256/32 color support:
  121.  
  123.         CASE 0: BEEP: PRINT "Text mode not supported by PRINTBOX!": _DISPLAY: SLEEP 3: END
  124.         CASE 1
  125.             Black~& = 0
  126.             White~& = 15
  127.             Grey~& = 24
  128.             Grey2~& = 19
  129.         CASE 4
  130.             Black~& = &HFF000000
  131.             White~& = &HFFFFFFFF
  132.             Grey~& = &H226666666
  133.             Grey2~& = &HFF221122
  134.     END SELECT
  135.  
  136.  
  137.     RowLen = MaximalRowLenght(nr)
  138.     TextLenght = RowLen * _FONTWIDTH
  139.     B = TBA2(nr).B
  140.     BH = TBA2(nr).BH
  141.  
  142.     TextHeight = _FONTHEIGHT
  143.     X = TBA2(nr).X
  144.     Y = TBA2(nr).Y
  145.     BoxLenght = TBA2(nr).L - 2
  146.     BoxHeight = 1 + TBA2(nr).H * _FONTHEIGHT
  147.  
  149.         mwh = mwh + _MOUSEWHEEL
  150.         IF mwh THEN EXIT WHILE
  151.     WEND
  152.  
  153.     IF _MOUSEX >= X - 30 AND _MOUSEX <= X + 30 + BoxLenght * _FONTWIDTH THEN
  154.         IF _MOUSEY >= Y - 3 AND _MOUSEY <= Y + 3 + 2 * TextHeight THEN
  155.             B = B + mwh * 4
  156.         END IF
  157.     END IF
  158.  
  159.  
  160.     '
  161.     MB1 = _MOUSEBUTTON(1)
  162.     MX = _MOUSEX
  163.     MY = _MOUSEY
  164.  
  165.  
  166.  
  167.  
  168.     LINE (X - 30, Y)-(X + 30 + BoxLenght * _FONTWIDTH, Y + BoxHeight), Grey~&, BF 'vnitrek okna                                   window inside
  169.     LINE (X - 30, Y - 3)-(X + 30 + BoxLenght * _FONTWIDTH, Y + BoxHeight), White~&, B
  170.     LINE (X - 28, Y - 1)-(X + 28 + BoxLenght * _FONTWIDTH, Y + BoxHeight - TextHeight), White~&, B
  171.  
  172.     'borders for lines up / down
  173.     LINE (X + 30 + BoxLenght * _FONTWIDTH, Y - 1)-(X + 11 + BoxLenght * _FONTWIDTH, Y + BoxHeight - TextHeight), White~&, B
  174.  
  175.  
  176.     '  slider X calculations. For calculating slider lenght you need the number of characters of the longest sentence used in the box. MaximalRowLenght function return it:
  177.     '////////////////////////////////////////////////////////
  178.     TL = B / RowLen * 100 'pocatecni poloha pruhu v procentech            begining position for bottom box (percentually)
  179.     L = TBA2(nr).L * _FONTWIDTH 'celkova delka pruhu v pixelech           total slide lenght in pixels
  180.     Actual = _CEIL(X + (TL / 100 * L)) '                                  graphic position for bottom box
  181.     boxl = BoxLenght * _FONTWIDTH
  182.     BL = boxl / (TextLenght / 100) 'delka posuvneho boxiku  v procentech     box on bottom lenght  (how it is done: Slider lenght is percentually size as window bottom (for X - Shift).
  183.     '                                                                        if 30 percent of the sentence length is visible in the window, then the slider is 30 percent of the length of the X-side this window
  184.     IF BL > 100 THEN BL = 100 '                                              if text lenght < window X side, draw slider as 100 percent of X window side
  185.  
  186.     BBL = boxl / 100 * BL
  187.  
  188.     'posuvnik X        Slider X
  189.     LINE (Actual, Y + BoxHeight - TextHeight + 5)-(Actual + BBL, Y + BoxHeight - TextHeight + 12), White~&, BF
  190.     LINE (Actual, Y + BoxHeight - TextHeight + 5)-(Actual + BBL, Y + BoxHeight - TextHeight + 12), Grey2~&, B
  191.     '////////////////////////////////////////////////////////////
  192.  
  193.  
  194.  
  195.  
  196.  
  197.  
  198.     'slider Y (the same os for X slider)
  199.     DelkaSteny = BoxHeight - TextHeight - (2 * _FONTHEIGHT) - 2
  200.     ZaznamuNaStenu = DelkaSteny / _FONTHEIGHT
  201.     Zaznamu100 = ZaznamuNaStenu / (TBA2(nr).I_e - TBA2(nr).I_s) * 100
  202.     BBH = (Zaznamu100 / 100) * DelkaSteny
  203.     IF BBH > DelkaSteny THEN BBH = DelkaSteny
  204.  
  205.     Pozice = 1 + (BH - TBA2(nr).I_e) / TBA2(nr).I_e
  206.     actualH = Y + _FONTHEIGHT + ((DelkaSteny - BBH) * Pozice)
  207.  
  208.  
  209.     'posuvnik Y        Slider Y
  210.     LINE (TBA2(nr).X + TBA2(nr).L * _FONTWIDTH, actualH)-(TBA2(nr).X + TBA2(nr).L * _FONTWIDTH + 7, actualH + BBH), White~&, BF
  211.     LINE (TBA2(nr).X + TBA2(nr).L * _FONTWIDTH, actualH)-(TBA2(nr).X + TBA2(nr).L * _FONTWIDTH + 7, actualH + BBH), Grey2~&, B
  212.  
  213.  
  214.  
  215.     ' solution for moving text by click + move to down box
  216.     IF MX >= X AND MX <= X + _FONTWIDTH * (TBA2(nr).L - 2) THEN
  217.         IF MY >= Y + BoxHeight - TextHeight AND MY <= Y + BoxHeight THEN
  218.             IF MB1 THEN
  219.                 omx = MX
  220.                 DO UNTIL _MOUSEX <> MX
  221.                     WHILE _MOUSEINPUT: WEND
  222.                     MB1 = _MOUSEBUTTON(1)
  223.                     B = B + _MOUSEX - omx
  224.                 LOOP
  225.             END IF
  226.         END IF
  227.     END IF
  228.  
  229.     ' solution for moving text up and down by clicking and move to box on right
  230.     IF MX >= X + 10 + BoxLenght * _FONTWIDTH AND MX <= X + 30 + BoxLenght * _FONTWIDTH THEN
  231.         IF MY >= Y + 16 AND MY <= Y + BoxHeight - 40 THEN
  232.             IF MB1 THEN
  233.                 omy = MY
  234.                 DO UNTIL _MOUSEY <> MY
  235.                     WHILE _MOUSEINPUT: WEND
  236.                     MB1 = _MOUSEBUTTON(1)
  237.                     BH = BH + _MOUSEY - omy
  238.                 LOOP
  239.             END IF
  240.         END IF
  241.     END IF
  242.  
  243.     ABY = Y + 2 + BoxHeight - TextHeight '                  ArrowBottomY coordinate
  244.     LUPAC = X + 15 + BoxLenght * _FONTWIDTH '               Left UP/Down Arrow coordinate
  245.  
  246.     _PUTIMAGE (LUPAC, ABY), Arrow0& '                              Arrow to right
  247.     _PUTIMAGE (X - 27, ABY + 1), Arrow1& '                                  left
  248.     _PUTIMAGE (LUPAC, Y + 2), Arrow3& '                                     up
  249.     _PUTIMAGE (LUPAC - 1, Y + TextHeight * (TBA2(nr).H - 2)), Arrow2& '     down
  250.  
  251.     IF TIMER < 1 THEN TBA2(nr).D = 0
  252.  
  253.     'driving up arrow
  254.     IF MX >= LUPAC AND MX <= LUPAC + 12 THEN
  255.         IF MY >= Y + 2 AND MY <= Y + 14 THEN
  256.             IF TBA2(nr).D < TIMER THEN
  257.                 IF _PIXELSIZE = 4 THEN
  258.                     LINE (LUPAC, Y + 2)-(LUPAC + 12, Y + 14), &H44FFFFFF, BF
  259.                 ELSE
  260.                     LINE (LUPAC, Y + 2)-(LUPAC + 12, Y + 14), 14, B
  261.                 END IF
  262.                 IF MB1 THEN BH = BH - 1
  263.                 TBA2(nr).D = TIMER + .01
  264.                 MB1 = 0
  265.             END IF
  266.         END IF
  267.     END IF
  268.  
  269.     'driving down arrow
  270.     IF MX >= LUPAC - 1 AND MX <= LUPAC + 11 THEN
  271.         IF MY >= Y + TextHeight * (TBA2(nr).H - 2) AND MY <= 12 + Y + TextHeight * (TBA2(nr).H - 2) THEN
  272.             IF TBA2(nr).D < TIMER THEN
  273.                 IF _PIXELSIZE = 4 THEN
  274.                     LINE (LUPAC - 1, Y + TextHeight * (TBA2(nr).H - 2))-(LUPAC + 11, 12 + Y + TextHeight * (TBA2(nr).H - 2)), &H44FFFFFF, BF
  275.                 ELSE
  276.                     LINE (LUPAC - 1, Y + TextHeight * (TBA2(nr).H - 2))-(LUPAC + 11, 12 + Y + TextHeight * (TBA2(nr).H - 2)), 14, B
  277.                 END IF
  278.                 IF MB1 THEN BH = BH + 1
  279.                 TBA2(nr).D = TIMER + .01
  280.                 MB1 = 0
  281.             END IF
  282.         END IF
  283.     END IF
  284.  
  285.  
  286.  
  287.     'driving right arrow on bottom
  288.     IF MX >= LUPAC AND MX <= LUPAC + 12 THEN
  289.         IF MY >= ABY AND MY <= ABY + 12 THEN
  290.  
  291.             IF TBA2(nr).D < TIMER THEN
  292.                 IF _PIXELSIZE = 4 THEN
  293.                     LINE (LUPAC, ABY)-(LUPAC + 12, ABY + 12), &H44FFFFFF, BF
  294.                 ELSE
  295.                     LINE (LUPAC, ABY)-(LUPAC + 12, ABY + 12), 14, B
  296.                 END IF
  297.                 IF MB1 THEN
  298.                     B = B + 1
  299.                     MB1 = 0
  300.                     TBA2(nr).D = TIMER + .01
  301.                 END IF
  302.             END IF
  303.         END IF
  304.     END IF
  305.  
  306.     'driving left arrow on bottom
  307.     IF MX >= X - 27 AND MX <= X - 15 THEN '12 + 15 = 27, 12 is arrow width
  308.         IF MY >= ABY + 1 AND MY <= ABY + 13 THEN
  309.             IF TBA2(nr).D < TIMER THEN
  310.                 IF _PIXELSIZE = 4 THEN
  311.                     LINE (X - 27, ABY + 1)-(X - 15, ABY + 13), &H44FFFFFF, BF
  312.                 ELSE
  313.  
  314.                     LINE (X - 27, ABY + 1)-(X - 15, ABY + 13), 14, B
  315.                 END IF
  316.                 IF MB1 THEN
  317.                     B = B - 1
  318.                     MB1 = 0
  319.                     TBA2(nr).D = TIMER + .01
  320.                 END IF
  321.             END IF
  322.         END IF
  323.     END IF
  324.  
  325.  
  326.     'new: left - right keyboard driving:       (home, end, pg up, pg dn, insert (not edit), delete (not edit), arrows up, down, left, right)
  327.     IF MX >= X - 30 AND MX <= X + BoxLenght * _FONTWIDTH + 30 THEN
  328.         IF MY > Y AND MY <= Y + BoxHeight THEN
  329.  
  330.             KH& = _KEYHIT
  331.             IF KH& THEN
  332.                 SELECT CASE KH&
  333.                     CASE 18176: B = 1
  334.                     CASE 20224: B = RowLen - TBA2(nr).L + 1
  335.                     CASE 18688: B = B - TBA2(nr).L ' PgUP
  336.                     CASE 20736: B = B + TBA2(nr).L ' PgDN
  337.                     CASE 19200: B = B - 1 '          left
  338.                     CASE 19712: B = B + 1 '          right
  339.                     CASE 18432: BH = BH - 1 '        up
  340.                     CASE 20480: BH = BH + 1 '         down
  341.                     CASE 20992: BH = BH + TBA2(nr).H 'insert
  342.                     CASE 21428: BH = BH - TBA2(nr).H 'delete
  343.                 END SELECT
  344.                 _KEYCLEAR
  345.             END IF
  346.  
  347.         END IF
  348.     END IF
  349.  
  350.     IF BH < TBA2(nr).I_s THEN BH = TBA2(nr).I_s
  351.     IF BH > TBA2(nr).I_e THEN BH = TBA2(nr).I_e
  352.  
  353.  
  354.     IF B > RowLen - TBA2(nr).L + 1 THEN B = RowLen - TBA2(nr).L + 1
  355.     IF B < 1 THEN B = 1
  356.  
  357.     TBA2(nr).B = B '      B is variable for shift left and right
  358.     TBA2(nr).BH = BH '    BH is variable for shift up and down
  359.  
  360.     IF _PIXELSIZE = 4 THEN COLOR &HFFFFFFFF ELSE COLOR 15
  361.  
  362.     IF TBA2(nr).filter = 0 THEN CString k(), nr: TBA2(nr).filter = 1 'and this is row, which AGAIN find me STRING BUG. Nr is not correct, if is STRING without star used!
  363.  
  364.  
  365.     BHE = BH + TBA2(nr).H - 2
  366.     IF BHE > TBA2(nr).I_e THEN BHE = TBA2(nr).I_e
  367.  
  368.  
  369.     'coloring and printing content
  371.  
  372.     FOR Rows = BH TO BHE
  373.         FOR v = 1 TO RowLen
  374.             FOR T = LBOUND(k) + 1 TO UBOUND(k)
  375.                 IF k(T).flag = nr THEN '               here is contained color bug. For better solution must be first found starting color, on which text start. It will be done later.
  376.                     IF Rows = k(T).row THEN
  377.                         IF v = k(T).onpos + 1 THEN COLOR k(T).clr: EXIT FOR
  378.                     END IF
  379.                 END IF
  380.             NEXT
  381.             IF v >= B AND v <= B + TBA2(nr).L THEN
  382.                 _PRINTSTRING (X - 20 + (w * _FONTWIDTH), Y + (Rows - BH) * _FONTHEIGHT), MID$(GlobalText(Rows), v, 1)
  383.                 w = w + 1
  384.             END IF
  385.         NEXT
  386.         w = 0
  387.     NEXT Rows
  390.  
  391.  
  392. FUNCTION PutArrow&
  393.     IF _PIXELSIZE = 4 THEN
  394.         PutArrow& = _NEWIMAGE(12, 12, 32)
  395.     ELSE
  396.         PutArrow& = _NEWIMAGE(12, 12, 256)
  397.     END IF
  398.  
  399.     D = _DEST
  400.     _DEST PutArrow&
  401.  
  402.     LINE (1, 4)-(6, 4)
  403.     LINE (1, 8)-(6, 8)
  404.     LINE (1, 4)-(1, 8)
  405.     LINE (6, 4)-(6, 1)
  406.     LINE (6, 8)-(6, 11)
  407.     LINE (6, 11)-(11, 6)
  408.     LINE (6, 1)-(11, 6)
  409.  
  410.     IF _PIXELSIZE(D) = 4 THEN PAINT (6, 6), &HFF777777, &HFFFFFFFF ELSE PAINT (6, 6), 10, 15
  411.     IF _PIXELSIZE(D) = 4 THEN _CLEARCOLOR &HFF000000, PutArrow& ELSE _CLEARCOLOR 0, PutArrow&
  412.     _DEST D
  414.  
  415.  
  416. SUB CString (K() AS Colored, index AS INTEGER)
  417.     FOR rows = TBA2(index).I_s TO TBA2(index).I_e
  418.         source$ = GlobalText(rows)
  419.         FOR S = 1 TO LEN(source$)
  420.             old$ = t$
  421.             t$ = MID$(source$, S, 1)
  422.             IF ASC(t$) >= 48 AND ASC(t$) <= 57 AND incolor THEN colornr$ = colornr$ + t$
  423.             IF incolor AND ASC(t$) < 48 OR incolor AND ASC(t$) > 57 THEN
  424.                 K(kk).clr = VAL(colornr$): D = D + LEN(colornr$): colornr$ = "": incolor = 0
  425.                 IF old$ = "/" THEN text$ = text$ + old$
  426.             END IF
  427.  
  428.             IF t$ = "/" THEN
  429.                 D = D + 1
  430.                 incolor = 1
  431.                 REDIM _PRESERVE K(UBOUND(k) + 1) AS Colored
  432.                 kk = UBOUND(k)
  433.                 K(kk).onpos = S - D
  434.                 K(kk).flag = index
  435.                 K(kk).row = rows
  436.             END IF
  437.             IF incolor = 0 THEN text$ = text$ + t$
  438.         NEXT
  439.  
  440.         GlobalText(rows) = text$
  441.         text$ = ""
  442.         ind = ind + 1
  443.         D = 0
  444.     NEXT rows
  446.  
  447.  
  448. SUB R90 (img0 AS LONG, img1 AS LONG, img2 AS LONG, img3 AS LONG) 'create 4 arrows from one in four directions
  449.     IF img0 >= -1 THEN EXIT SUB 'source image is invalid
  450.     W = _WIDTH(img0)
  451.     H = _HEIGHT(img0)
  452.     P = _PIXELSIZE(img0)
  453.     DIM CC AS _UNSIGNED LONG
  454.  
  455.     SELECT CASE P
  456.         CASE 0: EXIT SUB 'text mode unsupported
  457.         CASE 1: D = 256: CC = 0
  458.         CASE 4: D = 32: CC = &HFF000000
  459.     END SELECT
  460.  
  461.     img1 = _NEWIMAGE(W, H, D)
  462.     _PUTIMAGE , img0, img1, (W, 1)-(1, H) '180 degrees rotating
  463.  
  464.     img2 = _NEWIMAGE(H, W, D) '            90
  465.     _MAPTRIANGLE (0, 0)-(W, 0)-(W, H), img0 TO(H, 0)-(H, W)-(0, W), img2
  466.     _MAPTRIANGLE (0, 0)-(W, H)-(0, H), img0 TO(H, 0)-(0, W)-(0, 0), img2
  467.  
  468.     img3 = _NEWIMAGE(H, W, D)
  469.     _PUTIMAGE , img2, img3, (1, W)-(H, 1) '270
  470.     _CLEARCOLOR CC, img1
  471.     _CLEARCOLOR CC, img2
  472.     _CLEARCOLOR CC, img3
  474.  
  475. FUNCTION MaximalRowLenght (i)
  476.     MaximalRowLenght = 0
  477.     REDIM test(0) AS STRING
  478.     ClearColorRecordsAndVauesFromTextArray TBA2(i).I_s, TBA2(i).I_e, test()
  479.  
  480.     FOR p = LBOUND(test) TO UBOUND(test)
  481.         IF MaximalRowLenght < LEN(test(p)) THEN MaximalRowLenght = LEN(test(p))
  482.     NEXT
  484.  
  485. SUB ClearColorRecordsAndVauesFromTextArray (start, eend, arrname() AS STRING) 'If we need find maximal row lenght, first must color tags be deleted from text.
  486.     REDIM arrname(eend - start) AS STRING
  487.     FOR c = start TO eend
  488.         FOR L = 1 TO LEN(GlobalText(c))
  489.             ch$ = MID$(GlobalText(c), L, 1)
  490.             IF ch$ = "/" THEN iscolor = 1
  491.             IF iscolor AND ASC(ch$) > 47 AND ASC(ch$) < 58 THEN ELSE t$ = t$ + ch$
  492.             IF iscolor AND ASC(ch$) < 47 OR iscolor AND ASC(ch$) > 58 THEN
  493.                 iscolor = 0
  494.             END IF
  495.         NEXT
  496.         arrname(c - start) = t$
  497.         t$ = ""
  498.     NEXT c
  500.  
  501. 'End of future "TextBox.BM"
  502.  

  [ This attachment cannot be displayed inline in 'Print Page' view ]  

X - slider:

Also, this program does not have a limited number of sliders. You can place them as much as big is your RAM. This is the older version on which the X/Y new version is based.


Code: QB64: [Select]
  1. 'promise: Textbox with use as PRINT. NEED GRAPHIC SCREEN!
  2.  
  3. 'this is future "TextBox.BI"
  4. TYPE Colored
  5.     onpos AS INTEGER
  6.     clr AS _UNSIGNED LONG
  7.     flag AS INTEGER
  9. REDIM SHARED k(0) AS Colored
  10.  
  11. TYPE TB
  12.     X AS INTEGER '   X position graphic coord
  13.     Y AS INTEGER '   Y position graphic coord
  14.     L AS INTEGER '   TextBox lenght
  15.     T AS STRING '    TextBox text
  16.     B AS INTEGER '   Text begin in textbox  (for shift)
  17.     Arrow AS LONG
  18.     D AS SINGLE 'for time delay between click to arrows
  20. REDIM SHARED TBA(0) AS TB
  21. SCREEN _NEWIMAGE(800, 600, 256) 'screen must be initialized before PutArrow& is run.
  22.  
  23.  
  24. TBA(0).Arrow = PutArrow&
  25. 'real textboxes starting from 1
  26.  
  27. 'end of future "TextBox.BI"
  28.  
  29.  
  30. DIM test(10) AS LONG
  31.  
  32. FOR t = 1 TO 10
  33.     test(t) = INITBOX(100 + 25 * RND, 40 * t, "/42Hi World in 32 bites/29 colored long text/15 placed in textbox.", 15 + RND * 60)
  35. Demo = INITBOX(150, 500, "/49 Here /55is used /42absolutely random color /77number...", 29)
  36.  
  37.  
  39.  
  40.     FOR p = 1 TO 10
  41.         XY_BOX p
  42.     NEXT
  43.     XY_BOX Demo
  44.  
  45.     _DISPLAY
  47.  
  48. 'this is future "TextBox.BM"
  49.  
  50. FUNCTION INITBOX (X AS INTEGER, Y AS INTEGER, Text AS STRING, BoxLenght AS INTEGER) 'X, Y are GRAPHIC coordinates
  51.     UTB = UBOUND(tba)
  52.     REDIM _PRESERVE TBA(UTB + 1) AS TB
  53.     TBA(UTB + 1).X = X
  54.     TBA(UTB + 1).Y = Y
  55.     TBA(UTB + 1).L = BoxLenght
  56.     CString Text, text2$, k(), UTB + 1
  57.     TBA(UTB + 1).T = text2$
  58.     TBA(UTB + 1).B = 1
  59.     INITBOX = UTB + 1
  61.  
  62.  
  63. SUB XY_BOX (nr AS LONG)
  64.     IF nr < 1 OR nr > UBOUND(tba) THEN EXIT SUB 'subscript out of range prevention
  65.     '256/32 color support:
  67.         CASE 0: BEEP: PRINT "Text mode not supported by PRINTBOX!": _DISPLAY: SLEEP 3: END
  68.         CASE 1
  69.             Black~& = 0
  70.             White~& = 15
  71.             Grey~& = 24
  72.             Grey2~& = 19
  73.         CASE 4
  74.             Black~& = &HFF000000
  75.             White~& = &HFFFFFFFF
  76.             Grey~& = &HFF6666666
  77.             Grey2~& = &HFF221122
  78.     END SELECT
  79.  
  80.  
  81.  
  82.  
  83.     TextBoxArrow& = TBA(0).Arrow
  84.     TextLenght = _PRINTWIDTH(TBA(nr).T)
  85.     B = TBA(nr).B
  86.     TextHeight = _FONTHEIGHT
  87.     X = TBA(nr).X
  88.     Y = TBA(nr).Y
  89.     BoxLenght = TBA(nr).L
  90.     T$ = MID$(TBA(nr).T, TBA(nr).B, TBA(nr).L) 'text loader
  91.  
  92.  
  94.         mwh = mwh + _MOUSEWHEEL
  95.         IF mwh THEN EXIT WHILE
  96.     WEND
  97.  
  98.     IF _MOUSEX >= X - 30 AND _MOUSEX <= X + 30 + BoxLenght * _FONTWIDTH THEN
  99.         IF _MOUSEY >= Y - 3 AND _MOUSEY <= Y + 3 + 2 * TextHeight THEN
  100.             B = B + mwh * 4
  101.         END IF
  102.     END IF
  103.  
  104.  
  105.     '
  106.     MB1 = _MOUSEBUTTON(1)
  107.     MX = _MOUSEX
  108.     MY = _MOUSEY
  109.  
  110.     LINE (X - 30, Y - 3)-(X + 30 + BoxLenght * _FONTWIDTH, Y + TextHeight * 2), Black~&, BF
  111.  
  112.  
  113.     LINE (X - 30, Y + TextHeight)-(X + 30 + BoxLenght * _FONTWIDTH, Y + TextHeight * 2), Grey~&, BF
  114.     LINE (X - 30, Y - 3)-(X + 30 + BoxLenght * _FONTWIDTH, Y + 2 * TextHeight), White~&, B
  115.  
  116.     LINE (X - 28, Y - 1)-(X + 28 + BoxLenght * _FONTWIDTH, Y + TextHeight), White~&, B
  117.  
  118.     TL = B / LEN(TBA(nr).T) * 100 'pocatecni poloha pruhu v procentech       begining position for bottom box (perecentually)
  119.     L = TBA(nr).L * _FONTWIDTH
  120.     Actual = _CEIL(X + (TL / 100 * L)) '                                     graphic position for bottom box
  121.     boxl = BoxLenght * _FONTWIDTH
  122.     BL = boxl / (TextLenght / 100) 'delka posuvneho boxiku  v procentech     box on bottom lenght
  123.     IF BL > 100 THEN BL = 100
  124.  
  125.     BBL = boxl / 100 * BL
  126.  
  127.     'posuvnik                 Slider
  128.     LINE (Actual, Y + TextHeight + 5)-(Actual + BBL, Y + TextHeight * 2 - 3), White~&, BF
  129.     LINE (Actual, Y + TextHeight + 5)-(Actual + BBL, Y + TextHeight * 2 - 3), Grey2~&, B
  130.  
  131.  
  132.  
  133.     IF MX >= X AND MX <= X + _FONTWIDTH * TBA(nr).L THEN
  134.         IF MY >= Y + TextHeight + 5 AND MY <= Y + TextHeight * 2 - 3 THEN
  135.             IF MB1 THEN
  136.                 omx = MX
  137.                 DO UNTIL _MOUSEX <> MX
  138.                     WHILE _MOUSEINPUT: WEND
  139.                     MB1 = _MOUSEBUTTON(1)
  140.                     B = B + _MOUSEX - omx
  141.                 LOOP
  142.             END IF
  143.         END IF
  144.     END IF
  145.  
  146.  
  147.     _PUTIMAGE (X + 15 + BoxLenght * _FONTWIDTH, Y + TextHeight + 1), TextBoxArrow&
  148.     _PUTIMAGE (X - 15, Y + TextHeight + 1)-(X - 27, Y + TextHeight + 1 + 12), TextBoxArrow&
  149.  
  150.     IF TIMER < 1 THEN TBA(nr).D = 0
  151.  
  152.     IF MX >= X + 15 + BoxLenght * _FONTWIDTH AND MX <= X + 15 + BoxLenght * _FONTWIDTH + 12 THEN
  153.         IF MY >= Y + 1 + TextHeight AND MY <= Y + TextHeight * 2 THEN
  154.             IF TBA(nr).D < TIMER THEN
  155.                 IF _PIXELSIZE = 4 THEN
  156.                     LINE (X + 15 + BoxLenght * _FONTWIDTH, Y + TextHeight + 1)-(X + 15 + BoxLenght * _FONTWIDTH + 11, Y + TextHeight * 2), &H44FFFFFF, BF
  157.                 ELSE
  158.                     LINE (X + 15 + BoxLenght * _FONTWIDTH, Y + TextHeight + 1)-(X + 15 + BoxLenght * _FONTWIDTH + 11, Y + TextHeight * 2), 14, B
  159.                 END IF
  160.                 IF MB1 THEN
  161.                     B = B + 1
  162.                 END IF
  163.                 TBA(nr).D = TIMER + .01
  164.             END IF
  165.         END IF
  166.     END IF
  167.  
  168.     IF MX >= X - 26 AND MX <= X - 15 THEN
  169.         IF MY >= Y + 1 + TextHeight AND MY <= Y + TextHeight * 2 THEN
  170.  
  171.             SELECT CASE _KEYHIT
  172.                 CASE 18176: B = 1
  173.                 CASE 20224: B = LEN(TBA(nr).T) - TBA(nr).L + 1
  174.                 CASE 18688: B = B - TBA(nr).L
  175.                 CASE 20736: B = B + TBA(nr).L
  176.             END SELECT
  177.  
  178.  
  179.             IF TBA(nr).D < TIMER THEN
  180.                 IF _PIXELSIZE = 4 THEN
  181.                     LINE (X - 26, Y + TextHeight + 1)-(X - 15, Y + TextHeight * 2), &H44FFFFFF, BF
  182.                 ELSE
  183.                     LINE (X - 26, Y + TextHeight + 1)-(X - 15, Y + TextHeight * 2), 14, B
  184.                 END IF
  185.                 IF MB1 THEN
  186.                     B = B - 1
  187.                 END IF
  188.                 TBA(nr).D = TIMER + .01
  189.             END IF
  190.         END IF
  191.     END IF
  192.  
  193.     IF B > LEN(TBA(nr).T) - TBA(nr).L + 1 THEN B = LEN(TBA(nr).T) - TBA(nr).L + 1
  194.     IF B < 1 THEN B = 1
  195.     TBA(nr).B = B
  196.  
  197.     IF _PIXELSIZE = 4 THEN COLOR &HFFFFFFFF ELSE COLOR 15
  198.  
  199.  
  200.     FOR V = 1 TO LEN(TBA(nr).T)
  201.         FOR t = LBOUND(k) + 1 TO UBOUND(k)
  202.             IF k(t).flag = nr THEN
  203.                 IF V = k(t).onpos + 1 THEN COLOR k(t).clr: EXIT FOR
  204.             END IF
  205.         NEXT
  206.  
  207.         IF V >= B AND V <= B + TBA(nr).L THEN
  208.             _PRINTSTRING (X + (W * _FONTWIDTH), Y), MID$(TBA(nr).T, V, 1)
  209.             W = W + 1
  210.         END IF
  211.     NEXT
  212.  
  214.  
  215.  
  216. FUNCTION PutArrow&
  217.     IF _PIXELSIZE = 4 THEN
  218.         PutArrow& = _NEWIMAGE(12, 12, 32)
  219.     ELSE
  220.         PutArrow& = _NEWIMAGE(12, 12, 256)
  221.     END IF
  222.  
  223.     D = _DEST
  224.     _DEST PutArrow&
  225.  
  226.     LINE (1, 4)-(6, 4) '  ------------     up
  227.     LINE (1, 8)-(6, 8) '  ------------     down
  228.     LINE (1, 4)-(1, 8) '  I                arrow back
  229.     LINE (6, 4)-(6, 1)
  230.     LINE (6, 8)-(6, 11)
  231.     LINE (6, 11)-(11, 6)
  232.     LINE (6, 1)-(11, 6)
  233.  
  234.     IF _PIXELSIZE(D) = 4 THEN PAINT (6, 6), &HFF777777, &HFFFFFFFF ELSE PAINT (6, 6), 10, 15
  235.     IF _PIXELSIZE(D) = 4 THEN _CLEARCOLOR &HFF000000, PutArrow& ELSE _CLEARCOLOR 0, PutArrow&
  236.     _DEST D
  238.  
  239. SUB CString (source AS STRING, text AS STRING, K() AS Colored, index AS INTEGER)
  240.     FOR S = 1 TO LEN(source$)
  241.         t$ = MID$(source$, S, 1)
  242.         IF ASC(t$) >= 48 AND ASC(t$) <= 57 AND incolor THEN colornr$ = colornr$ + t$
  243.         IF incolor AND ASC(t$) < 48 OR incolor AND ASC(t$) > 57 THEN K(kk).clr = VAL(colornr$): D = D + LEN(colornr$): colornr$ = "": incolor = 0
  244.         IF t$ = "/" THEN
  245.             D = D + 1
  246.             incolor = 1
  247.             REDIM _PRESERVE K(UBOUND(k) + 1) AS Colored
  248.             kk = UBOUND(k)
  249.             K(kk).onpos = S - D
  250.             K(kk).flag = index
  251.         END IF
  252.         IF incolor = 0 THEN text$ = text$ + t$
  253.     NEXT
  255.  
  256. 'End of future "TextBox.BM"
  257.  

  [ This attachment cannot be displayed inline in 'Print Page' view ]  

There are two known flies. One - the slider position calculation is not entirely accurate. I really don't want to deal with it. Second - if the color definition starts outside the displayed part in the X / Y slider, it is displayed in white. This is what I want to solve, and I'll solve it sometime.... not today.
Title: Re: Scroll Bar
Post by: TempodiBasic on September 30, 2019, 05:10:29 pm
waiting news...
Title: Re: Scroll Bar
Post by: bplus on October 01, 2019, 06:58:17 pm
Congrats Petr!

I just have worked out all the bugs in mine. I use the whole box as a 2D scroll bar with mouse clicks or down and drag.
Like in my hScroller, I use indicator bars around the box to show the location of text left and right and top to bottom.

I will post code later when I get more than 2D text boxes going.

PS 317 lines so far ;-))

Title: Re: Scroll Bar
Post by: TempodiBasic on October 01, 2019, 08:39:18 pm
Well it seems that here we'll have 3 good tool for textbox with scrolling both as single line both as multiline!
Great work
Title: Re: Scroll Bar
Post by: Petr on October 02, 2019, 08:04:52 am
Quote
BPlus wrote:

I will post code later when I get more than 2D text boxes going.

  [ This attachment cannot be displayed inline in 'Print Page' view ]  

Quote
PS 317 lines so far ;-))

Yes, without coloring text ;)

TempodiBasic wrote:

Quote
waiting news...
Which?

The color correction (bug repair), about which write on top, is done. I will release another fix as soon as it is time to put it into the program :)
Title: Re: Scroll Bar
Post by: Petr on October 02, 2019, 08:22:23 am
BPlus, there are many options that lead to huge programs with complexity. For example. Someone already solved it but not in the textbox - text and image insertion. This can be done by adding another command (so as is "/") to the text loop. Maybe I'll try. If I am now using the tag / for the color command, I add another one, with the width, height, and name of the image, and then the position of the image in the textbox must follow. This is an example. Or - something lighter - a tag to set the color and transparency of the window background. It kind of starts to remind me of HTML ...

But still. First, I fix the current bugs, only then, maybe I'll try more.

Title: Re: Scroll Bar
Post by: bplus on October 02, 2019, 08:46:03 am
Quote
Yes, without coloring text ;)

I am coloring only the Box in focus, using Tab or Shift + Tab or Mouse over to change Box in focus for mouse or key input.

In screen shot you can see another box in focus, lit up Green background light Blue fore.
  [ This attachment cannot be displayed inline in 'Print Page' view ]  

Dang! another bug!
Title: Re: Scroll Bar
Post by: STxAxTIC on October 02, 2019, 09:02:41 am
Beautiful 3d screenshot bplus. I pulled this off once and posted at *.not, but the community was, um, not interested. Let's hope you catch more attention!
Title: Re: Scroll Bar
Post by: bplus on October 02, 2019, 09:14:13 am
Quote from: STxAxTIC on October 02, 2019, 09:02:41 am
Beautiful 3d screenshot bplus. I pulled this off once and posted at *.not, but the community was, um, not interested. Let's hope you catch more attention!

Hi STxAxTIC,

Not sure if you mean the little text indicator bars of my screen shot or Petr's screen shot of "swinging door open" like screen, an effect I like very much. :)
Title: Re: Scroll Bar
Post by: TempodiBasic on October 02, 2019, 09:24:38 am
Well I see news coming often in this thread!
Great job boys!
Title: Re: Scroll Bar
Post by: STxAxTIC on October 03, 2019, 10:21:25 am
Oh oops thats what I get for doing this while driving. Yes, the scrollbars are mad awesome. I admit I scrolled too fast and saw it was Petr that cranked out the tilted screenshot. Nice work both of you though. It's better than mine looked like, and Galleon even complemented it. He'd be even more impressed by you guys.
Title: Re: Scroll Bar
Post by: Petr on October 04, 2019, 01:36:29 pm
Hi. Yeah, 3D... i create also one for you, current version works but from keyboard only, that is not enought. I add 3D version here later (in better graphic).

 This next here is 2D, which can be placed really in many copyes to screen, contains color bug repair.

1980x1050 on screen resolution recommended.

Code: QB64: [Select]
  1.  
  2.  
  3. 'this is future "TextBox.BI"
  4. TYPE Colored '                      This Array contains colors positions on text and color values. This array is created in SUB CString.
  5.     onpos AS INTEGER
  6.     clr AS _UNSIGNED LONG
  7.     flag AS INTEGER
  8.     row AS INTEGER
  10. REDIM SHARED k(0) AS Colored
  11.  
  12. TYPE TB2
  13.     X AS INTEGER '   X position graphic coord
  14.     Y AS INTEGER '   Y position graphic coord
  15.     L AS INTEGER '   TextBox lenght
  16.     H AS INTEGER '   Textbox HEIGHT                                            NEW
  17.     T AS STRING * 1 '    TextBox text
  18.     B AS INTEGER '   Text begin in textbox  (for shift), X axis
  19.     BH AS INTEGER '  Text begin in textbox  (for shift), Y axis                NEW
  20.  
  21.     D AS SINGLE '    for time delay between click to arrows
  22.     I_s AS INTEGER
  23.     I_e AS INTEGER
  24.     filter AS _BYTE 'new info flag for CString, which is needed just in the start, but not more.
  25.     init AS _BYTE
  27.  
  28. REDIM SHARED TBA2(0) AS TB2
  29. REDIM SHARED GlobalText(0) AS STRING 'spolecne obrovske textove pole obsahujici texty pro vsechna okna vcetne udaju o barvach
  30. DIM SHARED Arrow0 AS LONG, Arrow1 AS LONG, Arrow2 AS LONG, Arrow3 AS LONG
  31.  
  32.  
  33. SCREEN _NEWIMAGE(1980, 1050, 256) 'screen must be initialized before PutArrow& is run.
  34. Arrow0 = PutArrow
  35. R90 Arrow0, Arrow1, Arrow2, Arrow3 'create four arrows in four directions from first source image
  36. 'end of future "TextBox.BI"
  37.  
  38.  
  39.  
  40.  
  41. DIM Text1(7) AS STRING
  42. DIM Text2(14) AS STRING
  43.  
  44. Text1(1) = "/14This is content /1for /2array /3Text1. Original and source text array content is in"
  45. Text1(2) = "/44array Text1. Because Petr can just 2 ways (first: MEM Pointer to array insert"
  46. Text1(3) = "/45to type), or second, easyest - all texts insert to one STRING SHARED array, and"
  47. Text1(4) = "/46writing informations about start and end index to TYPE, is now this text also"
  48. Text1(5) = "/47inserted to array named as GlobalText. Because this text contains 7 rows and "
  49. Text1(6) = "/48Text1 array is inserted as first, is this saved in indexes 0 to 6 in array"
  50. Text1(7) = "/49GlobalText. Info about this records are here saved to TBA2().I_s and TBA2().I_e"
  51.  
  52.  
  53.  
  54. Text2(1) = "                /14   Example for use:"
  55. Text2(2) = "/45With /40'/90/'/40 /45and then number you set colors. If you use _SCREEN _NEWIMAGE in 256 colors,"
  56. Text2(3) = "then use number from 0 to 256. But if you use 32 bit screen, then dont use &H values but"
  57. Text2(4) = "/50 number. This number can be returned using this easy source code:"
  58. Text2(5) = "/55 COLOR~& = &HFFFFFFFF  /60 or /55 COLOR~& = _RGBA32(255, 255, 255)"
  59. Text2(6) = "PRINT COLOR~&. /60 This is number, which you need for use to 32 bit screens with this"
  60. Text2(7) = "easy program. (i write soon automatic translator for it, but with my time....)/9"
  61. Text2(8) = "Program construction: - All strings are saved to array /14 GlobalText."
  62. Text2(9) = "                     /9 - Function /14R90/9 create 4 images which contains rows, rotated from 1"
  63. Text2(10) = "                       source image, which is created with Function /14PutArrow./9"
  64. Text2(11) = "                     - /14CString /9SUB create help array for colors used in text to array /14K/9."
  65. Text2(12) = "                     - /14MaximalRowLenght/9 Function return lenght of longest row in text array."
  66. Text2(13) = "                     - Function /14INITBOX2/9 write all needed records to program arrays and return record number."
  67. Text2(14) = "                     - /14XY_BOX /9SUB - own program. Study it /33yourself /40:-)"
  68.  
  69.  
  70.  
  71. DIM boxes(35)
  72.  
  73. FOR B1 = 1 TO 10
  74.     boxes(B1) = INITBOX2(-158 + 198 * B1, 50, Text1(), 17, 10)
  76.  
  77. FOR B1 = 11 TO 20
  78.     boxes(B1) = INITBOX2(-158 + 198 * (-10 + B1), 250, Text2(), 17, 10)
  80.  
  81. FOR B1 = 21 TO 30
  82.     boxes(B1) = INITBOX2(-158 + 198 * (-20 + B1), 450, Text1(), 17, 15)
  84.  
  85. co = 40
  86. FOR B1 = 31 TO 35
  87.     boxes(B1) = INITBOX2(co, 700, Text2(), 35, 20)
  88.     co = co + 400
  90.  
  91.  
  92.  
  93.  
  95.     FOR B1 = 1 TO 10
  96.         XY_BOX boxes(B1)
  97.     NEXT
  98.  
  99.     FOR B1 = 11 TO 20
  100.         XY_BOX boxes(B1)
  101.     NEXT
  102.  
  103.     FOR B1 = 21 TO 30
  104.         XY_BOX boxes(B1)
  105.     NEXT
  106.  
  107.     FOR B1 = 31 TO 35
  108.         XY_BOX boxes(B1)
  109.     NEXT
  110.  
  111.     _DISPLAY
  112.     _LIMIT 60
  114.  
  115.  
  116.  
  117. 'this is future "TextBox.BM"
  118. FUNCTION INITBOX2 (X AS INTEGER, Y AS INTEGER, Text() AS STRING, BoxLenght AS INTEGER, BoxHeight AS INTEGER) 'X, Y are GRAPHIC coordinates
  119.     UTB = UBOUND(tba2)
  120.     REDIM _PRESERVE TBA2(UTB + 1) AS TB2
  121.     TBA2(UTB + 1).X = X
  122.     TBA2(UTB + 1).Y = Y
  123.     TBA2(UTB + 1).L = BoxLenght
  124.     TBA2(UTB + 1).H = BoxHeight
  125.  
  126.  
  127.  
  128.  
  129.     TBA2(UTB + 1).T = ""
  130.     U1 = UBOUND(globaltext)
  131.     U2 = UBOUND(text)
  132.  
  133.     TBA2(UTB + 1).I_s = U1
  134.     TBA2(UTB + 1).I_e = U1 + U2
  135.  
  136.     REDIM _PRESERVE GlobalText(U1 + U2 + 1) AS STRING
  137.  
  138.     FOR insert = U1 TO U1 + U2
  139.         GlobalText(insert) = Text(t)
  140.         t = t + 1
  141.     NEXT
  142.  
  143.     TBA2(UTB + 1).BH = U1 + 1 'after first start: first row (BH is shift in Y, B is shift in X axis)
  144.     TBA2(UTB + 1).B = 1 'and first column
  145.     INITBOX2 = UTB + 1
  147.  
  148.  
  149. SUB XY_BOX (nr AS LONG)
  150.  
  151.  
  153.         mwh = mwh + _MOUSEWHEEL
  154.         IF mwh THEN EXIT WHILE
  155.     WEND
  156.  
  157.  
  158.     '
  159.     MB1 = _MOUSEBUTTON(1)
  160.     MX = _MOUSEX
  161.     MY = _MOUSEY
  162.     RowLen = MaximalRowLenght(nr)
  163.     TextLenght = RowLen * _FONTWIDTH
  164.     B = TBA2(nr).B
  165.     BH = TBA2(nr).BH
  166.  
  167.     TextHeight = _FONTHEIGHT
  168.     X = TBA2(nr).X
  169.     Y = TBA2(nr).Y
  170.     BoxLenght = TBA2(nr).L - 2
  171.     BoxHeight = 1 + TBA2(nr).H * _FONTHEIGHT
  172.     Init = TBA2(nr).init
  173.  
  174.  
  175.     IF MX >= X - 30 AND MX <= X + 30 + (BoxLenght + 2) * _FONTWIDTH THEN
  176.         IF MY >= Y - 30 AND MY <= Y + BoxHeight THEN
  177.             onpos = 1
  178.         END IF
  179.     END IF
  180.  
  181.     IF Init = 0 OR onpos THEN
  182.  
  183.  
  184.  
  185.         '256/32 color support:
  186.  
  187.         SELECT CASE _PIXELSIZE
  188.             CASE 0: BEEP: PRINT "Text mode not supported by PRINTBOX!": _DISPLAY: SLEEP 3: END
  189.             CASE 1
  190.                 Black~& = 0
  191.                 White~& = 15
  192.                 Grey~& = 24
  193.                 Grey2~& = 19
  194.             CASE 4
  195.                 Black~& = &HFF000000
  196.                 White~& = &HFFFFFFFF
  197.                 Grey~& = &H226666666
  198.                 Grey2~& = &HFF221122
  199.         END SELECT
  200.  
  201.  
  202.         RowLen = MaximalRowLenght(nr)
  203.         TextLenght = RowLen * _FONTWIDTH
  204.         B = TBA2(nr).B
  205.         BH = TBA2(nr).BH
  206.  
  207.         TextHeight = _FONTHEIGHT
  208.         X = TBA2(nr).X
  209.         Y = TBA2(nr).Y
  210.         BoxLenght = TBA2(nr).L - 2
  211.         BoxHeight = 1 + TBA2(nr).H * _FONTHEIGHT
  212.  
  213.         '        WHILE _MOUSEINPUT:
  214.         '        mwh = mwh + _MOUSEWHEEL
  215.         '            IF mwh THEN EXIT WHILE
  216.         '        WEND
  217.  
  218.         '        IF _MOUSEX >= X - 30 AND _MOUSEX <= X + 30 + BoxLenght * _FONTWIDTH THEN
  219.         '        IF _MOUSEY >= Y - 3 AND _MOUSEY <= Y + 3 + 2 * TextHeight THEN
  220.         '        B = B + mwh * 4
  221.         '    END IF
  222.         '    END IF
  223.  
  224.  
  225.         '
  226.         '       MB1 = _MOUSEBUTTON(1)
  227.         '       MX = _MOUSEX
  228.         '       MY = _MOUSEY
  229.  
  230.  
  231.  
  232.  
  233.         LINE (X - 30, Y)-(X + 30 + BoxLenght * _FONTWIDTH, Y + BoxHeight), Grey~&, BF 'vnitrek okna                                   window inside
  234.         LINE (X - 30, Y - 3)-(X + 30 + BoxLenght * _FONTWIDTH, Y + BoxHeight), White~&, B
  235.         LINE (X - 28, Y - 1)-(X + 28 + BoxLenght * _FONTWIDTH, Y + BoxHeight - TextHeight), White~&, B
  236.  
  237.         'borders for lines up / down
  238.         LINE (X + 30 + BoxLenght * _FONTWIDTH, Y - 1)-(X + 11 + BoxLenght * _FONTWIDTH, Y + BoxHeight - TextHeight), White~&, B
  239.  
  240.  
  241.         '  slider X calculations. For calculating slider lenght you need the number of characters of the longest sentence used in the box. MaximalRowLenght function return it:
  242.         '////////////////////////////////////////////////////////
  243.         TL = B / RowLen * 100 'pocatecni poloha pruhu v procentech            begining position for bottom box (percentually)
  244.         L = TBA2(nr).L * _FONTWIDTH 'celkova delka pruhu v pixelech           total slide lenght in pixels
  245.         Actual = _CEIL(X + (TL / 100 * L)) '                                  graphic position for bottom box
  246.         boxl = BoxLenght * _FONTWIDTH
  247.         BL = boxl / (TextLenght / 100) 'delka posuvneho boxiku  v procentech     box on bottom lenght  (how it is done: Slider lenght is percentually size as window bottom (for X - Shift).
  248.         '                                                                        if 30 percent of the sentence length is visible in the window, then the slider is 30 percent of the length of the X-side this window
  249.         IF BL > 100 THEN BL = 100 '                                              if text lenght < window X side, draw slider as 100 percent of X window side
  250.  
  251.         BBL = boxl / 100 * BL
  252.  
  253.         'posuvnik X        Slider X
  254.         LINE (Actual, Y + BoxHeight - TextHeight + 5)-(Actual + BBL, Y + BoxHeight - TextHeight + 12), White~&, BF
  255.         LINE (Actual, Y + BoxHeight - TextHeight + 5)-(Actual + BBL, Y + BoxHeight - TextHeight + 12), Grey2~&, B
  256.         '////////////////////////////////////////////////////////////
  257.  
  258.  
  259.  
  260.  
  261.  
  262.  
  263.         'slider Y (the same os for X slider)
  264.         DelkaSteny = BoxHeight - TextHeight - (2 * _FONTHEIGHT) - 2
  265.         ZaznamuNaStenu = DelkaSteny / _FONTHEIGHT
  266.         Zaznamu100 = ZaznamuNaStenu / (TBA2(nr).I_e - TBA2(nr).I_s) * 100
  267.         BBH = (Zaznamu100 / 100) * DelkaSteny
  268.         IF BBH > DelkaSteny THEN BBH = DelkaSteny
  269.  
  270.         Pozice = 1 + (BH - TBA2(nr).I_e) / TBA2(nr).I_e
  271.         actualH = Y + _FONTHEIGHT + ((DelkaSteny - BBH) * Pozice)
  272.  
  273.  
  274.         'posuvnik Y        Slider Y
  275.         LINE (TBA2(nr).X + TBA2(nr).L * _FONTWIDTH, actualH)-(TBA2(nr).X + TBA2(nr).L * _FONTWIDTH + 7, actualH + BBH), White~&, BF
  276.         LINE (TBA2(nr).X + TBA2(nr).L * _FONTWIDTH, actualH)-(TBA2(nr).X + TBA2(nr).L * _FONTWIDTH + 7, actualH + BBH), Grey2~&, B
  277.  
  278.  
  279.  
  280.         ' solution for moving text by click + move to down box
  281.         IF MX >= X AND MX <= X + _FONTWIDTH * (TBA2(nr).L - 2) THEN
  282.             IF MY >= Y + BoxHeight - TextHeight AND MY <= Y + BoxHeight THEN
  283.                 IF MB1 THEN
  284.                     omx = MX
  285.                     DO UNTIL _MOUSEX <> MX
  286.                         WHILE _MOUSEINPUT: WEND
  287.                         MB1 = _MOUSEBUTTON(1)
  288.                         B = B + _MOUSEX - omx
  289.                     LOOP
  290.                 END IF
  291.             END IF
  292.         END IF
  293.  
  294.         ' solution for moving text up and down by clicking and move to box on right
  295.         IF MX >= X + 10 + BoxLenght * _FONTWIDTH AND MX <= X + 30 + BoxLenght * _FONTWIDTH THEN
  296.             IF MY >= Y + 16 AND MY <= Y + BoxHeight - 40 THEN
  297.                 IF MB1 THEN
  298.                     omy = MY
  299.                     DO UNTIL _MOUSEY <> MY
  300.                         WHILE _MOUSEINPUT: WEND
  301.                         MB1 = _MOUSEBUTTON(1)
  302.                         BH = BH + _MOUSEY - omy
  303.                     LOOP
  304.                 END IF
  305.             END IF
  306.         END IF
  307.  
  308.         ABY = Y + 2 + BoxHeight - TextHeight '                  ArrowBottomY coordinate
  309.         LUPAC = X + 15 + BoxLenght * _FONTWIDTH '               Left UP/Down Arrow coordinate
  310.  
  311.         _PUTIMAGE (LUPAC, ABY), Arrow0& '                              Arrow to right
  312.         _PUTIMAGE (X - 27, ABY + 1), Arrow1& '                                  left
  313.         _PUTIMAGE (LUPAC, Y + 2), Arrow3& '                                     up
  314.         _PUTIMAGE (LUPAC - 1, Y + TextHeight * (TBA2(nr).H - 2)), Arrow2& '     down
  315.  
  316.         IF TIMER < 1 THEN TBA2(nr).D = 0
  317.  
  318.         'driving up arrow
  319.         IF MX >= LUPAC AND MX <= LUPAC + 12 THEN
  320.             IF MY >= Y + 2 AND MY <= Y + 14 THEN
  321.                 IF TBA2(nr).D < TIMER THEN
  322.                     IF _PIXELSIZE = 4 THEN
  323.                         LINE (LUPAC, Y + 2)-(LUPAC + 12, Y + 14), &H44FFFFFF, BF
  324.                     ELSE
  325.                         LINE (LUPAC, Y + 2)-(LUPAC + 12, Y + 14), 14, B
  326.                     END IF
  327.                     IF MB1 THEN BH = BH - 1
  328.                     TBA2(nr).D = TIMER + .01
  329.                     MB1 = 0
  330.                 END IF
  331.             END IF
  332.         END IF
  333.  
  334.         'driving down arrow
  335.         IF MX >= LUPAC - 1 AND MX <= LUPAC + 11 THEN
  336.             IF MY >= Y + TextHeight * (TBA2(nr).H - 2) AND MY <= 12 + Y + TextHeight * (TBA2(nr).H - 2) THEN
  337.                 IF TBA2(nr).D < TIMER THEN
  338.                     IF _PIXELSIZE = 4 THEN
  339.                         LINE (LUPAC - 1, Y + TextHeight * (TBA2(nr).H - 2))-(LUPAC + 11, 12 + Y + TextHeight * (TBA2(nr).H - 2)), &H44FFFFFF, BF
  340.                     ELSE
  341.                         LINE (LUPAC - 1, Y + TextHeight * (TBA2(nr).H - 2))-(LUPAC + 11, 12 + Y + TextHeight * (TBA2(nr).H - 2)), 14, B
  342.                     END IF
  343.                     IF MB1 THEN BH = BH + 1
  344.                     TBA2(nr).D = TIMER + .01
  345.                     MB1 = 0
  346.                 END IF
  347.             END IF
  348.         END IF
  349.  
  350.  
  351.  
  352.         'driving right arrow on bottom
  353.         IF MX >= LUPAC AND MX <= LUPAC + 12 THEN
  354.             IF MY >= ABY AND MY <= ABY + 12 THEN
  355.  
  356.                 IF TBA2(nr).D < TIMER THEN
  357.                     IF _PIXELSIZE = 4 THEN
  358.                         LINE (LUPAC, ABY)-(LUPAC + 12, ABY + 12), &H44FFFFFF, BF
  359.                     ELSE
  360.                         LINE (LUPAC, ABY)-(LUPAC + 12, ABY + 12), 14, B
  361.                     END IF
  362.                     IF MB1 THEN
  363.                         B = B + 1
  364.                         MB1 = 0
  365.                         TBA2(nr).D = TIMER + .01
  366.                     END IF
  367.                 END IF
  368.             END IF
  369.         END IF
  370.  
  371.         'driving left arrow on bottom
  372.         IF MX >= X - 27 AND MX <= X - 15 THEN '12 + 15 = 27, 12 is arrow width
  373.             IF MY >= ABY + 1 AND MY <= ABY + 13 THEN
  374.                 IF TBA2(nr).D < TIMER THEN
  375.                     IF _PIXELSIZE = 4 THEN
  376.                         LINE (X - 27, ABY + 1)-(X - 15, ABY + 13), &H44FFFFFF, BF
  377.                     ELSE
  378.  
  379.                         LINE (X - 27, ABY + 1)-(X - 15, ABY + 13), 14, B
  380.                     END IF
  381.                     IF MB1 THEN
  382.                         B = B - 1
  383.                         MB1 = 0
  384.                         TBA2(nr).D = TIMER + .01
  385.                     END IF
  386.                 END IF
  387.             END IF
  388.         END IF
  389.  
  390.  
  391.         'new: left - right keyboard driving:       (home, end, pg up, pg dn, insert (not edit), delete (not edit), arrows up, down, left, right)
  392.         IF MX >= X - 30 AND MX <= X + BoxLenght * _FONTWIDTH + 30 THEN
  393.             IF MY > Y AND MY <= Y + BoxHeight THEN
  394.  
  395.                 KH& = _KEYHIT
  396.                 IF KH& THEN
  397.                     SELECT CASE KH&
  398.                         CASE 18176: B = 1
  399.                         CASE 20224: B = RowLen - TBA2(nr).L + 1
  400.                         CASE 18688: B = B - TBA2(nr).L ' PgUP
  401.                         CASE 20736: B = B + TBA2(nr).L ' PgDN
  402.                         CASE 19200: B = B - 1 '          left
  403.                         CASE 19712: B = B + 1 '          right
  404.                         CASE 18432: BH = BH - 1 '        up
  405.                         CASE 20480: BH = BH + 1 '         down
  406.                         CASE 20992: BH = BH + TBA2(nr).H 'insert
  407.                         CASE 21428: BH = BH - TBA2(nr).H 'delete
  408.                     END SELECT
  409.                     _KEYCLEAR
  410.                 END IF
  411.  
  412.             END IF
  413.         END IF
  414.  
  415.         IF BH < TBA2(nr).I_s THEN BH = TBA2(nr).I_s
  416.         IF BH > TBA2(nr).I_e THEN BH = TBA2(nr).I_e
  417.  
  418.  
  419.         IF B > RowLen - TBA2(nr).L + 1 THEN B = RowLen - TBA2(nr).L + 1
  420.         IF B < 1 THEN B = 1
  421.  
  422.         TBA2(nr).B = B '      B is variable for shift left and right
  423.         TBA2(nr).BH = BH '    BH is variable for shift up and down
  424.  
  425.         IF _PIXELSIZE = 4 THEN COLOR &HFFFFFFFF ELSE COLOR 15
  426.  
  427.         IF TBA2(nr).filter = 0 THEN CString k(), nr: TBA2(nr).filter = 1 'and this is row, which AGAIN find me STRING BUG. Nr is not correct, if is STRING without star used!
  428.  
  429.  
  430.         BHE = BH + TBA2(nr).H - 2
  431.         IF BHE > TBA2(nr).I_e THEN BHE = TBA2(nr).I_e
  432.  
  433.  
  434.         'coloring and printing content
  436.  
  437.  
  438.         'first line invalid color bug repair
  439.         FOR t = LBOUND(k) + 1 TO UBOUND(k)
  440.             IF k(t).flag = nr THEN
  441.                 IF k(t).row < BH THEN kkk~& = k(t).clr
  442.             END IF
  443.         NEXT
  444.         COLOR kkk~&
  445.  
  446.  
  447.  
  448.         FOR Rows = BH TO BHE
  449.             FOR v = 1 TO RowLen
  450.                 FOR t = LBOUND(k) + 1 TO UBOUND(k)
  451.                     IF k(t).flag = nr THEN '               here is repaired color bug.
  452.                         IF Rows = k(t).row THEN
  453.                             IF v = k(t).onpos + 1 THEN COLOR k(t).clr: EXIT FOR
  454.                         END IF
  455.                     END IF
  456.                 NEXT
  457.                 IF v >= B AND v <= B + TBA2(nr).L THEN
  458.                     _PRINTSTRING (X - 20 + (w * _FONTWIDTH), Y + (Rows - BH) * _FONTHEIGHT), MID$(GlobalText(Rows), v, 1)
  459.                     w = w + 1
  460.                 END IF
  461.             NEXT
  462.             w = 0
  463.         NEXT Rows
  465.  
  466.  
  467.         TBA2(nr).init = 1
  468.     END IF
  469.  
  470.  
  471.  
  473.  
  474.  
  475. FUNCTION PutArrow&
  476.     IF _PIXELSIZE = 4 THEN
  477.         PutArrow& = _NEWIMAGE(12, 12, 32)
  478.     ELSE
  479.         PutArrow& = _NEWIMAGE(12, 12, 256)
  480.     END IF
  481.  
  482.     D = _DEST
  483.     _DEST PutArrow&
  484.  
  485.     LINE (1, 4)-(6, 4)
  486.     LINE (1, 8)-(6, 8)
  487.     LINE (1, 4)-(1, 8)
  488.     LINE (6, 4)-(6, 1)
  489.     LINE (6, 8)-(6, 11)
  490.     LINE (6, 11)-(11, 6)
  491.     LINE (6, 1)-(11, 6)
  492.  
  493.     IF _PIXELSIZE(D) = 4 THEN PAINT (6, 6), &HFF777777, &HFFFFFFFF ELSE PAINT (6, 6), 10, 15
  494.     IF _PIXELSIZE(D) = 4 THEN _CLEARCOLOR &HFF000000, PutArrow& ELSE _CLEARCOLOR 0, PutArrow&
  495.     _DEST D
  497.  
  498.  
  499. SUB CString (K() AS Colored, index AS INTEGER)
  500.     FOR rows = TBA2(index).I_s TO TBA2(index).I_e
  501.         source$ = GlobalText(rows)
  502.         FOR S = 1 TO LEN(source$)
  503.             old$ = t$
  504.             t$ = MID$(source$, S, 1)
  505.             IF ASC(t$) >= 48 AND ASC(t$) <= 57 AND incolor THEN colornr$ = colornr$ + t$
  506.             IF incolor AND ASC(t$) < 48 OR incolor AND ASC(t$) > 57 THEN
  507.                 K(kk).clr = VAL(colornr$): D = D + LEN(colornr$): colornr$ = "": incolor = 0
  508.                 IF old$ = "/" THEN text$ = text$ + old$
  509.             END IF
  510.  
  511.             IF t$ = "/" THEN
  512.                 D = D + 1
  513.                 incolor = 1
  514.                 REDIM _PRESERVE K(UBOUND(k) + 1) AS Colored
  515.                 kk = UBOUND(k)
  516.                 K(kk).onpos = S - D
  517.                 K(kk).flag = index
  518.                 K(kk).row = rows
  519.             END IF
  520.             IF incolor = 0 THEN text$ = text$ + t$
  521.         NEXT
  522.  
  523.         GlobalText(rows) = text$
  524.         text$ = ""
  525.         ind = ind + 1
  526.         D = 0
  527.     NEXT rows
  529.  
  530.  
  531. SUB R90 (img0 AS LONG, img1 AS LONG, img2 AS LONG, img3 AS LONG) 'create 4 arrows from one in four directions
  532.     IF img0 >= -1 THEN EXIT SUB 'source image is invalid
  533.     W = _WIDTH(img0)
  534.     H = _HEIGHT(img0)
  535.     P = _PIXELSIZE(img0)
  536.     DIM CC AS _UNSIGNED LONG
  537.  
  538.     SELECT CASE P
  539.         CASE 0: EXIT SUB 'text mode unsupported
  540.         CASE 1: D = 256: CC = 0
  541.         CASE 4: D = 32: CC = &HFF000000
  542.     END SELECT
  543.  
  544.     img1 = _NEWIMAGE(W, H, D)
  545.     _PUTIMAGE , img0, img1, (W, 1)-(1, H) '180 degrees rotating
  546.  
  547.     img2 = _NEWIMAGE(H, W, D) '            90
  548.     _MAPTRIANGLE (0, 0)-(W, 0)-(W, H), img0 TO(H, 0)-(H, W)-(0, W), img2
  549.     _MAPTRIANGLE (0, 0)-(W, H)-(0, H), img0 TO(H, 0)-(0, W)-(0, 0), img2
  550.  
  551.     img3 = _NEWIMAGE(H, W, D)
  552.     _PUTIMAGE , img2, img3, (1, W)-(H, 1) '270
  553.     _CLEARCOLOR CC, img1
  554.     _CLEARCOLOR CC, img2
  555.     _CLEARCOLOR CC, img3
  557.  
  558. FUNCTION MaximalRowLenght (i)
  559.     MaximalRowLenght = 0
  560.     REDIM test(0) AS STRING
  561.     ClearColorRecordsAndVauesFromTextArray TBA2(i).I_s, TBA2(i).I_e, test()
  562.  
  563.     FOR p = LBOUND(test) TO UBOUND(test)
  564.         IF MaximalRowLenght < LEN(test(p)) THEN MaximalRowLenght = LEN(test(p))
  565.     NEXT
  567.  
  568. SUB ClearColorRecordsAndVauesFromTextArray (start, eend, arrname() AS STRING) 'If we need find maximal row lenght, first must color tags be deleted from text.
  569.     REDIM arrname(eend - start) AS STRING
  570.     FOR c = start TO eend
  571.         FOR L = 1 TO LEN(GlobalText(c))
  572.             ch$ = MID$(GlobalText(c), L, 1)
  573.             IF ch$ = "/" THEN iscolor = 1
  574.             IF iscolor AND ASC(ch$) > 47 AND ASC(ch$) < 58 THEN ELSE t$ = t$ + ch$
  575.             IF iscolor AND ASC(ch$) < 47 OR iscolor AND ASC(ch$) > 58 THEN
  576.                 iscolor = 0
  577.             END IF
  578.         NEXT
  579.         arrname(c - start) = t$
  580.         t$ = ""
  581.     NEXT c
  583.  
  584. 'End of future "TextBox.BM"
  585.  


Program output:

  [ This attachment cannot be displayed inline in 'Print Page' view ]  
Title: Re: Scroll Bar
Post by: SMcNeill on October 04, 2019, 10:58:46 pm
Here’s an idea I just had for a 3D window:  Us OpenGL to map textures of segments an image to a cube.  Let the “sliders” rotate the cube left/right, up/down...  It’d basically scroll a screen of text at a time...

If I find time, while the concept is fresh in my head, I might take a shot at having fun and doing it, but you guys are also free to have fun with it if you want.  I think it’d make a cute little 3D- scroller.  😁
Text Only | Text with Attachments