' 1440 twips per inch.
' Non shared UDTs
enl%
= 13:
CALL font_size_setup
(enl%
)
IF RIGHT$(dir.home
, 1) <> "\" THEN dir.home
= dir.home
+ "\" dir.wp = dir.home: dir.orig = dir.home
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
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:
' BUTTONS ----------------------------->
button_text$ = " Reset ": bw% = 11: bh% = 2: brow% = 30: bcol% = 94
button_display$ = "on"
button_text$ = " Print ": bw% = 11: bh% = 2: brow2% = 30: bcol2% = 115
''' ss = CSRLIN: rr = POS(0): LOCATE 1, 1: PRINT tabx%; nof% + nob%;: LOCATE ss, rr
CASE 0 ' Pop up not present.
CASE 1 ' Pop up active. Drop downs closed.
CASE 8 ' Print page number.
i%
= tabx%:
GOSUB print_page_num
i%
= tabx%:
GOSUB reset_values
i%
= tabx%:
GOSUB print_doc
tabx% = tabx% + 1
IF tabx%
> nof%
+ nob%
THEN tabx%
= 0 tab_trigger% = tabx%
up_arrowx%
(tabx%
) = -ABS(up_arrowx%
(tabx%
))
i%
= tabx%:
GOSUB up_arrow
up_arrowx%
(tabx%
) = ABS(up_arrowx%
(tabx%
)) LOCATE up_arrowy%
(tabx%
), up_arrowx%
(tabx%
)
tabx% = tabx% - 1
tabx% = 0
tab_trigger% = tabx%
tabx% = tabx% + 1
tabx% = 0
tab_trigger% = tabx%
dn_arrowx%
(tabx%
) = -ABS(dn_arrowx%
(tabx%
))
i%
= tabx%:
GOSUB dn_arrow
dn_arrowx%
(tabx%
) = ABS(dn_arrowx%
(tabx%
)) LOCATE dn_arrowy%
(tabx%
), dn_arrowx%
(tabx%
)
GOSUB font_color_open_dropdown
GOSUB font_type_open_dropdown
CASE 2 ' Drop down menu is open.
IF mb.l
AND l_click%
= 0 AND my%
= up_arrowy%
(tabx%
) AND -mx%
= up_arrowx%
(tabx%
) THEN
' Reset button
' Print button
IF up_arrowx%
(i%
) < 0 OR dn_arrowx%
(i%
) < 0 THEN
GOSUB font_color_open_dropdown
GOSUB font_type_open_dropdown
autoclick% = 0
IF tab_trigger%
OR tab_trigger%
= 0 AND mx%
<> oldmx%
OR tab_trigger%
= 0 AND my%
<> oldmy%
THEN 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
LOCATE up_arrowy%
(i%
), up_arrowx%
(i%
) up_arrowx%
(i%
) = ABS(up_arrowx%
(i%
)) * -1 LOCATE dn_arrowy%
(i%
), dn_arrowx%
(i%
) dn_arrowx%
(i%
) = ABS(dn_arrowx%
(i%
)) * -1 IF up_arrowx%
(i%
) < 0 OR dn_arrowx%
(i%
) < 0 THEN up_arrowx%
(i%
) = ABS(up_arrowx%
(i%
)) dn_arrowx%
(i%
) = ABS(dn_arrowx%
(i%
))
IF tab_trigger%
OR mx%
< ABS(fieldx%
(i%
)) OR mx%
> ABS(fieldx%
(i%
)) + 6 OR my%
<> fieldy%
(i%
) THEN
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
IF autoclick%
THEN IF oldmx%
<> mx%
OR oldmy%
<> my%
THEN autoclick%
= 0 IF tab_trigger%
THEN tab_trigger%
= 0 oldmx% = mx%: oldmy% = my%
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"
COLOR 3, 1:
LOCATE gen_var.w1
+ 3, gen_var.w2
+ 7 - LEN(field_name$
(i%
)) / 2:
PRINT field_name$
(i%
);
LOCATE gen_var.w1
+ 4, gen_var.w2
+ 3 up_arrowy%
(i%
) = CSRLIN: up_arrowx%
(i%
) = POS(0) dn_arrowy%
(i%
) = CSRLIN: dn_arrowx%
(i%
) = POS(0) LOCATE gen_var.w1
+ 5, gen_var.w2
+ 4 + field_size%
(i%
) - LEN(entry$
(i%
)) gen_var.w2 = gen_var.w2 + 15
IF i%
= 4 THEN gen_var.w1
= 10: gen_var.w2
= 11
'---------------------------------------------------------------
i% = 7
up_arrowy%
(i%
) = CSRLIN: up_arrowx%
(i%
) = POS(0) ' Hidden untl popup opens. dn_arrowy%
(i%
) = CSRLIN: dn_arrowx%
(i%
) = POS(0) LOCATE gen_var.w1
+ 5, gen_var.w2
+ 4
i% = 8
gen_var.w1 = 18: gen_var.w2 = 17
LOCATE gen_var.w1
+ 1, gen_var.w2
+ 1 LOCATE gen_var.w1
+ 1, gen_var.w2
+ 4
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))
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))
bdisplay:
IF button_display$
<> "off" THEN _PUTIMAGE ((bcol%
- 1) * 8, (brow%
- 1) * 16), Gdown
_PUTIMAGE ((bcol2%
- 1) * 8, (brow2%
- 1) * 16), Gdown2
bhover:
IF button_display$
<> "off" THEN _PUTIMAGE ((bcol%
- 1) * 8, (brow%
- 1) * 16), Ghover
_PUTIMAGE ((bcol2%
- 1) * 8, (brow2%
- 1) * 16), Gdown2
tabx% = 9
bhover2:
IF button_display$
<> "off" THEN _PUTIMAGE ((bcol%
- 1) * 8, (brow%
- 1) * 16), Gdown
_PUTIMAGE ((bcol2%
- 1) * 8, (brow2%
- 1) * 16), Ghover2
tabx% = 10
activate_field:
LOCATE fieldy%
(i%
), ABS(fieldx%
(i%
)) + field_size%
(i%
) + 1
LOCATE fieldy%
(i%
) - 1, ABS(fieldx%
(i%
)) + field_size%
(i%
) + 1 LOCATE fieldy%
(i%
), ABS(fieldx%
(i%
)) + field_size%
(i%
) + 1
LOCATE fieldy%
(i%
) - 1, ABS(fieldx%
(i%
)) + field_size%
(i%
) LOCATE fieldy%
(i%
), ABS(fieldx%
(i%
)) + field_size%
(i%
) LOCATE fieldy%
(i%
) + 1, ABS(fieldx%
(i%
)) + field_size%
(i%
)
fieldx%(i%) = -fieldx%(i%)
tabx% = i%
neutralize_field:
fieldx%
(i%
) = ABS(fieldx%
(i%
)) LOCATE fieldy%
(i%
) - 1, fieldx%
(i%
) - 1 LOCATE fieldy%
(i%
), fieldx%
(i%
) - 1 LOCATE fieldy%
(i%
), ABS(fieldx%
(i%
)) + field_size%
(i%
) + 1 LOCATE fieldy%
(i%
) + 1, fieldx%
(i%
) - 1
LOCATE fieldy%
(i%
) - 1, ABS(fieldx%
(i%
)) + field_size%
(i%
) + 1 LOCATE fieldy%
(i%
), ABS(fieldx%
(i%
)) + field_size%
(i%
) + 1
LOCATE fieldy%
(i%
) - 1, fieldx%
(i%
) + field_size%
(i%
) LOCATE fieldy%
(i%
), fieldx%
(i%
) + field_size%
(i%
) LOCATE fieldy%
(i%
) + 1, fieldx%
(i%
) + field_size%
(i%
)
IF tab_trigger%
= 0 THEN tabx%
= 0
up_arrow:
dn_arrow:
increase_value: ' Nested GOSUB for up_arrow and dn_arrow------------------
a1$ = entry$(i%)
j = j + 1
a1$
= MID$(entry$
(i%
), 1, INSTR(entry$
(i%
), ".") - 1) + MID$(entry$
(i%
), INSTR(entry$
(i%
), ".") + 1) j = j + k%
entry$
(i%
) = MID$(a1$
, 1, LEN(a1$
) - 2) + "." + MID$(a1$
, 2) LOCATE fieldy%
(i%
), ABS(fieldx%
(i%
)) + field_size%
(i%
) - LEN(entry$
(i%
))
decrease_value:
a1$ = entry$(i%)
j = j - 1
a1$
= MID$(entry$
(i%
), 1, INSTR(entry$
(i%
), ".") - 1) + MID$(entry$
(i%
), INSTR(entry$
(i%
), ".") + 1) j = j - k%
entry$
(i%
) = MID$(a1$
, 1, LEN(a1$
) - 2) + "." + MID$(a1$
, 2) LOCATE fieldy%
(i%
), ABS(fieldx%
(i%
)) + field_size%
(i%
) - LEN(entry$
(i%
)) RETURN ' End Nested GOSUB-------------------------------------------------
font_color_open_dropdown:
up_arrowx%
(tabx%
) = -ABS(up_arrowx%
(tabx%
)) smode% = 2
button_display$ = "on"
scr = 0: row = 1
i% = tabx%
LOCATE fieldy%
(i%
) + j%
, ABS(fieldx%
(i%
)) - 1
j% = 0
j% = j% + 1
font_color$(j%) = a1$
j% = j% - 1
a1$
= SPACE$(field_size%
(tabx%
)) MID$(a1$
, 1) = font_color$
(k%
) LOCATE fieldy%
(i%
) + k%
+ 1, ABS(fieldx%
(i%
))
gen_var.vartable
= 3:
CALL setvariables
(scrb
, c1%
, c2%
, c1alt%
, h1%
, h2%
, row
, ins%
, dwidth
, dwidth2
, menubar%
, menuheightmax%
)
entry$(tabx%) = font_color$(row)
a1$
= SPACE$(field_size%
(tabx%
)) MID$(a1$
, 1) = font_color$
(row
)
row = row - 1
row = row + 1
scr = 0:: row = 1
scr = noe - page.h: row = page.h
IF my%
= up_arrowy%
(tabx%
) AND mx%
= ABS(up_arrowx%
(tabx%
)) THEN
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 entry$(tabx%) = font_color$(row)
a1$
= SPACE$(field_size%
(tabx%
)) MID$(a1$
, 1) = font_color$
(row
)
mb.w = 0
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%)
IF my%
= up_arrowy%
(tabx%
) AND mx%
= ABS(up_arrowx%
(tabx%
)) THEN hover_arrow% = tabx%
oldmx% = mx%: oldmy% = my%
' NESTED GOSUBS for font_color_open_dropdown -----------------------------
highlight_color:
a1$
= SPACE$(field_size%
(tabx%
)) MID$(a1$
, 1) = font_color$
(hlf%
)
LOCATE fieldy%
(tabx%
) + row
, ABS(fieldx%
(tabx%
)) a1$
= SPACE$(field_size%
(tabx%
)) MID$(a1$
, 1) = font_color$
(row
) 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
i% = tabx%
LOCATE fieldy%
(i%
) + j%
, ABS(fieldx%
(i%
)) - 1 button_display$ = "off"
LOCATE fieldy%
(i%
) + j%
, ABS(fieldx%
(i%
)) - 1
j% = 0
j% = j% + 1
font_type$(j%) = a1$
h%
= 999:
CALL scrollbar_update
(h%
, scrb
, noe
, row
, scr
) h%
= 1:
CALL scrollbar_update
(h%
, scrb
, noe
, row
, scr
)
i% = tabx%
j% = 0
j% = j% + 1
LOCATE fieldy%
(i%
) + 1 + j%
, ABS(fieldx%
(i%
))
row = 1: scr = 0
entry$(tabx%) = font_type$(scr + row)
a1$
= SPACE$(field_size%
(tabx%
)) MID$(a1$
, 1) = font_type$
(scr
+ row
)
IF b$
= oldb$
AND scr
+ 2 <= noe
THEN ' Step through same first letter files. scr = scr + 1
row
= 1:
GOSUB scrollfonts
oldb$ = b$
i% = 0
i% = i% + 1
IF x$
<> oldx$
THEN oldx$
= x$: j%
= i%
scr = i% - 1
IF scr
+ page.h
> noe
THEN scr
= noe
- page.h
row
= 1:
GOSUB scrollfonts
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
row = row - 1
scr = scr - 1
row = row + 1
scr = scr + 1
k% = page.h - 1
k% = page.h - 1
IF scr
+ k%
<= noe
- page.h
THEN scr
= scr
+ k%
ELSE scr
= noe
- page.h
scr = 0:: row = 1
scr = noe - page.h: row = page.h
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 entry$(tabx%) = font_type$(scr + row)
a1$
= SPACE$(field_size%
(tabx%
)) MID$(a1$
, 1) = font_type$
(scr
+ row
)
' Scrollbar routine.
IF my%
= up_arrowy%
(tabx%
) AND mx%
= ABS(up_arrowx%
(tabx%
)) THEN
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.
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 scrb.x
> 0 THEN scrb.x
= scrb.x
- 1: h%
= -1 ' Top arrow scrb.x = scrb.x + 1: h% = -2 ' Bottom arrow.
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.
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
scrb.adjust = (my% - (scrb.t + 1)) - scrb.x + 1: h% = -2
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
)
delay.
on!
= 0 ' Toggle off.
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 ' =======================================================
mb.w = 0
scrbardrag% = 0: scrb.adjust = 0: draglock% = 0
IF gen_var.locked
= 2 AND mb.l
= 0 THEN gen_var.locked
= 0
scrbardrag% = 0: scrb.adjust = 0: draglock% = 0
IF gen_var.locked
= 2 AND mb.l
= 0 THEN gen_var.locked
= 0
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%)
IF my%
= up_arrowy%
(tabx%
) AND mx%
= ABS(up_arrowx%
(tabx%
)) THEN hover_arrow% = tabx%
oldmx% = mx%: oldmy% = my%
' NESTED GOSUB for font_type_open_dropdown ------------------------------
scrollfonts:
IF scr
< 0 THEN scr
= 0 ' Precaution. LOCATE fieldy%
(tabx%
) + i%
, ABS(fieldx%
(tabx%
)) a1$
= SPACE$(field_size%
(tabx%
)) MID$(a1$
, 1) = font_type$
(i%
+ scr
) hlf%
= row
+ scr: hlfy%
= CSRLIN: hlfx%
= POS(0) LOCATE fieldy%
(tabx%
) + row
, ABS(fieldx%
(tabx%
))
h%
= 1:
CALL scrollbar_update
(h%
, scrb
, noe
, row
, scr
)
print_page_num:
IF entry$
(i%
) = "off" THEN entry$
(i%
) = "on" ELSE entry$
(i%
) = "off"
reset_values:
print_doc:
margin_rtf$ = "\viewkind4\uc1\pard\"
twips%
(i%
) = VAL(entry$
(i%
)) * 1440 - 1800 margin_rtf$
= margin_rtf$
+ "margt" + LTRIM$(STR$(twips%
(i%
))) + "\" margin_rtf$
= margin_rtf$
+ "margb" + LTRIM$(STR$(twips%
(i%
))) + "\" twips%
(i%
) = VAL(entry$
(i%
)) * 1440 - 1440 margin_rtf$
= margin_rtf$
+ "li" + LTRIM$(STR$(twips%
(i%
))) + "\" margin_rtf$
= margin_rtf$
+ "ri" + LTRIM$(STR$(twips%
(i%
))) + "\" fontsize%
= VAL(entry$
(i%
)) * 2 fontsize_rtf$
= "sa200\sl276\slmult1\cf1\fs" + LTRIM$(STR$(fontsize%
)) + "\lang9 " fontcolor_rtf$ = "{\colortbl ;\red0\green0\blue0;}"
fontcolor_rtf$ = "{\colortbl ;\red255\green0\blue0;}"
fontcolor_rtf$ = "{\colortbl ;\red0\green0\blue255;}"
fontcolor_rtf$ = "{\colortbl ;\red0\green255\blue0;}"
fontcolor_rtf$ = "{\colortbl ;\red102\green102\blue102;}"
fonttype_rtf$ = "{\rtf1\ansi\ansicpg1252\deff0\nouicompat\deflang1033{\fonttbl{\f0\fnil\fcharset0 " + entry$(i%) + ";}}"
IF entry$
(i%
) = "on" THEN printpagefooter$
= "{\field{\*\fldinst PAGE}{\fldrslt 1}}" ELSE printpagefooter$
= ""
header$ = fonttype_rtf$ + fontcolor_rtf$ + margin_rtf$ + fontsize_rtf$
footer$ = "\cf0\f1\fs22\par}" + printpagefooter$
PRINT "Your text goes here!" END ''''''''''''''''''''''''''
highlight_font:
a1$
= SPACE$(field_size%
(tabx%
)) MID$(a1$
, 1) = font_type$
(hlf%
)
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) LOCATE fieldy%
(tabx%
) + row
, ABS(fieldx%
(tabx%
)) RETURN ' END NESTED GOSUBS --------------------------------------------------------
poll_mouse:
mb.w = 0
close_dropdown:
smode% = 1
up_arrowx%
(tabx%
) = ABS(up_arrowx%
(tabx%
)) IF button_display$
= "off" THEN button_display$
= "on" hlf% = 0: hlfx% = 0: hlfy% = 0
audit_close_x:
xclose% = -xclose%
close_x:
SUB font_size_setup
(ENL%
) winmode$ = "2"
SCRNSIZE% = SCRNSIZE% + ENL%
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.
nofull:
ChangeFont:
_FONT 16 ' Inbuilt 8x16 default font. currentf&
= _LOADFONT(fontpath$
, fontsize%
, style$
)
f& = currentf&
SUB popup
(msg$
, msg%
, button$
(), button%
, button_index%
, text$
, config%
, mydelay%
, mx%
, my%
, xclose%
, yclose%
)
CASE 0 ' Message box only like exit. Find / Replace are cases 1 and 2. config% = 2 ' Find
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
config% = 3 ' Find / Replace
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
IF gen_var.w3
= 0 THEN gen_var.w3
= 3 ' Min. 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.
IF gen_var.w4
= 0 THEN ' Calculate form container width IF fndrep.find_or_replace
= 0 THEN gen_var.w4
= LEN(msg$
) + 4 ' Min IF LEN(ifield$
(i%
)) + fndrep.ifield
> gen_var.w4
THEN gen_var.w4
= LEN(ifield$
(i%
)) + fndrep.ifield
+ 6
' Auto-Center
gen_var.w1
= _HEIGHT \
2 - gen_var.w3 \
2 + .5 gen_var.w2
= _WIDTH \
2 - gen_var.w4 \
2 + .5
oldsmode%
= gen_var.smode:
PCOPY 0, 1:
SCREEN 0, 0, 1, 1: gen_var.smode
= 1 oldsmode%
= gen_var.smode:
PCOPY 1, 2:
SCREEN 0, 0, 2, 2: gen_var.smode
= 2
LOCATE gen_var.w1
, gen_var.w2
, 0 ' Cursor hide A$ = ""
LOCATE gen_var.w1
+ gen_var.w3
- 1, gen_var.w2
FOR i
= 1 TO gen_var.w3
- 2
'''''''''''''
LOCATE gen_var.w1
, gen_var.w2
+ gen_var.w4
- 2:
COLOR 15, 1
LOCATE gen_var.w1
+ 1, gen_var.w2
+ gen_var.w4 \
2 - LEN(msg$
) \
2
LOCATE gen_var.w1
+ 1, gen_var.w2
+ gen_var.w4 \
2 - LEN(msg$
) \
2
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. 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. 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. passrightmargin%
= POS(0) - 1 ' Sets right margin of the find input field.
ELSE ' No buttons present. LOCATE gen_var.w1
+ gen_var.w3 \
2, gen_var.w2
+ gen_var.w4 \
2 - LEN(msg$
) \
2
button% = 0 ' Reset buttons.
IF mydelay%
THEN ' Sending to printer... gen_var.action = "" ' Finished gen_var.action = "print" one of two.
gen_var.smode
= oldsmode%:
SCREEN 0, 0, gen_var.smode
, gen_var.smode:
COLOR 0, 7
clear_button:
tab_and_enter_fields:
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 LOCATE ifieldyy%
(fndrep.ifrow
), ifieldxx%
(fndrep.ifrow
), 1 b$ = ""
' Remove any highlighting.
LOCATE ifieldyy%
(fndrep.ifrow
), ifieldxx%
(fndrep.ifrow
), 0 LOCATE ifieldyy%
(fndrep.ifrow
), ifieldxx%
(fndrep.ifrow
) entry$(fndrep.ifrow) = text$
tabx% = 1 ' To reloop.
entry$(fndrep.ifrow) = text$
entry$(fndrep.ifrow) = text$
fndrep.ifrow = fndrep.ifrow + 1
LOCATE ifieldyy%
(fndrep.ifrow
), ifieldxx%
(fndrep.ifrow
), 1 b$ = ""
tabx% = tabx% + 1
IF tabx%
> button%
AND fndrep.ifrow
= 0 THEN tabx%
= 1 ' No input fields.
button_actions:
j% = 0
j%
= j%
+ LEN(button$
(button_index%
+ i%
)) + 2 LOCATE buttonyy%
, gen_var.w2
+ gen_var.w4 \
2 - j% \
2 - 1 k% = 0
FOR i%
= button_index%
+ 1 TO button_index%
+ button%
k% = k% + 1
LOCATE buttonyy%
, gen_var.w2
+ gen_var.w4 \
2 - j% \
2 k% = 0
' Prints names on buttons.
FOR i%
= button_index%
+ 1 TO button_index%
+ button%
k% = k% + 1
IF fndrep.find_or_replace
THEN LOCATE ifieldyy%
(fndrep.ifrow
), ifieldxx%
(fndrep.ifrow
), 1 tabx% = 0
' <--------------------------
gen_var.action = "" ' Removes all gen_var.action conditions. Waits for new actions assigned by button selection.
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$)
'''CALL user(b$, mx%, my%, alt%, shift%, ctrl%, ctrlshift%, con_panel%, doc_title$, doc_saved%, scrb, scrbscrbardrag%, x$(), noe, scr, ins%, dwidth)
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. fndrep.find_action = "Whole Word"
fndrep.find_action = "Whole/Case"
' Find Function only.
fndrep.find_action = "Any Part"
fndrep.find_action = "Any/Case"
IF button_index%
= 0 THEN gen_var.action
= "yes" IF button_index%
= 2 THEN gen_var.action
= "retry" 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. gen_var.action = "close"
IF LEN(fndrep.find_action
) THEN fndrep.find_action
= "" ' Remove whole, part, etc. find designations with esc key.
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 bhl%
THEN IF bhl%
= 1 AND my%
<> mouselocator%
OR bhl%
= 1 AND MID$(mouselocator$
, mx%
, 1) = "0" THEN tabx%
= 0: bhl%
= 0
IF oldmx%
= mx%
AND oldmy%
= my%
THEN i%
= 0 ELSE i%
= -1 ' Mouse has moved.
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.
entry$(fndrep.ifrow) = text$
h% = k%: tabx% = h%
IF fndrep.find_or_replace
THEN LOCATE inputfieldyy%
, inputfieldxx%
h% = 0: tabx% = 0
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?
IF my%
= mouselocator%
AND MID$(mouselocator$
, mx%
, 1) <> "0" THEN IF button_index%
= 0 THEN gen_var.action
= "yes" IF button_index%
= 2 THEN gen_var.action
= "retry" 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. IF button_index%
= 0 THEN gen_var.action
= "no" IF button_index%
= 2 THEN gen_var.action
= "abort" 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. ' Find Function only.
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. 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.
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
'''''''''''''''''''''''''''
' IMPORTANT: THIS ERRORED ONCE, BUT I WAS UNABLE TO EASILY REPEAT IT.
text$ = entry$(fndrep.ifrow)
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
FUNCTION Button_HW
(wide
, tall
, r
, g
, b
, rc
, gc
, bc
, caption$
) ' Button function courtesy of the Amazing Steve.
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
SUB setvariables
(scrb
AS my_scrb
, c1%
, c2%
, c1alt%
, h1%
, h2%
, row
, ins%
, dwidth
, dwidth2
, menubar%
, menuheightmax%
) menubar% = 1 ' Menu bar location.
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.
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 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.
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
scrn.h = 25
margin.t = 15
margin.b = 6
margin.l = 15
margin.r = 16
page.w = scrn.w - (margin.l + margin.r)
page.h = scrn.h - (margin.t + margin.b)
menuheightmax% = scrn.h - 4
scrn.h = 25
margin.t = 15
margin.b = 4
margin.l = 15
margin.r = 16
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
' 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.
IF h%
THEN ' Places thumb or resets thumb scrb.s
= (scrb.h
+ 1) * 2 - noe:
IF scrb.s
<= 0 THEN scrb.s
= 1 scrb.s = 1
scrb.x = 0
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
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
IF scrb.x
+ scrb.s
> scrb.h
THEN ' Scrollbox expansion adjustment. scrb.x = scrb.h - scrb.s
scrb.i
= INT(scrb.x
* ((noe
- scrb.d
) / (scrb.h
- scrb.s
)))
' 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. FOR i%
= 1 TO scrb.h
' Bar
IF scrb.s
THEN thumb%
= scrb.t
+ scrb.x
+ 1 LOCATE scrb.t
+ scrb.x
+ i%
, scrb.l
