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