06-14-2022, 10:32 AM
That takes me back to 2014...
I added a few API effects tonight near the top, which could be removed for Linux / Mac users.
It runs a bit glitchy in GL, but was perfect in SDL, go figure. Sublte differences in LOCATE vs put , I suspect.
Drag window, resize by ragging edges, move with arrows and press tab to switch from move with arrows to resize with arrows. Min, max, and close buttons work as do the scroll bars. Clicking "File" does nothing.
Another type of GUI with buttons. Steve showed me how to work in some hardware magic with graphics buttons in SCREEN 0. I modified his work a just bit, and learned a thing or two in the process.
Fun stuff for sure. I hope you have a blast advancing your GUI, too.
Pete
Code: (Select All)
DECLARE DYNAMIC LIBRARY "User32"
FUNCTION GetWindowLongA& (BYVAL hwnd AS LONG, BYVAL nIndex AS LONG)
FUNCTION SetWindowPos& (BYVAL hWnd AS LONG, BYVAL hWndInsertAfter AS _OFFSET, BYVAL X AS INTEGER, BYVAL Y AS INTEGER, BYVAL cx AS INTEGER, BYVAL cy AS INTEGER, BYVAL uFlags AS _OFFSET)
FUNCTION SetWindowLongA& (BYVAL hwnd AS LONG, BYVAL nIndex AS LONG, BYVAL dwNewLong AS LONG)
END DECLARE
COMMON SHARED MOUSEACT%, oldmx, oldmy
DIM a(100) AS STRING * 160
TYPE RegType
AX AS INTEGER
BX AS INTEGER
CX AS INTEGER
DX AS INTEGER
BP AS INTEGER
SI AS INTEGER
DI AS INTEGER
FLAGS AS INTEGER
DS AS INTEGER
ES AS INTEGER
END TYPE
DIM SHARED Registers AS RegType
DIM SHARED LB%, RB%, MB%, DX%, CX%
REM Scr12& = _NEWIMAGE(_DESKTOPWIDTH, _DESKTOPHEIGHT, 256)
Scr12& = _NEWIMAGE(1200, 600, 256)
SCREEN Scr12&
_DELAY .1
GWL_STYLE = -16
ws_border = &H800000
WS_VISIBLE = &H10000000
_TITLE "Borderless GUI Window"
DIM hWnd AS LONG
hWnd = _WINDOWHANDLE
DO: LOOP UNTIL hWnd
winstyle2& = GetWindowLongA&(hWnd, GWL_STYLE)
winstyle& = -12582913
a& = SetWindowLongA&(hWnd, GWL_STYLE, winstyle& AND WS_VISIBLE)
a& = SetWindowPos&(hWnd, 0, 0, 0, 0, 0, 39)
i = 16
fontpath$ = ENVIRON$("SYSTEMROOT") + "\fonts\lucon.ttf" 'Find Windows Folder Path.
fontsize% = 24
style$ = "MONOSPACE"
font& = _LOADFONT(fontpath$, fontsize%, style$)
_FONT font&
sm_col = _DESKTOPWIDTH / 2 - _WIDTH / 2
sm_row = (_DESKTOPHEIGHT - 50) / 2 - _HEIGHT / 2
_SCREENMOVE sm_col, sm_row
EX% = 1: GOSUB mdriver
pal 9, 59, 59, 59
pal 5, 57, 57, 57
pal 3, 50, 50, 50
pal 1, 25, 25, 30
pal 0, 15, 25, 45
hpixels = 15
vpixels = 24
lstop = 1
tstop = 1
rstop = 80
bstop = 25
minheight = 4
minwidtxh = 4
pageleft = 30
pagewidtxh = 20
pagetop = 7
pageheight = 12
pcoloxr = 15
fcoloxr = 0
scoloxr = 0
WHILE -1
GOSUB mask
LINE (pageleft * hpixels - hpixels, pagetop * vpixels - vpixels)-((pageleft + pagewidtxh) * hpixels, (pagetop + pageheight) * vpixels), pcoloxr, BF
LINE ((pageleft - 1) * hpixels + 1, (pagetop - 1) * vpixels + 1)-((pageleft + pagewidtxh) * hpixels - 1, (pagetop + pageheight) * vpixels - 1), 1, B
LINE ((pageleft - 1) * hpixels + 5, (pagetop) * vpixels - 4)-((pageleft + pagewidtxh) * hpixels - 5, (pagetop + pageheight) * vpixels - 5), 1, B
PAINT ((pageleft - 1) * hpixels + 3, (pagetop) * vpixels + 0), 1
LINE ((pageleft - 1) * hpixels + 7, (pagetop + 1) * vpixels + 1)-((pageleft + pagewidtxh) * hpixels - 7, (pagetop + pageheight) * vpixels - 7), 0, B
'
LINE ((pageleft - 1) * hpixels + 7, (pagetop) * vpixels - 2)-((pageleft + pagewidtxh) * hpixels - 7, (pagetop + 1) * vpixels - 1), 3, BF
IF pagetop + 1 < 18 THEN
' QB64 is unable to print text past row 17.
COLOR 8, 3
x$ = "File"
x$ = MID$(x$, 1, pagewidtxh - 1)
_PRINTSTRING ((pageleft - .5) * hpixels + 7, pagetop * vpixels), x$
END IF
'
' 3-D Menu strip
LINE ((pageleft - 1) * hpixels + 7, (pagetop) * vpixels - 2)-((pageleft + pagewidtxh) * hpixels - 7, (pagetop) * vpixels - 2), 8, B
LINE ((pageleft - 1) * hpixels + 7, (pagetop) * vpixels - 2)-((pageleft - 1) * hpixels + 7, (pagetop + 1) * vpixels - 1), 0, B
'---------------
'
LINE ((pageleft - 1) * hpixels + 8, (pagetop + pageheight - 1) * vpixels - 0)-((pageleft + pagewidtxh) * hpixels - 8, (pagetop + pageheight) * vpixels - 7 - 2), 9, BF
GOSUB verticalslide
LINE ((pageleft - 1) * hpixels + 8, (pagetop + pageheight - 1) * vpixels - 1)-((pageleft + pagewidtxh) * hpixels - 8, (pagetop + pageheight - 1) * vpixels - 0), 5, B
GOSUB verticalscrollbar
'
GOSUB Horizontalscrollbar
'
' Vertical Upper Arrow Button
LINE (vbarleft, (pagetop - 1) * vpixels + 50)-((pageleft + pagewidtxh - 2) * hpixels + 21, (pagetop - 1) * vpixels + 65), 5, BF
LINE (vbarleft, (pagetop - 1) * vpixels + 50)-((pageleft + pagewidtxh - 2) * hpixels + 21, (pagetop - 1) * vpixels + 65), 7, B
' Round Button Cornors
PSET (vbarleft, (pagetop - 1) * vpixels + 65), 5
PSET ((pageleft + pagewidtxh - 2) * hpixels + 21, (pagetop - 1) * vpixels + 65), 5
PSET ((pageleft + pagewidtxh - 2) * hpixels + 21, (pagetop - 1) * vpixels + 50), 5
PSET (vbarleft, (pagetop - 1) * vpixels + 50), 5
'
LINE ((pageleft + pagewidtxh - 2) * hpixels + 11, (pagetop - 1) * vpixels + 50)-((pageleft + pagewidtxh - 2) * hpixels + 21, (pagetop - 1) * vpixels + 65), 3, BF
'
'Triangle Up
l = (pageleft + pagewidtxh - 2) * hpixels + 9
t = (pagetop + 1) * vpixels + 6
s = 10
q = 5
'
LINE (l + q, t)-(l + s, t + q), 5
LINE (l + q, t)-(l, t + q), 5
LINE (l, t + q)-(l + s, t + q), 5
PAINT (l + q, t + q / 2), 5
'
LINE (l + q, t)-(l, t + q), 8
'
' Vertical Lower Arrow Button
LINE (vbarleft, (pagetop + pageheight - 2) * vpixels + 5)-((pageleft + pagewidtxh - 2) * hpixels + 21, (pagetop + pageheight - 2) * vpixels + 21), 5, BF
LINE (vbarleft, (pagetop + pageheight - 2) * vpixels + 5)-((pageleft + pagewidtxh - 2) * hpixels + 21, (pagetop + pageheight - 2) * vpixels + 21), 7, B
' Round Button Cornors
PSET (vbarleft, (pagetop + pageheight - 2) * vpixels + 21), 5
PSET ((pageleft + pagewidtxh - 2) * hpixels + 21, (pagetop + pageheight - 2) * vpixels + 21), 5
PSET ((pageleft + pagewidtxh - 2) * hpixels + 21, (pagetop + pageheight - 2) * vpixels + 5), 5
PSET (vbarleft, (pagetop + pageheight - 2) * vpixels + 5), 5
'
LINE ((pageleft + pagewidtxh - 2) * hpixels + 11, (pagetop + pageheight - 2) * vpixels + 5)-((pageleft + pagewidtxh - 2) * hpixels + 21, (pagetop + pageheight - 2) * vpixels + 21), 3, BF
'
' Triangle Down
l = (pageleft + pagewidtxh - 2) * hpixels + 9
t = (pagetop + pageheight - 2) * vpixels + 11
s = 10
q = 5
'
LINE (l, t)-(l + s, t), 5
LINE (l + q, t + q)-(l + s, t), 5
LINE (l, t)-(l + q, t + q), 5
PAINT (l + q, t + q / 2), 5
LINE (l, t)-(l + s, t), 8
'
' Left Horizontal Arrow Button
LINE ((pageleft - 1) * hpixels + 9, (pagetop + pageheight - 1) * vpixels + 1)-((pageleft - 1) * hpixels + 26, (pagetop + pageheight - 1) * vpixels + 16), 5, BF
LINE ((pageleft - 1) * hpixels + 9, (pagetop + pageheight - 1) * vpixels + 1)-((pageleft - 1) * hpixels + 26, (pagetop + pageheight - 1) * vpixels + 16), 7, B
LINE ((pageleft - 1) * hpixels + 10, (pagetop + pageheight - 1) * vpixels + 6)-((pageleft - 1) * hpixels + 25, (pagetop + pageheight - 1) * vpixels + 15), 3, BF
'
' Round Button Cornors
PSET ((pageleft - 1) * hpixels + 9, (pagetop + pageheight - 1) * vpixels + 1), 5
PSET ((pageleft - 1) * hpixels + 25, (pagetop + pageheight - 1) * vpixels + 1), 5
PSET ((pageleft - 1) * hpixels + 25, (pagetop + pageheight - 1) * vpixels + 16), 5
PSET ((pageleft - 1) * hpixels + 9, (pagetop + pageheight - 1) * vpixels + 16), 5
'
l = (pageleft - 1) * hpixels + 14
t = (pagetop + pageheight - 1) * vpixels + 4
s = 10
q = 5
'
' Triangle Left
LINE (l + q, t)-(l + q, t + s), 5
LINE (l, t + q)-(l + q, t), 5
LINE (l, t + q)-(l + q, t + s), 5
PAINT (l + q / 2, t + q), 5
LINE (l, t + q)-(l + q, t), 8
'
' Right Horizontal Arrow Button
LINE ((pageleft + pagewidtxh - 3) * hpixels + 2, (pagetop + pageheight - 1) * vpixels + 1)-((pageleft + pagewidtxh - 3) * hpixels + 19, (pagetop + pageheight - 1) * vpixels + 16), 5, BF
LINE ((pageleft + pagewidtxh - 3) * hpixels + 2, (pagetop + pageheight - 1) * vpixels + 1)-((pageleft + pagewidtxh - 3) * hpixels + 19, (pagetop + pageheight - 1) * vpixels + 16), 7, B
LINE ((pageleft + pagewidtxh - 3) * hpixels + 3, (pagetop + pageheight - 1) * vpixels + 6)-((pageleft + pagewidtxh - 3) * hpixels + 18, (pagetop + pageheight - 1) * vpixels + 15), 3, BF
'
' Round Button Cornors
PSET ((pageleft + pagewidtxh - 3) * hpixels + 2, (pagetop + pageheight - 1) * vpixels + 1), 5
PSET ((pageleft + pagewidtxh - 3) * hpixels + 19, (pagetop + pageheight - 1) * vpixels + 1), 5
PSET ((pageleft + pagewidtxh - 3) * hpixels + 19, (pagetop + pageheight - 1) * vpixels + 16), 5
PSET ((pageleft + pagewidtxh - 3) * hpixels + 2, (pagetop + pageheight - 1) * vpixels + 16), 5
'
'Triangle Right
l = (pageleft + pagewidtxh - 3) * hpixels + 9
t = (pagetop + pageheight - 1) * vpixels + 4
s = 10
q = 5
LINE (l, t)-(l, t + s), 5
LINE (l, t)-(l + q, t + q), 5
LINE (l, t + s)-(l + q, t + q), 5
PAINT (l + q / 2, t + q), 5
'
LINE (l, t)-(l + q, t + q), 8
'
' Top Controls
l = 73 ' 68 + 5 boarder
h = 14
x = 5
LINE ((pageleft + pagewidtxh) * hpixels - l - 1, pagetop * vpixels - vpixels)-((pageleft + pagewidtxh) * hpixels - x, pagetop * vpixels - vpixels + h + 1), 15, BF
LINE ((pageleft + pagewidtxh) * hpixels - l, pagetop * vpixels - vpixels)-((pageleft + pagewidtxh) * hpixels - x, pagetop * vpixels - vpixels + h), 0, B
LINE ((pageleft + pagewidtxh) * hpixels - l, pagetop * vpixels - vpixels)-((pageleft + pagewidtxh) * hpixels - x - 1, pagetop * vpixels - vpixels), 15
LINE ((pageleft + pagewidtxh) * hpixels - l, pagetop * vpixels - vpixels)-((pageleft + pagewidtxh) * hpixels - l, pagetop * vpixels - vpixels + h), 0
LINE ((pageleft + pagewidtxh) * hpixels - l + 38 / 2, pagetop * vpixels - vpixels)-((pageleft + pagewidtxh) * hpixels - l + 38 / 2, pagetop * vpixels - vpixels + h), 0
LINE ((pageleft + pagewidtxh) * hpixels - l + 74 / 2, pagetop * vpixels - vpixels)-((pageleft + pagewidtxh) * hpixels - l + 74 / 2, pagetop * vpixels - vpixels + h), 0
LINE ((pageleft + pagewidtxh) * hpixels - l + 2, pagetop * vpixels - vpixels)-((pageleft + pagewidtxh) * hpixels - l + 36 / 2, pagetop * vpixels - vpixels + h - 2), 5, BF
LINE ((pageleft + pagewidtxh) * hpixels - l + 40 / 2, pagetop * vpixels - vpixels)-((pageleft + pagewidtxh) * hpixels - l + 72 / 2, pagetop * vpixels - vpixels + h - 2), 5, BF
LINE ((pageleft + pagewidtxh) * hpixels - l + 78 / 2, pagetop * vpixels - vpixels + 1)-((pageleft + pagewidtxh) * hpixels - x - 2, pagetop * vpixels - vpixels + h - 2), 4, BF
LINE ((pageleft + pagewidtxh) * hpixels - l + 3, pagetop * vpixels - vpixels + 8)-((pageleft + pagewidtxh) * hpixels - l + 16, pagetop * vpixels - vpixels + 11), 0, B
LINE ((pageleft + pagewidtxh) * hpixels - l + 4, pagetop * vpixels - vpixels + 9)-((pageleft + pagewidtxh) * hpixels - l + 15, pagetop * vpixels - vpixels + 10), 15, BF
LINE ((pageleft + pagewidtxh) * hpixels - l + 22, pagetop * vpixels - vpixels + 3)-((pageleft + pagewidtxh) * hpixels - l + 34, pagetop * vpixels - vpixels + 11), 3, BF
LINE ((pageleft + pagewidtxh) * hpixels - l + 22, pagetop * vpixels - vpixels + 3)-((pageleft + pagewidtxh) * hpixels - l + 34, pagetop * vpixels - vpixels + 11), 0, B
LINE ((pageleft + pagewidtxh) * hpixels - l + 25, pagetop * vpixels - vpixels + 6)-((pageleft + pagewidtxh) * hpixels - l + 31, pagetop * vpixels - vpixels + 8), 5, BF
LINE ((pageleft + pagewidtxh) * hpixels - l + 46, pagetop * vpixels - vpixels + 1)-((pageleft + pagewidtxh) * hpixels - l + 60, pagetop * vpixels - vpixels + 12), 15, BF
s = 6
a = 2
q = s / a
l = 0
t = 0
l = (pageleft + pagewidtxh - 1) * hpixels - 8
t = (pagetop) * vpixels - vpixels + s + 2
LINE (l + q, t)-(l + s, t + q), 4
LINE (l + q, t)-(l, t + q), 4
LINE (l, t + q)-(l + s, t + q), 4
PAINT (l + q, t + q / 2), 4
l = (pageleft + pagewidtxh - 1) * hpixels - 8
t = (pagetop) * vpixels - vpixels + 1
LINE (l, t)-(l + s, t), 4
LINE (l + q, t + q)-(l + s, t), 4
LINE (l, t)-(l + q, t + q), 4
PAINT (l + q, t + q / 2), 4
l = (pageleft + pagewidtxh - 1) * hpixels - 2
t = (pagetop) * vpixels - vpixels + 3
LINE (l + q, t)-(l + q, t + s), 4
LINE (l, t + q)-(l + q, t), 4
LINE (l, t + q)-(l + q, t + s), 4
PAINT (l + q / 2, t + q), 4
l = (pageleft + pagewidtxh - 1) * hpixels - 11
t = (pagetop) * vpixels - vpixels + 3
LINE (l, t)-(l, t + s), 4
LINE (l, t)-(l + q, t + q), 4
LINE (l, t + s)-(l + q, t + q), 4
PAINT (l + q / 2, t + q), 4
l = 73 ' 68 + 5 boarder
h = 14
x = 5
LINE ((pageleft + pagewidtxh) * hpixels - l + 46, pagetop * vpixels - vpixels + 1)-((pageleft + pagewidtxh) * hpixels - l + 60, pagetop * vpixels - vpixels + 12), 4, B
'
IF flag THEN
flag = 0
PCOPY 1, 0
END IF
'
WHILE -1
IF autokeyboard$ <> "" THEN
keyboard$ = autokeyboard$
autokeyboard$ = ""
ELSE
EX% = 2: GOSUB mdriver
' Bypass INKEY$ to speed up drag.
IF LB% = 0 THEN
_LIMIT 100
keyboard$ = INKEY$
IF keyboard$ <> "" THEN
drag = 0
flag = 0
moriginx = 0
moriginy = 0
END IF
ELSE
_LIMIT 100
' Clear keyboard buffer
_KEYCLEAR
IF flag = 1 THEN flag = 0: EXIT WHILE
END IF
END IF
SELECT CASE keyboard$
CASE CHR$(9)
flag2 = (flag2 + 1) MOD 3 'ABS(flag2 -1)
' Setting origflag2 allows or keypresses and mouse drag to work independently with the same flag2 variable or both.
origflag2 = flag2
CASE CHR$(27)
SYSTEM
CASE ELSE
SELECT CASE ABS(flag2)
CASE 1
SELECT CASE keyboard$
CASE CHR$(0) + "H"
IF pagetop > 1 THEN
pagetop = pagetop - 1
END IF
CASE CHR$(0) + "P"
IF pagetop + pageheight < 25 THEN
pagetop = pagetop + 1
END IF
CASE CHR$(0) + "K"
IF pageleft > 1 THEN
pageleft = pageleft - 1
END IF
CASE CHR$(0) + "M"
IF pageleft + pagewidtxh < 80 THEN
pageleft = pageleft + 1
END IF
END SELECT
CASE 2
SELECT CASE keyboard$
CASE CHR$(0) + "H"
IF pagetop > 1 THEN
pagetop = pagetop - 1
GOSUB phup
END IF
CASE CHR$(0) + "P"
IF pageheight > 1 THEN
pagetop = pagetop + 1
GOSUB phdown
END IF
CASE CHR$(0) + "K"
IF pageleft > 1 THEN
pageleft = pageleft - 1
GOSUB pwup
END IF
CASE CHR$(0) + "M"
IF pagewidtxh > 1 THEN
pageleft = pageleft + 1
GOSUB pwdown
END IF
END SELECT
CASE ELSE
SELECT CASE keyboard$
CASE CHR$(0) + "H"
IF pageheight > 1 THEN
GOSUB phdown
END IF
CASE CHR$(0) + "P"
IF pagetop + pageheight < 25 THEN
GOSUB phup
END IF
CASE CHR$(0) + "K"
IF pagewidtxh > 1 THEN
GOSUB pwdown
END IF
CASE CHR$(0) + "M"
IF pageleft + pagewidtxh < 80 THEN
GOSUB pwup
END IF
END SELECT
END SELECT
END SELECT
IF keyboard$ <> "" THEN
EXIT WHILE
END IF
WEND
WEND
SYSTEM
mask:
_LIMIT 1000
SCREEN , 0, 1, 0
' Mask
LINE ((pageleft - 2) * hpixels, (pagetop - 2) * vpixels)-((pageleft + pagewidtxh + 1) * hpixels, (pagetop + pageheight + 1) * vpixels), scoloxr, BF
flag = -1
RETURN
verticalslide:
LINE ((pageleft + pagewidtxh - 2) * hpixels + 5, ((pagetop + 1) * vpixels) + 2)-((pageleft + pagewidtxh - 2) * hpixels + 22, (pagetop + pageheight - 1) * vpixels + 16), 9, BF
LINE ((pageleft + pagewidtxh - 2) * hpixels + 5, ((pagetop + 1) * vpixels) + 2)-((pageleft + pagewidtxh - 2) * hpixels + 6, (pagetop + pageheight - 1) * vpixels + 16), 5, B
RETURN
verticalscrollbar:
' Vertical Scroll Bar
vbartop = (pagetop + 1) * vpixels + 19
vhidden = 40 - pageheight - 1
IF vhidden < 0 THEN vhidden = 0
vslide = vhidden
IF vslide > pageheight - 5 THEN vslide = pageheight - 5
vbarheight = 28 + vpixels * (pageheight - 5 - vslide)
vbarleft = (pageleft + pagewidtxh - 2) * hpixels + 6
vbarright = (pageleft + pagewidtxh - 2) * hpixels + 21
IF pageheight > 4 THEN
'
LINE (vbarleft, vbartop + vbar * vpixels)-((pageleft + pagewidtxh - 2) * hpixels + 21, vbartop + vbarheight + vbar * vpixels), 5, BF
LINE (vbarleft, vbartop + vbar * vpixels)-((pageleft + pagewidtxh - 2) * hpixels + 21, vbartop + vbarheight + vbar * vpixels), 7, B
' Round Button Cornors
PSET (vbarleft, vbartop + vbar * vpixels), 5
PSET ((pageleft + pagewidtxh - 2) * hpixels + 21, vbartop + vbar * vpixels), 5
PSET ((pageleft + pagewidtxh - 2) * hpixels + 21, vbartop + vbarheight + vbar * vpixels), 5
PSET (vbarleft, vbartop + vbarheight + vbar * vpixels), 5
'
LINE ((pageleft + pagewidtxh - 2) * hpixels + 11, (pagetop + 1 + vbar) * vpixels + 21)-((pageleft + pagewidtxh - 2) * hpixels + 21, vbartop + vbarheight + vbar * vpixels - 1), 3, BF
' scroll bar hash lines
LINE ((pageleft + pagewidtxh - 2) * hpixels + 9, vbartop + vbar * vpixels + vbarheight / 2 - 7)-((pageleft + pagewidtxh - 2) * hpixels + 20, vbartop + vbar * vpixels + vbarheight / 2 - 5), 8, BF
LINE ((pageleft + pagewidtxh - 2) * hpixels + 10, vbartop + vbar * vpixels + vbarheight / 2 - 6)-((pageleft + pagewidtxh - 2) * hpixels + 20, vbartop + vbar * vpixels + vbarheight / 2 - 5), 5, BF
'
LINE ((pageleft + pagewidtxh - 2) * hpixels + 9, vbartop + vbar * vpixels + vbarheight / 2 - 2)-((pageleft + pagewidtxh - 2) * hpixels + 20, vbartop + vbar * vpixels + vbarheight / 2), 8, BF
LINE ((pageleft + pagewidtxh - 2) * hpixels + 10, vbartop + vbar * vpixels + vbarheight / 2 - 1)-((pageleft + pagewidtxh - 2) * hpixels + 20, vbartop + vbar * vpixels + vbarheight / 2), 5, BF
'
LINE ((pageleft + pagewidtxh - 2) * hpixels + 9, vbartop + vbar * vpixels + vbarheight / 2 + 3)-((pageleft + pagewidtxh - 2) * hpixels + 20, vbartop + vbar * vpixels + vbarheight / 2 + 5), 8, BF
LINE ((pageleft + pagewidtxh - 2) * hpixels + 10, vbartop + vbar * vpixels + vbarheight / 2 + 4)-((pageleft + pagewidtxh - 2) * hpixels + 20, vbartop + vbar * vpixels + vbarheight / 2 + 5), 5, BF
END IF
RETURN
'
Verticalscrollmask:
LINE ((pageleft + pagewidtxh - 2) * hpixels + 5, (pagetop + 1) * vpixels + 17)-((pageleft + pagewidtxh - 2) * hpixels + 22, (pagetop + pageheight - 2) * vpixels + 5), 9, BF
LINE ((pageleft + pagewidtxh - 2) * hpixels + 5, (pagetop + 1) * vpixels + 17)-((pageleft + pagewidtxh - 2) * hpixels + 6, (pagetop + pageheight - 2) * vpixels + 5), 5, B
RETURN
'
Horizontalscrollbar:
' Horizontal Scroll Bar
hbarleft = (pageleft - 1) * hpixels + 28
horzhidden = 145 - pagewidtxh - 1
IF horzhidden < 0 THEN horzhidden = 0
hslide = horzhidden
IF hslide > pagewidtxh - 5.5 THEN hslide = pagewidtxh - 5.5
hbarwidtxh = 28 + hpixels * (pagewidtxh - 5.5 - hslide)
hbartop = (pagetop + pageheight - 1) * vpixels + 1
hbarbottom = (pagetop + pageheight - 1) * vpixels + 16
'
IF pagewidtxh > 5 THEN
LINE (hbarleft + hbar * hpixels, hbartop)-(hbarleft + hbarwidtxh + hbar * hpixels, hbarbottom), 5, BF
LINE (hbarleft + hbar * hpixels, hbartop)-(hbarleft + hbarwidtxh + hbar * hpixels, hbarbottom), 7, B
'
' Round Button Cornors
PSET (hbarleft + hbar * hpixels, hbartop), 5
PSET (hbarleft + hbarwidtxh + hbar * hpixels, hbartop), 5
PSET (hbarleft + hbar * hpixels, hbarbottom), 5
PSET (hbarleft + hbarwidtxh + hbar * hpixels, hbarbottom), 5
'
LINE (hbarleft + hbar * hpixels + 1, hbartop + 5)-(hbarleft + hbarwidtxh + hbar * hpixels, hbarbottom - 1), 3, BF
'
' scroll bar hash lines
LINE (INT(hbarleft + hbar * hpixels + hbarwidtxh / 2 - 7), hbartop + 3)-(INT(hbarleft + hbar * hpixels + hbarwidtxh / 2 - 5), hbarbottom - 3), 8, BF
LINE (INT(hbarleft + hbar * hpixels + hbarwidtxh / 2 - 6), hbartop + 4)-(INT(hbarleft + hbar * hpixels + hbarwidtxh / 2 - 5), hbarbottom - 3), 5, BF
'
LINE (INT(hbarleft + hbar * hpixels + hbarwidtxh / 2 - 2), hbartop + 3)-(INT(hbarleft + hbar * hpixels + hbarwidtxh / 2), hbarbottom - 3), 8, BF
LINE (INT(hbarleft + hbar * hpixels + hbarwidtxh / 2 - 1), hbartop + 4)-(INT(hbarleft + hbar * hpixels + hbarwidtxh / 2), hbarbottom - 3), 5, BF
'
LINE (INT(hbarleft + hbar * hpixels + hbarwidtxh / 2 + 3), hbartop + 3)-(hbarleft + hbar * hpixels + hbarwidtxh / 2 + 5, hbarbottom - 3), 8, BF
LINE (INT(hbarleft + hbar * hpixels + hbarwidtxh / 2 + 4), hbartop + 4)-(hbarleft + hbar * hpixels + hbarwidtxh / 2 + 5, hbarbottom - 3), 5, BF
RETURN
'
Horizontalscrollmask:
LINE ((pageleft - 1) * hpixels + 28, (pagetop + pageheight - 1) * vpixels + 1)-((pageleft + pagewidtxh - 3) * hpixels + 2, (pagetop + pageheight - 1) * vpixels + 16), 9, BF
LINE ((pageleft - 1) * hpixels + 28, (pagetop + pageheight - 1) * vpixels + 1)-((pageleft + pagewidtxh - 3) * hpixels + 2, (pagetop + pageheight - 1) * vpixels + 16), 5, B
END IF
RETURN
'
phup:
pageheight = pageheight + 1
RETURN '''
IF vbar < vslide THEN
vbar = vbar + .5
END IF
RETURN
'
phdown:
pageheight = pageheight - 1
IF vbar >= vslide THEN vbar = vbar - 1
RETURN '''
IF vbar > 0 THEN
vbar = vbar - .5
END IF
RETURN
'
pwup:
pagewidtxh = pagewidtxh + 1
RETURN '''
IF hbar < hslide THEN
hbar = hbar + .5
END IF
RETURN
'
pwdown:
pagewidtxh = pagewidtxh - 1
IF hbar >= hslide THEN hbar = hbar - 1
RETURN '''
IF hbar > 0 THEN
hbar = hbar - .5
END IF
RETURN
REM - DRAW ALTERNATIVE -----------------------------------------------------------------
triangle$ = "H5 G5 R10"
PSET ((pageleft + pagewidtxh) * hpixels, pagetop * vpixels - vpixels + 15), 1
DRAW triangle$
PAINT ((pageleft + pagewidtxh) * hpixels - 10 / 2, pagetop * vpixels - vpixels + 15 - 5 / 2), 1
triangle$ = "G5 H5 R10"
PSET ((pageleft + pagewidtxh) * hpixels, (pagetop + pageheight) * vpixels - 19), 1
DRAW triangle$
PAINT ((pageleft + pagewidtxh) * hpixels - 10 / 2, (pagetop + pageheight) * vpixels - 19 + 5 / 2), 1
triangle$ = "U10 F5 G5"
PSET ((pageleft + pagewidtxh) * hpixels - hpixels, (pagetop + pageheight) * vpixels), 1
DRAW triangle$
PAINT ((pageleft + pagewidtxh) * hpixels - hpixels + 5 / 2, (pagetop + pageheight) * vpixels - 10 / 2), 1
triangle$ = "H5 E5 D10"
PSET (pageleft * hpixels - 10 / 2, vpixels * 16), 1
DRAW triangle$
PAINT (pageleft * hpixels - 15 / 2, vpixels * 16 - 5), 1
REM ----------------------------------------------------------------------------------
'
mdriver:
'
REM INITIATE MOUSE
IF MOUSEACT% = 0 THEN
Registers.AX = 0: GOSUB CALLI
MOUSEACT% = 1
RETURN
END IF
'
IF EX% = 1 THEN
Registers.AX = 1: GOSUB CALLI
Registers.AX% = 3: GOSUB CALLI
DX% = Registers.DX%
CX% = Registers.CX%
mousex = DX% + 1
mousey = CX% + 1
oldmousex = DX% + 1
oldmousey = DY% + 1
RETURN
END IF
'
' Unremark below to track variables.
'/'SCREEN , 0, 1, 1: LOCATE 1, 1: PRINT drag; " ";: LOCATE , POS(0) - 15: PRINT vbar;hbar; maction$ '''''
'
Registers.AX = 3: GOSUB CALLI
'
REM MOUSE LOCATION (USES mousex AND mousey TO CONVERT TO 25 * 80 SCREEN SIZE)
DX% = Registers.DX%
CX% = Registers.CX%
mousex = DX% + 1
mousey = CX% + 1
'
REM MOUSE BUTTONS
LB% = Registers.BX% AND 1
RB% = (Registers.BX% AND 2) \ 2
MB% = (Registers.BX% AND 4) \ 4
'
IF LB% <> 0 AND drag = 0 THEN
' Goes on the left click itself, and times the event if the left mouse is held down
IF mousey > (pageleft + pagewidtxh - 2) * hpixels + 5 AND mousey < (pageleft + pagewidtxh - 2) * hpixels + 22 THEN
'/' change lower border in mdriver routine when variables are created to replace coordinates or this button. (pagetop + pageheight - 2) * vpixels + 21
IF mousex > (pagetop + 1) * vpixels + 2 AND mousex <= (pagetop + pageheight - 2) * vpixels + 21 THEN
IF mousex > vbartop + vbarheight + vbar * vpixels THEN
IF ABS(TIMER - z1) < .2 OR vbar >= vslide THEN RETURN
GOSUB Verticalscrollmask
vbar = vbar + .5
GOSUB verticalscrollbar
PCOPY 1, 0
z1 = TIMER
RETURN
ELSE
IF vbar > 0 THEN
IF ABS(TIMER - z1) < .2 THEN RETURN
GOSUB Verticalscrollmask
vbar = vbar - .5
GOSUB verticalscrollbar
PCOPY 1, 0
z1 = TIMER
RETURN
END IF
END IF
END IF
END IF
' Goes on the left click itself, and times the event if the left mouse is held down
IF mousex > (pagetop + pageheight - 1) * vpixels AND mousex < (pagetop + pageheight) * vpixels THEN
'/' change lower border in mdriver routine when variables are created to replace coordinates or this button. (pagetop + pageheight - 2) * vpixels + 21
IF mousey > pageleft * hpixels - 5 AND mousey < (pageleft + pagewidtxh - 2) * hpixels + 5 THEN
IF mousey > hbarleft + hbarwidtxh + hbar * hpixels THEN
IF ABS(TIMER - z1) < .2 OR hbar >= hslide THEN RETURN
GOSUB Horizontalscrollmask
hbar = hbar + .5
GOSUB Horizontalscrollbar
PCOPY 1, 0
z1 = TIMER
RETURN
ELSE
IF hbar > 0 THEN
IF ABS(TIMER - z1) < .2 THEN RETURN
GOSUB Horizontalscrollmask
hbar = hbar - .5
GOSUB Horizontalscrollbar
PCOPY 1, 0
z1 = TIMER
RETURN
END IF
END IF
END IF
END IF
END IF
z1 = 0
'
IF LB% <> 0 AND drag = 0 AND maction$ = "" OR LB% = 0 AND maction$ <> "" THEN
' Under current state this routine must execute before the following drag analysis.
' Drag must be zero to prevent other drag routines from triggering these eventswhen let button is being held down.
IF mousex > (pagetop - 1) * vpixels + 1 AND mousex < (pagetop - 1) * vpixels + 16 THEN
IF mousey > (pageleft + pagewidtxh) * hpixels - 73 AND mousey < (pageleft + pagewidtxh) * hpixels - 54 THEN
' Minimize
IF maction$ = "" THEN
maction$ = "min"
RETURN
END IF
IF maction$ = "min" THEN
GOSUB mask
restorxe = -1
origpageleft = pageleft
origpagewidtxh = pagewidtxh
origpagetop = pagetop
origpageheight = pageheight
pageleft = 1
pagewidtxh = minwidtxh
pagetop = bstop - minheight
pageheight = minheight
flag = 1
maction$ = ""
RETURN
ELSE
maction$ = ""
END IF
END IF
IF mousey > (pageleft + pagewidtxh) * hpixels - 54 AND mousey < (pageleft + pagewidtxh) * hpixels - 36 THEN
' Restore
IF maction$ = "" THEN
maction$ = "restore"
RETURN
END IF
IF maction$ = "restore" THEN
SELECT CASE restorxe
CASE 0
restorxe = -1
origpageleft = pageleft
origpagewidtxh = pagewidtxh
origpagetop = pagetop
origpageheight = pageheight
pageleft = lstop
pagewidtxh = rstop - 1
pagetop = tstop
pageheight = bstop - 1
CASE -1
restorxe = 0
GOSUB mask
pageleft = origpageleft
pagewidtxh = origpagewidtxh
pagetop = origpagetop
pageheight = origpageheight
END SELECT
flag = 1
LB% = -1
maction$ = ""
RETURN
ELSE
maction$ = ""
END IF
END IF
IF mousey > (pageleft + pagewidtxh) * hpixels - 36 AND mousey < (pageleft + pagewidtxh) * hpixels - 5 THEN
' Exit Window
IF maction$ = "" THEN
maction$ = "exit"
RETURN
END IF
IF maction$ = "exit" THEN
maction$ = ""
SCREEN , 0, 1, 1
CLS
_DELAY .33
SYSTEM
ELSE
maction$ = ""
END IF
END IF
ELSE
' Mouse was moved off target while left button remained depressed.
maction$ = ""
END IF
END IF
'
IF LB% = 0 THEN
IF drag > 0 THEN
' drag over, reset values
drag = 0
flag = 0
moriginx = 0
moriginy = 0
END IF
WHILE -1
' Top Title Bar to Move GUI.
IF mousey >= (pageleft - 1) * hpixels + 6 AND mousey <= (pageleft + pagewidtxh - 5) * hpixels - 2 THEN
IF mousex >= (pagetop - 1) * vpixels + 8 AND mousex <= pagetop * vpixels - 3 THEN
drag = -9
EXIT WHILE
END IF
END IF
'
' Vertical Scroll Bar Coordinates
IF mousex >= vbartop + vbar * vpixels AND mousex <= vbartop + vbarheight + vbar * vpixels THEN
IF mousey >= vbarleft AND mousey <= vbarright THEN
drag = -10
EXIT WHILE
END IF
END IF
'
' Horizontal Scroll Bar Coordinates
IF mousey >= hbarleft + hbar * hpixels AND mousey <= hbarleft + hbarwidtxh + hbar * hpixels THEN
IF mousex >= hbartop AND mousex <= hbarbottom THEN
drag = -11
EXIT WHILE
END IF
END IF
'
' LEFT SIDE
IF mousey >= (pageleft - 1) * hpixels AND mousey <= (pageleft - 1) * hpixels + hpixels / 3 THEN
' 2 * (vpixels / 3) opens bottom left for bottom left cornor evaluation below.
IF mousex >= pagetop * vpixels - vpixels AND mousex <= (pagetop + pageheight) * vpixels - 2 * (vpixels / 3) THEN
IF mousex >= pagetop * vpixels - vpixels AND mousex <= pagetop * vpixels - vpixels + vpixels / 3 THEN
' Top Left Cornor
drag = -5
ELSE
drag = -1
END IF
EXIT WHILE
END IF
END IF
'
' TOP SIDE
IF mousex >= pagetop * vpixels - vpixels AND mousex <= pagetop * vpixels - vpixels + vpixels / 3 THEN
IF mousey >= pageleft * hpixels - hpixels AND mousey <= (pageleft + pagewidtxh) * hpixels THEN
IF mousey >= (pageleft + pagewidtxh) * hpixels - hpixels / 3 AND mousey <= (pageleft + pagewidtxh) * hpixels THEN
' Top Right Cornor
drag = -6
ELSE
IF mousey >= (pageleft - 1) * hpixels + 6 AND mousey <= (pageleft + pagewidtxh - 5) * hpixels - 2 THEN
' no drag -2 where top controls are being moused over.
drag = -2
END IF
END IF
EXIT WHILE
END IF
END IF
'
' RIGHT SIDE
IF mousey >= (pageleft + pagewidtxh) * hpixels - hpixels / 3 AND mousey <= (pageleft + pagewidtxh) * hpixels THEN
IF mousex >= pagetop * vpixels - vpixels AND mousex <= (pagetop + pageheight) * vpixels THEN
IF mousex >= (pagetop + pageheight) * vpixels - vpixels / 3 AND mousex <= (pagetop + pageheight) * vpixels THEN
' Bottom Right Cornor
drag = -7
ELSE
drag = -3
END IF
EXIT WHILE
END IF
END IF
'
' BOTTOM SIDE
IF mousex >= (pagetop + pageheight) * vpixels - vpixels / 3 AND mousex <= (pagetop + pageheight) * vpixels THEN
IF mousey >= (pageleft - 1) * hpixels AND mousey <= (pageleft + pagewidtxh) * hpixels THEN
' Bottom Left Cornor
IF mousey >= (pageleft - 1) * hpixels AND mousey <= (pageleft - 1) * hpixels + hpixels / 3 THEN
drag = -8
ELSE
drag = -4
END IF
EXIT WHILE
END IF
END IF
EXIT WHILE
WEND
END IF
REM ------------------------------------------------------------------------------------
'
IF drag <> 0 THEN
GOSUB mousedragger
ELSE
' drag is zero
drag = 0
IF INT(mousex / vpixels) + 1 = pagetop AND INT(mousey / hpixels) + 1 = pageleft THEN
drag = -1
END IF
END IF
'---------------------------------------------------------------------------------------
oldmousex = mousex
oldmousey = mousey
RETURN
'
CALLI:
CALL INTERRUPT(&H33, Registers, Registers)
RETURN
'
' Sub-Routine for drag
mousedragger:
IF LB% = 0 THEN
IF INT(oldmousex / vpixels) = INT(mousex / vpixels) AND INT(oldmousey / hpixels) = INT(mousey / hpixels) THEN
moriginx = mousex
moriginy = mousey
ELSE
' Mouse pointer was moved off target.
drag = 0
flag = 0
morininx = 0
moriginy = 0
END IF
ELSE
' Left Button Down
' Setting flag to 1 indicates the mouse caused the object to change.
drag = ABS(drag)
flag = 1
WHILE -1
IF INKEY$ = CHR$(27) THEN END
SELECT CASE ABS(drag)
CASE 1
' Left side
IF INT(mousey / hpixels) <> INT(moriginy / hpixels) THEN
' Expand Left Side to Left
IF mousey < moriginy THEN
IF pageleft > lstop THEN
pageleft = pageleft - 1
GOSUB pwup
moriginy = moriginy - hpixels
EXIT WHILE
ELSE
' If no movement was made, reset flag so a static redraw will not occur.
flag = 0
EXIT WHILE
END IF
ELSE
' Contract Left Side to Right
IF pagewidtxh > minwidtxh THEN
pageleft = pageleft + 1
GOSUB pwdown
moriginy = moriginy + hpixels
EXIT WHILE
ELSE
' If no movement was made, reset flag so a static redraw will not occur.
flag = 0
EXIT WHILE
END IF
END IF
ELSE
flag = 0
EXIT WHILE
END IF
CASE 2
' Top
IF INT(mousex / vpixels) <> INT(moriginx / vpixels) THEN
' Expand Top Left Cornor Up
IF mousex < moriginx THEN
IF pagetop > tstop THEN
pagetop = pagetop - 1
GOSUB phup
moriginx = moriginx - vpixels
EXIT WHILE
ELSE
' If no movement was made, reset flag so a static redraw will not occur.
flag = 0
EXIT WHILE
END IF
ELSE
' Contract Top Left Cornor Down
IF pageheight > minheight THEN
pagetop = pagetop + 1
GOSUB phdown
moriginx = moriginx + vpixels
EXIT WHILE
ELSE
' If no movement was made, reset flag so a static redraw will not occur.
flag = 0
EXIT WHILE
END IF
END IF
ELSE
flag = 0
EXIT WHILE
END IF
CASE 3
' Right side
IF INT(mousey / hpixels) <> INT(moriginy / hpixels) THEN
' Expand Right Side to Right
IF mousey > moriginy THEN
IF pageleft + pagewidtxh < rstop THEN
GOSUB pwup
moriginy = moriginy + hpixels
EXIT WHILE
ELSE
' If no movement was made, reset flag so a static redraw will not occur.
flag = 0
EXIT WHILE
END IF
ELSE
' Contract Right Side to Left
IF pagewidtxh > minwidtxh THEN
GOSUB pwdown
moriginy = moriginy - hpixels
EXIT WHILE
ELSE
' If no movement was made, reset flag so a static redraw will not occur.
flag = 0
EXIT WHILE
END IF
END IF
ELSE
flag = 0
EXIT WHILE
END IF
CASE 4
' Bottom
IF INT(mousex / vpixels) <> INT(moriginx / vpixels) THEN
' Expand Bottom Right Cornor Down
IF mousex > moriginx THEN
IF pagetop + pageheight < bstop THEN
GOSUB phup
moriginx = moriginx + vpixels
EXIT WHILE
ELSE
' If no movement was made, reset flag so a static redraw will not occur.
flag = 0
EXIT WHILE
END IF
ELSE
' Contract Bottom Right Cornor Up
IF pageheight > minheight THEN
GOSUB phdown
moriginx = moriginx - vpixels
EXIT WHILE
ELSE
' If no movement was made, reset flag so a static redraw will not occur.
flag = 0
EXIT WHILE
END IF
END IF
ELSE
flag = 0
EXIT WHILE
END IF
CASE 5
' Top Left Diagnonal
IF INT(mousey / hpixels) <> INT(moriginy / hpixels) AND INT(mousex / vpixels) <> INT(moriginx / vpixels) THEN
IF mousex < moriginx THEN
' Expand Left Cornor Up to the Left
IF pagetop > tstop THEN
pagetop = pagetop - 1
GOSUB phup
moriginx = moriginx - vpixels
IF pageleft <= 1 THEN
EXIT WHILE
END IF
pageleft = pageleft - 1
GOSUB pwup
moriginy = moriginy - hpixels
END IF
ELSE
' Contract Left Cornor Down to the Right
IF pageheight > minheight THEN
pagetop = pagetop + 1
GOSUB phdown
moriginx = moriginx + vpixels
IF pagewitdxh > 1 THEN
EXIT WHILE
END IF
pageleft = pageleft + 1
GOSUB pwdown
moriginy = moriginy + hpixels
EXIT WHILE
END IF
END IF
END IF
' Top Left Cornor Up/Down
IF INT(mousex / vpixels) <> INT(moriginx / vpixels) THEN
' Expand Top Left Cornor Up
IF mousex < moriginx THEN
IF pagetop > tstop THEN
pagetop = pagetop - 1
GOSUB phup
moriginx = moriginx - vpixels
EXIT WHILE
ELSE
' If no movement was made, reset flag so a static redraw will not occur.
flag = 0
EXIT WHILE
END IF
ELSE
' Contract Top Left Cornor Down
IF pageheight > minheight THEN
pagetop = pagetop + 1
GOSUB phdown
moriginx = moriginx + vpixels
EXIT WHILE
ELSE
' If no movement was made, reset flag so a static redraw will not occur.
flag = 0
EXIT WHILE
END IF
END IF
END IF
' Top Left Cornor Left/Right
IF INT(mousey / hpixels) <> INT(moriginy / hpixels) THEN
' Expand Left Cornor to Left
IF mousey < moriginy THEN
IF pageleft > lstop THEN
pageleft = pageleft - 1
GOSUB pwup
moriginy = moriginy - hpixels
EXIT WHILE
ELSE
' If no movement was made, reset flag so a static redraw will not occur.
flag = 0
EXIT WHILE
END IF
ELSE
' Contract Left Cornor to Right
IF pagewidtxh > minwidtxh THEN
pageleft = pageleft + 1
GOSUB pwdown
moriginy = moriginy + hpixels
EXIT WHILE
ELSE
' If no movement was made, reset flag so a static redraw will not occur.
flag = 0
EXIT WHILE
END IF
END IF
ELSE
flag = 0
EXIT WHILE
END IF
CASE 6
' Top Right Diagnonal
IF INT(mousey / hpixels) <> INT(moriginy / hpixels) AND INT(mousex / vpixels) <> INT(moriginx / vpixels) THEN
IF mousex < moriginx THEN
' Expand Right Cornor Up to the Right
IF pagetop > tstop THEN
pagetop = pagetop - 1
GOSUB phup
moriginx = moriginx - vpixels
IF pageleft + pagewidtxh >= 80 THEN
EXIT WHILE
END IF
GOSUB pwup
moriginy = moriginy + hpixels
END IF
ELSE
' Contract Right Cornor Down to the Left
IF pageheight > minheight THEN
pagetop = pagetop + 1
GOSUB phdown
moriginx = moriginx + vpixels
IF pagewidtxh <= 1 THEN
EXIT WHILE
END IF
GOSUB pwdown
moriginy = moriginy - hpixels
EXIT WHILE
END IF
END IF
END IF
' Top Right Cornor up/down
IF INT(mousex / vpixels) <> INT(moriginx / vpixels) THEN
' Expand Top Right Cornor Up
IF mousex < moriginx THEN
IF pagetop > tstop THEN
pagetop = pagetop - 1
GOSUB phup
moriginx = moriginx - vpixels
EXIT WHILE
ELSE
' If no movement was made, reset flag so a static redraw will not occur.
flag = 0
EXIT WHILE
END IF
ELSE
' Contract Top Right Cornor Down
IF pageheight > minheight THEN
pagetop = pagetop + 1
GOSUB phdown
moriginx = moriginx + vpixels
EXIT WHILE
ELSE
' If no movement was made, reset flag so a static redraw will not occur.
flag = 0
EXIT WHILE
END IF
END IF
END IF
' Top Right Cornor left/right
IF INT(mousey / hpixels) <> INT(moriginy / hpixels) THEN
' Expand Right Cornor to Right
IF mousey > moriginy THEN
IF pageleft + pagewidtxh < rstop THEN
GOSUB pwup
moriginy = moriginy + hpixels
EXIT WHILE
ELSE
' If no movement was made, reset flag so a static redraw will not occur.
flag = 0
EXIT WHILE
END IF
ELSE
' Contract Right Cornor to Left
IF pagewidtxh > minwidtxh THEN
GOSUB pwdown
moriginy = moriginy - hpixels
EXIT WHILE
ELSE
' If no movement was made, reset flag so a static redraw will not occur.
flag = 0
EXIT WHILE
END IF
END IF
ELSE
flag = 0
EXIT WHILE
END IF
CASE 7
' Bottom Right Cornor Diagnonal
IF INT(mousey / hpixels) <> INT(moriginy / hpixels) AND INT(mousex / vpixels) <> INT(moriginx / vpixels) THEN
IF mousex > moriginx THEN
' Expand Bottom Right Cornor Down to the Right
IF pagetop + pageheight < bstop THEN
GOSUB phup
moriginx = moriginx + vpixels
IF pageleft + pagewidtxh >= rstop THEN
EXIT WHILE
END IF
GOSUB pwup
moriginy = moriginy + hpixels
END IF
ELSE
' Contract Bottom Right Cornor Up to the Left
IF pageheight > minheight THEN
GOSUB phdown
moriginx = moriginx - vpixels
IF pagewidtxh <= 1 THEN
EXIT WHILE
END IF
GOSUB pwdown
moriginy = moriginy - hpixels
EXIT WHILE
END IF
END IF
END IF
' Bottom Right Cornor Up/Down
IF INT(mousex / vpixels) <> INT(moriginx / vpixels) THEN
' Expand Bottom Right Cornor Down
IF mousex > moriginx THEN
IF pagetop + pageheight < bstop THEN
GOSUB phup
moriginx = moriginx + vpixels
EXIT WHILE
ELSE
' If no movement was made, reset flag so a static redraw will not occur.
flag = 0
EXIT WHILE
END IF
ELSE
' Contract Bottom Right Cornor Up
IF pageheight > minheight THEN
GOSUB phdown
moriginx = moriginx - vpixels
EXIT WHILE
ELSE
' If no movement was made, reset flag so a static redraw will not occur.
flag = 0
EXIT WHILE
END IF
END IF
END IF
' Bottom Right Cornor Left/Right
IF INT(mousey / hpixels) <> INT(moriginy / hpixels) THEN
' Expand Bottom Right Cornor to Right
IF mousey > moriginy THEN
IF pageleft + pagewidtxh < rstop THEN
GOSUB pwup
moriginy = moriginy + hpixels
EXIT WHILE
ELSE
' If no movement was made, reset flag so a static redraw will not occur.
flag = 0
EXIT WHILE
END IF
ELSE
' Contract Bottom Right Corner to Left
IF pagewidtxh > minwidtxh THEN
GOSUB pwdown
moriginy = moriginy - hpixels
EXIT WHILE
ELSE
' If no movement was made, reset flag so a static redraw will not occur.
flag = 0
EXIT WHILE
END IF
END IF
ELSE
flag = 0
EXIT WHILE
END IF
CASE 8
' Bottom Left Cornor Diagnonal
IF INT(mousey / hpixels) <> INT(moriginy / hpixels) AND INT(mousex / vpixels) <> INT(moriginx / vpixels) THEN
IF mousex > moriginx THEN
' Expand Bottom Left Cornor Down to the Left
IF pagetop + pageheight < bstop THEN
GOSUB phup
moriginx = moriginx + vpixels
IF pageleft <= 1 THEN
EXIT WHILE
END IF
pageleft = pageleft - 1
GOSUB pwup
moriginy = moriginy - hpixels
END IF
ELSE
' Contract Bottom Left Cornor Up to the Right
IF pageheight > minheight THEN
GOSUB phdown
moriginx = moriginx - vpixels
IF pagewidtxh <= 1 THEN
EXIT WHILE
END IF
pageleft = pageleft + 1
GOSUB pwdown
moriginy = moriginy + hpixels
EXIT WHILE
END IF
END IF
END IF
' Bottom Left Cornor Up/Down
IF INT(mousex / vpixels) <> INT(moriginx / vpixels) THEN
' Expand Bottom Left Cornor Down
IF mousex > moriginx THEN
IF pagetop + pageheight < bstop THEN
GOSUB phup
moriginx = moriginx + vpixels
EXIT WHILE
ELSE
' If no movement was made, reset flag so a static redraw will not occur.
flag = 0
EXIT WHILE
END IF
ELSE
' Contract Bottom Left Cornor Up
IF pageheight > minheight THEN
GOSUB phdown
moriginx = moriginx - vpixels
EXIT WHILE
ELSE
' If no movement was made, reset flag so a static redraw will not occur.
flag = 0
EXIT WHILE
END IF
END IF
END IF
' Bottom Left Cornor Left/Right
IF INT(mousey / hpixels) <> INT(moriginy / hpixels) THEN
' Expand Bottom Right Cornor to Right
IF mousey > moriginy THEN
IF pagewidtxh > minwidtxh THEN
pageleft = pageleft + 1
GOSUB pwdown
moriginy = moriginy + hpixels
EXIT WHILE
ELSE
' If no movement was made, reset flag so a static redraw will not occur.
flag = 0
EXIT WHILE
END IF
ELSE
' Contract Bottom Left Corner to Left
IF pageleft > lstop THEN
pageleft = pageleft - 1
GOSUB pwup
moriginy = moriginy - hpixels
EXIT WHILE
ELSE
' If no movement was made, reset flag so a static redraw will not occur.
flag = 0
EXIT WHILE
END IF
END IF
ELSE
flag = 0
EXIT WHILE
END IF
CASE 9
' Move GUI
' Left
IF INT(mousey / hpixels) < INT(moriginy / hpixels) AND INT(mousex / vpixels) = INT(moriginx / vpixels) THEN
IF pageleft > lstop THEN
pageleft = pageleft - 1
moriginy = moriginy - hpixels
EXIT WHILE
ELSE
flag = 0
EXIT WHILE
END IF
END IF
' Up
IF INT(mousex / vpixels) < INT(moriginx / vpixels) AND INT(mousey / hpixels) = INT(moriginy / hpixels) THEN
IF pagetop > tstop THEN
pagetop = pagetop - 1
moriginx = moriginx - vpixels
EXIT WHILE
ELSE
flag = 0
EXIT WHILE
END IF
END IF
' Right
IF INT(mousey / hpixels) > INT(moriginy / hpixels) AND INT(mousex / vpixels) = INT(moriginx / vpixels) THEN
IF pageleft + pagewidtxh < rstop THEN
pageleft = pageleft + 1
moriginy = moriginy + hpixels
EXIT WHILE
ELSE
flag = 0
EXIT WHILE
END IF
END IF
' Down
IF INT(mousex / vpixels) > INT(moriginx / vpixels) AND INT(mousey / hpixels) = INT(moriginy / hpixels) THEN
IF pagetop + pageheight < bstop THEN
pagetop = pagetop + 1
moriginx = moriginx + vpixels
EXIT WHILE
ELSE
flag = 0
EXIT WHILE
END IF
END IF
' Diagonal Left Up
IF INT(mousex / vpixels) < INT(moriginx / vpixels) AND INT(mousey / hpixels) < INT(moriginy / hpixels) THEN
IF pageleft > lstop THEN
pageleft = pageleft - 1
moriginy = moriginy - hpixels
END IF
IF pagetop > tstop THEN
pagetop = pagetop - 1
moriginx = moriginx - vpixels
END IF
IF moriginx = mousex AND moriginy = mousey THEN
flag = 0
END IF
EXIT WHILE
END IF
' Diagonal Right Up
IF INT(mousex / vpixels) < INT(moriginx / vpixels) AND INT(mousey / hpixels) > INT(moriginy / hpixels) THEN
IF pagetop > tstop THEN
pagetop = pagetop - 1
moriginx = moriginx - vpixels
END IF
IF pageleft + pagewidtxh < rstop THEN
pageleft = pageleft + 1
moriginy = moriginy + hpixels
END IF
IF moriginx = mousex AND moriginy = mousey THEN
flag = 0
END IF
EXIT WHILE
END IF
' Diagonal Right Down
IF INT(mousex / vpixels) > INT(moriginx / vpixels) AND INT(mousey / hpixels) > INT(moriginy / hpixels) THEN
IF pagetop + pageheight < bstop THEN
pagetop = pagetop + 1
moriginx = moriginx + vpixels
END IF
IF pageleft + pagewidtxh < rstop THEN
pageleft = pageleft + 1
moriginy = moriginy + hpixels
END IF
IF moriginx = mousex AND moriginy = mousey THEN
flag = 0
END IF
EXIT WHILE
END IF
' Diagonal Left Down
IF INT(mousex / vpixels) > INT(moriginx / vpixels) AND INT(mousey / hpixels) < INT(moriginy / hpixels) THEN
IF pageleft > lstop THEN
pageleft = pageleft - 1
moriginx = moriginx + vpixels
END IF
IF pagetop + pageheight < bstop THEN
pagetop = pagetop + 1
moriginy = moriginy - hpixels
END IF
IF moriginx = mousex AND moriginy = mousey THEN
flag = 0
END IF
EXIT WHILE
END IF
moriginx = mousex
moriginy = mousey
flag = 0
EXIT WHILE
CASE 10
' V-Scrollbar Down
IF INT(mousex / (vpixels / 2)) > INT(moriginx / (vpixels / 2)) AND vbar < vslide THEN
flag = 0
GOSUB Verticalscrollmask
vbar = vbar + .5
moriginx = moriginx + vpixels / 2
GOSUB verticalscrollbar
PCOPY 1, 0
EXIT WHILE
END IF
' V-Scrollbar Up
IF INT(mousex / (vpixels / 2)) < INT(moriginx / (vpixels / 2)) AND vbar > 0 THEN
flag = 0
GOSUB Verticalscrollmask
vbar = vbar - .5
moriginx = moriginx - vpixels / 2
GOSUB verticalscrollbar
PCOPY 1, 0
EXIT WHILE
END IF
flag = 0
EXIT WHILE
CASE 11
' H-Scrollbar Right
IF INT(mousey / (hpixels / 2)) > INT(moriginy / (hpixels / 2)) AND hbar < hslide THEN
flag = 0
GOSUB Horizontalscrollmask
hbar = hbar + .5
moriginy = moriginy + hpixels / 2
GOSUB Horizontalscrollbar
PCOPY 1, 0
EXIT WHILE
END IF
' H-Scrollbar Left
IF INT(mousey / (hpixels / 2)) < INT(moriginy / (hpixels / 2)) AND hbar > 0 THEN
flag = 0
GOSUB Horizontalscrollmask
hbar = hbar - .5
moriginy = moriginy - hpixels / 2
GOSUB Horizontalscrollbar
PCOPY 1, 0
EXIT WHILE
END IF
flag = 0
EXIT WHILE
END SELECT
WEND
END IF
RETURN
'
SUB pal (colx%, r%, g%, b%)
OUT &H3C8, colx%
OUT &H3C9, r%
OUT &H3C9, g%
OUT &H3C9, b%
END SUBI added a few API effects tonight near the top, which could be removed for Linux / Mac users.
It runs a bit glitchy in GL, but was perfect in SDL, go figure. Sublte differences in LOCATE vs put , I suspect.
Drag window, resize by ragging edges, move with arrows and press tab to switch from move with arrows to resize with arrows. Min, max, and close buttons work as do the scroll bars. Clicking "File" does nothing.
Another type of GUI with buttons. Steve showed me how to work in some hardware magic with graphics buttons in SCREEN 0. I modified his work a just bit, and learned a thing or two in the process.
Code: (Select All)
SCREEN 0, 0, 0, 0
' 1440 twips per inch.
PALETTE 7, 63: COLOR 0, 7: CLS
_CONTROLCHR OFF
DIM SHARED gen_var AS my_gen_var
DIM SHARED fndrep AS my_fndrep
DIM SHARED dir AS my_dir
DIM SHARED scrn AS my_scrn
DIM SHARED page AS my_page
DIM SHARED margin AS my_margin
DIM SHARED cursor AS my_cursor
DIM SHARED mb AS my_mb
TYPE my_gen_var
action AS STRING
chdir_text AS STRING
undorow AS INTEGER
undocol AS INTEGER
undoscr AS INTEGER
redorow AS INTEGER
redocol AS INTEGER
redoscr AS INTEGER
undoswitch AS INTEGER
change_initiate AS INTEGER
vartable AS INTEGER
locked AS INTEGER
w1 AS INTEGER
w2 AS INTEGER
w3 AS INTEGER
w4 AS INTEGER
smode AS INTEGER
END TYPE
TYPE my_fndrep
find_action AS STRING
find_or_replace AS INTEGER
ifield AS INTEGER
noif AS INTEGER
ifrow AS INTEGER
END TYPE
TYPE my_dir
home AS STRING
wp AS STRING
orig AS STRING
END TYPE
TYPE my_scrn
w AS INTEGER
h AS INTEGER
END TYPE
TYPE my_page
w AS INTEGER
h AS INTEGER
c AS INTEGER
END TYPE
TYPE my_margin
t AS INTEGER
b AS INTEGER
l AS INTEGER
r AS INTEGER
END TYPE
TYPE my_cursor
find AS INTEGER
scbrrow AS INTEGER ' row + scr
scbrcol AS INTEGER ' POS(0)
holdscr AS INTEGER ' Holds scr
holdrow AS INTEGER ' Holds row
holdscrbx AS INTEGER ' Holds scrb.x
top AS INTEGER
bot AS INTEGER
END TYPE
TYPE my_mb
l AS INTEGER
r AS INTEGER
m AS INTEGER
w AS INTEGER
drag AS INTEGER
dragon AS INTEGER
END TYPE
' Non shared UDTs
TYPE my_scrb
t AS INTEGER
b AS INTEGER
l AS INTEGER
x AS INTEGER
i AS INTEGER
d AS INTEGER
h AS INTEGER
s AS INTEGER
opt AS INTEGER
adjust AS INTEGER
END TYPE
_SCREENMOVE 0, 0
enl% = 13: CALL font_size_setup(enl%)
_DELAY .3
dir.home = _CWD$
IF INSTR(dir.home, "\") = 0 THEN CLS: PRINT "Error in variable formatting for dir.home.": END '''
IF RIGHT$(dir.home, 1) <> "\" THEN dir.home = dir.home + "\"
dir.wp = dir.home: dir.orig = dir.home
CALL pageset
COLOR 0, 7
END
font_types:
DATA Arial,Arial Black,Arial Narrow,Bahnschrift,Book Antiqua,Bookman Old Style,Bookshelf Symbol 7,Bradley Hand ITC,Calibri,Calibri Light,Calisto MT,Cambria,Cambria Math,Candara,Candara Light,Century,Century Gothic,Comic Sans MS,Consolas,Constantia
DATA Corbel,Corbel Light,Courier,Courier New,Ebrima,Fixedsys,Franklin Gothic Medium,Freestyle Script,French Script MT,Gabriola,Gadugi,Gautami,Georgia,HoloLens MDL2 Assets,Impact,Ink Free,Javanese Text,Juice ITC,Kristen ITC,Leelawadee
DATA Leelawadee UI,Leelawadee UI Semilight,Lucida Console,Lucida Handwriting,Lucida Sans Unicode,Malgun Gothic,Marlett,Microsoft Himalaya,Microsoft JhengHei,Microsoft JhengHei Light,Microsoft JhengHei UI,Microsoft JhengHei UI Light,Microsoft New Tai Lue,Microsoft PhagsPa,Microsoft Sans Serif,Microsoft Tai Le,Microsoft Uighur,Microsoft YaHei,Microsoft YaHei UI,Microsoft YaHei UI Light
DATA Microsoft Yi Baiti,MingLiU,PMingLiU,MingLiU-ExtB,PMingLiU-ExtB,MingLiU_HKSCS,MingLiU_HKSCS-ExtB,Mistral,Modern,Mongolian Baiti,Monotype Corsiva,MS Gothic,MS PGothic,MS Reference Sans Serif,MS Reference Specialty,MS Sans Serif,MS Serif,MS UI Gothic,NSimSun,MT Extra,MV Boli,Myanmar Text
DATA Nirmala UI,Narkisim,Nirmala UI,Nirmala UI Semilight,NSimSun,Palatino Linotype,Papyrus,PMingLiU-ExtB,Pristina,Roman,Script,Segoe MDL2 Assets,Segoe Print,Segoe Script,Segoe UI Black,Segoe UI Emoji,Segoe UI Historic,Segoe UI Light,Segoe UI Semibold,Segoe UI Semilight
DATA Segoe UI Symbol,SimSun,SimSun-ExtB,Sitka Banner,Sitka Display,Sitka Heading,Sitka Small,Sitka Subheading,Sitka Text,Small Fonts,Sylfaen,Symbol,System,Tahoma,Tempus Sans ITC,Terminal,Times New Roman,Trebuchet MS,Verdana,Webdings
DATA EOF
SUB pageset
DIM scrb AS my_scrb
gen_var.w1 = 4: gen_var.w2 = 11: gen_var.w3 = 18: gen_var.w4 = 60
msg$ = " Printer Page Settings "
msg% = -1
CALL popup(msg$, msg%, button$(), button%, button_index%, text$, config%, mydelay%, mx%, my%, xclose%, yclose%)
smode% = 1 '''''''' Temporary.
nof% = 8: nob% = 2 ' 8 fileds and two buttons.
REDIM field_name$(10), fieldx%(10), fieldy%(10), field_size%(10), up_arrowx%(10), up_arrowy%(10), dn_arrowx%(10), dn_arrowy%(10)
REDIM entry$(10), min_val_entry%(5), max_val_entry%(5)
field_name$(1) = "Margin Top": field_size%(1) = 5: min_val_entry%(1) = 1: max_val_entry%(1) = 9.5
field_name$(2) = "Margin Bottom": field_size%(2) = 5: min_val_entry%(2) = 1: max_val_entry%(2) = 9.5
field_name$(3) = "Margin Left": field_size%(3) = 5: min_val_entry%(3) = 1.25: max_val_entry%(3) = 9.5
field_name$(4) = "Margin Right": field_size%(4) = 5: min_val_entry%(4) = 1.25: max_val_entry%(4) = 9.5
field_name$(5) = "Font Size ": field_size%(5) = 5: min_val_entry%(5) = 8: max_val_entry%(5) = 72
field_name$(6) = "Font Color": field_size%(6) = 5
field_name$(7) = "Font Type": field_size%(7) = 20
field_name$(8) = "Print Page Number": field_size%(8) = 1
font_color_data:
DATA Black,Red,Blue,Green,Grey,EOF
GOSUB starting_values
' BUTTONS ----------------------------->
button_text$ = " Reset ": bw% = 11: bh% = 2: brow% = 30: bcol% = 94
GOSUB formatbutton
button_display$ = "on"
button_text$ = " Print ": bw% = 11: bh% = 2: brow2% = 30: bcol2% = 115
GOSUB formatbutton2
GOSUB bdisplay
DO
''' ss = CSRLIN: rr = POS(0): LOCATE 1, 1: PRINT tabx%; nof% + nob%;: LOCATE ss, rr
_LIMIT 30
b$ = INKEY$
IF LEN(b$) THEN
SELECT CASE smode%
CASE 0 ' Pop up not present.
IF b$ = CHR$(27) THEN SYSTEM
CASE 1 ' Pop up active. Drop downs closed.
SELECT CASE b$
CASE CHR$(27)
smode% = 0: SCREEN 0, 0, 0, 0: button_display$ = "off": _DISPLAY: _KEYCLEAR
CASE CHR$(13)
SELECT CASE tabx%
CASE 8 ' Print page number.
i% = tabx%: GOSUB print_page_num
CASE 9 ' Reset.
i% = tabx%: GOSUB reset_values
CASE 10 ' Print.
i% = tabx%: GOSUB print_doc
END SELECT
CASE CHR$(9)
tabx% = tabx% + 1
IF tabx% > nof% + nob% THEN tabx% = 0
tab_trigger% = tabx%
_KEYCLEAR: _DELAY .1
CASE CHR$(0) + "H"
IF tabx% THEN
SELECT CASE tabx%
CASE 1 TO 5
up_arrowx%(tabx%) = -ABS(up_arrowx%(tabx%))
i% = tabx%: GOSUB up_arrow
up_arrowx%(tabx%) = ABS(up_arrowx%(tabx%))
iyy% = CSRLIN: ixx% = POS(0)
_DELAY .05
LOCATE up_arrowy%(tabx%), up_arrowx%(tabx%)
COLOR 11, 1
PRINT CHR$(30);
COLOR 7, 0
LOCATE iyy%, ixx%
_KEYCLEAR
CASE ELSE
END SELECT
END IF
CASE CHR$(0) + "K"
tabx% = tabx% - 1
IF tabx% < 0 THEN
tabx% = 0
ELSE
tab_trigger% = tabx%
_KEYCLEAR: _DELAY .1
END IF
CASE CHR$(0) + "M"
tabx% = tabx% + 1
IF tabx% > nof% + nob% THEN
tabx% = 0
ELSE
tab_trigger% = tabx%
_KEYCLEAR: _DELAY .1
END IF
CASE CHR$(0) + "P"
IF tabx% THEN
SELECT CASE tabx%
CASE 1 TO 5
dn_arrowx%(tabx%) = -ABS(dn_arrowx%(tabx%))
i% = tabx%: GOSUB dn_arrow
dn_arrowx%(tabx%) = ABS(dn_arrowx%(tabx%))
iyy% = CSRLIN: ixx% = POS(0)
_DELAY .05
LOCATE dn_arrowy%(tabx%), dn_arrowx%(tabx%)
COLOR 11, 1
PRINT CHR$(31);
COLOR 7, 0
LOCATE iyy%, ixx%
_KEYCLEAR
CASE 6
GOSUB font_color_open_dropdown
CASE 7
GOSUB font_type_open_dropdown
END SELECT
END IF
END SELECT
CASE 2 ' Drop down menu is open.
IF b$ = CHR$(0) + "H" THEN
GOSUB close_dropdown
END IF
END SELECT
ELSE
GOSUB poll_mouse
END IF
IF my% = yclose% AND mx% = ABS(xclose%) THEN
IF mb.l AND l_click% = 0 OR mb.l AND autoclick% THEN GOSUB close_x
END IF
GOSUB audit_close_x
SELECT CASE smode%
CASE 2
IF mb.l AND l_click% = 0 AND my% = up_arrowy%(tabx%) AND -mx% = up_arrowx%(tabx%) THEN
GOSUB close_dropdown
END IF
GOSUB bdisplay
CASE 1
IF mb.l AND l_click% = 0 THEN
' Reset button
IF mx% >= 47 AND mx% <= 52 AND my% = 19 THEN
GOSUB reset_values
END IF
' Print button
IF mx% >= 58 AND mx% <= 63 AND my% = 19 THEN
GOSUB print_doc
END IF
END IF
IF mb.l AND l_click% = 0 OR mb.l AND autoclick% THEN
FOR i% = 1 TO nof%
IF i% = 8 THEN
IF mx% = ABS(fieldx%(i%)) AND my% = fieldy%(i%) THEN
GOSUB print_page_num
END IF
END IF
SELECT CASE i%
CASE 1 TO 5
IF up_arrowx%(i%) < 0 OR dn_arrowx%(i%) < 0 THEN
IF up_arrowx%(i%) < 0 THEN
GOSUB up_arrow
ELSE
GOSUB dn_arrow
END IF
END IF
CASE 6 ' Font color.
IF my% = dn_arrowy%(i%) AND mx% = ABS(dn_arrowx%(i%)) THEN
IF dn_arrowx%(i%) < 0 THEN
GOSUB font_color_open_dropdown
END IF
END IF
CASE 7
IF my% = dn_arrowy%(i%) AND mx% = ABS(dn_arrowx%(i%)) THEN
IF dn_arrowx%(i%) < 0 THEN
GOSUB font_type_open_dropdown
END IF
END IF
END SELECT
NEXT
ELSE
IF mb.w THEN
FOR i% = 1 TO 5
IF fieldx%(i%) < 0 THEN
IF mb.w < 0 THEN GOSUB increase_value ELSE GOSUB decrease_value
EXIT FOR
END IF
NEXT
ELSEIF mb.l = 0 THEN
autoclick% = 0
z1 = TIMER
ELSE
IF ABS(z1 - TIMER) > .5 THEN autoclick% = -1: z1 = TIMER
END IF
END IF
IF tab_trigger% AND tabx% = 9 OR mx% >= 47 AND mx% <= 52 AND my% = 19 THEN
GOSUB bhover
ELSEIF tab_trigger% AND tabx% = 10 OR mx% >= 58 AND mx% <= 63 AND my% = 19 THEN
GOSUB bhover2
ELSE
GOSUB bdisplay
END IF
IF tab_trigger% OR tab_trigger% = 0 AND mx% <> oldmx% OR tab_trigger% = 0 AND my% <> oldmy% THEN
DO
IF tab_trigger% THEN
iyy% = CSRLIN: ixx% = CSRLIN
FOR i% = 1 TO nof%
IF up_arrowx%(i%) < 0 THEN up_arrowx%(i%) = ABS(up_arrowx%(i%)): LOCATE up_arrowy%(i%), up_arrowx%(i%): COLOR 11, 1: PRINT CHR$(30);: COLOR 14, 0: LOCATE iyy%, ixx%
IF dn_arrowx%(i%) < 0 THEN dn_arrowx%(i%) = ABS(dn_arrowx%(i%)): LOCATE dn_arrowy%(i%), dn_arrowx%(i%): COLOR 11, 1: PRINT CHR$(31);: COLOR 14, 0: LOCATE iyy%, ixx%
NEXT
ELSE
FOR i% = 1 TO nof%
IF i% <> 8 THEN ' Exclude non-arrow input field.
IF mx% = up_arrowx%(i%) AND my% = up_arrowy%(i%) OR mx% = dn_arrowx%(i%) AND my% = dn_arrowy%(i%) THEN
GOSUB activate_field
IF my% = up_arrowy%(i%) AND i% <> 6 AND i% <> 7 THEN
LOCATE up_arrowy%(i%), up_arrowx%(i%)
COLOR 14, 1
PRINT CHR$(30);
up_arrowx%(i%) = ABS(up_arrowx%(i%)) * -1
COLOR 7, 0
ELSE
LOCATE dn_arrowy%(i%), dn_arrowx%(i%)
COLOR 14, 1
PRINT CHR$(31);
dn_arrowx%(i%) = ABS(dn_arrowx%(i%)) * -1
COLOR 7, 0
END IF
EXIT DO
ELSE
IF up_arrowx%(i%) < 0 OR dn_arrowx%(i%) < 0 THEN
iyy% = CSRLIN: ixx% = POS(0)
up_arrowx%(i%) = ABS(up_arrowx%(i%))
dn_arrowx%(i%) = ABS(dn_arrowx%(i%))
COLOR 11, 1
IF up_arrowy%(i%) THEN LOCATE up_arrowy%(i%), up_arrowx%(i%): PRINT CHR$(30);
IF dn_arrowy%(i%) THEN LOCATE dn_arrowy%(i%), dn_arrowx%(i%): PRINT CHR$(31);
LOCATE iyy%, ixx%
GOSUB neutralize_field
END IF
END IF
END IF
NEXT
END IF
FOR i% = 1 TO nof%
IF fieldx%(i%) < 0 THEN
IF tab_trigger% OR mx% < ABS(fieldx%(i%)) OR mx% > ABS(fieldx%(i%)) + 6 OR my% <> fieldy%(i%) THEN
GOSUB neutralize_field
END IF
END IF
IF tab_trigger% = i% OR tab_trigger% = 0 AND fieldx%(i%) > 0 AND mx% >= fieldx%(i%) AND mx% <= fieldx%(i%) + field_size%(i%) + 1 AND my% = fieldy%(i%) THEN
GOSUB activate_field
END IF
NEXT
EXIT DO
LOOP
END IF
IF autoclick% THEN IF oldmx% <> mx% OR oldmy% <> my% THEN autoclick% = 0
IF tab_trigger% THEN tab_trigger% = 0
END SELECT
oldmx% = mx%: oldmy% = my%
LOOP
EXIT SUB
starting_values:
gen_var.w1 = 4: gen_var.w2 = 11
entry$(1) = "1.00"
entry$(2) = "1.00"
entry$(3) = "1.25"
entry$(4) = "1.25"
entry$(5) = "12"
entry$(6) = "Black"
entry$(7) = "Calibri"
entry$(8) = "off"
FOR i% = 1 TO 6
COLOR 3, 1: LOCATE gen_var.w1 + 3, gen_var.w2 + 7 - LEN(field_name$(i%)) / 2: PRINT field_name$(i%);
COLOR 11, 1
LOCATE gen_var.w1 + 4, gen_var.w2 + 3
PRINT CHR$(218); STRING$(6, CHR$(196)); CHR$(191);
LOCATE gen_var.w1 + 5, gen_var.w2 + 3: PRINT CHR$(179);
LOCATE gen_var.w1 + 5, gen_var.w2 + 10: PRINT CHR$(179)
LOCATE gen_var.w1 + 6, gen_var.w2 + 3: PRINT CHR$(192); STRING$(field_size%(i%) + 1, CHR$(196)); CHR$(217);
COLOR 11, 1: LOCATE gen_var.w1 + 4, gen_var.w2 + 10
up_arrowy%(i%) = CSRLIN: up_arrowx%(i%) = POS(0)
IF i% <> 6 THEN
PRINT CHR$(30);
COLOR 3, 1: LOCATE gen_var.w1 + 5, gen_var.w2 + 10: PRINT CHR$(186);
END IF
COLOR 11, 1: LOCATE gen_var.w1 + 6, gen_var.w2 + 10
dn_arrowy%(i%) = CSRLIN: dn_arrowx%(i%) = POS(0)
PRINT CHR$(31);
COLOR 7, 0: LOCATE gen_var.w1 + 5, gen_var.w2 + 4
fieldy%(i%) = CSRLIN: fieldx%(i%) = POS(0)
PRINT SPACE$(field_size%(i%));
LOCATE gen_var.w1 + 5, gen_var.w2 + 4 + field_size%(i%) - LEN(entry$(i%))
PRINT entry$(i%);
COLOR 1, 0: PRINT CHR$(222);
gen_var.w2 = gen_var.w2 + 15
IF i% = 4 THEN gen_var.w1 = 10: gen_var.w2 = 11
NEXT
'---------------------------------------------------------------
i% = 7
COLOR 3, 1: LOCATE gen_var.w1 + 3, gen_var.w2 + 10: PRINT field_name$(i%);
COLOR 11, 1: LOCATE gen_var.w1 + 4, gen_var.w2 + 3
PRINT CHR$(218); STRING$(21, CHR$(196));
up_arrowy%(i%) = CSRLIN: up_arrowx%(i%) = POS(0) ' Hidden untl popup opens.
PRINT CHR$(191);
LOCATE gen_var.w1 + 5, gen_var.w2 + 3: PRINT CHR$(179);
LOCATE gen_var.w1 + 5, gen_var.w2 + 25: PRINT CHR$(179)
LOCATE gen_var.w1 + 6, gen_var.w2 + 3: PRINT CHR$(192); STRING$(field_size%(i%) + 1, CHR$(196)); CHR$(217);
COLOR 11, 1: LOCATE gen_var.w1 + 6, gen_var.w2 + 25
dn_arrowy%(i%) = CSRLIN: dn_arrowx%(i%) = POS(0)
PRINT CHR$(31);
COLOR 7, 0: LOCATE gen_var.w1 + 5, gen_var.w2 + 4
fieldx%(i%) = POS(0): fieldy%(i%) = CSRLIN
PRINT SPACE$(field_size%(i%));
COLOR 1, 0: PRINT CHR$(222);
LOCATE gen_var.w1 + 5, gen_var.w2 + 4
COLOR 7, 0
PRINT entry$(i%);
i% = 8
gen_var.w1 = 18: gen_var.w2 = 17
COLOR 11, 1
LOCATE gen_var.w1, gen_var.w2: PRINT CHR$(218); STRING$(1, CHR$(196)); CHR$(191);
LOCATE gen_var.w1 + 1, gen_var.w2: PRINT CHR$(179);
LOCATE gen_var.w1 + 1, gen_var.w2 + 2: PRINT CHR$(179);
LOCATE gen_var.w1 + 2, gen_var.w2: PRINT CHR$(192); STRING$(field_size%(i%), CHR$(196)); CHR$(217);
COLOR 7, 0
LOCATE gen_var.w1 + 1, gen_var.w2 + 1
fieldx%(i%) = POS(0): fieldy%(i%) = CSRLIN
PRINT SPACE$(field_size%(i%));
COLOR 3, 1
LOCATE gen_var.w1 + 1, gen_var.w2 + 4
printpagey% = CSRLIN: printpagex% = POS(0)
PRINT field_name$(i%);
RETURN
formatbutton:
Gdown = Button_HW(bw% * 8, bh% * 16, 170, 170, 170, -9, -7, -1, MID$(button_text$, 1, bw% - 2))
Ghover = Button_HW(bw% * 8, bh% * 16, 200, 200, 200, -8, -7, -1, MID$(button_text$, 1, bw% - 2))
Gdrag = Button_HW(bw% * 8, bh% * 16, 200, 200, 200, -1, -1, -1, MID$(button_text$, 1, bw% - 2))
RETURN
formatbutton2:
Gdown2 = Button_HW(bw% * 8, bh% * 16, 170, 170, 170, -9, -7, -1, MID$(button_text$, 1, bw% - 2))
Ghover2 = Button_HW(bw% * 8, bh% * 16, 200, 200, 200, -8, -7, -1, MID$(button_text$, 1, bw% - 2))
Gdrag2 = Button_HW(bw% * 8, bh% * 16, 200, 200, 200, -1, -1, -1, MID$(button_text$, 1, bw% - 2))
RETURN
bdisplay:
IF button_display$ <> "off" THEN
_PUTIMAGE ((bcol% - 1) * 8, (brow% - 1) * 16), Gdown
_PUTIMAGE ((bcol2% - 1) * 8, (brow2% - 1) * 16), Gdown2
END IF
_DISPLAY
RETURN
bhover:
IF button_display$ <> "off" THEN
_PUTIMAGE ((bcol% - 1) * 8, (brow% - 1) * 16), Ghover
_PUTIMAGE ((bcol2% - 1) * 8, (brow2% - 1) * 16), Gdown2
tabx% = 9
END IF
_DISPLAY
RETURN
bhover2:
IF button_display$ <> "off" THEN
_PUTIMAGE ((bcol% - 1) * 8, (brow% - 1) * 16), Gdown
_PUTIMAGE ((bcol2% - 1) * 8, (brow2% - 1) * 16), Ghover2
tabx% = 10
END IF
_DISPLAY
RETURN
activate_field:
iyy% = CSRLIN: ixx% = POS(0)
IF i% = 8 THEN j% = 0 ELSE j% = 1
LOCATE fieldy%(i%) - 1, ABS(fieldx%(i%)) - 1
COLOR 14, 1
PRINT CHR$(218); STRING$(field_size%(i%) + j%, 196);
LOCATE fieldy%(i%), ABS(fieldx%(i%)) - 1
PRINT CHR$(179);
IF i% < 6 THEN
LOCATE fieldy%(i%), ABS(fieldx%(i%)) + field_size%(i%) + 1
PRINT CHR$(186);
END IF
LOCATE fieldy%(i%) + 1, ABS(fieldx%(i%)) - 1
PRINT CHR$(192); STRING$(field_size%(i%) + j%, 196);
IF i% = 6 OR i% = 7 THEN
COLOR 14, 1
LOCATE fieldy%(i%) - 1, ABS(fieldx%(i%)) + field_size%(i%) + 1
PRINT CHR$(191);
LOCATE fieldy%(i%), ABS(fieldx%(i%)) + field_size%(i%) + 1
PRINT CHR$(179);
END IF
IF i% = 8 THEN
LOCATE fieldy%(i%) - 1, ABS(fieldx%(i%)) + field_size%(i%)
PRINT CHR$(191);
LOCATE fieldy%(i%), ABS(fieldx%(i%)) + field_size%(i%)
PRINT CHR$(179);
LOCATE fieldy%(i%) + 1, ABS(fieldx%(i%)) + field_size%(i%)
PRINT CHR$(217);
END IF
COLOR 7, 0
LOCATE iyy%, ixx%
fieldx%(i%) = -fieldx%(i%)
tabx% = i%
RETURN
neutralize_field:
iyy% = CSRLIN: ixx% = POS(0)
IF i% = 8 THEN j% = 0 ELSE j% = 1
fieldx%(i%) = ABS(fieldx%(i%))
COLOR 11, 1
LOCATE fieldy%(i%) - 1, fieldx%(i%) - 1
PRINT CHR$(218); STRING$(field_size%(i%) + j%, 196);
LOCATE fieldy%(i%), fieldx%(i%) - 1
PRINT CHR$(179);
IF i% < 6 THEN
LOCATE fieldy%(i%), ABS(fieldx%(i%)) + field_size%(i%) + 1
PRINT CHR$(186);
END IF
LOCATE fieldy%(i%) + 1, fieldx%(i%) - 1
PRINT CHR$(192); STRING$(field_size%(i%) + j%, 196);
IF i% = 6 OR i% = 7 THEN
COLOR 11, 1
LOCATE fieldy%(i%) - 1, ABS(fieldx%(i%)) + field_size%(i%) + 1
PRINT CHR$(191);
LOCATE fieldy%(i%), ABS(fieldx%(i%)) + field_size%(i%) + 1
PRINT CHR$(179);
END IF
IF i% = 8 THEN
LOCATE fieldy%(i%) - 1, fieldx%(i%) + field_size%(i%)
PRINT CHR$(191);
LOCATE fieldy%(i%), fieldx%(i%) + field_size%(i%)
PRINT CHR$(179);
LOCATE fieldy%(i%) + 1, fieldx%(i%) + field_size%(i%)
PRINT CHR$(217);
END IF
COLOR 7, 0
LOCATE iyy%, ixx%
IF tab_trigger% = 0 THEN tabx% = 0
RETURN
up_arrow:
iyy% = CSRLIN: ixx% = POS(0)
LOCATE up_arrowy%(i%), ABS(up_arrowx%(i%))
COLOR 11, 1
PRINT CHR$(30);
GOSUB bdisplay
_DELAY .1
LOCATE up_arrowy%(i%), ABS(up_arrowx%(i%))
COLOR 14, 1
PRINT CHR$(30);
GOSUB increase_value
LOCATE iyy%, ixx%
GOSUB bdisplay
RETURN
dn_arrow:
iyy% = CSRLIN: ixx% = POS(0)
LOCATE dn_arrowy%(i%), ABS(dn_arrowx%(i%))
COLOR 11, 1
PRINT CHR$(31);
GOSUB bdisplay
_DELAY .1
LOCATE dn_arrowy%(i%), ABS(dn_arrowx%(i%))
COLOR 14, 1
PRINT CHR$(31);
GOSUB decrease_value
LOCATE iyy%, ixx%
GOSUB bdisplay
RETURN
increase_value: ' Nested GOSUB for up_arrow and dn_arrow------------------
IF VAL(entry$(i%)) < max_val_entry%(i%) THEN
IF i% = 5 THEN
a1$ = entry$(i%)
j = VAL(a1$)
j = j + 1
entry$(i%) = LTRIM$(STR$(j))
ELSE
k% = 5: IF mb.w THEN k% = 20
a1$ = MID$(entry$(i%), 1, INSTR(entry$(i%), ".") - 1) + MID$(entry$(i%), INSTR(entry$(i%), ".") + 1)
j = VAL(a1$)
j = j + k%
a1$ = LTRIM$(STR$(j))
entry$(i%) = MID$(a1$, 1, LEN(a1$) - 2) + "." + MID$(a1$, 2)
END IF
COLOR 7, 0
LOCATE fieldy%(i%), ABS(fieldx%(i%)): PRINT SPACE$(field_size%(i%));
LOCATE fieldy%(i%), ABS(fieldx%(i%)) + field_size%(i%) - LEN(entry$(i%))
PRINT entry$(i%);
ELSE
SOUND 500, .1
END IF
RETURN
decrease_value:
IF VAL(entry$(i%)) > min_val_entry%(i%) THEN
IF i% = 5 THEN
a1$ = entry$(i%)
j = VAL(a1$)
j = j - 1
entry$(i%) = LTRIM$(STR$(j))
ELSE
k% = 5: IF mb.w THEN k% = 20
a1$ = MID$(entry$(i%), 1, INSTR(entry$(i%), ".") - 1) + MID$(entry$(i%), INSTR(entry$(i%), ".") + 1)
j = VAL(a1$)
j = j - k%
a1$ = LTRIM$(STR$(j))
entry$(i%) = MID$(a1$, 1, LEN(a1$) - 2) + "." + MID$(a1$, 2)
END IF
COLOR 7, 0
LOCATE fieldy%(i%), ABS(fieldx%(i%)): PRINT SPACE$(field_size%(i%));
LOCATE fieldy%(i%), ABS(fieldx%(i%)) + field_size%(i%) - LEN(entry$(i%))
PRINT entry$(i%);
ELSE
SOUND 500, .1
END IF
RETURN ' End Nested GOSUB-------------------------------------------------
font_color_open_dropdown:
up_arrowx%(tabx%) = -ABS(up_arrowx%(tabx%))
smode% = 2
PCOPY 1, 2
SCREEN 0, 0, 2, 2
PALETTE 7, 63
button_display$ = "on"
GOSUB bdisplay
scr = 0: row = 1
i% = tabx%
COLOR 11, 1
LOCATE printpagey%, printpagex%: PRINT SPACE$(LEN(field_name$(8)));
LOCATE fieldy%(i%) - 1, ABS(fieldx%(i%)) + field_size%(i%) + 1: PRINT CHR$(30);
LOCATE fieldy%(i%) + 1, ABS(fieldx%(i%)) - 1
FOR j% = 1 TO 5
COLOR 14, 1: PRINT CHR$(179);
COLOR 7, 0: PRINT SPACE$(field_size%(i%));
COLOR 1, 0: PRINT CHR$(222);
COLOR 14, 1: PRINT CHR$(179);
LOCATE fieldy%(i%) + j%, ABS(fieldx%(i%)) - 1
NEXT
PRINT CHR$(192); STRING$(field_size%(i%) + 1, 196); CHR$(217);
COLOR 8, 0
LOCATE fieldy%(i%), ABS(fieldx%(i%)): PRINT MID$(entry$(tabx%), 1, field_size%(tabx%));
COLOR 7, 0
LOCATE fieldy%(i%) + 1, ABS(fieldx%(i%))
RESTORE font_color_data
j% = 0
DO
READ a1$
IF a1$ = "EOF" THEN EXIT DO
j% = j% + 1
IF a1$ <> entry$(tabx%) THEN
REDIM _PRESERVE font_color$(j%)
font_color$(j%) = a1$
ELSE
j% = j% - 1
END IF
LOOP
LOCATE fieldy%(i%) + 1, ABS(fieldx%(i%))
FOR k% = 1 TO j%
IF k% = 1 THEN COLOR 1, 3: hlf% = k%: hlfy% = CSRLIN: hlfx% = POS(0) ELSE COLOR 7, 0
a1$ = SPACE$(field_size%(tabx%))
MID$(a1$, 1) = font_color$(k%)
PRINT a1$;
LOCATE fieldy%(i%) + k% + 1, ABS(fieldx%(i%))
NEXT
LOCATE fieldy%(i%) + 1, ABS(fieldx%(i%))
gen_var.vartable = 3: CALL setvariables(scrb, c1%, c2%, c1alt%, h1%, h2%, row, ins%, dwidth, dwidth2, menubar%, menuheightmax%)
DO
_LIMIT 30
IF autokey$ = "" THEN b$ = INKEY$ ELSE b$ = autokey$: autokey$ = ""
IF LEN(b$) THEN
SELECT CASE b$
CASE CHR$(27)
GOSUB close_dropdown
EXIT DO
CASE CHR$(13)
GOSUB close_dropdown
entry$(tabx%) = font_color$(row)
a1$ = SPACE$(field_size%(tabx%))
MID$(a1$, 1) = font_color$(row)
LOCATE fieldy%(tabx%), ABS(fieldx%(tabx%))
COLOR 7, 0
PRINT a1$;
EXIT DO
CASE CHR$(0) + "H"
IF row > 1 THEN
row = row - 1
GOSUB highlight_color
END IF
CASE CHR$(0) + "P"
IF row < page.h THEN
row = row + 1
GOSUB highlight_color
END IF
CASE CHR$(0) + "w"
scr = 0:: row = 1
CASE CHR$(0) + "u"
scr = noe - page.h: row = page.h
END SELECT
ELSE
GOSUB poll_mouse
END IF
IF my% = yclose% AND mx% = ABS(xclose%) THEN
IF mb.l AND l_click% = 0 OR mb.l AND autoclick% THEN GOSUB close_x
END IF
GOSUB audit_close_x
IF mb.l THEN
IF my% = up_arrowy%(tabx%) AND mx% = ABS(up_arrowx%(tabx%)) THEN
GOSUB close_dropdown
EXIT DO
END IF
IF my% >= fieldy%(tabx%) AND my% <= fieldy%(tabx%) + 5 THEN
IF mx% >= ABS(fieldx%(tabx%)) AND mx% <= ABS(fieldx%(tabx%)) + field_size%(tabx%) - 1 THEN
GOSUB close_dropdown
IF my% <> fieldy%(tabx%) THEN
entry$(tabx%) = font_color$(row)
a1$ = SPACE$(field_size%(tabx%))
MID$(a1$, 1) = font_color$(row)
LOCATE fieldy%(tabx%), ABS(fieldx%(tabx%))
COLOR 7, 0
PRINT a1$;
END IF
EXIT DO
END IF
END IF
ELSEIF mb.w THEN
IF mb.w < 0 THEN autokey$ = CHR$(0) + "H"
IF mb.w > 0 THEN autokey$ = CHR$(0) + "P"
mb.w = 0
_DELAY .2
ELSE
IF oldmx% <> mx% OR oldmy% <> my% THEN
IF mx% >= ABS(fieldx%(tabx%)) AND mx% <= ABS(fieldx%(tabx%)) + field_size%(tabx%) - 1 THEN
IF my% > fieldy%(tabx%) AND my% <= fieldy%(tabx%) + 4 THEN
row = my% - fieldy%(tabx%)
GOSUB highlight_color
END IF
END IF
END IF
END IF
IF my% = up_arrowy%(tabx%) AND mx% = ABS(up_arrowx%(tabx%)) THEN
hover_arrow% = tabx%
iyy% = CSRLIN: ixx% = POS(0)
COLOR 14, 1: LOCATE up_arrowy%(tabx%), ABS(up_arrowx%(tabx%))
PRINT CHR$(30);
LOCATE iyy%, ixx%
ELSE
IF hover_arrow% THEN
iyy% = CSRLIN: ixx% = POS(0)
COLOR 11, 1: LOCATE up_arrowy%(tabx%), ABS(up_arrowx%(tabx%))
PRINT CHR$(30);
LOCATE iyy%, ixx%
END IF
END IF
GOSUB bdisplay
oldmx% = mx%: oldmy% = my%
LOOP
COLOR 7, 0
RETURN
' NESTED GOSUBS for font_color_open_dropdown -----------------------------
highlight_color:
IF hlf% THEN
LOCATE hlfy%, hlfx%
COLOR 7, 0
a1$ = SPACE$(field_size%(tabx%))
MID$(a1$, 1) = font_color$(hlf%)
PRINT a1$;
END IF
LOCATE fieldy%(tabx%) + row, ABS(fieldx%(tabx%))
a1$ = SPACE$(field_size%(tabx%))
MID$(a1$, 1) = font_color$(row)
hlf% = row: hlfy% = CSRLIN: hlfx% = POS(0)
COLOR 1, 3: PRINT a1$;: COLOR 7, 0
LOCATE fieldy%(tabx%) + row, ABS(fieldx%(tabx%))
RETURN ' END NESTED GOSUBS --------------------------------------------------------
font_type_open_dropdown:
up_arrowx%(tabx%) = -ABS(up_arrowx%(tabx%))
gen_var.vartable = 4: CALL setvariables(scrb, c1%, c2%, c1alt%, h1%, h2%, row, ins%, dwidth, dwidth2, menubar%, menuheightmax%)
smode% = 2
PCOPY 1, 2
SCREEN 0, 0, 2, 2
PALETTE 7, 63
i% = tabx%
COLOR 8, 0
LOCATE fieldy%(i%), ABS(fieldx%(i%)): PRINT MID$(entry$(tabx%), 1, field_size%(tabx%));
COLOR 11, 1
LOCATE fieldy%(i%) - 1, ABS(fieldx%(i%)) + field_size%(i%) + 1: PRINT CHR$(30);
LOCATE fieldy%(i%) + 1, ABS(fieldx%(i%)) - 1
FOR j% = 1 TO 5
COLOR 14, 1: PRINT CHR$(179);
COLOR 7, 0: PRINT SPACE$(field_size%(i%));
COLOR 1, 0: PRINT CHR$(222);
COLOR 14, 1: PRINT CHR$(179);
LOCATE fieldy%(i%) + j%, ABS(fieldx%(i%)) - 1
NEXT
PRINT CHR$(192); STRING$(field_size%(i%) + 1, 196); CHR$(217);
COLOR 7, 0
button_display$ = "off"
COLOR 11, 1
LOCATE fieldy%(i%) - 1, ABS(fieldx%(i%)) + field_size%(i%) + 1: PRINT CHR$(30);
LOCATE fieldy%(i%) + 1, ABS(fieldx%(i%)) - 1
FOR j% = 1 TO 7
COLOR 14, 1: PRINT CHR$(179);
COLOR 7, 0: PRINT SPACE$(field_size%(i%));
COLOR 1, 0: PRINT CHR$(222);
COLOR 14, 1: PRINT CHR$(179);
LOCATE fieldy%(i%) + j%, ABS(fieldx%(i%)) - 1
NEXT
PRINT CHR$(192); STRING$(field_size%(i%) + 1, 196); CHR$(217);
COLOR 7, 0
IF noe = 0 THEN
j% = 0
RESTORE font_types
DO
READ a1$
IF a1$ = "EOF" THEN EXIT DO
j% = j% + 1
REDIM _PRESERVE font_type$(j%)
font_type$(j%) = a1$
LOOP
noe = UBOUND(font_type$)
END IF
h% = 999: CALL scrollbar_update(h%, scrb, noe, row, scr)
h% = 1: CALL scrollbar_update(h%, scrb, noe, row, scr)
i% = tabx%
LOCATE fieldy%(i%) + 1, ABS(fieldx%(i%))
j% = 0
DO
j% = j% + 1
PRINT font_type$(j%);
IF j% = 6 THEN EXIT DO
LOCATE fieldy%(i%) + 1 + j%, ABS(fieldx%(i%))
LOOP
LOCATE fieldy%(i%) + 1, ABS(fieldx%(i%))
row = 1: scr = 0
GOSUB highlight_font
DO
_LIMIT 30
IF autokey$ = "" THEN b$ = INKEY$ ELSE b$ = autokey$: autokey$ = ""
IF LEN(b$) THEN
SELECT CASE b$
CASE CHR$(27)
GOSUB close_dropdown: EXIT DO
CASE CHR$(13)
GOSUB close_dropdown
entry$(tabx%) = font_type$(scr + row)
a1$ = SPACE$(field_size%(tabx%))
MID$(a1$, 1) = font_type$(scr + row)
LOCATE fieldy%(tabx%), ABS(fieldx%(tabx%))
COLOR 7, 0
PRINT a1$;
EXIT DO
CASE "a" TO "z", "A" TO "Z"
IF noe > 0 THEN
DO
b$ = UCASE$(b$)
IF b$ = oldb$ AND scr + 2 <= noe THEN ' Step through same first letter files.
IF UCASE$(LEFT$(font_type$(scr + 2), 1)) = b$ AND scr + page.h < noe THEN
scr = scr + 1
row = 1: GOSUB scrollfonts
END IF
EXIT DO
ELSE
oldb$ = b$
END IF
i% = 0
DO
IF i% = noe THEN EXIT DO
i% = i% + 1
x$ = UCASE$(MID$(font_type$(i%), 1, 1))
IF b$ <= x$ AND x$ >= "A" AND x$ <= "Z" THEN EXIT DO
IF x$ <> oldx$ THEN oldx$ = x$: j% = i%
LOOP
IF b$ = x$ THEN
scr = i% - 1
IF scr + page.h > noe THEN scr = noe - page.h
row = 1: GOSUB scrollfonts
ELSEIF b$ < x$ THEN
oldb$ = "" ' No exact match so disable step option.
scr = j% - 1
IF scr + page.h > noe THEN scr = noe - page.h
row = 1: GOSUB scrollfonts
END IF
EXIT DO
LOOP
END IF
CASE CHR$(0) + "H"
IF row > 1 THEN
row = row - 1
GOSUB highlight_font
ELSE
scr = scr - 1
GOSUB scrollfonts
END IF
CASE CHR$(0) + "P"
IF row < page.h THEN
row = row + 1
GOSUB highlight_font
ELSE
IF scr < noe - page.h THEN
scr = scr + 1
GOSUB scrollfonts
END IF
END IF
CASE CHR$(0) + "I"
k% = page.h - 1
IF scr - k% >= 0 THEN scr = scr - k% ELSE scr = 0
GOSUB scrollfonts
CASE CHR$(0) + "Q"
k% = page.h - 1
IF scr + k% <= noe - page.h THEN scr = scr + k% ELSE scr = noe - page.h
GOSUB scrollfonts
CASE CHR$(0) + "w"
scr = 0:: row = 1
GOSUB scrollfonts
CASE CHR$(0) + "u"
scr = noe - page.h: row = page.h
GOSUB scrollfonts
END SELECT
ELSE
GOSUB poll_mouse
END IF
IF mb.l AND l_click% = 0 THEN
IF my% >= fieldy%(tabx%) AND my% <= fieldy%(tabx%) + 6 THEN
IF mx% >= ABS(fieldx%(tabx%)) AND mx% <= ABS(fieldx%(tabx%)) + field_size%(tabx%) - 1 THEN
GOSUB close_dropdown
IF my% <> fieldy%(tabx%) THEN
entry$(tabx%) = font_type$(scr + row)
a1$ = SPACE$(field_size%(tabx%))
MID$(a1$, 1) = font_type$(scr + row)
LOCATE fieldy%(tabx%), ABS(fieldx%(tabx%))
COLOR 7, 0
PRINT a1$;
END IF
EXIT DO
END IF
END IF
END IF
IF my% = yclose% AND mx% = ABS(xclose%) THEN
IF mb.l AND l_click% = 0 OR mb.l AND autoclick% THEN GOSUB close_x
END IF
GOSUB audit_close_x
' Scrollbar routine.
IF mb.l THEN
IF my% = up_arrowy%(tabx%) AND mx% = ABS(up_arrowx%(tabx%)) THEN
GOSUB close_dropdown
EXIT DO
END IF
IF mx% >= scrb.l - 1 AND mx% <= scrb.l + 1 AND my% - (scrb.t + 1) >= scrb.x AND my% - (scrb.t + 1) <= scrb.x + scrb.s - 1 THEN draglock% = -1
IF draglock% = -1 AND my% > scrb.t AND my% < scrb.b OR mx% = scrb.l AND scrb.s <> 0 AND my% >= scrb.t AND my% <= scrb.b AND mb.w = 0 OR scrbardrag% AND my% > scrb.t AND my% < scrb.b AND mb.w = 0 THEN ' Mouse on scrollbar, doing a bar cursor drag.
gen_var.locked = 2 ' Locked on scrollbar
IF my% = scrb.t AND scrb.x = 0 OR my% = scrb.b AND scrb.x + scrb.s = scrb.h THEN ' Mouse on a scrollbar arrow.
IF my% = scrb.t THEN scrb.i = 0 ELSE scrb.i = noe - page.h
scr = scrb.i
h% = 0: CALL scrollbar_update(h%, scrb, noe, row, scr) ' Positions scrollbar box.
GOSUB scrollfonts
ELSEIF my% = scrb.t AND scrb.x > 0 OR my% = scrb.b AND scrb.x + scrb.s <= scrb.h THEN ' Mouse on a scrollbar arrow.
IF my% = scrb.t AND mb.w = 0 THEN
IF scrb.x > 0 THEN scrb.x = scrb.x - 1: h% = -1 ' Top arrow
ELSE
scrb.x = scrb.x + 1: h% = -2 ' Bottom arrow.
END IF
IF mb.w = 0 THEN delay.on! = .15
j% = INT(scrb.x * ((noe - scrb.d) / (scrb.h - scrb.s)))
IF j% >= 0 AND j% <= noe - page.h THEN ' Condition exists unless j% is negative such as doc is blank and mouse wheel is rolled downward.
scrb.i = j%
scr = scrb.i
h% = 0: CALL scrollbar_update(h%, scrb, noe, row, scr) ' Positions scrollbar box.
GOSUB scrollfonts
END IF
ELSEIF my% - (scrb.t + 1) >= scrb.x AND my% - (scrb.t + 1) <= scrb.x + scrb.s - 1 AND scrbardrag% = 0 THEN ' Mouse on scrollbar block.
scrbardrag% = -1: scrb.adjust = (my% - (scrb.t + 1)) - scrb.x
ELSEIF draglock% = -1 AND my% > scrb.t AND my% < scrb.b OR my% > scrb.t AND my% < scrb.b THEN ' Mouse on scrollbar between scrollbar arrow and cursor.
IF draglock% = -1 AND my% > scrb.t AND my% < scrb.b OR my% - (scrb.t + 1) - scrb.adjust >= 0 AND my% - (scrb.t + 1) + scrb.s - scrb.adjust <= scrb.h AND scrbardrag% <> -1 OR scrbardrag% = 0 THEN
IF scrbardrag% = 0 THEN ' No drag, so adjust for cursor length for a click inside the scrollbar above or below the current scrollbar cursor position.
IF my% - (scrb.t + 1) > scrb.x THEN
scrb.adjust = (my% - (scrb.t + 1)) - scrb.x - 1: h% = -1
ELSE
scrb.adjust = (my% - (scrb.t + 1)) - scrb.x + 1: h% = -2
END IF
END IF
scrb.x = my% - (scrb.t + 1) - scrb.adjust
scrb.i = INT(scrb.x * ((noe - scrb.d) / (scrb.h - scrb.s)))
scr = scrb.i
h% = 0: CALL scrollbar_update(h%, scrb, noe, row, scr)
GOSUB scrollfonts
IF delay.on! THEN ' Scrollbar delay.
_DELAY delay.on!
delay.on! = 0 ' Toggle off.
END IF
ELSE ' Scrollbar is at top or bottom and mouse cursor is moving vertically along the scrollbar cursor. This allows the variable to readjust.
IF mx% = scrb.l THEN scrbardrag% = 0: scrb.adjust = 0: draglock% = 0
END IF
END IF
' =======================================================
END IF
_DELAY .2
ELSEIF mb.w THEN
IF mb.w > 0 THEN autokey$ = CHR$(0) + "Q"
IF mb.w < 0 THEN autokey$ = CHR$(0) + "I"
mb.w = 0
_DELAY .2
scrbardrag% = 0: scrb.adjust = 0: draglock% = 0
IF gen_var.locked = 2 AND mb.l = 0 THEN gen_var.locked = 0
ELSE
scrbardrag% = 0: scrb.adjust = 0: draglock% = 0
IF gen_var.locked = 2 AND mb.l = 0 THEN gen_var.locked = 0
IF oldmx% <> mx% OR oldmy% <> my% THEN
IF mx% >= ABS(fieldx%(tabx%)) AND mx% <= ABS(fieldx%(tabx%)) + field_size%(tabx%) - 1 THEN
IF my% > fieldy%(tabx%) AND my% <= fieldy%(tabx%) + 6 THEN
row = my% - fieldy%(tabx%)
GOSUB highlight_font
END IF
END IF
END IF
END IF
IF my% = up_arrowy%(tabx%) AND mx% = ABS(up_arrowx%(tabx%)) THEN
hover_arrow% = tabx%
iyy% = CSRLIN: ixx% = POS(0)
COLOR 14, 1: LOCATE up_arrowy%(tabx%), ABS(up_arrowx%(tabx%))
PRINT CHR$(30);
LOCATE iyy%, ixx%
ELSE
IF hover_arrow% THEN
iyy% = CSRLIN: ixx% = POS(0)
COLOR 11, 1: LOCATE up_arrowy%(tabx%), ABS(up_arrowx%(tabx%))
PRINT CHR$(30);
LOCATE iyy%, ixx%
END IF
END IF
oldmx% = mx%: oldmy% = my%
GOSUB bdisplay
LOOP
RETURN
' NESTED GOSUB for font_type_open_dropdown ------------------------------
scrollfonts:
COLOR 7, 0
IF scr < 0 THEN scr = 0 ' Precaution.
FOR i% = 1 TO page.h
IF i% + scr > noe THEN EXIT FOR
LOCATE fieldy%(tabx%) + i%, ABS(fieldx%(tabx%))
a1$ = SPACE$(field_size%(tabx%))
MID$(a1$, 1) = font_type$(i% + scr)
IF i% = row THEN
COLOR 1, 3
hlf% = row + scr: hlfy% = CSRLIN: hlfx% = POS(0)
ELSE
COLOR 7, 0
END IF
PRINT a1$;
NEXT
LOCATE fieldy%(tabx%) + row, ABS(fieldx%(tabx%))
h% = 1: CALL scrollbar_update(h%, scrb, noe, row, scr)
RETURN
print_page_num:
iyy% = CSRLIN: ixx% = POS(0)
IF entry$(i%) = "off" THEN entry$(i%) = "on" ELSE entry$(i%) = "off"
COLOR 8, 0
LOCATE fieldy%(i%), ABS(fieldx%(i%))
IF entry$(i%) = "on" THEN PRINT CHR$(254); ELSE PRINT " ";
COLOR 7, 0
LOCATE iyy%, ixx%
RETURN
reset_values:
GOSUB bdisplay: _DELAY .1
SOUND 1000, .1
GOSUB bhover
GOSUB starting_values
RETURN
print_doc:
REDIM twips%(4)
GOSUB bdisplay: _DELAY .1
SOUND 1000, .1
GOSUB bhover
_DELAY .5
CLS
margin_rtf$ = "\viewkind4\uc1\pard\"
REDIM twips%(4)
FOR i% = 1 TO nof%
SELECT CASE i%
CASE 1, 2
IF VAL(entry$(i%)) > 1.25 THEN
twips%(i%) = VAL(entry$(i%)) * 1440 - 1800
IF i% = 1 THEN
margin_rtf$ = margin_rtf$ + "margt" + LTRIM$(STR$(twips%(i%))) + "\"
ELSE
margin_rtf$ = margin_rtf$ + "margb" + LTRIM$(STR$(twips%(i%))) + "\"
END IF
END IF
CASE 3, 4
IF VAL(entry$(i%)) > 1.00 THEN
twips%(i%) = VAL(entry$(i%)) * 1440 - 1440
IF i% = 3 THEN
margin_rtf$ = margin_rtf$ + "li" + LTRIM$(STR$(twips%(i%))) + "\"
ELSE
margin_rtf$ = margin_rtf$ + "ri" + LTRIM$(STR$(twips%(i%))) + "\"
END IF
END IF
CASE 5
fontsize% = VAL(entry$(i%)) * 2
fontsize_rtf$ = "sa200\sl276\slmult1\cf1\fs" + LTRIM$(STR$(fontsize%)) + "\lang9 "
CASE 6
SELECT CASE LCASE$(entry$(i%))
CASE "black"
fontcolor_rtf$ = "{\colortbl ;\red0\green0\blue0;}"
CASE "red"
fontcolor_rtf$ = "{\colortbl ;\red255\green0\blue0;}"
CASE "blue"
fontcolor_rtf$ = "{\colortbl ;\red0\green0\blue255;}"
CASE "green"
fontcolor_rtf$ = "{\colortbl ;\red0\green255\blue0;}"
CASE "grey"
fontcolor_rtf$ = "{\colortbl ;\red102\green102\blue102;}"
END SELECT
CASE 7
fonttype_rtf$ = "{\rtf1\ansi\ansicpg1252\deff0\nouicompat\deflang1033{\fonttbl{\f0\fnil\fcharset0 " + entry$(i%) + ";}}"
CASE 8
IF entry$(i%) = "on" THEN printpagefooter$ = "{\field{\*\fldinst PAGE}{\fldrslt 1}}" ELSE printpagefooter$ = ""
END SELECT
NEXT
header$ = fonttype_rtf$ + fontcolor_rtf$ + margin_rtf$ + fontsize_rtf$
footer$ = "\cf0\f1\fs22\par}" + printpagefooter$
CLS
PRINT header$
PRINT "Your text goes here!"
PRINT footer$
_CLIPBOARD$ = header$ + "Your text here!" + footer$
END ''''''''''''''''''''''''''
RETURN
highlight_font:
IF hlf% THEN
LOCATE hlfy%, hlfx%
COLOR 7, 0
a1$ = SPACE$(field_size%(tabx%))
MID$(a1$, 1) = font_type$(hlf%)
PRINT a1$;
END IF
LOCATE fieldy%(tabx%) + row, ABS(fieldx%(tabx%))
a1$ = SPACE$(field_size%(tabx%))
MID$(a1$, 1) = font_type$(row + scr)
hlf% = row + scr: hlfy% = CSRLIN: hlfx% = POS(0)
COLOR 1, 3: PRINT a1$;: COLOR 7, 0
LOCATE fieldy%(tabx%) + row, ABS(fieldx%(tabx%))
RETURN ' END NESTED GOSUBS --------------------------------------------------------
poll_mouse:
IF mb.l AND l_click% = 0 THEN l_click% = -1
mb.w = 0
WHILE _MOUSEINPUT
mb.w = mb.w + _MOUSEWHEEL
WEND
IF mb.w = 0 THEN
mx% = _MOUSEX ' Mouse column.
my% = _MOUSEY ' Mouse row.
mb.l = _MOUSEBUTTON(1)
mb.r = _MOUSEBUTTON(2)
mb.m = _MOUSEBUTTON(3)
END IF
IF mb.l = 0 AND l_click% THEN l_click% = 0
RETURN
close_dropdown:
smode% = 1
SCREEN 0, 0, 1, 1
up_arrowx%(tabx%) = ABS(up_arrowx%(tabx%))
IF button_display$ = "off" THEN button_display$ = "on"
hlf% = 0: hlfx% = 0: hlfy% = 0
COLOR 7, 0
RETURN
audit_close_x:
IF my% = yclose% AND mx% = xclose% THEN
iyy% = CSRLIN: ixx% = POS(0)
COLOR 15, 4: LOCATE yclose%, xclose%: PRINT "x";
xclose% = -xclose%
LOCATE iyy%, ixx%
END IF
IF xclose% < 0 THEN
IF my% <> yclose% OR mx% <> ABS(xclose%) THEN
xclose% = ABS(xclose%)
iyy% = CSRLIN: ixx% = POS(0)
COLOR 7, 1: LOCATE yclose%, xclose%: PRINT "x";
LOCATE iyy%, ixx%
COLOR 7, 0
END IF
END IF
RETURN
close_x:
SOUND 1000, .1
xclose% = ABS(xclose%)
COLOR 15, 1
LOCATE yclose%, xclose%
PRINT "x";
GOSUB bdisplay
_DELAY .15
COLOR 7, 0
SYSTEM ''''''''''''
RETURN
END SUB
SUB font_size_setup (ENL%)
IF displayfullscreen% = -1 THEN EXIT SUB
WINXX1% = CSRLIN: WINYY1% = POS(1)
winmode$ = "2"
IF ENL% <> 0 THEN
full = _FULLSCREEN
IF full = 0 THEN
SELECT CASE ENL%
CASE -1: IF SCRNSIZE% > 0 THEN ELSE EXIT SUB
CASE 1: IF SCRNSIZE% < 14 THEN ELSE EXIT SUB
END SELECT
ELSE
EXIT SUB
END IF
END IF
SCRNSIZE% = SCRNSIZE% + ENL%
SELECT CASE winmode$
CASE "1"
full = _FULLSCREEN
IF full <> 0 THEN _FULLSCREEN _OFF
GOSUB ChangeFont
CASE "2"
full = _FULLSCREEN
IF full <> 0 THEN _FULLSCREEN _OFF
style$ = "MONOSPACE"
fontsize% = SCRNSIZE% + 13
IF fontsize% < 14 THEN winmode$ = ""
IF fontsize% < 18 THEN style$ = style$ + ", BOLD"
fontpath$ = ENVIRON$("SYSTEMROOT") + "\fonts\lucon.ttf" 'Find Windows Folder Path.
GOSUB ChangeFont
CASE "3"
GOSUB ChangeFont
_FULLSCREEN _SQUAREPIXELS
full = _FULLSCREEN
IF full = 0 THEN GOSUB nofull
CASE "4"
GOSUB ChangeFont
_FULLSCREEN _STRETCH
full = _FULLSCREEN
IF full = 0 THEN GOSUB nofull
END SELECT
LOCATE WINXX1%, WINYY1%
EXIT SUB
nofull:
_FULLSCREEN _OFF
RETURN
ChangeFont:
IF winmode$ <> "2" THEN
_FONT 16 ' Inbuilt 8x16 default font.
currentf& = _FONT
ELSE
currentf& = _LOADFONT(fontpath$, fontsize%, style$)
_FONT currentf&
END IF
IF currentf& <> f& AND f& <> defaultf& THEN _FREEFONT f&
f& = currentf&
RETURN
END SUB
SUB popup (msg$, msg%, button$(), button%, button_index%, text$, config%, mydelay%, mx%, my%, xclose%, yclose%)
DIM scrb AS my_scrb
SELECT CASE fndrep.find_or_replace
CASE 0 ' Message box only like exit. Find / Replace are cases 1 and 2.
REDIM ifield$(0)
CASE 1
config% = 2 ' Find
REDIM ifield$(1)
REDIM entry$(1)
msg$ = ""
fndrep.ifield = 48 ' Input field length.
ifield$(1) = "Find:"
button% = 4: button_index% = 4
gen_var.w1 = 0: gen_var.w2 = 0: gen_var.w3 = 0: gen_var.w4 = 0
fndrep.noif = 1
CASE 2
config% = 3 ' Find / Replace
REDIM ifield$(2)
REDIM entry$(2)
msg$ = ""
fndrep.ifield = 48
ifield$(1) = " Find:"
ifield$(2) = "Replace:"
button% = 4: button_index% = 4
gen_var.w1 = 0: gen_var.w2 = 0: gen_var.w3 = 7: gen_var.w4 = 0
fndrep.noif = 2
END SELECT
iyy% = CSRLIN: ixx% = POS(0)
SELECT CASE msg%
CASE -2
IF gen_var.w3 = 0 THEN gen_var.w3 = 3 ' Min.
CASE ELSE
REDIM button$(8), ifieldyy%(fndrep.noif), ifieldxx%(fndrep.noif)
button$(1) = "Yes": button$(2) = "No!"
button$(3) = "Retry": button$(4) = "Cancel"
button$(5) = "Whole Word": button$(6) = "Whole/Case": button$(7) = "Any Part": button$(8) = "Any/Case"
IF gen_var.w3 = 0 THEN gen_var.w3 = 5 ' Min.
END SELECT
IF gen_var.w4 = 0 THEN ' Calculate form container width
IF fndrep.find_or_replace = 0 THEN
gen_var.w4 = LEN(msg$) + 4 ' Min
ELSE
FOR i% = 1 TO UBOUND(ifield$)
IF LEN(ifield$(i%)) + fndrep.ifield > gen_var.w4 THEN gen_var.w4 = LEN(ifield$(i%)) + fndrep.ifield + 6
NEXT
END IF
END IF
IF gen_var.w1 = 0 THEN
' Auto-Center
gen_var.w1 = _HEIGHT \ 2 - gen_var.w3 \ 2 + .5
gen_var.w2 = _WIDTH \ 2 - gen_var.w4 \ 2 + .5
END IF
SELECT CASE gen_var.smode
CASE 0
oldsmode% = gen_var.smode: PCOPY 0, 1: SCREEN 0, 0, 1, 1: gen_var.smode = 1
CASE 1
oldsmode% = gen_var.smode: PCOPY 1, 2: SCREEN 0, 0, 2, 2: gen_var.smode = 2
END SELECT
PALETTE 7, 63
LOCATE gen_var.w1, gen_var.w2, 0 ' Cursor hide
FOR i = 1 TO gen_var.w3
A$ = ""
COLOR 15, 1
LOCATE , gen_var.w2
A$ = A$ + SPACE$(gen_var.w4 - LEN(A$))
PRINT A$;
IF i <> 1 THEN
COLOR 1, 0: PRINT CHR$(176)
ELSE PRINT
END IF
NEXT i
LOCATE , gen_var.w2 + 1
COLOR 1, 0: PRINT STRING$(gen_var.w4, CHR$(176));
COLOR 14, 1
LOCATE gen_var.w1, gen_var.w2
PRINT CHR$(218); STRING$(gen_var.w4 - 2, CHR$(196)); CHR$(191);
LOCATE gen_var.w1 + gen_var.w3 - 1, gen_var.w2
PRINT CHR$(192); STRING$(gen_var.w4 - 2, CHR$(196)); CHR$(217);
FOR i = 1 TO gen_var.w3 - 2
LOCATE gen_var.w1 + i, gen_var.w2: PRINT CHR$(179);: LOCATE gen_var.w1 + i, gen_var.w2 + gen_var.w4 - 1: PRINT CHR$(179);
NEXT i
'''''''''''''
IF msg% <> -2 THEN
LOCATE gen_var.w1, gen_var.w2 + gen_var.w4 - 2: COLOR 15, 1
yclose% = CSRLIN: xclose% = POS(0): PRINT "x";
END IF
IF LEN(msg$) OR fndrep.noif THEN
SELECT CASE msg%
CASE -2 ' Flash Message.
LOCATE gen_var.w1 + 1, gen_var.w2 + gen_var.w4 \ 2 - LEN(msg$) \ 2
PRINT msg$;
CASE -1 ' Message title.
LOCATE gen_var.w1 + 1, gen_var.w2 + gen_var.w4 \ 2 - LEN(msg$) \ 2
PRINT msg$;
IF button% THEN GOSUB button_actions ' Yes / No would go here but save as does not use this button system, and would bypass this condition.
CASE 0 ' No message title. Usually used with input fields with limited vertical space.
IF fndrep.noif THEN
fndrep.ifrow = 1
IF UBOUND(ifield$) > 1 THEN i% = 2: j% = UBOUND(ifield$) ELSE i% = 0: j% = 1 ' Where 2 is the spacing between input fields.
FOR g% = 1 TO UBOUND(ifield$)
LOCATE gen_var.w1 + gen_var.w3 \ 2 - j% + i% * (g% - 1), gen_var.w2 + gen_var.w4 \ 2 - (fndrep.ifield + LEN(ifield$(g%)) + 2) \ 2
ifieldyy%(g%) = CSRLIN: ifieldxx%(g%) = POS(0) + LEN(ifield$(g%)) + 1 ' Start of text input line.
COLOR 15, 1: PRINT ifield$(g%);
COLOR 8, 1: PRINT CHR$(222);
COLOR c2%, c1%: PRINT SPACE$(fndrep.ifield);
NEXT
passrightmargin% = POS(0) - 1 ' Sets right margin of the find input field.
END IF
IF button% THEN
GOSUB button_actions
ELSE ' No buttons present.
LOCATE gen_var.w1 + gen_var.w3 \ 2, gen_var.w2 + gen_var.w4 \ 2 - LEN(msg$) \ 2
PRINT msg$;
END IF
END SELECT
END IF
LOCATE iyy%, ixx%
button% = 0 ' Reset buttons.
_KEYCLEAR
IF mydelay% THEN ' Sending to printer...
gen_var.action = "" ' Finished gen_var.action = "print" one of two.
_DELAY mydelay%: mydelay% = 0
gen_var.smode = oldsmode%: SCREEN 0, 0, gen_var.smode, gen_var.smode: COLOR 0, 7
END IF
EXIT SUB
clear_button:
COLOR 0, 7
LOCATE buttonyy%, INSTR(mouselocator$, LTRIM$(STR$(h%)))
PRINT SPACE$(1) + button$(h% + button_index%) + SPACE$(1);
RETURN
tab_and_enter_fields:
DO
IF tabx% = 0 AND fndrep.ifrow > 0 AND fndrep.ifrow <= UBOUND(ifield$) OR tabx% = button% AND fndrep.ifrow OR LEN(gen_var.action) AND fndrep.ifrow THEN
IF tabx% = button% THEN ' Last tab button is highlighted. Go back to input fields.
h% = button%: GOSUB clear_button
IF fndrep.ifrow THEN ' Only for popups with input line(s).
entry$(fndrep.ifrow) = text$
tabx% = 0
IF fndrep.ifrow = UBOUND(ifield$) THEN fndrep.ifrow = 1 ELSE fndrep.ifrow = fndrep.ifrow + 1
text$ = entry$(fndrep.ifrow): _KEYCLEAR
LOCATE ifieldyy%(fndrep.ifrow), ifieldxx%(fndrep.ifrow), 1
END IF
b$ = ""
EXIT DO
END IF
' Remove any highlighting.
IF UBOUND(ifield$) >= 1 THEN
LOCATE ifieldyy%(fndrep.ifrow), ifieldxx%(fndrep.ifrow), 0
COLOR 7, 0
PRINT SPACE$(fndrep.ifield);
LOCATE ifieldyy%(fndrep.ifrow), ifieldxx%(fndrep.ifrow)
PRINT MID$(text$, 1, fndrep.ifield);
entry$(fndrep.ifrow) = text$
IF fndrep.ifrow + 1 > UBOUND(ifield$) THEN
tabx% = 1 ' To reloop.
entry$(fndrep.ifrow) = text$
ELSE
entry$(fndrep.ifrow) = text$
fndrep.ifrow = fndrep.ifrow + 1
text$ = entry$(fndrep.ifrow): _KEYCLEAR
LOCATE ifieldyy%(fndrep.ifrow), ifieldxx%(fndrep.ifrow), 1
b$ = ""
EXIT DO
END IF
END IF
EXIT DO
ELSE
tabx% = tabx% + 1
IF tabx% > button% AND fndrep.ifrow = 0 THEN tabx% = 1 ' No input fields.
EXIT DO
END IF
LOOP
RETURN
button_actions:
buttonyy% = CSRLIN + 2
j% = 0
FOR i% = 1 TO button%
j% = j% + LEN(button$(button_index% + i%)) + 2
NEXT
LOCATE buttonyy%, gen_var.w2 + gen_var.w4 \ 2 - j% \ 2 - 1
COLOR 0, 7
mouselocator$ = STRING$(_WIDTH, "0"): mouselocator% = buttonyy%
k% = 0
FOR i% = button_index% + 1 TO button_index% + button%
IF k% THEN LOCATE , POS(0) + 2
k% = k% + 1
MID$(mouselocator$, POS(0)) = STRING$(LEN(button$(i%)) + 2, LTRIM$(STR$(k%)))
PRINT SPACE$(LEN(button$(i%)) + 2);
NEXT
LOCATE buttonyy%, gen_var.w2 + gen_var.w4 \ 2 - j% \ 2
COLOR 0, 7
k% = 0
' Prints names on buttons.
FOR i% = button_index% + 1 TO button_index% + button%
IF k% THEN LOCATE buttonyy%, POS(0) + 4
PRINT button$(i%);
k% = k% + 1
NEXT
IF fndrep.find_or_replace THEN
LOCATE ifieldyy%(fndrep.ifrow), ifieldxx%(fndrep.ifrow), 1
tabx% = 0
_KEYCLEAR: text$ = ""
END IF
' <--------------------------
gen_var.action = "" ' Removes all gen_var.action conditions. Waits for new actions assigned by button selection.
DO
IF fndrep.find_or_replace THEN
inputfieldyy% = CSRLIN: inputfieldxx% = POS(0)
'''CALL textinput(text$, passrightmargin%, mykey%, doctype_full$, inputline%, fav$(), favy%(), favx%(), doctype$(), doctype%, doctypey%(), doctypex%(), x$(), xfull$(), scrb, noe, row, scr, config%, b$, mx%, my%, doc_title$)
ELSE
'''CALL user(b$, mx%, my%, alt%, shift%, ctrl%, ctrlshift%, con_panel%, doc_title$, doc_saved%, scrb, scrbscrbardrag%, x$(), noe, scr, ins%, dwidth)
END IF
IF LEN(b$) THEN
SELECT CASE b$
CASE CHR$(13)
IF fndrep.find_or_replace THEN
GOSUB tab_and_enter_fields
IF LEN(b$) THEN ' b$ can be made null in the gosub above. This occurs when there are still more fields to fill in.
SELECT CASE tabx%
CASE 1
fndrep.find_action = "Whole Word"
CASE 2
fndrep.find_action = "Whole/Case"
' Find Function only.
CASE 0, 3
fndrep.find_action = "Any Part"
CASE 4
fndrep.find_action = "Any/Case"
END SELECT
END IF
ELSE
SELECT CASE tabx%
CASE 1
IF button_index% = 0 THEN gen_var.action = "yes"
IF button_index% = 2 THEN gen_var.action = "retry"
CASE 2
IF button_index% = 0 THEN gen_var.action = "no"
IF button_index% = 2 THEN gen_var.action = "abort" ' Note: Button says cancel, but gen_var.action needs to be different to get a specific program flow.
END SELECT
END IF
CASE CHR$(27)
gen_var.action = "close"
IF LEN(fndrep.find_action) THEN fndrep.find_action = "" ' Remove whole, part, etc. find designations with esc key.
END SELECT
END IF
IF LEN(gen_var.action) THEN EXIT DO '------------------------------->
IF my% = gen_var.w1 AND mx% = gen_var.w2 + gen_var.w4 - 2 THEN ' Mouse located on the x button for the Find / Replace popup.
IF closex% = 0 THEN closex% = -1: xx1% = CSRLIN: yy1% = POS(0): LOCATE my%, mx%: COLOR 15, 4: PRINT "x";: LOCATE xx1%, yy1%
ELSE
IF closex% THEN closex% = 0: xx1% = CSRLIN: yy1% = POS(0): LOCATE gen_var.w1, gen_var.w2 + gen_var.w4 - 2: COLOR 7, 1: PRINT "x";: LOCATE xx1%, yy1%
END IF
IF bhl% THEN IF bhl% = 1 AND my% <> mouselocator% OR bhl% = 1 AND MID$(mouselocator$, mx%, 1) = "0" THEN tabx% = 0: bhl% = 0
IF b$ = CHR$(9) THEN GOSUB tab_and_enter_fields
IF oldmx% = mx% AND oldmy% = my% THEN i% = 0 ELSE i% = -1 ' Mouse has moved.
IF b$ = CHR$(9) OR my% = mouselocator% AND MID$(mouselocator$, mx%, 1) <> "0" AND i% THEN
IF b$ = CHR$(9) THEN k% = tabx%: bhl% = 9 ELSE k% = VAL(MID$(mouselocator$, mx%, 1)): tabx% = k%: bhl% = 1
IF fndrep.find_or_replace THEN LOCATE , , 0 ' Hide cursor while making buttons.
IF h% AND h% <> tabx% THEN
entry$(fndrep.ifrow) = text$
GOSUB clear_button
END IF
h% = k%: tabx% = h%
COLOR 0, 3
LOCATE buttonyy%, INSTR(mouselocator$, LTRIM$(STR$(h%)))
PRINT SPACE$(1) + button$(h% + button_index%) + SPACE$(1);
IF fndrep.find_or_replace THEN LOCATE inputfieldyy%, inputfieldxx%
_DELAY .15
ELSE
IF h% AND tabx% = 0 THEN
iyy% = CSRLIN: ixx% = POS(0)
IF fndrep.find_or_replace THEN LOCATE , , 0
COLOR 0, 7
LOCATE buttonyy%, INSTR(mouselocator$, LTRIM$(STR$(h%)))
PRINT SPACE$(1) + button$(h% + button_index%) + SPACE$(1);
LOCATE iyy%, ixx%
h% = 0: tabx% = 0
END IF
END IF
IF mb.l THEN
IF closex% THEN
IF LEN(fndrep.find_action) THEN fndrep.find_action = "" ' Remove whole, part, etc. find designations with x mouse click.
SOUND 1000, .1: closex% = 0
gen_var.action = "close" ' This will be changed later to "close retry" for 3rd level popups like file already exists. Overwrite?
END IF
IF my% = mouselocator% AND MID$(mouselocator$, mx%, 1) <> "0" THEN
SOUND 1000, .1
SELECT CASE VAL(MID$(mouselocator$, mx%, 1))
CASE 1
IF button_index% = 0 THEN gen_var.action = "yes"
IF button_index% = 2 THEN gen_var.action = "retry"
IF button_index% = 4 THEN
IF config% = 2 THEN gen_var.action = "find"
IF config% = 3 THEN gen_var.action = "replace"
fndrep.find_action = "Whole Word": GOSUB tab_and_enter_fields ' F3 Find option.
END IF
CASE 2
IF button_index% = 0 THEN gen_var.action = "no"
IF button_index% = 2 THEN gen_var.action = "abort"
IF button_index% = 4 THEN
IF config% = 2 THEN gen_var.action = "find"
IF config% = 3 THEN gen_var.action = "replace"
fndrep.find_action = "Whole/Case": GOSUB tab_and_enter_fields ' F3 Find option.
END IF
' Find Function only.
CASE 3
IF button_index% = 4 THEN
IF config% = 2 THEN gen_var.action = "find"
IF config% = 3 THEN gen_var.action = "replace"
fndrep.find_action = "Any Part": GOSUB tab_and_enter_fields ' F3 Find option.
END IF
CASE 4
IF button_index% = 4 THEN
IF config% = 2 THEN gen_var.action = "find"
IF config% = 3 THEN gen_var.action = "replace"
fndrep.find_action = "Any/Case": GOSUB tab_and_enter_fields ' F3 Find option.
END IF
END SELECT
END IF
IF mb.l AND fndrep.noif > 1 THEN
IF mx% >= ifieldxx%(1) AND mx% <= ifieldxx%(1) + fndrep.ifield AND my% >= ifieldyy%(1) AND my% <= ifieldyy%(UBOUND(ifield$)) THEN
entry$(fndrep.ifrow) = text$
fndrep.ifrow = 0
FOR i% = 1 TO UBOUND(ifield$)
IF my% = ifieldyy%(i%) THEN fndrep.ifrow = i%: EXIT FOR
NEXT
'''''''''''''''''''''''''''
' IMPORTANT: THIS ERRORED ONCE, BUT I WAS UNABLE TO EASILY REPEAT IT.
IF fndrep.ifrow = 0 THEN CLS: PRINT "Error in fndrep.ifrow.": END '''
IF mx% <= ifieldxx%(fndrep.ifrow) + LEN(text$) THEN LOCATE my%, mx%, 1 ELSE LOCATE my%, ifieldxx%(fndrep.ifrow) + LEN(text$)
text$ = entry$(fndrep.ifrow)
END IF
END IF
END IF
IF b$ = CHR$(9) THEN b$ = "" ' Note: b$ = "" may not be necessary but works as a precaution.
oldmy% = my%: oldmx% = mx%
LOOP UNTIL LEN(gen_var.action) ' Note: A 2nd exit do with len(gen_var.action) is present in the inkey portion of this loop.
gen_var.smode = oldsmode%: SCREEN 0, 0, gen_var.smode, gen_var.smode: COLOR 0, 7
RETURN
END SUB
FUNCTION Button_HW (wide, tall, r, g, b, rc, gc, bc, caption$)
' Button function courtesy of the Amazing Steve.
DIM k AS _UNSIGNED LONG, d AS _UNSIGNED LONG, bg AS _UNSIGNED LONG, t AS _UNSIGNED LONG
Dest = _DEST
t = _NEWIMAGE(wide, tall, 32)
_DEST t
FOR i = 0 TO 10
rm = rm + rc
gm = gm + gc
bm = bm + bc
k = _RGB32(r + rm, g + gm, b + bm)
LINE (x + i, y + i)-(x + wide - i, y + tall - i), k, B
NEXT
PAINT (x + i, y + i), k
COLOR _RGB32(r, g, b), 0
_PRINTSTRING (x + (wide - _PRINTWIDTH(caption$)) / 2, y + (tall - _FONTHEIGHT) / 2), caption$
Button_HW = _COPYIMAGE(t, 33)
_FREEIMAGE t
_DEST Dest
END SUB
SUB setvariables (scrb AS my_scrb, c1%, c2%, c1alt%, h1%, h2%, row, ins%, dwidth, dwidth2, menubar%, menuheightmax%)
menubar% = 1 ' Menu bar location.
SELECT CASE gen_var.vartable
CASE 1 ' Text Editor
margin.t = 2
margin.b = 1
margin.l = 2
margin.r = 3
ins% = 7
ovm% = 1 ' Change this to 0 for no over margin cursoring. 0 needed if right margin is at edge of screen.
c1% = 0: c2% = 7: h1% = 15: h2% = 1 ' Normal text and highlighted text colors.
scrn.w = _WIDTH
scrn.h = _HEIGHT
page.w = scrn.w - (margin.l + margin.r)
page.h = scrn.h - (margin.t + margin.b)
scrb.t = margin.t + 1
scrb.b = margin.t + page.h
scrb.l = margin.l + page.w + 2
scrb.d = scrb.b - scrb.t + 1
scrb.h = scrb.b - scrb.t - 1 ' Max. vertical scroll. Bar minus the top and bottom arrow symbols.
dwidth = scrn.w - (margin.l + margin.r): dwidth2 = dwidth + 2
c1alt% = c1% + c2% * 16
IF row = 0 THEN row = 1
IF page.c = 0 THEN page.c = 7 ' Cursor apearance as underline.
CASE 2 ' Popup operations. Margins control the file display window but not the input line.
scrn.h = 25
margin.t = 4
margin.b = 12
margin.l = 11
margin.r = 12
dwidth = scrn.w - (margin.l + margin.r): dwidth2 = dwidth + 2
c1% = 7: c2% = 0: h1% = 15: h2% = 1 ' Normal text and highlighted text colors.
scrn.w = _WIDTH
scrn.h = _HEIGHT
page.w = scrn.w - (margin.l + margin.r)
page.h = scrn.h - (margin.t + margin.b)
scrb.x = 0 ' Relative position of the scrollbar cursor from top of scrb.h. 0 Off / 1 to
scrb.t = margin.t + 1
scrb.b = margin.t + page.h
scrb.l = margin.l + page.w + 2
scrb.d = scrb.b - scrb.t + 1
scrb.h = scrb.b - scrb.t - 1 ' Max. vertical scroll. Bar minus the top and bottom arrow symbols.
menuheightmax% = scrn.h - 4
CASE 3 ' Font colors.
scrn.h = 25
margin.t = 15
margin.b = 6
margin.l = 15
margin.r = 16
scrn.w = _WIDTH
scrn.h = _HEIGHT
page.w = scrn.w - (margin.l + margin.r)
page.h = scrn.h - (margin.t + margin.b)
menuheightmax% = scrn.h - 4
CASE 4 ' Font types.
scrn.h = 25
margin.t = 15
margin.b = 4
margin.l = 15
margin.r = 16
scrn.w = _WIDTH
scrn.h = _HEIGHT
page.w = scrn.w - (margin.l + margin.r)
page.h = scrn.h - (margin.t + margin.b)
scrb.x = 0 ' Relative position of the scrollbar cursor from top of scrb.h. 0 Off / 1 to
scrb.t = margin.t + 1
scrb.b = margin.t + page.h
scrb.l = margin.l + page.w + 2
scrb.d = scrb.b - scrb.t + 1
scrb.h = scrb.b - scrb.t - 1 ' Max. vertical scroll. Bar minus the top and bottom arrow symbols.
menuheightmax% = scrn.h - 4
END SELECT
END SUB
SUB scrollbar_update (h%, scrb AS my_scrb, noe AS INTEGER, row, scr)
STATIC thumb%
' h% = 0 No thumb position calculation required, just remake bar.
' h% = 1 Calculate thumb position.
' h% = 999. Reset STATIC thumb% to zero and exit.
' This sub utilizes exit subs.
dc% = _DEFAULTCOLOR
bc% = _BACKGROUNDCOLOR
IF h% THEN ' Places thumb or resets thumb
IF h% = 999 THEN thumb% = 0: EXIT SUB ' Resets thumb.
IF scrb.opt = 0 THEN
scrb.s = (scrb.h + 1) * 2 - noe: IF scrb.s <= 0 THEN scrb.s = 1
ELSE
scrb.s = 1
END IF
IF scr = 0 THEN
scrb.x = 0
ELSE
IF scrb.x < page.h - 3 AND page.h + scr >= INT((scrb.x + 1) * ((noe - scrb.d) / (scrb.h - scrb.s))) + page.h THEN
scrb.x = 0
DO UNTIL scrb.x = scrb.h - scrb.s OR page.h + scr < INT((scrb.x + 1) * ((noe - scrb.d) / (scrb.h - scrb.s))) + page.h
scrb.x = scrb.x + 1
LOOP
ELSEIF row + scr < scrb.i THEN
scrb.x = page.h - 3
DO UNTIL page.h + scr > INT((scrb.x + 1 - 2) * ((noe - scrb.d) / (scrb.h - scrb.s))) + page.h
scrb.x = scrb.x - 1
LOOP
END IF
END IF
IF scrb.x + scrb.s > scrb.h THEN ' Scrollbox expansion adjustment.
scrb.x = scrb.h - scrb.s
END IF
scrb.i = INT(scrb.x * ((noe - scrb.d) / (scrb.h - scrb.s)))
END IF
' Makes scrollbar and displays thumb.
IF scrb.t + scrb.x + 1 <> thumb% OR scrb.s = 0 THEN ' scrb.s = 0 allows thumb to be removed if text deletion makes doc less than page height.
IF scrb.s = 0 THEN thumb% = 0
yy% = CSRLIN: xx% = POS(0)
LOCATE scrb.t, scrb.l
COLOR 0, 7
PRINT CHR$(24); ' Arrow up
COLOR 7, 0
FOR i% = 1 TO scrb.h ' Bar
LOCATE scrb.t + i%, scrb.l
PRINT CHR$(177);
NEXT i%
LOCATE scrb.b, scrb.l
COLOR 0, 7
PRINT CHR$(25); ' Arrow down
COLOR 7, 0
IF noe > scrb.h + 2 THEN
IF scrb.s THEN thumb% = scrb.t + scrb.x + 1
FOR i% = 1 TO scrb.s
LOCATE scrb.t + scrb.x + i%, scrb.l
COLOR 1, 0
PRINT CHR$(176); ' Scrollbar thumb aka box.
NEXT
COLOR 7, 0
END IF
LOCATE yy%, xx%
END IF
COLOR dc%, bc%
END SUB
Fun stuff for sure. I hope you have a blast advancing your GUI, too.
Pete
If eggs are brain food, Biden takes his scrambled.