Posts: 250
Threads: 44
Joined: May 2022
Reputation:
28
I started working on another project, and part of it is the need to have a window on the screen where it will be possible to move the text up and down and left and right. The attached program does this, but in this version you can use arrows with a rectangle showing the position between them for only one window. This is for greater simplicity. In the next version, the program will already include arrows with a slider in such a way that they can be used on multiple windows. (the OldMy variable which is now STATIC would cause problems and will have to be custom for each dialog).
The program supports PgUp and PgDown for scrolling up and down, Home and End are for jumping in the line to the beginning and end of the line, then of course arrows on the keyboard, arrows on the monitor and also by dragging the rectangle between the arrows. After pressing Enter, the function returns the line number where the yellow bar is.
Note the structure of the program. The arrows to control the position of the text in the window can be easily placed anywhere.
Code: (Select All)
'This program will be part of a larger project for SoundEditor.
'The task of this small program is to display a text field in a
'window that allows text to be scrolled left, right, up and down.
'When Enter is pressed, function return row number.
'Note the structure of the program. Arrows with stripes, which are located
'here on the sides of the text window, can be placed independently anywhere.
'Just modify the call to the Arrow function.
'
Dim Shared Samples(1000) As String
For gensamp = 0 To 1000
For char = 1 To 300 + 125 * Rnd
a$ = a$ + Chr$(32 + 64 * Rnd)
Next
Samples(gensamp) = a$
a$ = ""
Next
Screen _NewImage(1024, 768, 32)
Cls , _RGB32(240)
Do
SelectSample = ViewSamples(40, 30, 760, 705, 1, "Samples list:", Samples())
Locate 1
If SelectSample > -1 Then Print "Function return record number:"; SelectSample
_Display
_Limit 20
Loop
Function ViewSamples (xs As Integer, ys As Integer, xe As Integer, ye As Integer, Mode As _Byte, Title As String, a() As String)
' Xs: upper left corner X position
' Ys: upper left corner Y position
' Xe: bottom right corner X position
' Ye: bottom right corner Y position
' Mode: if it is zero, no text movement is allowed in the X-axis, and text that would go outside the window
' is terminated by three dots, if is 1, is allowed text movement in the X-axis.
' Title: Window title
' A() is array which contains text
ViewSamples = -1
Static VS_Pos 'selector position VERTICAL
Static ListStart, ListEnd
Static HS_POS, HS_MAX 'selector position HORIZONTAL
If HS_MAX = 0 Then
For t = 0 To UBound(a)
CurrentLen = Len(a(t))
If HS_MAX < CurrentLen Then HS_MAX = CurrentLen
Next t
End If
If HS_POS < 1 Then HS_POS = 1
If xe < xs Then Swap xe, xs
If ye < ys Then Swap ye, ys
'----
'There are two options to jump right to the last position in the text.
'left it set to always jump to the position of the longest string. Other
'options (commented out/disallowed here) are that they jump to the end based
'on the length of a particular string.
' If HS_POS > Len(a(VS_Pos)) - ((xe - xs) \ _FontWidth) + 2 Then HS_POS = Len(a(VS_Pos)) - ((xe - xs) \ _FontWidth) + 2
' If HS_POS > HS_MAX Then HS_POS = HS_MAX
If HS_POS > HS_MAX - (xe - xs) \ _FontWidth Then HS_POS = HS_MAX - (xe - xs) \ _FontWidth
VS_Wdth = xe - xs
VS_Hght = ye - ys
Line (xs, ys)-(xe, ye), _RGB32(200), BF
Line (xs, ys)-(xe, ye), _RGB32(120), B
If Len(_Trim$(Title$)) > VS_Wdth \ _FontWidth Then
Title$ = Mid$(Title$, 1, VS_Wdth \ _FontWidth - 3) + "..."
End If
_PrintMode _KeepBackground
Color _RGB32(0)
_PrintString (xs + VS_Wdth \ 2 - _PrintWidth(Title$) \ 2, ys), Title$
Line (xs, ys + _FontHeight)-(xe, ys + _FontHeight), _RGB32(120)
If VS_Pos > ListEnd - 1 Then
Nr_lines = (ye - ys) \ _FontHeight
ListStart = VS_Pos - Nr_lines + 3
End If
If ListStart > 3 + UBound(a) - VS_Hght \ _FontHeight Then ListStart = 3 + UBound(a) - VS_Hght \ _FontHeight
If VS_Pos < ListStart Then ListStart = VS_Pos
If ListStart < 0 Then ListStart = 0
ListEnd = ListStart + VS_Hght \ _FontHeight
If VS_Hght \ _FontHeight Mod _FontHeight Then ListEnd = ListEnd - 3
If ListEnd > UBound(a) Then ListEnd = UBound(a)
i = 0
_PrintMode _FillBackground
For s = ListStart To ListEnd
If VS_Pos = s Then Color _RGB32(0), _RGB32(255, 255, 0) Else Color _RGB32(0), _RGB32(200)
Select Case Mode
Case 0
If Len(a(s)) > VS_Wdth \ _FontWidth - 1 Then
a$ = Mid$(a(s), 1, VS_Wdth \ _FontWidth - 4) + "..."
Else
a$ = a(s)
End If
Case 1
' If Len(a(s)) > VS_Wdth \ _FontWidth - 1 Then 'if is used this conditon so rows, which lenght is not bigger than window width, are not scrolled to left
b$ = a(s) + String$(HS_MAX - Len(_Trim$(a(s))), Chr$(32))
a$ = Mid$(b$, HS_POS, VS_Wdth \ _FontWidth - 1)
' Else
' a$ = a(s)
' End If
End Select
_PrintString (xs + 5, 5 + ys + _FontHeight + i * _FontHeight), a$
i = i + 1
Next
'Keyboard support
k& = _KeyHit
If Mode Then
XArrow = Arrow(xs + 2, ye + 4, xe - xs - 2, 1, HS_MAX, HS_POS) 'modify this two lines (XArrow and YArrow) and move scrooll bars
End If ' and arrows to other place on the screen
YArrow = Arrow(xe + 2, ys, ye - ys, -1, UBound(a), VS_Pos)
VS_Pos = VS_Pos + YArrow
HS_POS = HS_POS + XArrow
Select Case k&
Case 18432: VS_Pos = VS_Pos - 1 'arrow up
Case 20480: VS_Pos = VS_Pos + 1 'arrow down
Case 13: ViewSamples = VS_Pos: Exit Function
Case 18688: VS_Pos = VS_Pos - (ye - ys) \ _FontHeight 'PgUp
Case 20736: VS_Pos = VS_Pos + (ye - ys) \ _FontHeight 'PgDn
Case 19200: HS_POS = HS_POS - 1 'arrow left
Case 19712: HS_POS = HS_POS + 1 'arrow right
Case 18176: HS_POS = 1 ' home
Case 20224: HS_POS = HS_MAX ' end
End Select
If VS_Pos < 0 Then VS_Pos = 0
If VS_Pos > UBound(a) Then VS_Pos = UBound(a)
End Function
Function Arrow (Xs As Integer, Ys As Integer, Lenght As Integer, Typ As _Byte, SizeOf As Long, SizeNow As Long)
Arrow = 0
Static OldMy
'function draw a rectangular field on the axis with arrows at the end.
'SizeOf: maximum size (number of total records in array or lenght of the longest string)
'SizeNow: current position number (number of the record in the field or number of the position in the string from the left)
'Xs: left upper corner X axis position
'Ys: left upper corner Y axis position
'Lenght: lenght (width for Typ = 1 or height for typ = -1) for scroll bar with arrows in pixels
'Typ: 1 is for horizontal dialog (scrollbar in X axis)
' -1 is for vertical dialog (scrollbar in Y axis)
While _MouseInput
Wend
MX = _MouseX
MY = _MouseY
MB = _MouseButton(1)
Select Case Typ
Case -1 ' this is for Y axis (vertical dialog)
X1 = Xs: X2 = Xs + 7 'up arrow
Y1 = Ys: Y2 = Ys + 12
X3 = X1: X4 = X2
Y3 = Ys + Lenght - 12: y4 = Ys + Lenght 'down arrow
'logic - up arrow
MouseInUP = 0
UpArrowColor~& = _RGB32(96)
If MX > X1 And MX < X2 Then
If MY > Y1 And MY < Y2 Then
If MB Then Arrow = -1
UpArrowColor~& = _RGB32(75)
Line (X1, Y1)-(X2, Y2), _RGB32(190), BF
MouseInUP = 1
End If
End If
If MouseInUP = 0 Then Line (X1, Y1)-(X2, Y2), _RGB32(250), BF
'end for logic up arrow
'logic down arrow
MouseInDN = 0
DnArrowColor~& = _RGB32(96)
If MX > X3 And MX < X4 Then
If MY > Y3 And MY < y4 Then
If MB Then Arrow = 1
DnArrowColor~& = _RGB32(75)
Line (X3, Y3)-(X4, y4), _RGB32(190), BF
MouseInDN = 1
End If
End If
If MouseInDN = 0 Then Line (X3, Y3)-(X4, y4), _RGB32(250), BF
'end for logic down arrow
'arrow size: 7x6 pixels
Restore arrbin
For X = 0 To 6
For Y = 0 To 5
Read Z
If Z Then
PSet (Xs + X, Ys + Y), UpArrowColor~& 'sipka nahoru
PSet (Xs + X, Ys - Y + Lenght), DnArrowColor~& 'sipka dolu
End If
Next Y, X
Line (Xs - 2, Ys - 2)-(Xs + 9, Ys + Lenght + 2), _RGB32(100), B 'outter line
'Description of the inner rectangle:
'If you can see all the lines of text in the window, the rectangle is over the entire slider.
'If you can only see 50 percent of the text in the window, the rectangle is exactly halfway up the slider.
'The length of the rectangle is determined by calculating percentages.
'If you see 10 percent of the text in the window (100 percent is the maximum size of the field
'passed - we are talking about scrolling up and down), then the length of the displayed rectangle will be
'exactly 10 percent of the length between the arrows of the dialog box. However, arrows are also drawn
'in this length, therefore the length between the upper and lower border of the dialog is reduced
'by 16 pixels (8 pixels for one arrow). This length is then the basis of 100 percent in pixels for calculating
'the length of the rectangle between the arrows.
arrbin: 'arrow image descriptor point by point
Data 0,0,0,1,1,1,0,0,1,1,1,0,0,1,1,1,0,0,1,1,1,0,0,0,0,1,1,1,0,0,0,0,1,1,1,0,0,0,0,1,1,1
Visible = (Lenght \ _FontHeight) - 2
PointerLenPercent = Visible / SizeOf
If PointerLenPercent > 1 Then PointerLenPercent = 1
RectangleSize = PointerLenPercent * (Lenght - 16)
RectanglePos = Int(Ys + 8 + (Lenght - 16 - RectangleSize) * SizeNow / SizeOf)
RecTangleColor~& = _RGB32(200)
'To increase the speed, the percentage of the height that the mouse click came from
' is calculated here. This will determine which record in the field it corresponds
' to (for example, in a dialog with a height of 100 pixels, you click on a position
' 20 pixels from the top, that is 20 percent. The passed field has a thousand records.
' 20 percents of a thousand records is 200, so you want to see position 200 Because the
'dialog knows which position you are in, it will return the difference between the current
'position in the field and the calculated position in the field (for example, if you are at
' position 50 when you click the mouse in the bar, the program will return the value 150 )
'condition for move by clicking to rectangle in scrollbar
If MX > Xs - 70 And MX < Xs + 70 Then
If MY >= RectanglePos - 20 And MY <= RectanglePos + RectangleSize + 20 Then
RecTangleColor~& = _RGB32(75)
If MB Then
PercentAm = (MY - Ys - 8) / (Lenght - 16)
Iam = PercentAm * SizeOf
arr = Iam - SizeNow
Arrow = Int(arr)
End If
End If
End If
Line (Xs + 1, Ys + 6)-(Xs + 6, Ys + 6 + Lenght - 16), _RGB32(255), BF 'clear area before placing rectangle to new position
Line (Xs + 1, RectanglePos)-(Xs + 6, RectanglePos + RectangleSize), RecTangleColor~&, BF
Case 1
'Scrollbar to left and to right in X axis
X1 = Xs: X2 = Xs + 12 'left arrow
Y1 = Ys - 1: Y2 = Ys + 8
X3 = X1 + Lenght - 12: X4 = X1 + Lenght
Y3 = Ys - 1: y4 = Ys + 8 'right arrow
'logic - left arrow
MouseInUP = 0
LeftArrowColor~& = _RGB32(96)
If MX > X1 And MX < X2 Then
If MY > Y1 And MY < Y2 Then
If MB Then Arrow = -1
LeftArrowColor~& = _RGB32(75)
Line (X1, Y1)-(X2, Y2), _RGB32(190), BF
MouseInUP = 1
End If
End If
If MouseInUP = 0 Then Line (X1, Y1)-(X2, Y2), _RGB32(250), BF
'logic left arrow - end
'logic right arrow
MouseInDN = 0
RightArrowColor~& = _RGB32(96)
If MX > X3 And MX < X4 Then
If MY > Y3 And MY < y4 Then
If MB Then Arrow = 1
RightArrowColor~& = _RGB32(75)
Line (X3, Y3)-(X4, y4), _RGB32(190), BF
MouseInDN = 1
End If
End If
If MouseInDN = 0 Then Line (X3, Y3)-(X4, y4), _RGB32(250), BF
'logic right arrow - end
'arrow size is 7x6 pixels
Restore arrbin2
For X = 0 To 5
For Y = 0 To 6
Read Z1
If Z1 Then
PSet (Xs + X, Ys + Y), LeftArrowColor~& 'arrow up
PSet (Xs + Lenght - X, Ys + Y), RightArrowColor~& 'arrow down
End If
Next Y, X
Line (Xs - 2, Ys - 2)-(Xs + Lenght + 2, Ys + 9), _RGB32(100), B 'outter line
'The calculation of the size of the rectangle inside the slider is similar to the previous case:
'First, the length of the longest string in the array is determined (see line 46 for the calculation of
'the variable HS_MAX which is then passed to the function as a parameter) and then the same procedure
'is followed. You click the mouse in the rectangle, it calculates how many percent from the left edge
'it is, the same number of percent in the length of the chain is calculated, the default shift from
'left to right is taken into account, and that is subtracted.
'Example. You are on third posiiton from the left. You click in the rectangle.
'According to the position of the mouse in the Y axis, it is calculated that you
'click 11 percent away from the position Ys + 8 (8 pixels occupied by the arrow).
'So you want to get to the 11 percent position on the X axis in the string text.
'This means that if, for example, the variable HS_MAX, which is passed to the function
'by the SizeOf parameter, is 250, then the longest string has 250 characters. 11 percents
'of 250 characters is 28 characters after rounding. Since you are at position 3, the function
'returns an offset of 25 characters.
'arrow image data point by point
arrbin2:
Data 0,0,0,1,0,0,0,0,0,1,1,1,0,0,0,1,1,1,1,1,0,1,1,1,0,1,1,1,1,1,0,0,0,1,1,1,0,0,0,0,0,1
Visible = ((Lenght - 16) \ _FontWidth) ' how much characters is visible in window
PointerLenPercent = Visible \ (SizeOf / 100) ' how much percents it is (SizeOf is longest string lenght)
PointerLenPercent = PointerLenPercent / 100
If PointerLenPercent > 1 Then PointerLenPercent = 1
RectangleSize = PointerLenPercent * (Lenght - 16) 'rectangle lenght in slider
RectanglePos = Int(Xs + 8 + (Lenght - 16) * (SizeNow / SizeOf)) 'rectangle positon in slider
RecTangleColor~& = _RGB32(200)
If MX >= RectanglePos - RectangleSize - 16 And MX <= RectanglePos + RectangleSize + 16 Then
If MY > Ys - 5 And MY < Ys + 16 Then
RecTangleColor~& = _RGB32(75)
If MB Then
PercentAm = (MX - Xs - 8) / (Lenght - 16)
Iam = PercentAm * SizeOf
arr = Iam - SizeNow
Arrow = Int(arr)
End If
End If
End If
Line (Xs + 8, Ys - 1)-(Xs + Lenght - 8, Ys + 8), _RGB32(255), BF 'clear area before draw new rectangle to new position
Line (RectanglePos, Ys)-(RectanglePos + RectangleSize, Ys + 8), RecTangleColor~&, BF
End Select
End Function
Posts: 730
Threads: 120
Joined: Apr 2022
Reputation:
106
That's looking pretty good, @Petr! It's very functional. Everything works.
- Dav
Posts: 51
Threads: 14
Joined: Apr 2022
Reputation:
6
Thats awesome. I like that alot
Posts: 51
Threads: 14
Joined: Apr 2022
Reputation:
6
09-09-2024, 11:55 PM
(This post was last modified: 09-10-2024, 12:06 AM by Keybone.)
I was just messing around and i made the arrow buttons functional.
it was only a few lines of code i just figured id do it.
Code: (Select All)
'This program will be part of a larger project for SoundEditor.
'The task of this small program is to display a text field in a
'window that allows text to be scrolled left, right, up and down.
'When Enter is pressed, function return row number.
'Note the structure of the program. Arrows with stripes, which are located
'here on the sides of the text window, can be placed independently anywhere.
'Just modify the call to the Arrow function.
'
Dim Shared Samples(1000) As String
For gensamp = 0 To 1000
For char = 1 To 300 + (125 * Rnd)
a$ = a$ + Chr$(32 + 64 * Rnd)
Next
Samples(gensamp) = a$
a$ = ""
Next gensamp
Screen _NewImage(1280, 1024, 32)
Cls , _RGBA32(255, 0, 0, 255) ' Background color for desktop
Do
SelectSample = ViewSamples(40, 30, 760, 705, 1, "Samples list:", Samples())
Locate 1
If SelectSample > -1 Then Print "Function return record number:"; SelectSample
_Display
_Limit 20
Loop
Function ViewSamples (xs As Integer, ys As Integer, xe As Integer, ye As Integer, Mode As _Byte, Title As String, a() As String)
' Xs: upper left corner X position
' Ys: upper left corner Y position
' Xe: bottom right corner X position
' Ye: bottom right corner Y position
' Mode: if it is zero, no text movement is allowed in the X-axis, and text that would go outside the window
' is terminated by three dots, if is 1, is allowed text movement in the X-axis.
' Title: Window title
' A() is array which contains text
ViewSamples = -1
Static VS_Pos 'selector position VERTICAL
Static ListStart, ListEnd
Static HS_POS, HS_MAX 'selector position HORIZONTAL
If HS_MAX = 0 Then
For t = 0 To UBound(a)
CurrentLen = Len(a(t))
If HS_MAX < CurrentLen Then HS_MAX = CurrentLen
Next t
End If
If HS_POS < 1 Then HS_POS = 1
If xe < xs Then Swap xe, xs
If ye < ys Then Swap ye, ys
'----
'There are two options to jump right to the last position in the text.
'left it set to always jump to the position of the longest string. Other
'options (commented out/disallowed here) are that they jump to the end based
'on the length of a particular string.
' If HS_POS > Len(a(VS_Pos)) - ((xe - xs) \ _FontWidth) + 2 Then HS_POS = Len(a(VS_Pos)) - ((xe - xs) \ _FontWidth) + 2
' If HS_POS > HS_MAX Then HS_POS = HS_MAX
If HS_POS > HS_MAX - (xe - xs) \ _FontWidth Then HS_POS = HS_MAX - (xe - xs) \ _FontWidth
VS_Wdth = xe - xs
VS_Hght = ye - ys
Line (xs, ys)-(xe, ye), _RGB32(200), BF
Line (xs, ys)-(xe, ye), _RGB32(120), B
If Len(_Trim$(Title$)) > VS_Wdth \ _FontWidth Then
Title$ = Mid$(Title$, 1, VS_Wdth \ _FontWidth - 3) + "..."
End If
_PrintMode _KeepBackground
Color _RGB32(0)
_PrintString (xs + VS_Wdth \ 2 - _PrintWidth(Title$) \ 2, ys), Title$
Line (xs, ys + _FontHeight)-(xe, ys + _FontHeight), _RGB32(120)
If VS_Pos > ListEnd - 1 Then
Nr_lines = (ye - ys) \ _FontHeight
ListStart = VS_Pos - Nr_lines + 3
End If
If ListStart > 3 + UBound(a) - VS_Hght \ _FontHeight Then ListStart = 3 + UBound(a) - VS_Hght \ _FontHeight
If VS_Pos < ListStart Then ListStart = VS_Pos
If ListStart < 0 Then ListStart = 0
ListEnd = ListStart + VS_Hght \ _FontHeight
If VS_Hght \ _FontHeight Mod _FontHeight Then ListEnd = ListEnd - 3
If ListEnd > UBound(a) Then ListEnd = UBound(a)
i = 0
_PrintMode _FillBackground
For s = ListStart To ListEnd
If VS_Pos = s Then Color _RGB32(0), _RGB32(255, 255, 0) Else Color _RGB32(0), _RGB32(200)
Select Case Mode
Case 0
If Len(a(s)) > VS_Wdth \ _FontWidth - 1 Then
a$ = Mid$(a(s), 1, VS_Wdth \ _FontWidth - 4) + "..."
Else
a$ = a(s)
End If
Case 1
' If Len(a(s)) > VS_Wdth \ _FontWidth - 1 Then 'if is used this conditon so rows, which lenght is not bigger than window width, are not scrolled to left
b$ = a(s) + String$(HS_MAX - Len(_Trim$(a(s))), Chr$(32))
a$ = Mid$(b$, HS_POS, VS_Wdth \ _FontWidth - 1)
' Else
' a$ = a(s)
' End If
End Select
_PrintString (xs + 5, 5 + ys + _FontHeight + i * _FontHeight), a$
i = i + 1
Next
'Keyboard support
k& = _KeyHit
If Mode Then
XArrow = Arrow(xs + 2, ye + 4, xe - xs - 2, 1, HS_MAX, HS_POS) 'modify this two lines (XArrow and YArrow) and move scrooll bars
End If ' and arrows to other place on the screen
YArrow = Arrow(xe + 2, ys, ye - ys, -1, UBound(a), VS_Pos)
VS_Pos = VS_Pos + YArrow
HS_POS = HS_POS + XArrow
Select Case k&
Case 18432: VS_Pos = VS_Pos - 1 'arrow up
Case 20480: VS_Pos = VS_Pos + 1 'arrow down
Case 13: ViewSamples = VS_Pos: Exit Function
Case 18688: VS_Pos = VS_Pos - (ye - ys) \ _FontHeight 'PgUp
Case 20736: VS_Pos = VS_Pos + (ye - ys) \ _FontHeight 'PgDn
Case 19200: HS_POS = HS_POS - 1 'arrow left
Case 19712: HS_POS = HS_POS + 1 'arrow right
Case 18176: HS_POS = 1 ' home
Case 20224: HS_POS = HS_MAX ' end
End Select
If VS_Pos < 0 Then VS_Pos = 0
If VS_Pos > UBound(a) Then VS_Pos = UBound(a)
End Function
Function Arrow (Xs As Integer, Ys As Integer, Lenght As Integer, Typ As _Byte, SizeOf As Long, SizeNow As Long)
Arrow = 0
Static OldMy
'function draw a rectangular field on the axis with arrows at the end.
'SizeOf: maximum size (number of total records in array or lenght of the longest string)
'SizeNow: current position number (number of the record in the field or number of the position in the string from the left)
'Xs: left upper corner X axis position
'Ys: left upper corner Y axis position
'Lenght: lenght (width for Typ = 1 or height for typ = -1) for scroll bar with arrows in pixels
'Typ: 1 is for horizontal dialog (scrollbar in X axis)
' -1 is for vertical dialog (scrollbar in Y axis)
While _MouseInput
Wend
MX = _MouseX
MY = _MouseY
MB = _MouseButton(1)
Select Case Typ
Case -1 ' this is for Y axis (vertical dialog)
X1 = Xs: X2 = Xs + 7 'up arrow
Y1 = Ys: Y2 = Ys + 12
X3 = X1: X4 = X2
Y3 = Ys + Lenght - 12: y4 = Ys + Lenght 'down arrow
'logic - up arrow
MouseInUP = 0
UpArrowColor~& = _RGB32(96)
If MX > X1 And MX < X2 Then
If MY > Y1 And MY < Y2 Then
If MB Then Arrow = -1
UpArrowColor~& = _RGB32(75)
Line (X1, Y1)-(X2, Y2), _RGB32(190), BF
MouseInUP = 1
End If
End If
If MouseInUP = 0 Then Line (X1, Y1)-(X2, Y2), _RGB32(250), BF
If MouseInUP = 1 Then
SizeNow = SizeNow - 1
End If
'end for logic up arrow
'logic down arrow
MouseInDN = 0
DnArrowColor~& = _RGB32(96)
If MX > X3 And MX < X4 Then
If MY > Y3 And MY < y4 Then
If MB Then Arrow = 1
DnArrowColor~& = _RGB32(75)
Line (X3, Y3)-(X4, y4), _RGB32(190), BF
MouseInDN = 1
End If
End If
If MouseInDN = 0 Then Line (X3, Y3)-(X4, y4), _RGB32(250), BF
If MouseInDN = 1 Then
SizeNow = SizeNow + 1
End If
'end for logic down arrow
'arrow size: 7x6 pixels
Restore arrbin
For X = 0 To 6
For Y = 0 To 5
Read Z
If Z Then
PSet (Xs + X, Ys + Y), UpArrowColor~& 'sipka nahoru
PSet (Xs + X, Ys - Y + Lenght), DnArrowColor~& 'sipka dolu
End If
Next Y, X
Line (Xs - 2, Ys - 2)-(Xs + 9, Ys + Lenght + 2), _RGB32(100), B 'outter line
'Description of the inner rectangle:
'If you can see all the lines of text in the window, the rectangle is over the entire slider.
'If you can only see 50 percent of the text in the window, the rectangle is exactly halfway up the slider.
'The length of the rectangle is determined by calculating percentages.
'If you see 10 percent of the text in the window (100 percent is the maximum size of the field
'passed - we are talking about scrolling up and down), then the length of the displayed rectangle will be
'exactly 10 percent of the length between the arrows of the dialog box. However, arrows are also drawn
'in this length, therefore the length between the upper and lower border of the dialog is reduced
'by 16 pixels (8 pixels for one arrow). This length is then the basis of 100 percent in pixels for calculating
'the length of the rectangle between the arrows.
arrbin: 'arrow image descriptor point by point
Data 0,0,0,1,1,1,0,0,1,1,1,0,0,1,1,1,0,0,1,1,1,0,0,0,0,1,1,1,0,0,0,0,1,1,1,0,0,0,0,1,1,1
Visible = (Lenght \ _FontHeight) - 2
PointerLenPercent = Visible / SizeOf
If PointerLenPercent > 1 Then PointerLenPercent = 1
RectangleSize = PointerLenPercent * (Lenght - 16)
RectanglePos = Int(Ys + 8 + (Lenght - 16 - RectangleSize) * SizeNow / SizeOf)
RecTangleColor~& = _RGB32(200)
'To increase the speed, the percentage of the height that the mouse click came from
' is calculated here. This will determine which record in the field it corresponds
' to (for example, in a dialog with a height of 100 pixels, you click on a position
' 20 pixels from the top, that is 20 percent. The passed field has a thousand records.
' 20 percents of a thousand records is 200, so you want to see position 200 Because the
'dialog knows which position you are in, it will return the difference between the current
'position in the field and the calculated position in the field (for example, if you are at
' position 50 when you click the mouse in the bar, the program will return the value 150 )
'condition for move by clicking to rectangle in scrollbar
If MX > Xs - 70 And MX < Xs + 70 Then
If MY >= RectanglePos - 20 And MY <= RectanglePos + RectangleSize + 20 Then
RecTangleColor~& = _RGB32(75)
If MB Then
PercentAm = (MY - Ys - 8) / (Lenght - 16)
Iam = PercentAm * SizeOf
arr = Iam - SizeNow
Arrow = Int(arr)
End If
End If
End If
Line (Xs + 1, Ys + 6)-(Xs + 6, Ys + 6 + Lenght - 16), _RGB32(255), BF 'clear area before placing rectangle to new position
Line (Xs + 1, RectanglePos)-(Xs + 6, RectanglePos + RectangleSize), RecTangleColor~&, BF
Case 1
'Scrollbar to left and to right in X axis
X1 = Xs: X2 = Xs + 12 'left arrow
Y1 = Ys - 1: Y2 = Ys + 8
X3 = X1 + Lenght - 12: X4 = X1 + Lenght
Y3 = Ys - 1: y4 = Ys + 8 'right arrow
'logic - left arrow
MouseInUP = 0
LeftArrowColor~& = _RGB32(96)
If MX > X1 And MX < X2 Then
If MY > Y1 And MY < Y2 Then
If MB Then Arrow = -1
LeftArrowColor~& = _RGB32(75)
Line (X1, Y1)-(X2, Y2), _RGB32(190), BF
MouseInUP = 1
End If
End If
If MouseInUP = 0 Then Line (X1, Y1)-(X2, Y2), _RGB32(250), BF
If MouseInUP = 1 Then
SizeNow = SizeNow - 1
End If
'logic left arrow - end
'logic right arrow
MouseInDN = 0
RightArrowColor~& = _RGB32(96)
If MX > X3 And MX < X4 Then
If MY > Y3 And MY < y4 Then
If MB Then Arrow = 1
RightArrowColor~& = _RGB32(75)
Line (X3, Y3)-(X4, y4), _RGB32(190), BF
MouseInDN = 1
End If
End If
If MouseInDN = 0 Then Line (X3, Y3)-(X4, y4), _RGB32(250), BF
If MouseInDN = 1 Then
SizeNow = SizeNow + 1
End If
'logic right arrow - end
'arrow size is 7x6 pixels
Restore arrbin2
For X = 0 To 5
For Y = 0 To 6
Read Z1
If Z1 Then
PSet (Xs + X, Ys + Y), LeftArrowColor~& 'arrow up
PSet (Xs + Lenght - X, Ys + Y), RightArrowColor~& 'arrow down
End If
Next Y, X
Line (Xs - 2, Ys - 2)-(Xs + Lenght + 2, Ys + 9), _RGB32(100), B 'outter line
'The calculation of the size of the rectangle inside the slider is similar to the previous case:
'First, the length of the longest string in the array is determined (see line 46 for the calculation of
'the variable HS_MAX which is then passed to the function as a parameter) and then the same procedure
'is followed. You click the mouse in the rectangle, it calculates how many percent from the left edge
'it is, the same number of percent in the length of the chain is calculated, the default shift from
'left to right is taken into account, and that is subtracted.
'Example. You are on third posiiton from the left. You click in the rectangle.
'According to the position of the mouse in the Y axis, it is calculated that you
'click 11 percent away from the position Ys + 8 (8 pixels occupied by the arrow).
'So you want to get to the 11 percent position on the X axis in the string text.
'This means that if, for example, the variable HS_MAX, which is passed to the function
'by the SizeOf parameter, is 250, then the longest string has 250 characters. 11 percents
'of 250 characters is 28 characters after rounding. Since you are at position 3, the function
'returns an offset of 25 characters.
'arrow image data point by point
arrbin2:
Data 0,0,0,1,0,0,0,0,0,1,1,1,0,0,0,1,1,1,1,1,0,1,1,1,0,1,1,1,1,1,0,0,0,1,1,1,0,0,0,0,0,1
Visible = ((Lenght - 16) \ _FontWidth) ' how much characters is visible in window
PointerLenPercent = Visible \ (SizeOf / 100) ' how much percents it is (SizeOf is longest string lenght)
PointerLenPercent = PointerLenPercent / 100
If PointerLenPercent > 1 Then PointerLenPercent = 1
RectangleSize = PointerLenPercent * (Lenght - 16) 'rectangle lenght in slider
RectanglePos = Int(Xs + 8 + (Lenght - 16) * (SizeNow / SizeOf)) 'rectangle positon in slider
RecTangleColor~& = _RGB32(200)
If MX >= RectanglePos - RectangleSize - 16 And MX <= RectanglePos + RectangleSize + 16 Then
If MY > Ys - 5 And MY < Ys + 16 Then
RecTangleColor~& = _RGB32(75)
If MB Then
PercentAm = (MX - Xs - 8) / (Lenght - 16)
Iam = PercentAm * SizeOf
arr = Iam - SizeNow
Arrow = Int(arr)
End If
End If
End If
Line (Xs + 8, Ys - 1)-(Xs + Lenght - 8, Ys + 8), _RGB32(255), BF 'clear area before draw new rectangle to new position
Line (RectanglePos, Ys)-(RectanglePos + RectangleSize, Ys + 8), RecTangleColor~&, BF
End Select
End Function
Posts: 250
Threads: 44
Joined: May 2022
Reputation:
28
09-10-2024, 10:28 AM
(This post was last modified: 09-10-2024, 10:30 AM by Petr.)
As I wrote, the functions listed in this thread are intended to be used multiple times. The design of the program in the previous case did not allow this, and now there is a version that does. When I wrote in the previous case that the problem would be one variable (which was left over from the development and was no longer used (rolling under the table laughing)), I was somewhat optimistic, but the solution was still there.
Unfortunately, the memory declaration error with STRING appeared again (I use QB64Pe 3.8.0) and therefore I had to define the variable Title as STRING * 30 on line 23, and to clean it up I used _Trim$ in the ViewSamples function in the program itself.
In order to operate the window from the keyboard, you have to move the mouse into it, or use the arrows and sliders designed for mouse control.
Code: (Select All)
'This program will be part of a larger project for SoundEditor.
'The task of this small program is to display a text field in a
'window that allows text to be scrolled left, right, up and down.
'When Enter is pressed, function return row number.
'Note the structure of the program. Arrows with stripes, which are located
'here on the sides of the text window, can be placed independently anywhere.
'this was really VERY optimistic:
'Just modify the call to the Arrow function.
'this version now allow multimple use.
Type MoreView
As Integer Xs, Ys, Xe, Ye
As Long VS_POS, HS_POS, HS_MAX, ListStart, ListEnd
As _Byte Mode
As String * 30 Title
End Type
ReDim Shared MV(0) As MoreView 'array which allowed more call ViewSamples
Dim Shared MX, MY, LB, RB, MW 'shared variables for mouse
Dim Samples(70) As String 'first random text array
For gensamp = 0 To 70
For char = 1 To 300 + 125 * Rnd
a$ = a$ + Chr$(32 + 64 * Rnd)
Next
Samples(gensamp) = a$
a$ = ""
Next
Dim SamplesTwo(270) As String 'second random text array
For gensamp = 0 To 270
For char = 1 To 10 + 50 * Rnd
a$ = a$ + Chr$(32 + 64 * Rnd)
Next
SamplesTwo(gensamp) = a$
a$ = ""
Next
Screen _NewImage(1024, 768, 32)
Cls , _RGB32(240)
'DO NOT PLACE THIS TO MY LOOP!
'call new dialogs
First = NewView(40, 38, 160, 380, 1, "Samples list A:")
Second = NewView(370, 38, 570, 315, 1, "Samples list B:")
Third = NewView(50, 410, 333, 750, 1, "Example C:")
Fourth = NewView(400, 407, 900, 700, 1, "Example D:")
Do
SelectSampleA = ViewSamples(First, Samples())
SelectSampleB = ViewSamples(Second, Samples())
SelectSampleC = ViewSamples(Third, SamplesTwo())
SelectSampleD = ViewSamples(Fourth, SamplesTwo())
Locate 1
If SelectSampleA > -1 Then Print "(A) - Function return record number:"; SelectSampleA
If SelectSampleB > -1 Then Print "(B) - Function return record number:"; SelectSampleB
If SelectSampleC > -1 Then Print "(C) - Function return record number:"; SelectSampleC
If SelectSampleD > -1 Then Print "(D) - Function return record number:"; SelectSampleD
_Display
_Limit 20
Loop
Function NewView (xs As Integer, ys As Integer, xe As Integer, ye As Integer, Mode As _Byte, Title As String)
i = UBound(MV)
MV(i).Xs = xs
MV(i).Ys = ys
MV(i).Xe = xe
MV(i).Ye = ye
MV(i).Mode = Mode
MV(i).Title = Title
ReDim _Preserve MV(i + 1) As MoreView
NewView = i
End Function
Function ViewSamples (idx As Long, a() As String)
' A() is array which contains text
ReDim As Integer Xs, Ys, Xe, Ye
ReDim As _Byte Mode
Dim As String Title
ReDim As Long VS_POS, HS_POS, HS_MAX, ListStart, ListEnd, K
Xs = MV(idx).Xs ' Xs: upper left corner X position
Ys = MV(idx).Ys ' Ys: upper left corner Y position
Xe = MV(idx).Xe ' Xe: bottom right corner X position
Ye = MV(idx).Ye ' Ye: bottom right corner Y position
Mode = MV(idx).Mode ' Mode: if it is zero, no text movement is allowed in the X-axis, and text that would go outside the window
' is terminated by three dots, if is 1, is allowed text movement in the X-axis.
Title = _Trim$(MV(idx).Title) 'Title: Window title
VS_POS = MV(idx).VS_POS 'selector position VERTICAL
HS_POS = MV(idx).HS_POS 'selector position HORIZONTAL
HS_MAX = MV(idx).HS_MAX 'Total horizontal records
ListStart = MV(idx).ListStart
ListEnd = MV(idx).ListEnd
ViewSamples = -1
If HS_MAX = 0 Then
For t = 0 To UBound(a)
CurrentLen = Len(a(t))
If HS_MAX < CurrentLen Then HS_MAX = CurrentLen
Next t
End If
If HS_POS < 1 Then HS_POS = 1
If Xe < Xs Then Swap Xe, Xs
If Ye < Ys Then Swap Ye, Ys
'----
'There are two options to jump right to the last position in the text.
'left it set to always jump to the position of the longest string. Other
'options (commented out/disallowed here) are that they jump to the end based
'on the length of a particular string.
' If HS_POS > Len(a(VS_Pos)) - ((xe - xs) \ _FontWidth) + 2 Then HS_POS = Len(a(VS_Pos)) - ((xe - xs) \ _FontWidth) + 2
' If HS_POS > HS_MAX Then HS_POS = HS_MAX
If HS_POS > HS_MAX - (Xe - Xs) \ _FontWidth Then HS_POS = HS_MAX - (Xe - Xs) \ _FontWidth
VS_Wdth = Xe - Xs
VS_Hght = Ye - Ys
Line (Xs, Ys)-(Xe, Ye), _RGB32(200), BF
Line (Xs, Ys)-(Xe, Ye), _RGB32(120), B
If Len(_Trim$(Title$)) > VS_Wdth \ _FontWidth Then
Title$ = Mid$(Title$, 1, VS_Wdth \ _FontWidth - 3) + "..."
End If
_PrintMode _KeepBackground
Color _RGB32(0)
_PrintString (Xs + VS_Wdth \ 2 - _PrintWidth(Title$) \ 2, Ys), Title$
Line (Xs, Ys + _FontHeight)-(Xe, Ys + _FontHeight), _RGB32(120)
If VS_POS > ListEnd Then
Nr_lines = (Ye - Ys) \ _FontHeight
ListStart = VS_POS - Nr_lines + 2
End If
If ListStart > 2 + UBound(a) - VS_Hght \ _FontHeight Then ListStart = 2 + UBound(a) - VS_Hght \ _FontHeight
If VS_POS < ListStart Then ListStart = VS_POS
If ListStart < 0 Then ListStart = 0
ListEnd = ListStart + VS_Hght \ _FontHeight
If VS_Hght \ _FontHeight Mod _FontHeight Then ListEnd = ListEnd - 2
If ListEnd > UBound(a) Then ListEnd = UBound(a)
i = 0
_PrintMode _FillBackground
For s = ListStart To ListEnd
If VS_POS = s Then Color _RGB32(0), _RGB32(255, 255, 0) Else Color _RGB32(0), _RGB32(200)
Select Case Mode
Case 0
If Len(a(s)) > VS_Wdth \ _FontWidth - 1 Then
a$ = Mid$(a(s), 1, VS_Wdth \ _FontWidth - 4) + "..."
Else
a$ = a(s)
End If
Case 1
' If Len(a(s)) > VS_Wdth \ _FontWidth - 1 Then 'if is used this conditon so rows, which lenght is not bigger than window width, are not scrolled to left
b$ = a(s) + String$(HS_MAX - Len(_Trim$(a(s))), Chr$(32))
a$ = Mid$(b$, HS_POS, VS_Wdth \ _FontWidth - 1)
' Else
' a$ = a(s)
' End If
End Select
_PrintString (Xs + 5, 5 + Ys + _FontHeight + i * _FontHeight), a$
i = i + 1
Next
If Mode Then
XArrow = Arrow(Xs + 2, Ye + 4, Xe - Xs - 2, 1, HS_MAX, HS_POS) 'modify this two lines (XArrow and YArrow) and move scrooll bars
End If ' and arrows to other place on the screen
YArrow = Arrow(Xe + 2, Ys, Ye - Ys, -1, UBound(a), VS_POS)
VS_POS = VS_POS + YArrow
HS_POS = HS_POS + XArrow
'Keyboard support (first is mouse position tested for locking keyboard support to correct window)
GetMouse
If MX > Xs And MX < Xe Then
If MY > Ys And MY < Ye Then
K& = _KeyHit
Select Case K&
Case 18432: VS_POS = VS_POS - 1 'arrow up
Case 20480: VS_POS = VS_POS + 1 'arrow down
Case 18688: VS_POS = VS_POS - (Ye - Ys) \ _FontHeight 'PgUp
Case 20736: VS_POS = VS_POS + (Ye - Ys) \ _FontHeight 'PgDn
Case 19200: HS_POS = HS_POS - 1 'arrow left
Case 19712: HS_POS = HS_POS + 1 'arrow right
Case 18176: HS_POS = 1 ' home
Case 20224: HS_POS = HS_MAX ' end
Case 13: ViewSamples = VS_POS: GoTo QuitFunction 'easyest way for upgrade this time is GoTo.... 
End Select
End If
End If
If VS_POS < 0 Then VS_POS = 0
If VS_POS > UBound(a) Then VS_POS = UBound(a)
QuitFunction:
MV(idx).VS_POS = VS_POS 'selector position VERTICAL
MV(idx).HS_POS = HS_POS 'selector position HORIZONTAL
MV(idx).HS_MAX = HS_MAX 'Total horizontal records
MV(idx).ListStart = ListStart
MV(idx).ListEnd = ListEnd
End Function
Sub GetMouse
While _MouseInput
Wend
MX = _MouseX
MY = _MouseY
LB = _MouseButton(1)
RB = _MouseButton(2)
MW = _MouseWheel
End Sub
Function Arrow (Xs As Integer, Ys As Integer, Lenght As Integer, Typ As _Byte, SizeOf As Long, SizeNow As Long)
Arrow = 0
'function draw a rectangular field on the axis with arrows at the end.
'SizeOf: maximum size (number of total records in array or lenght of the longest string)
'SizeNow: current position number (number of the record in the field or number of the position in the string from the left)
'Xs: left upper corner X axis position
'Ys: left upper corner Y axis position
'Lenght: lenght (width for Typ = 1 or height for typ = -1) for scroll bar with arrows in pixels
'Typ: 1 is for horizontal dialog (scrollbar in X axis)
' -1 is for vertical dialog (scrollbar in Y axis)
If SizeNow < 0 Then SizeNow = 0
While _MouseInput
Wend
MX = _MouseX
MY = _MouseY
MB = _MouseButton(1)
Select Case Typ
Case -1 ' this is for Y axis (vertical dialog)
X1 = Xs: X2 = Xs + 7 'up arrow
Y1 = Ys: Y2 = Ys + 12
X3 = X1: X4 = X2
Y3 = Ys + Lenght - 12: y4 = Ys + Lenght 'down arrow
'logic - up arrow
MouseInUP = 0
UpArrowColor~& = _RGB32(96)
If MX > X1 And MX < X2 Then
If MY > Y1 And MY < Y2 Then
If MB Then Arrow = -1
UpArrowColor~& = _RGB32(75)
Line (X1, Y1)-(X2, Y2), _RGB32(190), BF
MouseInUP = 1
End If
End If
If MouseInUP = 0 Then Line (X1, Y1)-(X2, Y2), _RGB32(250), BF
'end for logic up arrow
'logic down arrow
MouseInDN = 0
DnArrowColor~& = _RGB32(96)
If MX > X3 And MX < X4 Then
If MY > Y3 And MY < y4 Then
If MB Then Arrow = 1
DnArrowColor~& = _RGB32(75)
Line (X3, Y3)-(X4, y4), _RGB32(190), BF
MouseInDN = 1
End If
End If
If MouseInDN = 0 Then Line (X3, Y3)-(X4, y4), _RGB32(250), BF
'end for logic down arrow
'arrow size: 7x6 pixels
Restore arrbin
For X = 0 To 6
For Y = 0 To 5
Read Z
If Z Then
PSet (Xs + X, Ys + Y), UpArrowColor~& 'arrow up
PSet (Xs + X, Ys - Y + Lenght), DnArrowColor~& 'arrow down
End If
Next Y, X
Line (Xs - 2, Ys - 2)-(Xs + 9, Ys + Lenght + 2), _RGB32(100), B 'outter line
'Description of the inner rectangle:
'If you can see all the lines of text in the window, the rectangle is over the entire slider.
'If you can only see 50 percent of the text in the window, the rectangle is exactly halfway up the slider.
'The length of the rectangle is determined by calculating percentages.
'If you see 10 percent of the text in the window (100 percent is the maximum size of the field
'passed - we are talking about scrolling up and down), then the length of the displayed rectangle will be
'exactly 10 percent of the length between the arrows of the dialog box. However, arrows are also drawn
'in this length, therefore the length between the upper and lower border of the dialog is reduced
'by 16 pixels (8 pixels for one arrow). This length is then the basis of 100 percent in pixels for calculating
'the length of the rectangle between the arrows.
arrbin: 'arrow image descriptor point by point
Data 0,0,0,1,1,1,0,0,1,1,1,0,0,1,1,1,0,0,1,1,1,0,0,0,0,1,1,1,0,0,0,0,1,1,1,0,0,0,0,1,1,1
Visible = (Lenght \ _FontHeight) - 2
PointerLenPercent = Visible / SizeOf
If PointerLenPercent > 1 Then PointerLenPercent = 1
RectangleSize = PointerLenPercent * (Lenght - 16)
RectanglePos = Int(Ys + 8 + (Lenght - 16 - RectangleSize) * SizeNow / SizeOf)
RecTangleColor~& = _RGB32(200)
'To increase the speed, the percentage of the height that the mouse click came from
' is calculated here. This will determine which record in the field it corresponds
' to (for example, in a dialog with a height of 100 pixels, you click on a position
' 20 pixels from the top, that is 20 percent. The passed field has a thousand records.
' 20 percents of a thousand records is 200, so you want to see position 200 Because the
'dialog knows which position you are in, it will return the difference between the current
'position in the field and the calculated position in the field (for example, if you are at
' position 50 when you click the mouse in the bar, the program will return the value 150 )
'condition for move by clicking to rectangle in scrollbar
If MX > Xs - 20 And MX < Xs + 20 Then
If MY >= RectanglePos - 20 And MY <= RectanglePos + RectangleSize + 20 Then
RecTangleColor~& = _RGB32(75)
If MB Then
PercentAm = (MY - Ys - 8) / (Lenght - 16)
Iam = PercentAm * SizeOf
arr = Iam - SizeNow
Arrow = Int(arr)
End If
End If
End If
Line (Xs + 1, Ys + 6)-(Xs + 6, Ys + 6 + Lenght - 16), _RGB32(255), BF 'clear area before placing rectangle to new position
Line (Xs + 1, RectanglePos)-(Xs + 6, RectanglePos + RectangleSize), RecTangleColor~&, BF
' Line (Xs + 1, Ys + 12)-(Xs + 6, Ys + Lenght - 12), _RGB32(255), BF 'clear area before placing rectangle to new position
' Line (Xs + 1, RectanglePos)-(Xs + 6, RectanglePos + RectangleSize), RecTangleColor~&, BF
Case 1
'Scrollbar to left and to right in X axis
X1 = Xs: X2 = Xs + 12 'left arrow
Y1 = Ys - 1: Y2 = Ys + 8
X3 = X1 + Lenght - 12: X4 = X1 + Lenght
Y3 = Ys - 1: y4 = Ys + 8 'right arrow
'logic - left arrow
MouseInUP = 0
LeftArrowColor~& = _RGB32(96)
If MX > X1 And MX < X2 Then
If MY > Y1 And MY < Y2 Then
If MB Then Arrow = -1
LeftArrowColor~& = _RGB32(75)
Line (X1, Y1)-(X2, Y2), _RGB32(190), BF
MouseInUP = 1
End If
End If
If MouseInUP = 0 Then Line (X1, Y1)-(X2, Y2), _RGB32(250), BF
'logic left arrow - end
'logic right arrow
MouseInDN = 0
RightArrowColor~& = _RGB32(96)
If MX > X3 And MX < X4 Then
If MY > Y3 And MY < y4 Then
If MB Then Arrow = 1
RightArrowColor~& = _RGB32(75)
Line (X3, Y3)-(X4, y4), _RGB32(190), BF
MouseInDN = 1
End If
End If
If MouseInDN = 0 Then Line (X3, Y3)-(X4, y4), _RGB32(250), BF
'logic right arrow - end
'arrow size is 7x6 pixels
Restore arrbin2
For X = 0 To 5
For Y = 0 To 6
Read Z1
If Z1 Then
PSet (Xs + X, Ys + Y), LeftArrowColor~& 'arrow up
PSet (Xs + Lenght - X, Ys + Y), RightArrowColor~& 'arrow down
End If
Next Y, X
Line (Xs - 2, Ys - 2)-(Xs + Lenght + 2, Ys + 9), _RGB32(100), B 'outter line
'The calculation of the size of the rectangle inside the slider is similar to the previous case:
'First, the length of the longest string in the array is determined (see line 46 for the calculation of
'the variable HS_MAX which is then passed to the function as a parameter) and then the same procedure
'is followed. You click the mouse in the rectangle, it calculates how many percent from the left edge
'it is, the same number of percent in the length of the chain is calculated, the default shift from
'left to right is taken into account, and that is subtracted.
'Example. You are on third posiiton from the left. You click in the rectangle.
'According to the position of the mouse in the Y axis, it is calculated that you
'click 11 percent away from the position Ys + 8 (8 pixels occupied by the arrow).
'So you want to get to the 11 percent position on the X axis in the string text.
'This means that if, for example, the variable HS_MAX, which is passed to the function
'by the SizeOf parameter, is 250, then the longest string has 250 characters. 11 percents
'of 250 characters is 28 characters after rounding. Since you are at position 3, the function
'returns an offset of 25 characters.
'arrow image data point by point
arrbin2:
Data 0,0,0,1,0,0,0,0,0,1,1,1,0,0,0,1,1,1,1,1,0,1,1,1,0,1,1,1,1,1,0,0,0,1,1,1,0,0,0,0,0,1
Visible = ((Lenght - 16) \ _FontWidth) ' how much characters is visible in window
PointerLenPercent = Visible / SizeOf ' how much percents it is (SizeOf is longest string lenght)
If PointerLenPercent > 1 Then PointerLenPercent = 1
RectangleSize = PointerLenPercent * (Lenght - 16) 'rectangle lenght in slider
RectanglePos = Int(Xs + 8 + (Lenght - 16) * SizeNow / SizeOf) 'rectangle positon in slider
RecTangleColor~& = _RGB32(200)
If MX >= RectanglePos - RectangleSize - 16 And MX <= RectanglePos + RectangleSize + 16 Then
If MY > Ys - 5 And MY < Ys + 16 Then
RecTangleColor~& = _RGB32(75)
If MB Then
PercentAm = (MX - Xs - 8) / (Lenght - 16)
Iam = PercentAm * SizeOf
arr = Iam - SizeNow
Arrow = Int(arr)
End If
End If
End If
Line (Xs + 8, Ys - 1)-(Xs + Lenght - 8, Ys + 8), _RGB32(255), BF 'clear area before draw new rectangle to new position
Line (RectanglePos, Ys)-(RectanglePos + RectangleSize, Ys + 7), RecTangleColor~&, BF
End Select
End Function
@Keybone Thanks for the modification, it is already implanted in this version, + some fixes in my previous source code.
![[Image: image.png]](https://i.ibb.co/NVrNr5Y/image.png)
Posts: 51
Threads: 14
Joined: Apr 2022
Reputation:
6
(09-10-2024, 10:28 AM)Petr Wrote: As I wrote, the functions listed in this thread are intended to be used multiple times. The design of the program in the previous case did not allow this, and now there is a version that does. When I wrote in the previous case that the problem would be one variable (which was left over from the development and was no longer used (rolling under the table laughing)), I was somewhat optimistic, but the solution was still there.
Unfortunately, the memory declaration error with STRING appeared again (I use QB64Pe 3.8.0) and therefore I had to define the variable Title as STRING * 30 on line 23, and to clean it up I used _Trim$ in the ViewSamples function in the program itself.
In order to operate the window from the keyboard, you have to move the mouse into it, or use the arrows and sliders designed for mouse control.
Code: (Select All)
'This program will be part of a larger project for SoundEditor.
'The task of this small program is to display a text field in a
'window that allows text to be scrolled left, right, up and down.
'When Enter is pressed, function return row number.
'Note the structure of the program. Arrows with stripes, which are located
'here on the sides of the text window, can be placed independently anywhere.
'this was really VERY optimistic:
'Just modify the call to the Arrow function.
'this version now allow multimple use.
Type MoreView
As Integer Xs, Ys, Xe, Ye
As Long VS_POS, HS_POS, HS_MAX, ListStart, ListEnd
As _Byte Mode
As String * 30 Title
End Type
ReDim Shared MV(0) As MoreView 'array which allowed more call ViewSamples
Dim Shared MX, MY, LB, RB, MW 'shared variables for mouse
Dim Samples(70) As String 'first random text array
For gensamp = 0 To 70
For char = 1 To 300 + 125 * Rnd
a$ = a$ + Chr$(32 + 64 * Rnd)
Next
Samples(gensamp) = a$
a$ = ""
Next
Dim SamplesTwo(270) As String 'second random text array
For gensamp = 0 To 270
For char = 1 To 10 + 50 * Rnd
a$ = a$ + Chr$(32 + 64 * Rnd)
Next
SamplesTwo(gensamp) = a$
a$ = ""
Next
Screen _NewImage(1024, 768, 32)
Cls , _RGB32(240)
'DO NOT PLACE THIS TO MY LOOP!
'call new dialogs
First = NewView(40, 38, 160, 380, 1, "Samples list A:")
Second = NewView(370, 38, 570, 315, 1, "Samples list B:")
Third = NewView(50, 410, 333, 750, 1, "Example C:")
Fourth = NewView(400, 407, 900, 700, 1, "Example D:")
Do
SelectSampleA = ViewSamples(First, Samples())
SelectSampleB = ViewSamples(Second, Samples())
SelectSampleC = ViewSamples(Third, SamplesTwo())
SelectSampleD = ViewSamples(Fourth, SamplesTwo())
Locate 1
If SelectSampleA > -1 Then Print "(A) - Function return record number:"; SelectSampleA
If SelectSampleB > -1 Then Print "(B) - Function return record number:"; SelectSampleB
If SelectSampleC > -1 Then Print "(C) - Function return record number:"; SelectSampleC
If SelectSampleD > -1 Then Print "(D) - Function return record number:"; SelectSampleD
_Display
_Limit 20
Loop
Function NewView (xs As Integer, ys As Integer, xe As Integer, ye As Integer, Mode As _Byte, Title As String)
i = UBound(MV)
MV(i).Xs = xs
MV(i).Ys = ys
MV(i).Xe = xe
MV(i).Ye = ye
MV(i).Mode = Mode
MV(i).Title = Title
ReDim _Preserve MV(i + 1) As MoreView
NewView = i
End Function
Function ViewSamples (idx As Long, a() As String)
' A() is array which contains text
ReDim As Integer Xs, Ys, Xe, Ye
ReDim As _Byte Mode
Dim As String Title
ReDim As Long VS_POS, HS_POS, HS_MAX, ListStart, ListEnd, K
Xs = MV(idx).Xs ' Xs: upper left corner X position
Ys = MV(idx).Ys ' Ys: upper left corner Y position
Xe = MV(idx).Xe ' Xe: bottom right corner X position
Ye = MV(idx).Ye ' Ye: bottom right corner Y position
Mode = MV(idx).Mode ' Mode: if it is zero, no text movement is allowed in the X-axis, and text that would go outside the window
' is terminated by three dots, if is 1, is allowed text movement in the X-axis.
Title = _Trim$(MV(idx).Title) 'Title: Window title
VS_POS = MV(idx).VS_POS 'selector position VERTICAL
HS_POS = MV(idx).HS_POS 'selector position HORIZONTAL
HS_MAX = MV(idx).HS_MAX 'Total horizontal records
ListStart = MV(idx).ListStart
ListEnd = MV(idx).ListEnd
ViewSamples = -1
If HS_MAX = 0 Then
For t = 0 To UBound(a)
CurrentLen = Len(a(t))
If HS_MAX < CurrentLen Then HS_MAX = CurrentLen
Next t
End If
If HS_POS < 1 Then HS_POS = 1
If Xe < Xs Then Swap Xe, Xs
If Ye < Ys Then Swap Ye, Ys
'----
'There are two options to jump right to the last position in the text.
'left it set to always jump to the position of the longest string. Other
'options (commented out/disallowed here) are that they jump to the end based
'on the length of a particular string.
' If HS_POS > Len(a(VS_Pos)) - ((xe - xs) \ _FontWidth) + 2 Then HS_POS = Len(a(VS_Pos)) - ((xe - xs) \ _FontWidth) + 2
' If HS_POS > HS_MAX Then HS_POS = HS_MAX
If HS_POS > HS_MAX - (Xe - Xs) \ _FontWidth Then HS_POS = HS_MAX - (Xe - Xs) \ _FontWidth
VS_Wdth = Xe - Xs
VS_Hght = Ye - Ys
Line (Xs, Ys)-(Xe, Ye), _RGB32(200), BF
Line (Xs, Ys)-(Xe, Ye), _RGB32(120), B
If Len(_Trim$(Title$)) > VS_Wdth \ _FontWidth Then
Title$ = Mid$(Title$, 1, VS_Wdth \ _FontWidth - 3) + "..."
End If
_PrintMode _KeepBackground
Color _RGB32(0)
_PrintString (Xs + VS_Wdth \ 2 - _PrintWidth(Title$) \ 2, Ys), Title$
Line (Xs, Ys + _FontHeight)-(Xe, Ys + _FontHeight), _RGB32(120)
If VS_POS > ListEnd Then
Nr_lines = (Ye - Ys) \ _FontHeight
ListStart = VS_POS - Nr_lines + 2
End If
If ListStart > 2 + UBound(a) - VS_Hght \ _FontHeight Then ListStart = 2 + UBound(a) - VS_Hght \ _FontHeight
If VS_POS < ListStart Then ListStart = VS_POS
If ListStart < 0 Then ListStart = 0
ListEnd = ListStart + VS_Hght \ _FontHeight
If VS_Hght \ _FontHeight Mod _FontHeight Then ListEnd = ListEnd - 2
If ListEnd > UBound(a) Then ListEnd = UBound(a)
i = 0
_PrintMode _FillBackground
For s = ListStart To ListEnd
If VS_POS = s Then Color _RGB32(0), _RGB32(255, 255, 0) Else Color _RGB32(0), _RGB32(200)
Select Case Mode
Case 0
If Len(a(s)) > VS_Wdth \ _FontWidth - 1 Then
a$ = Mid$(a(s), 1, VS_Wdth \ _FontWidth - 4) + "..."
Else
a$ = a(s)
End If
Case 1
' If Len(a(s)) > VS_Wdth \ _FontWidth - 1 Then 'if is used this conditon so rows, which lenght is not bigger than window width, are not scrolled to left
b$ = a(s) + String$(HS_MAX - Len(_Trim$(a(s))), Chr$(32))
a$ = Mid$(b$, HS_POS, VS_Wdth \ _FontWidth - 1)
' Else
' a$ = a(s)
' End If
End Select
_PrintString (Xs + 5, 5 + Ys + _FontHeight + i * _FontHeight), a$
i = i + 1
Next
If Mode Then
XArrow = Arrow(Xs + 2, Ye + 4, Xe - Xs - 2, 1, HS_MAX, HS_POS) 'modify this two lines (XArrow and YArrow) and move scrooll bars
End If ' and arrows to other place on the screen
YArrow = Arrow(Xe + 2, Ys, Ye - Ys, -1, UBound(a), VS_POS)
VS_POS = VS_POS + YArrow
HS_POS = HS_POS + XArrow
'Keyboard support (first is mouse position tested for locking keyboard support to correct window)
GetMouse
If MX > Xs And MX < Xe Then
If MY > Ys And MY < Ye Then
K& = _KeyHit
Select Case K&
Case 18432: VS_POS = VS_POS - 1 'arrow up
Case 20480: VS_POS = VS_POS + 1 'arrow down
Case 18688: VS_POS = VS_POS - (Ye - Ys) \ _FontHeight 'PgUp
Case 20736: VS_POS = VS_POS + (Ye - Ys) \ _FontHeight 'PgDn
Case 19200: HS_POS = HS_POS - 1 'arrow left
Case 19712: HS_POS = HS_POS + 1 'arrow right
Case 18176: HS_POS = 1 ' home
Case 20224: HS_POS = HS_MAX ' end
Case 13: ViewSamples = VS_POS: GoTo QuitFunction 'easyest way for upgrade this time is GoTo....
End Select
End If
End If
If VS_POS < 0 Then VS_POS = 0
If VS_POS > UBound(a) Then VS_POS = UBound(a)
QuitFunction:
MV(idx).VS_POS = VS_POS 'selector position VERTICAL
MV(idx).HS_POS = HS_POS 'selector position HORIZONTAL
MV(idx).HS_MAX = HS_MAX 'Total horizontal records
MV(idx).ListStart = ListStart
MV(idx).ListEnd = ListEnd
End Function
Sub GetMouse
While _MouseInput
Wend
MX = _MouseX
MY = _MouseY
LB = _MouseButton(1)
RB = _MouseButton(2)
MW = _MouseWheel
End Sub
Function Arrow (Xs As Integer, Ys As Integer, Lenght As Integer, Typ As _Byte, SizeOf As Long, SizeNow As Long)
Arrow = 0
'function draw a rectangular field on the axis with arrows at the end.
'SizeOf: maximum size (number of total records in array or lenght of the longest string)
'SizeNow: current position number (number of the record in the field or number of the position in the string from the left)
'Xs: left upper corner X axis position
'Ys: left upper corner Y axis position
'Lenght: lenght (width for Typ = 1 or height for typ = -1) for scroll bar with arrows in pixels
'Typ: 1 is for horizontal dialog (scrollbar in X axis)
' -1 is for vertical dialog (scrollbar in Y axis)
If SizeNow < 0 Then SizeNow = 0
While _MouseInput
Wend
MX = _MouseX
MY = _MouseY
MB = _MouseButton(1)
Select Case Typ
Case -1 ' this is for Y axis (vertical dialog)
X1 = Xs: X2 = Xs + 7 'up arrow
Y1 = Ys: Y2 = Ys + 12
X3 = X1: X4 = X2
Y3 = Ys + Lenght - 12: y4 = Ys + Lenght 'down arrow
'logic - up arrow
MouseInUP = 0
UpArrowColor~& = _RGB32(96)
If MX > X1 And MX < X2 Then
If MY > Y1 And MY < Y2 Then
If MB Then Arrow = -1
UpArrowColor~& = _RGB32(75)
Line (X1, Y1)-(X2, Y2), _RGB32(190), BF
MouseInUP = 1
End If
End If
If MouseInUP = 0 Then Line (X1, Y1)-(X2, Y2), _RGB32(250), BF
'end for logic up arrow
'logic down arrow
MouseInDN = 0
DnArrowColor~& = _RGB32(96)
If MX > X3 And MX < X4 Then
If MY > Y3 And MY < y4 Then
If MB Then Arrow = 1
DnArrowColor~& = _RGB32(75)
Line (X3, Y3)-(X4, y4), _RGB32(190), BF
MouseInDN = 1
End If
End If
If MouseInDN = 0 Then Line (X3, Y3)-(X4, y4), _RGB32(250), BF
'end for logic down arrow
'arrow size: 7x6 pixels
Restore arrbin
For X = 0 To 6
For Y = 0 To 5
Read Z
If Z Then
PSet (Xs + X, Ys + Y), UpArrowColor~& 'arrow up
PSet (Xs + X, Ys - Y + Lenght), DnArrowColor~& 'arrow down
End If
Next Y, X
Line (Xs - 2, Ys - 2)-(Xs + 9, Ys + Lenght + 2), _RGB32(100), B 'outter line
'Description of the inner rectangle:
'If you can see all the lines of text in the window, the rectangle is over the entire slider.
'If you can only see 50 percent of the text in the window, the rectangle is exactly halfway up the slider.
'The length of the rectangle is determined by calculating percentages.
'If you see 10 percent of the text in the window (100 percent is the maximum size of the field
'passed - we are talking about scrolling up and down), then the length of the displayed rectangle will be
'exactly 10 percent of the length between the arrows of the dialog box. However, arrows are also drawn
'in this length, therefore the length between the upper and lower border of the dialog is reduced
'by 16 pixels (8 pixels for one arrow). This length is then the basis of 100 percent in pixels for calculating
'the length of the rectangle between the arrows.
arrbin: 'arrow image descriptor point by point
Data 0,0,0,1,1,1,0,0,1,1,1,0,0,1,1,1,0,0,1,1,1,0,0,0,0,1,1,1,0,0,0,0,1,1,1,0,0,0,0,1,1,1
Visible = (Lenght \ _FontHeight) - 2
PointerLenPercent = Visible / SizeOf
If PointerLenPercent > 1 Then PointerLenPercent = 1
RectangleSize = PointerLenPercent * (Lenght - 16)
RectanglePos = Int(Ys + 8 + (Lenght - 16 - RectangleSize) * SizeNow / SizeOf)
RecTangleColor~& = _RGB32(200)
'To increase the speed, the percentage of the height that the mouse click came from
' is calculated here. This will determine which record in the field it corresponds
' to (for example, in a dialog with a height of 100 pixels, you click on a position
' 20 pixels from the top, that is 20 percent. The passed field has a thousand records.
' 20 percents of a thousand records is 200, so you want to see position 200 Because the
'dialog knows which position you are in, it will return the difference between the current
'position in the field and the calculated position in the field (for example, if you are at
' position 50 when you click the mouse in the bar, the program will return the value 150 )
'condition for move by clicking to rectangle in scrollbar
If MX > Xs - 20 And MX < Xs + 20 Then
If MY >= RectanglePos - 20 And MY <= RectanglePos + RectangleSize + 20 Then
RecTangleColor~& = _RGB32(75)
If MB Then
PercentAm = (MY - Ys - 8) / (Lenght - 16)
Iam = PercentAm * SizeOf
arr = Iam - SizeNow
Arrow = Int(arr)
End If
End If
End If
Line (Xs + 1, Ys + 6)-(Xs + 6, Ys + 6 + Lenght - 16), _RGB32(255), BF 'clear area before placing rectangle to new position
Line (Xs + 1, RectanglePos)-(Xs + 6, RectanglePos + RectangleSize), RecTangleColor~&, BF
' Line (Xs + 1, Ys + 12)-(Xs + 6, Ys + Lenght - 12), _RGB32(255), BF 'clear area before placing rectangle to new position
' Line (Xs + 1, RectanglePos)-(Xs + 6, RectanglePos + RectangleSize), RecTangleColor~&, BF
Case 1
'Scrollbar to left and to right in X axis
X1 = Xs: X2 = Xs + 12 'left arrow
Y1 = Ys - 1: Y2 = Ys + 8
X3 = X1 + Lenght - 12: X4 = X1 + Lenght
Y3 = Ys - 1: y4 = Ys + 8 'right arrow
'logic - left arrow
MouseInUP = 0
LeftArrowColor~& = _RGB32(96)
If MX > X1 And MX < X2 Then
If MY > Y1 And MY < Y2 Then
If MB Then Arrow = -1
LeftArrowColor~& = _RGB32(75)
Line (X1, Y1)-(X2, Y2), _RGB32(190), BF
MouseInUP = 1
End If
End If
If MouseInUP = 0 Then Line (X1, Y1)-(X2, Y2), _RGB32(250), BF
'logic left arrow - end
'logic right arrow
MouseInDN = 0
RightArrowColor~& = _RGB32(96)
If MX > X3 And MX < X4 Then
If MY > Y3 And MY < y4 Then
If MB Then Arrow = 1
RightArrowColor~& = _RGB32(75)
Line (X3, Y3)-(X4, y4), _RGB32(190), BF
MouseInDN = 1
End If
End If
If MouseInDN = 0 Then Line (X3, Y3)-(X4, y4), _RGB32(250), BF
'logic right arrow - end
'arrow size is 7x6 pixels
Restore arrbin2
For X = 0 To 5
For Y = 0 To 6
Read Z1
If Z1 Then
PSet (Xs + X, Ys + Y), LeftArrowColor~& 'arrow up
PSet (Xs + Lenght - X, Ys + Y), RightArrowColor~& 'arrow down
End If
Next Y, X
Line (Xs - 2, Ys - 2)-(Xs + Lenght + 2, Ys + 9), _RGB32(100), B 'outter line
'The calculation of the size of the rectangle inside the slider is similar to the previous case:
'First, the length of the longest string in the array is determined (see line 46 for the calculation of
'the variable HS_MAX which is then passed to the function as a parameter) and then the same procedure
'is followed. You click the mouse in the rectangle, it calculates how many percent from the left edge
'it is, the same number of percent in the length of the chain is calculated, the default shift from
'left to right is taken into account, and that is subtracted.
'Example. You are on third posiiton from the left. You click in the rectangle.
'According to the position of the mouse in the Y axis, it is calculated that you
'click 11 percent away from the position Ys + 8 (8 pixels occupied by the arrow).
'So you want to get to the 11 percent position on the X axis in the string text.
'This means that if, for example, the variable HS_MAX, which is passed to the function
'by the SizeOf parameter, is 250, then the longest string has 250 characters. 11 percents
'of 250 characters is 28 characters after rounding. Since you are at position 3, the function
'returns an offset of 25 characters.
'arrow image data point by point
arrbin2:
Data 0,0,0,1,0,0,0,0,0,1,1,1,0,0,0,1,1,1,1,1,0,1,1,1,0,1,1,1,1,1,0,0,0,1,1,1,0,0,0,0,0,1
Visible = ((Lenght - 16) \ _FontWidth) ' how much characters is visible in window
PointerLenPercent = Visible / SizeOf ' how much percents it is (SizeOf is longest string lenght)
If PointerLenPercent > 1 Then PointerLenPercent = 1
RectangleSize = PointerLenPercent * (Lenght - 16) 'rectangle lenght in slider
RectanglePos = Int(Xs + 8 + (Lenght - 16) * SizeNow / SizeOf) 'rectangle positon in slider
RecTangleColor~& = _RGB32(200)
If MX >= RectanglePos - RectangleSize - 16 And MX <= RectanglePos + RectangleSize + 16 Then
If MY > Ys - 5 And MY < Ys + 16 Then
RecTangleColor~& = _RGB32(75)
If MB Then
PercentAm = (MX - Xs - 8) / (Lenght - 16)
Iam = PercentAm * SizeOf
arr = Iam - SizeNow
Arrow = Int(arr)
End If
End If
End If
Line (Xs + 8, Ys - 1)-(Xs + Lenght - 8, Ys + 8), _RGB32(255), BF 'clear area before draw new rectangle to new position
Line (RectanglePos, Ys)-(RectanglePos + RectangleSize, Ys + 7), RecTangleColor~&, BF
End Select
End Function
@Keybone Thanks for the modification, it is already implanted in this version, + some fixes in my previous source code.
That is so awesome
|
