Scroll Bar

[Petr]

OFFTOPIC - Steve your next video tutorial is in perfect quality! I see it tomorrow!

[Petr]

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
9. END TYPE
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.
25. END TYPE
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.  
76. DO
77.     XY_BOX A
78.     XY_BOX B
79.     XY_BOX C
80.     XY_BOX D
81.     _DISPLAY
82.     _LIMIT 60
83. LOOP
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
116. END FUNCTION
117.  
118.  
119. SUB XY_BOX (nr AS LONG)
120.     '256/32 color support:
121.  
122.     SELECT CASE _PIXELSIZE
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.  
148.     WHILE _MOUSEINPUT:
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
370.     _PRINTMODE _KEEPBACKGROUND
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
388.     _PRINTMODE _FILLBACKGROUND
389. END SUB
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
413. END FUNCTION
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
445. END SUB
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
473. END SUB
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
483. END FUNCTION
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
499. END SUB
500.  
501. 'End of future "TextBox.BM"
502.  

  [ You are not allowed to view this attachment ]  

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
8. END TYPE
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
19. END TYPE
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)
34. NEXT
35. Demo = INITBOX(150, 500, "/49 Here /55is used /42absolutely random color /77number...", 29)
36.  
37.  
38. DO
39.  
40.     FOR p = 1 TO 10
41.         XY_BOX p
42.     NEXT
43.     XY_BOX Demo
44.  
45.     _DISPLAY
46. LOOP
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
60. END FUNCTION
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:
66.     SELECT CASE _PIXELSIZE
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.  
93.     WHILE _MOUSEINPUT:
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.  
213. END SUB
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
237. END FUNCTION
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
254. END SUB
255.  
256. 'End of future "TextBox.BM"
257.  

  [ You are not allowed to view this attachment ]  

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.

[TempodiBasic]

waiting news...

[bplus]

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

[TempodiBasic]

Well it seems that here we'll have 3 good tool for textbox with scrolling both as single line both as multiline!
Great work

[Petr]

BPlus wrote:

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

  [ You are not allowed to view this attachment ]  

PS 317 lines so far ;-))

Yes, without coloring text ;)

TempodiBasic wrote:

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

[Petr]

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.

[bplus]

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.
  [ You are not allowed to view this attachment ]  

Dang! another bug!

[STxAxTIC]

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!

[bplus]

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

[TempodiBasic]

Well I see news coming often in this thread!
Great job boys!

[STxAxTIC]

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.

[Petr]

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
9. END TYPE
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
26. END TYPE
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)
75. NEXT
76.  
77. FOR B1 = 11 TO 20
78.     boxes(B1) = INITBOX2(-158 + 198 * (-10 + B1), 250, Text2(), 17, 10)
79. NEXT
80.  
81. FOR B1 = 21 TO 30
82.     boxes(B1) = INITBOX2(-158 + 198 * (-20 + B1), 450, Text1(), 17, 15)
83. NEXT
84.  
85. co = 40
86. FOR B1 = 31 TO 35
87.     boxes(B1) = INITBOX2(co, 700, Text2(), 35, 20)
88.     co = co + 400
89. NEXT
90.  
91.  
92.  
93.  
94. DO
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
113. LOOP
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
146. END FUNCTION
147.  
148.  
149. SUB XY_BOX (nr AS LONG)
150.  
151.  
152.     WHILE _MOUSEINPUT:
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
435.         _PRINTMODE _KEEPBACKGROUND
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
464.         _PRINTMODE _FILLBACKGROUND
465.  
466.  
467.         TBA2(nr).init = 1
468.     END IF
469.  
470.  
471.  
472. END SUB
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
496. END FUNCTION
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
528. END SUB
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
556. END SUB
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
566. END FUNCTION
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
582. END SUB
583.  
584. 'End of future "TextBox.BM"
585.  

Program output:

  [ You are not allowed to view this attachment ]  

[SMcNeill]

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