Scroll Bar

[bplus]

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,

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.  
3. DO
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
120. LOOP
121.  

[Erum]

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.

[Erum]

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.

[bplus]

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 :)

[Petr]

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:

  [ You are not allowed to view this attachment ]  

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.

[bplus]

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.

[Erum]

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.

[bplus]

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]

1. OPTION _EXPLICIT
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
26. NEXT
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
49. END SUB
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
55. END SUB
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
73. END FUNCTION
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
90. END SUB
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?

[TempodiBasic]

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
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

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
   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. 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!

[Erum]

Respected TempodiBasic and blpus,
Thnak you so much once again. I am gonna focus and try them and see which one works best.
Regards.

[Petr]

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
13. END TYPE
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)
25. NEXT
26.  
27.  
28. DO
29.  
30.     FOR p = 1 TO 20
31.         PRINTBOX p
32.     NEXT
33.  
34. LOOP
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
47. END FUNCTION
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$
110. END SUB
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
127. END FUNCTION
128. 'End of future "TextBox.BM"
129.  

  [ You are not allowed to view this attachment ]  

[Petr]

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
13. END TYPE
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)
25. NEXT
26. Demo = INITBOX(150, 500, "This is small text", 9)
27.  
28.  
29. DO
30.  
31.     FOR p = 1 TO 10
32.         PRINTBOX p
33.     NEXT
34.     PRINTBOX Demo
35.  
36.     _DISPLAY
37. LOOP
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
50. END FUNCTION
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$
139. END SUB
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
156. END FUNCTION
157. 'End of future "TextBox.BM"
158.  

[TempodiBasic]

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
13. END TYPE
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)
25. NEXT
26.  
27.  
28. DO
29.  
30.     FOR p = 1 TO 20
31.         PRINTBOX p
32.     NEXT
33.  
34. LOOP
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
47. END FUNCTION
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
65.     LOOP WHILE _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$
116. END SUB
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
133. END FUNCTION
134. 'End of future "TextBox.BM"
135.  
136.  

I hope it is portable to the final version....
Waiting  feedback
Goog Coding

[TempodiBasic]

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
13. END TYPE
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)
25. NEXT
26. Demo = INITBOX(150, 500, "This is small text", 9)
27.  
28.  
29. DO
30.  
31.     FOR p = 1 TO 10
32.         PRINTBOX p
33.     NEXT
34.     PRINTBOX Demo
35.  
36.     _DISPLAY
37. LOOP
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
50. END FUNCTION
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$
144. END SUB
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
161. END FUNCTION
162. 'End of future "TextBox.BM"
163.  

[bplus]

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
13. END TYPE
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
32.     WHILE _MOUSEINPUT
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
71. WEND
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
83. END SUB
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
97. END SUB
98.