As much as I love putting image on SCREEN 0, I've encountered a problem that I hope has a simple solution.
Step 1) Put a bunch of hardware images of buttons on SCREEN 0. Boy they look purdy!
Step 2) Put a SCREEN 0 popup window on the screen.
Now all is great unless that popup window overlaps any space occupied by the hardware button(s). If they overlay with the popup, the button(s) keep getting displayed over a portion of the popup. Keep in mind that popup is supposed to cover everything under it.
I don't think using _DISPLAYORDER matters here, but I could be wrong having never used it before.
I thought about turning the screen into an image and using it as a background under the popup, but _copyimage(0) just copies the software glyphs, and not the hardware images along with them. I'm not even sure that theory would work, if possible. I mean one draw back is that if things are moving in the background, like a timer, it would get suspended when turned into a background image.
Now it would really suck gym socks to have to go about this by redrawing all the hardware images, in partial form, so they would not overlap the popup. That would especially suck considering the popup can be dragged across the screen.
So if anyone has a solution for how to accomplish this with what I'm hoping is some standardized method, I'm all ears. Hey, if I was all brains, I wouldn't need to hear for you in the first place!
Pete
Edit: I'll throw in the huge ascii app if it helps. Left click in a text field then right click to get the popup menu to appear. You may have to move the mouse and right click to get the window to appear overlapping the hardware images.
Step 1) Put a bunch of hardware images of buttons on SCREEN 0. Boy they look purdy!
Step 2) Put a SCREEN 0 popup window on the screen.
Now all is great unless that popup window overlaps any space occupied by the hardware button(s). If they overlay with the popup, the button(s) keep getting displayed over a portion of the popup. Keep in mind that popup is supposed to cover everything under it.
I don't think using _DISPLAYORDER matters here, but I could be wrong having never used it before.
I thought about turning the screen into an image and using it as a background under the popup, but _copyimage(0) just copies the software glyphs, and not the hardware images along with them. I'm not even sure that theory would work, if possible. I mean one draw back is that if things are moving in the background, like a timer, it would get suspended when turned into a background image.
Now it would really suck gym socks to have to go about this by redrawing all the hardware images, in partial form, so they would not overlap the popup. That would especially suck considering the popup can be dragged across the screen.
So if anyone has a solution for how to accomplish this with what I'm hoping is some standardized method, I'm all ears. Hey, if I was all brains, I wouldn't need to hear for you in the first place!
Pete
Edit: I'll throw in the huge ascii app if it helps. Left click in a text field then right click to get the popup menu to appear. You may have to move the mouse and right click to get the window to appear overlapping the hardware images.
Code: (Select All)
Dim Shared demo As Integer, clean As _Bit
ReDim Shared text$(0), textlen(0), textlenmax(0), fld$(0), button$(0), mRow$(0), a$(0)
ReDim Shared As Long h1(0), h2(0), h3(3), fh(0)
ReDim Shared As Long bl1(0), bl2(0)
ReDim Shared As Long gfx1(0), gfx2(0), gfx3(0)
ReDim Shared As Integer x(0), y(0), y1(0), y2(0), x1(0), x2(0)
ReDim Shared As Integer FType(0), fnx(0), btnmap(0), btnfld(0), tabmap(0), BStyle(0)
Type fields_and_buttons
a As String
mapping As Integer
SimClick As Integer
BSelect As Integer
tabmax As Integer
tb As Integer
TabFldHl As Integer
fld As Integer
nof As Integer
nob As Integer
style As Integer
SkipAct As Integer
idle As Single
Fg As Integer
Bg As Integer
FTextFg As Integer
FTextBg As Integer
FNamFg As Integer
FHlRed As Integer
FHlGrn As Integer
FHlBlu As Integer
B1Fg As Integer ' Begin button colors.
B1Bg As Integer
B1HvrFg As Integer
B1HvrBg As Integer
B1FlashFg As Integer
B1FlashBg As Integer
B2BdrFg As Integer
B2BdrHover As Integer
B2BdrFlash As Integer
B3Fg As Integer
B3Bg As Integer
B3FlashFg As Integer
B3FlashBg As Integer
B3Ln1Red As Integer
B3Ln1Grn As Integer
B3Ln1Blu As Integer
B3Ln2Red As Integer
B3Ln2Grn As Integer
B3Ln2Blu As Integer
B3Ln3Red As Integer
B3Ln3Grn As Integer
B3Ln3Blu As Integer
B3Ln1HvrRed As Integer
B3Ln1HvrGrn As Integer
B3Ln1HvrBlu As Integer
B3Ln2HvrRed As Integer
B3Ln2HvrGrn As Integer
B3Ln2HvrBlu As Integer
B3Ln3HvrRed As Integer
B3Ln3HvrGrn As Integer
B3Ln3HvrBlu As Integer
End Type
Dim fb As fields_and_buttons
fb.Fg = 0
fb.Bg = 5
Palette fb.Bg, 63
fb.FTextFg = 15: fb.FTextBg = 0: fb.FNamFg = 0
fb.FHlRed = 0: fb.FHlGrn = 155: fb.FHlBlu = 155
fb.B1Fg = 15: fb.B1Bg = 1: fb.B1HvrFg = 3: fb.B1HvrBg = 3: fb.B1FlashFg = 1: fb.B1FlashBg = 3
fb.B2BdrFg = 8: fb.B2BdrHover = 1: fb.B2BdrFlash = 9
fb.B3Fg = 6: fb.B3Bg = 7: fb.B3FlashFg = 15: fb.B3FlashBg = 6
fb.B3Ln1Red = 155: fb.B3Ln1Grn = 155: fb.B3Ln1Blu = 155
fb.B3Ln2Red = 0: fb.B3Ln2Grn = 0: fb.B3Ln2Blu = 0
fb.B3Ln3Red = 255: fb.B3Ln3Grn = 255: fb.B3Ln3Blu = 255
fb.B3Ln1HvrRed = 0: fb.B3Ln1HvrGrn = 155: fb.B3Ln1HvrBlu = 155
fb.B3Ln2HvrRed = 0: fb.B3Ln2HvrGrn = 0: fb.B3Ln2HvrBlu = 0
fb.B3Ln3HvrRed = 255: fb.B3Ln3HvrGrn = 255: fb.B3Ln3HvrBlu = 255
demo = 0
fb.a = " Button Hybrid": fb_make fb, 5, 31, 3
fb.a = " Button Graphics ": fb_make fb, 8, 31, 4
fb.a = " Button Text ": fb_make fb, 12, 31, 2
fb.a = " Button Text ": fb_make fb, 15, 31, 1
fb.a = "Text:": fb_fields fb, _Height - 6, 31, 15, 15, "Text goes here."
fb.a = "More Text:": fb_fields fb, _Height - 4, 31, 30, 50, "Additional Text goes here."
Do
control fb, b$, mx, my, lb, rb
Loop
Sub control (fb As fields_and_buttons, b$, mx, my, lb, rb)
Static initiate As Integer, z1, autokey$ ' autokey$ needs to either be preserved here or passed back.
If initiate = 0 Then
initiate = 1
Dim nul As String * 1 ' Used only for demo.
If demo Then
Width 80, 30
Color fb.Fg, fb.Bg: Cls
fb.nof = 0: fb.nob = 0: fb.tabmax = 0
ReDim fld$(0), FType(0), btnmap(0), btnfld(0), BStyle(0)
ReDim y1(0), x1(0), y2(0), x2(0), button$(0)
clean = 1: fb_fields fb, y, x, length, lengthmax, filler$
clean = 1: fb_map fb, mapid
clean = 1: fb_make fb, y, x, ButtonStyle
End If
_Display
If fb.idle = 0 Then If fb.SkipAct = 0 Then fb.idle = 5 ' Default.
End If
If demo Then dmo fb, nul$, lb, mb, rb, mw, my, mx
MyMouse_and_Keyboard act, lb, mb, rb, my, mx, mw, shift%, AltStatus%, AltToggle%, alt%, ctrl%, clkcnt, drag, k&, b$, autokey$
If act Or Abs(z1 - Timer) < fb.idle Or fb.SkipAct <> 0 Then
If fb.SkipAct = 0 Then If act Then z1 = Timer: Palette fb.Bg, 63
fb_main fb, b$, mx, my, lb, rb, shift%, drag, autokey$
door = 0
Else
Palette fb.Bg, 7
If door = 0 Then fb_main fb, b$, mx, my, lb, rb, shift%, drag, autokey$
door = -1
End If
End Sub
Sub MyMouse_and_Keyboard (act, lb, mb, rb, my, mx, mw, shift%, AltStatus%, AltToggle%, alt%, ctrl%, clkcnt, drag, k&, b$, autokey$)
Dim As Integer oldmw
Static As Integer oldmy, oldmx, mwy, oldmwy
Static z1 As Single
Do
_Limit 60
act = 0
If AltStatus% Then AltStatus% = 0
If Len(autokey$) Then
b$ = Mid$(autokey$, 1, InStr(autokey$ + ",", ",") - 1)
autokey$ = Mid$(autokey$, InStr(autokey$ + ",", ",") + 1)
act = 1
Exit Do
Else
k& = _KeyHit
If k& = 100307 Or k& = 100308 Then
AltStatus% = -1
AltToggle% = 1 - AltToggle%
act = 1
Exit Do
End If
If k& > 0 Then
b$ = MKI$(k&)
If Mid$(b$, 2, 1) = Chr$(135) Then b$ = "" ' Keys like like Shift, Ctrl, and Alt.
If Right$(b$, 1) = Chr$(0) Then b$ = Left$(b$, 1)
act = 3
Else
b$ = ""
End If
End If
If z1 Then If Abs(Timer - z1) > .25 Then z1 = 0: clkcnt = 0
If lb > 0 Then
If lb = 1 Then
lb = -1: act = 1
Else
lb = 0: act = -1
End If
End If
If rb > 0 Then If rb = 1 Then rb = -1: act = 1 Else rb = 0
If mb > 0 Then If mb = 1 Then mb = -1: act = 1 Else mb = 0
While _MouseInput
mwy = mwy + _MouseWheel: act = 1
Wend
my = _MouseY
mx = _MouseX
If lb = -1 Then
If oldmy And oldmx <> mx Or oldmy And oldmy <> my Then
If mx <> oldmx Then drag = Sgn(mx - oldmx) ' Prevent zero which can occur if mouse moves off row when being dragged horizontally.
End If
End If
If drag = 0 Then
If mwy <> oldmw Then
mw = Sgn(mwy - oldmwy): mwy = 0
Else
mw = 0
End If
oldmwy = mwy
If _KeyDown(100303) Or _KeyDown(100304) Then shift% = -1: act = 1 Else If shift% Then shift% = 0
If _KeyDown(100305) Or _KeyDown(100306) Then ctrl% = -1: act = 1 Else If ctrl% Then ctrl% = 0
If _KeyDown(100307) Or _KeyDown(100308) Then alt% = -1: act = 1 Else If alt% Then alt% = 0
If ctrl% Then ' Convert select all, cut, copy, paste.
Select Case LCase$(b$)
Case "a": b$ = Chr$(1)
Case "x": b$ = Chr$(24)
Case "c": b$ = Chr$(3)
Case "v": b$ = Chr$(22)
Case Chr$(0) + "k": b$ = Chr$(0) + "s"
Case Chr$(0) + "m": b$ = Chr$(0) + "t"
End Select
End If
End If
If lb = -1 And _MouseButton(1) = 0 Then
lb = 2: drag = 0: hover = 0: act = 1
ElseIf rb = -1 And _MouseButton(2) = 0 Then
rb = 2: act = 1
ElseIf mb = -1 And _MouseButton(3) = 0 Then
mb = 2: act = 1
End If
If _MouseButton(1) Then
If lb = 0 Then
lb = 1: z1 = Timer: act = 1
clkcnt = clkcnt + 1
End If
ElseIf _MouseButton(2) And rb = 0 Then
rb = 1: act = 1
ElseIf _MouseButton(3) And mb = 0 Then
mb = 1: act = 1
End If
If my <> oldmy Or mx <> oldmx Then act = 2
oldmy = my: oldmx = mx
Exit Do
Loop
End Sub
Sub fb_main (fb As fields_and_buttons, b$, mx, my, lb, rb, shift%, drag, autokey$)
Static BTabHl As Integer, chngfld As Integer
s1 = CsrLin: s2 = Pos(0)
b_hover = 0: fb.fld = 0: fb.BSelect = 0
If fb.mapping Then ' Background was mapped.
If Len(mRow$(my)) Then
i = Asc(Mid$(mRow$(my), mx, 1))
If i > 96 Then
fb.fld = i - 96
If FType(fb.fld) = 5 Then b_hover = btnmap(fb.fld)
End If
End If
Else
For i = 1 To fb.nof ' Number of fields.
If my >= y1(i) And my <= y2(i) And mx >= x1(i) And mx <= x2(i) Then
Select Case FType(i)
Case 1 ' Input field.
fb.fld = i
Case 5 ' Button.
fb.fld = i
b_hover = btnmap(fb.fld)
Exit For
End Select
End If
Next
End If
If lb = 1 And FType(fb.fld) = 1 Then
fb.tb = fb.fld - 1
fb.TabFldHl = tabmap(fb.tb)
fb.fld = fb.tb
BTabHl = 0
ChangeField% = 1
Else
If fb.tabmax And b$ = Chr$(9) Then ChangeField% = -1 Else ChangeField% = 0
End If
If ChangeField% Then
If fb.tb = fb.tabmax Then ' Redo cycle.
fb.tb = 0: BTabHl = 0: fb.TabFldHl = 0
Else
If FType(fb.tb + 1) = 5 Then ' Button.
fb.tb = fb.tb + 1
BTabHl = 0
force = 1: ' Local variable to force any tab button field to remain highlighted.
Else ' Field.
fb.tb = fb.tb + 1 ' Increase tab field for text / non-button fields.
fb.TabFldHl = tabmap(fb.tb)
Locate y1(fb.tb), x1(fb.tb)
s1 = CsrLin: s2 = Pos(0)
End If
End If
End If
If fb.tb Then
If fb.TabFldHl And FType(fb.tb) = 1 Then ' Highlight tab field.
_PutImage ((fnx(fb.tb) - 1) * 8 - 3, (y1(fb.tb) - 1) * 16 - 2), fh(fb.TabFldHl)
If Abs(chngfld) <> fb.tb Then chngfld = fb.tb
End If
If b$ = Chr$(13) Then ' Tab field selected by Enter key.
If FType(fb.tb) = 5 Then
fb.SimClick = -btnmap(fb.tb) ' Simulate a left button click.
End If
End If
End If
For k = 1 To fb.nob
If demo Then BStyle(k) = (k - 1) \ 2 + 1
If fb.SimClick = -k Then
fb.SimClick = Abs(fb.SimClick)
h = 1: i = Len(button$(fb.SimClick))
j = fb.tb: l = btnmap(j)
Else
If BTabHl = k And FType(fb.tb) = 5 Then j = fb.tb: l = btnmap(j) Else j = btnfld(k): l = b_hover
h = lb: i = Len(button$(k))
End If
If BTabHl = k And b_hover <> k And fb.SimClick = 0 Then
Select Case BStyle(k)
Case 1
Color fb.B1HvrFg, fb.Bg
Locate y1(j) - 1, x1(j): Print String$(i, 220);
Locate y1(j) + 1, x1(j): Print String$(i, 223);
Color fb.B1Fg, fb.B1HvrBg
Locate y1(j), x1(j): Print button$(k);
Case 2
Color fb.B2BdrHover, fb.Bg
Locate y1(j), x1(j): Print Chr$(218) + String$(i, 196) + Chr$(191)
Locate y1(j) + 1, x1(j): Print Chr$(179);: Locate , Pos(0) + i: Print Chr$(179)
Locate y1(j) + 2, x1(j): Print Chr$(192) + String$(i, 196) + Chr$(217);
Locate y1(j) + 1, x1(j) + 1: Print button$(k);
Case 3
Color fb.B3Fg, fb.B3Bg
Locate y1(j) + 1, x1(j) + 1: Print button$(k);
_PutImage ((x(k) - 1) * 8, (y(k) - 1) * 16), bl2(k)
Case 4
_PutImage ((x(k) - 1) * 8, (y(k) - 1) * 16 + 8), gfx2(k)
Case 5
_PutImage ((x(k) - 1) * 8 + 4, (y(k) - 1) * 16), h2(k)
End Select
Else
Select Case BStyle(k)
Case 1
If h = 0 And b_hover = k Then
Color fb.B1HvrFg, fb.Bg
Locate y1(j) - 1, x1(j): Print String$(i, 220);
Locate y1(j) + 1, x1(j): Print String$(i, 223);
Color fb.B1Fg, fb.B1HvrBg
Locate y1(j), x1(j): Print button$(k);
ElseIf Abs(h) And b_hover = k Or fb.SimClick = k Then
Color fb.B1FlashBg, fb.Bg
Locate y1(j) - 1, x1(j): Print String$(i, 220);
Locate y1(j) + 1, x1(j): Print String$(i, 223);
Color fb.B1FlashFg, fb.B1FlashBg
Locate y1(j), x1(j): Print button$(k);
If h = 2 Then fb.BSelect = k
Else
Color fb.B1Bg, fb.Bg
Locate y1(j) - 1, x1(j): Print String$(i, 220);
Locate y1(j) + 1, x1(j): Print String$(i, 223);
Color fb.B1Fg, fb.B1Bg
Locate y1(j), x1(j): Print button$(k);
End If
Case 2
If h = 0 And b_hover = k Then
Color fb.B2BdrHover, fb.Bg
ElseIf Abs(h) And b_hover = k Or fb.SimClick = k Then
Color fb.B2BdrFlash, fb.Bg
If h = 2 Then fb.BSelect = k
Else
Color fb.B2BdrFg, fb.Bg
End If
Locate y1(j), x1(j): Print Chr$(218) + String$(i, 196) + Chr$(191)
Locate y1(j) + 1, x1(j): Print Chr$(179);: Locate , Pos(0) + i: Print Chr$(179)
Locate y1(j) + 2, x1(j): Print Chr$(192) + String$(i, 196) + Chr$(217);
Locate y1(j) + 1, x1(j) + 1: Print button$(k);
Case 3
If h = 0 And b_hover = k Then
Color fb.B3Fg, fb.B3Bg
Locate y1(j) + 1, x1(j) + 1: Print button$(k);
_PutImage ((x(k) - 1) * 8, (y(k) - 1) * 16), bl2(k)
ElseIf Abs(h) And b_hover = k Or fb.SimClick = k Then
Color fb.B3FlashFg, fb.B3FlashBg
Locate y1(j) + 1, x1(j) + 1: Print button$(k);
_PutImage ((x(k) - 1) * 8, (y(k) - 1) * 16), bl1(k)
If h = 2 Then fb.BSelect = k
Else
Color fb.B3Fg, fb.B3Bg
Locate y1(j) + 1, x1(j) + 1: Print button$(k);
_PutImage ((x(k) - 1) * 8, (y(k) - 1) * 16), bl1(k)
End If
Case 4
If h = 0 And b_hover = k Then
_PutImage ((x(k) - 1) * 8, (y(k) - 1) * 16 + 8), gfx2(k)
ElseIf Abs(h) And b_hover = k Or fb.SimClick = k Then
_PutImage ((x(k) - 1) * 8, (y(k) - 1) * 16 + 8), gfx3(k)
If h = 2 Then fb.BSelect = k
Else
_PutImage ((x(k) - 1) * 8, (y(k) - 1) * 16 + 8), gfx1(k)
End If
Case 5
If h = 0 And b_hover = k Then
_PutImage ((x(k) - 1) * 8 + 4, (y(k) - 1) * 16), h2(k)
ElseIf Abs(h) And b_hover = k Or fb.SimClick = k Then
_PutImage ((x(k) - 1) * 8 + 4, (y(k) - 1) * 16), h3(k)
If h = 2 Then fb.BSelect = k
Else
_PutImage ((x(k) - 1) * 8 + 4, (y(k) - 1) * 16), h1(k)
End If
End Select
End If
Next
Select Case FType(fb.tb)
Case 1
MyInput fb, chngfld, tabmap(fb.tb), lb, mb, rb, my, mx, mw, shift%, clkcnt, drag, b$, autokey$
Case 5
If b_hover = 0 Or force Then BTabHl = btnmap(fb.tb)
End Select
If demo Then
q1 = CsrLin: q2 = Pos(0)
Color fb.FTextFg, fb.FTextBg
Locate y1(1), x1(1): Print Space$(2);: Locate y1(1), x1(1): Print LTrim$(Str$(b_hover));
Locate y1(2), x1(2): Print Space$(2);: Locate y1(2), x1(2)
If b_hover Then Print LTrim$(Str$(BStyle(b_hover))); Else j = 0: Print LTrim$(Str$(j));
Locate y1(3), x1(3): Print Space$(2);: Locate y1(3), x1(3): Print LTrim$(Str$(fb.tb));
Color fb.Fg, fb.Bg
Locate q1, q2
End If
_Display
Locate s1, s2, 0 ''''
If fb.SimClick Then fb.BSelect = fb.SimClick: fb.SimClick = 0: _Delay .1
End Sub
Sub fb_fields (fb As fields_and_buttons, y, x, length, lengthmax, filler$)
Static initiate As Integer, cnt As Integer
If initiate = 0 Or clean Then
initiate = 1
cnt = 0
If fb.Bg <> _BackgroundColor Then Color fb.Fg, fb.Bg: Cls
If clean Then clean = 0: initiate = 0: Exit Sub
End If
s1 = CsrLin: s2 = Pos(0)
c1 = _DefaultColor: c2 = _BackgroundColor
fb.nof = fb.nof + 1: fb.tabmax = fb.tabmax + 1: cnt = cnt + 1
ReDim _Preserve text$(fb.nof), textlen(cnt), textlenmax(cnt), fld$(fb.nof), fh(cnt), tabmap(fb.nof)
ReDim _Preserve fnx(fb.nof), y1(fb.nof), x1(fb.nof), y2(fb.nof), x2(fb.nof), FType(fb.nof)
FType(fb.nof) = 1
textlen(cnt) = length
textlenmax(cnt) = lengthmax
Locate y, x
fnx(fb.nof) = x
tabmap(fb.nof) = cnt
Color fb.FNamFg, fb.Bg
Print fb.a;
Color fb.Bg, fb.FTextBg
Print "Ý";
j = Len(fb.a) + length + 2 ' Used in Line statement for highlighting line length configuration.
If Len(filler$) Then
fld$(fb.nof) = filler$
fb.a = filler$ + Space$(length - Len(filler$)): fb_map fb, 1
text$(cnt) = filler$
Else
fb.a = Space$(length): fb_map fb, 1
End If
Print "Þ";
t = _NewImage((j + 1) * 8, 2 * 16, 32)
_Dest t
Line (0, 0)-(j * 8 + 1, 16 * 1 + 3), _RGB32(fb.FHlRed, fb.FHlGrn, fb.FHlBlu), B
fh(cnt) = _CopyImage(t, 33)
_FreeImage t
_Dest 0
Color c1, c2
Locate s1, s2
End Sub
Sub fb_make (fb As fields_and_buttons, y As Integer, x As Integer, ButtonStyle As Integer)
Static initiate As Integer, btnnbr As Integer
If initiate = 0 Or clean Then
initiate = 1
btnnbr = 0
If fb.Bg <> _BackgroundColor Then Color fb.Fg, fb.Bg: Cls
If clean Then clean = 0: initiate = 0: Exit Sub
End If
s1 = CsrLin: s2 = Pos(0)
c1 = _DefaultColor: c2 = _BackgroundColor
j = Len(fb.a)
fb.nof = fb.nof + 1: fb.nob = fb.nob + 1: fb.tabmax = fb.tabmax + 1
ReDim _Preserve fld$(fb.nof), FType(fb.nof), btnmap(fb.nof), btnfld(fb.nob), BStyle(fb.nof)
BStyle(fb.nof) = ButtonStyle ' Passed variable from main.
FType(fb.nof) = 5
btnnbr = btnnbr + 1
btnmap(fb.nof) = btnnbr
btnfld(btnnbr) = fb.nof
ReDim _Preserve y1(fb.nof), x1(fb.nof), y2(fb.nof), x2(fb.nof), button$(fb.nof)
button$(btnnbr) = String$(j, 0) ' Fill any spaces with the null character.
Mid$(button$(btnnbr), 1 + (j - Len(_Trim$(fb.a))) \ 2) = _Trim$(fb.a)
Select Case BStyle(fb.nof)
Case 1 ' Single line button with blank border.
y = Abs(y)
Color fb.B1Fg, fb.B1Bg: Locate y, x: fb.a = button$(btnnbr): fb_map fb, 5
Color fb.B1Bg, fb.Bg: Locate y - 1, x: fb.a = String$(j, Chr$(220)): fb_map fb, 0
Locate y + 1, x: fb.a = String$(j, Chr$(223)): fb_map fb, 0
Case 2 ' Text button with line border.
Color fb.B2BdrFg, fb.Bg
Locate y - 1, x - 1: fb.a = Chr$(218) + String$(j, 196) + Chr$(191): fb_map fb, 6
Locate y, x - 1: fb.a = Chr$(179): fb_map fb, 0
Locate , Pos(0) + j: fb.a = Chr$(179): fb_map fb, 0
Locate y + 1, x - 1: fb.a = Chr$(192) + String$(j, 196) + Chr$(217): fb_map fb, 7
Locate y, x: fb.a = button$(btnnbr): fb_map fb, 0
Case 3 ' Text hybrid button with graphics line border.
Palette 6, 56
j = Len(fb.a)
k = btnnbr
ReDim _Preserve x(btnnbr), y(btnnbr), button$(btnnbr), bl1(btnnbr), bl2(btnnbr)
y(k) = y - 1: x(k) = x - 1
button$(i) = String$(j, 0)
Mid$(button$(i), 1 + (j - Len(_Trim$(fb.a))) / 2) = _Trim$(fb.a)
Locate y - 1, x - 1: Color fb.B3Fg, fb.Bg: fb.a = String$(j + 2, "Ü"): fb_map fb, 6
Locate y, x - 1: Color fb.B3Fg, fb.B3Fg: fb.a = String$(j + 2, 0): fb_map fb, 0
Locate y + 1, x - 1: Color fb.B3Fg, fb.Bg: fb.a = String$(j + 2, "ß"): fb_map fb, 7
Dest = _Dest
t = _NewImage((j + 3) * 8, 4 * 16, 32)
_Dest t
Line (2, 7 + 2)-((j + 2) * 8 - 2, 16 * 2 + 7 - 2), _RGB32(fb.B3Ln1Red, fb.B3Ln1Grn, fb.B3Ln1Blu), B
Line (0, 7)-((j + 2) * 8, 16 * 2 + 7), _RGB32(fb.B3Ln2Red, fb.B3Ln2Grn, fb.B3Ln2Blu), B
Line (8, 15)-((j + 1) * 8, 16 + 15), _RGB32(fb.B3Ln3Red, fb.B3Ln3Grn, fb.B3Ln3Blu), B
bl1(btnnbr) = _CopyImage(t, 33)
_FreeImage t
t = _NewImage((j + 3) * 8, 4 * 16, 32)
_Dest t
Line (2, 7 + 2)-((j + 2) * 8 - 2, 16 * 2 + 7 - 2), _RGB32(fb.B3Ln1HvrRed, fb.B3Ln1HvrGrn, fb.B3Ln1HvrBlu), B
Line (0, 7)-((j + 2) * 8, 16 * 2 + 7), _RGB32(fb.B3Ln2HvrRed, fb.B3Ln2HvrGrn, fb.B3Ln2HvrBlu), B
Line (8, 15)-((j + 1) * 8, 16 + 15), _RGB32(fb.B3Ln3HvrRed, fb.B3Ln3HvrGrn, fb.B3Ln3HvrBlu), B
bl2(btnnbr) = _CopyImage(t, 33)
_FreeImage t
_Dest 0
Case 4 ' Graphics hybrid button.
j = Len(fb.a)
ReDim _Preserve x(btnnbr), y(btnnbr), button$(btnnbr), gfx1(btnnbr), gfx2(btnnbr), gfx3(btnnbr)
y(btnnbr) = y - 1: x(btnnbr) = x - 1
button$(btnnbr) = String$(j + 2, 0)
Mid$(button$(btnnbr), 1 + (j - Len(_Trim$(fb.a))) / 2) = _Trim$(fb.a)
fb.a = " " + button$(btnnbr) + " ": j = j + 2 ' Widen margins for better button appearance.
Locate y - 1, x - 1: fb_map fb, 8
Locate y, x - 1: fb_map fb, -1
Locate y + 1, x - 1: fb_map fb, 9
gfx1(btnnbr) = fb_gfx(j * 8, 2 * 16, 170, 170, 170, -9, -9, -1, Mid$(fb.a, 1, j))
gfx2(btnnbr) = fb_gfx(j * 8, 2 * 16, 200, 200, 200, -8, -7, -1, Mid$(fb.a, 1, j))
gfx3(btnnbr) = fb_gfx(j * 8, 2 * 16, 200, 200, 200, -1, -1, -1, Mid$(fb.a, 1, j))
Case 5 ' HTML button.
img& = _LoadImage("activate-static.png", 32)
i = _Height(img&)
j = _Width(img&)
If j Mod 8 Then j = j \ 8 + 1 Else j = j \ 8
If i Mod 16 Then i = i \ 16 + 1 Else i = i \ 16
If i / 2 <> i \ 2 Then i = i + 1
If j / 2 <> j \ 2 Then j = j + 1
button$(btnnbr) = _Trim$(fb.a)
fb.a = String$(j, i)
ReDim _Preserve x(btnnbr), y(btnnbr), button$(btnnbr), h1(btnnbr), h2(btnnbr), h3(btnnbr)
y(btnnbr) = y - 1: x(btnnbr) = x - 1
Locate y - 1, x - 1: fb_map fb, 10
For k = 0 To i - 2
Locate y + k, x - 1: fb_map fb, -1
Next
h1(btnnbr) = _CopyImage(img&, 33)
_FreeImage img&
img& = _LoadImage("activate-hover.png", 32)
h2(btnnbr) = _CopyImage(img&, 33)
_FreeImage img&
img& = _LoadImage("activate-active.png", 32)
h3(btnnbr) = _CopyImage(img&, 33)
_FreeImage img&
End Select
Color c1, c2
Locate s1, s2
End Sub
Function fb_gfx (wide, tall, r, g, b, rc, gc, bc, caption$)
' Button function courtesy of the Amazing Steve.
Dim k 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$
fb_gfx = _CopyImage(t, 33)
_FreeImage t
_Dest Dest
End Function
Sub fb_map (fb As fields_and_buttons, mapid)
Static initiate As Integer, mapfld As Integer
If initiate = 0 Or clean Then
initiate = 1
ReDim mRow$(_Height)
mapfld = 96
If clean Then clean = 0: initiate = 0: Exit Sub
End If
If fb.mapping And mRow$(CsrLin) = "" Then mRow$(CsrLin) = Space$(_Width)
Select Case mapid
Case 1 ' Simple text field.
mapfld = mapfld + 1 ' Advance.
y1(mapfld - 96) = CsrLin
x1(mapfld - 96) = Pos(0)
y2(mapfld - 96) = CsrLin
x2(mapfld - 96) = Pos(0) + Len(fb.a)
Case 5 ' Single line button with blank padding.
mapfld = mapfld + 1 ' Advance.
y1(mapfld - 96) = CsrLin
x1(mapfld - 96) = Pos(0)
y2(mapfld - 96) = CsrLin
x2(mapfld - 96) = Pos(0) + Len(fb.a)
Case 6 ' Text or hybrid button top.
mapfld = mapfld + 1 ' Advance.
y1(mapfld - 96) = CsrLin: x1(mapfld - 96) = Pos(0)
Case 7 ' Text or hybrid button bottom.
y2(mapfld - 96) = CsrLin: x2(mapfld - 96) = Pos(0) + Len(fb.a)
Case 8 ' Graphics hybrid button top.
mapfld = mapfld + 1 ' Advance.
y1(mapfld - 96) = CsrLin
x1(mapfld - 96) = Pos(0)
Case 9 ' Graphics hybrid button bottom.
y2(mapfld - 96) = CsrLin
x2(mapfld - 96) = Pos(0) + Len(fb.a)
Case 10 ' HTML button.
mapfld = mapfld + 1 ' Advance.
y1(mapfld - 96) = CsrLin
x1(mapfld - 96) = Pos(0)
y2(mapfld - 96) = CsrLin + Asc(Mid$(fb.a, 1, 1))
x2(mapfld - 96) = Pos(0) + Len(fb.a)
End Select
If fb.mapping Then Mid$(mRow$(CsrLin), Pos(0)) = String$(Len(fb.a), Chr$(mapfld))
If mapid < 8 And mapid > -1 Then Print fb.a;
End Sub
Sub popup (m.top, m.left, m.height, m.width)
pop = 1
c.MenuBdrFg = 0
c.MenubrdBg = 5
c.MenuSdwFg = 6
c.MenuSdwBg = 0
c.MenuFg = 0
c.MenuBg = 5
spacing = 1
PCopy 0, 1
Palette 7, 7
Palette 6, 56
Locate m.top - pop, m.left - pop
For h = 1 To m.height
If h = 1 Then
Color c.MenuBdrFg, c.MenubrdBg
Print Chr$(218) + String$(m.width - 2, 196) + Chr$(191)
j = CsrLin
For i = 1 To m.height - 2
If CsrLin < _Height Then Locate j, m.left - pop Else Locate , m.left - pop
Color c.MenuBdrFg, c.MenubrdBg: Print Chr$(179);
Color c.MenuBdrFg, c.MenubrdBg: Print Space$(m.width - 2);
Color c.MenuBdrFg, c.MenubrdBg: Print Chr$(179);
j = j + 1
Next
Locate j, m.left - pop
Color c.MenuBdrFg, c.MenubrdBg: Print Chr$(192) + String$(m.width - 2, 196) + Chr$(217);
If pop Then ' Shadow effect.
Color c.MenuSdwFg, c.MenuSdwBg ' Shadow below.
Locate CsrLin + 1, m.left - pop + 2
For i = 1 To m.width
j = Screen(CsrLin, Pos(0))
Print Chr$(j);
Next
Locate m.top - pop + 1 ' Shadow to the right.
For i = 1 To m.height - 1
Locate , m.left - pop + m.width
j = Screen(CsrLin, Pos(0))
Print Chr$(j);
j = Screen(CsrLin, Pos(0))
Print Chr$(j)
Next
End If
End If
Color c.MenuFg, c.MenuBg
Locate m.top - pop + h + (h - 1) * spacing, m.left - pop + 2 - 1
Next h
End Sub
Sub dmo (fb As fields_and_buttons, nul As String * 1, lb, mb, rb, mw, my, mx)
Width 80, 35: _Font 16
ReDim a$(_Height)
_ScreenMove 0, 0
Input "Choose a button mapping method 0 or 1: ", fb.mapping
If fb.mapping = 0 Then _Title "Mouse / Keyboard Demo with Array Mapping" Else _Title "Mouse / Keyboard Demo with Screen Mapping"
_KeyClear
_Display
fb.Fg = 0
fb.Bg = 5
Palette fb.Bg, 63
Color fb.Fg, fb.Bg: Cls
fb.FTextFg = 15: fb.FTextBg = 0: fb.FNamFg = 0
fb.FHlRed = 0: fb.FHlGrn = 155: fb.FHlBlu = 155
fb.B1Fg = 15: fb.B1Bg = 1: fb.B1HvrFg = 3: fb.B1HvrBg = 3: fb.B1FlashFg = 1: fb.B1FlashBg = 3
fb.B2BdrFg = 8: fb.B2BdrHover = 1: fb.B2BdrFlash = 9
fb.B3Fg = 6: fb.B3Bg = 7: fb.B3FlashFg = 15: fb.B3FlashBg = 6
fb.B3Ln1Red = 155: fb.B3Ln1Grn = 155: fb.B3Ln1Blu = 155
fb.B3Ln2Red = 0: fb.B3Ln2Grn = 0: fb.B3Ln2Blu = 0
fb.B3Ln3Red = 255: fb.B3Ln3Grn = 255: fb.B3Ln3Blu = 255
fb.B3Ln1HvrRed = 0: fb.B3Ln1HvrGrn = 155: fb.B3Ln1HvrBlu = 155
fb.B3Ln2HvrRed = 0: fb.B3Ln2HvrGrn = 0: fb.B3Ln2HvrBlu = 0
fb.B3Ln3HvrRed = 255: fb.B3Ln3HvrGrn = 255: fb.B3Ln3HvrBlu = 255
fb.a = "Hover:": fb_fields fb, 2, 51, 2, 0, nul
fb.a = "Button Style:": fb_fields fb, 4, 51, 2, 0, nul
fb.a = "Tab:": fb_fields fb, 6, 51, 2, 0, nul
fb.a = " Button 1 ": fb_make fb, 10, 51, 1
fb.a = " Button 2 ": fb_make fb, 10, 66, 1
fb.a = " Button 3 ": fb_make fb, 15, 51, 2
fb.a = " Button 4 ": fb_make fb, 15, 66, 2
fb.a = " Button 5 ": fb_make fb, 20, 51, 3
fb.a = " Button 6 ": fb_make fb, 20, 66, 3
fb.a = " Button 7 ": fb_make fb, 25, 51, 4
fb.a = " Button 8 ": fb_make fb, 25, 66, 4
fb.a = "Activate": fb_make fb, 30, 51, 5
fb.a = "Activate": fb_make fb, 30, 66, 5
fb.a = "Text:": fb_fields fb, _Height - 2, 51, 19, 38, "Text goes here."
Locate 1, 1
_ControlChr Off
SkipAct = 0: z1 = Timer
idle = 5
Do
MyMouse_and_Keyboard act, lb, mb, rb, my, mx, mw, shift%, AltStatus%, AltToggle%, alt%, ctrl%, clkcnt, drag, k&, b$, autokey$
If act Or Abs(z1 - Timer) < idle Or SkipAct <> 0 Then
If SkipAct = 0 Then If act Then z1 = Timer: Palette fb.Bg, 63
fb_main fb, b$, mx, my, lb, rb, shift%, drag, autokey$
door = 0
Else
Palette fb.Bg, 7
If door = 0 Then fb_main fb, b$, mx, my, lb, rb, shift%, drag, autokey$
door = -1
End If
If drag Then
If olddrag <> drag Then
If drag > 0 Then print_array "Drag Right. Status = " + LTrim$(Str$(drag)) Else print_array "Drag Left. Status = " + LTrim$(Str$(drag))
olddrag = drag
End If
Else
olddrag = 0
End If
If oldlb <> lb Then
Select Case lb
Case 0
print_array "Left Button Up - Button Status = " + LTrim$(Str$(lb))
print_array "Number of clicks = " + LTrim$(Str$(clkcnt))
Case -1
print_array "Left Button Down - Button Status = " + LTrim$(Str$(lb))
Case 1
print_array "Left Button Pressed - Button Status = " + LTrim$(Str$(lb))
Case 2
print_array "Left Button Released - Button Status = " + LTrim$(Str$(lb))
End Select
End If
If oldmb <> mb Then
Select Case mb
Case 0: print_array "Middle Button Up - Button Status = " + LTrim$(Str$(mb))
Case -1: print_array "Middle Button Down - Button Status = " + LTrim$(Str$(mb))
Case 1: print_array "Middle Button Pressed - Button Status = " + LTrim$(Str$(mb))
Case 2: print_array "Middle Button Released - Button Status = " + LTrim$(Str$(mb))
End Select
End If
If oldrb <> rb Then
Select Case rb
Case 0: print_array "Right Button Up - Button Status = " + LTrim$(Str$(rb))
Case -1: print_array "Right Button Down - Button Status = " + LTrim$(Str$(rb))
Case 1: print_array "Right Button Pressed - Button Status = " + LTrim$(Str$(rb))
Case 2: print_array "Right Button Released - Button Status = " + LTrim$(Str$(rb))
End Select
End If
If oldmw <> mw Then
If mw < 0 Then print_array "Mouse Wheel Up - Wheel Status = " + LTrim$(Str$(mw))
If mw > 0 Then print_array "Mouse Wheel Down - Wheel Status = " + LTrim$(Str$(mw))
End If
If fb.BSelect Then print_array "Button Selected = " + LTrim$(Str$(fb.BSelect))
If oldalt% <> alt% Then
If alt% < 0 Then print_array "Alt Button Down" Else print_array "Alt Button Released"
End If
If oldctrl% <> ctrl% Then
If ctrl% < 0 Then print_array "Ctrl Button Down" Else print_array "Ctrl Button Released"
End If
If oldshift% <> shift% Then
If shift% < 0 Then print_array "Shift Button Down" Else print_array "Shift Button Released"
End If
If AltStatus% And OldAltStatus% <> AltStatus% Then
If AltToggle% Then print_array "Alt Key Pressed / Alt Toggle Status: On" Else print_array "Alt Key Pressed / Alt Toggle Status: Off"
End If
If k& < 0 Then oldb$ = ""
Select Case Len(b$)
Case 1
If oldb$ <> b$ Then x = CVI(MKI$(Asc(b$))): print_array "You Pressed: " + Chr$(x) + " Chr$(" + LTrim$(Str$(x)) + ")"
oldb$ = b$
Case 2
If oldb$ <> b$ Then print_array "You Pressed: " + "nul + " + LTrim$(Str$(Asc(Mid$(b$, 2, 1)))) + " Chr$(0) + " + Chr$(34) + Mid$(b$, 2, 1) + Chr$(34)
oldb$ = b$
End Select
oldlb = lb: oldrb = rb: oldmb = mb: oldmw = mw: oldalt% = alt%: oldctrl% = ctrl%: oldshift% = shift%: OldAltStatus% = AltStatus%
Loop
End Sub
Sub print_array (a$)
Static cnt As Integer, y As Integer
s1 = CsrLin: s2 = Pos(0)
y = y + 1
If cnt = _Height - 1 Then
Locate 1, 1
j = cnt: cnt = 0
For cnt = 1 To j - 1
a$(cnt) = a$(cnt + 1)
Print a$(cnt);
Next
a$(cnt) = Space$(45)
Mid$(a$(cnt), 1) = a$
Print a$(cnt);
Else
cnt = cnt + 1
a$(cnt) = Space$(45)
Mid$(a$(cnt), 1) = a$
Locate y, 1
Print a$(cnt);
End If
Locate s1, s2
End Sub
Sub MyInput (fb As fields_and_buttons, chngfld As Integer, ifield, lb, mb, rb, my, mx, mw, shift%, clkcnt, drag, b$, autokey$) ' Single line keyboard routine for input.
Static initiate, ml, mr, y, x, ovw, hscr, restore_color1, restore_color2
Static hl, string_pos, mhover_close, s1color, s2color
Static mki As inputvars
Static mhlinput As _Bit, popit
Static restricted_keys$
Static flen(), yfield(), xfield(), maxflen(), menu$()
restore_color1 = _DefaultColor: restore_color2 = _BackgroundColor
If initiate = 0 Then
initiate = 1
Type inputvars
CurStyle As Integer
CurShow As Integer
hl1 As Integer
hl2 As Integer
fld As Integer
mhovery As Integer
mhoverx As Integer
mvar As Integer
mtop As Integer
mleft As Integer
myclose As Integer
mxclose As Integer
page_color As Integer
skin_frg As Integer
skin_bkg As Integer
input_frg As Integer
input_bkg As Integer
skin_shadow_frg As Integer
skin_shadow_bkg As Integer
mwidth As Integer
mheight As Integer
End Type
Rem mki As inputvars is Dimmed as a static variable.
mki.page_color = _BackgroundColor
mki.hl1 = 0
mki.hl2 = 2: Palette 2, 46
mki.input_frg = 15
mki.input_bkg = 0
mki.skin_frg = 3: Palette mki.skin_frg, 1
mki.skin_bkg = 5: Palette mki.skin_bkg, 63
mki.skin_shadow_frg = 8
mki.skin_shadow_bkg = 0
End If
If initiate = 1 Or chngfld > 0 Then
initiate = 2
If hl Then Locate y, x: GoSub hl_off
b$ = "" ' Needed to prevent an autokey event if tab was used to open this input field.
Locate y1(fb.tb), x1(fb.tb)
Color mki.input_frg, mki.input_bkg ' Initiate input text color.
mki.fld = ifield: If mki.fld = 0 Then mki.fld = 1
ReDim _Preserve yfield(mki.fld) ' Row.
ReDim _Preserve xfield(mki.fld) ' Column.
ReDim _Preserve flen(mki.fld) ' Field length.
ReDim _Preserve maxflen(mki.fld) ' Max text length.
flen(mki.fld) = textlen(mki.fld)
maxflen(mki.fld) = textlenmax(mki.fld)
yfield(mki.fld) = CsrLin
xfield(mki.fld) = Pos(0)
If mki.CurStyle = 0 Then mki.CurStyle = 7: mki.CurShow = 1 ' Default cursor.
hscr = 0: mki.mhovery = 0: mki.mhoverx = 0: mhlinput = 0
ml = Pos(0)
mr = ml + flen(mki.fld)
If chngfld > 0 Then
chngfld = -chngfld
If lb <> 0 Then Locate my, mx
End If
y = CsrLin: x = Pos(0) ' Initial cursor position.
mki.CurShow = 1: Locate y, x, mki.CurShow, 7, mki.CurStyle ' Show cursor.
End If
Color mki.input_frg, mki.input_bkg: Locate y, x, 1
If popit Then
MyInput_PopUp mki, menu$(), hl, popit, lb, mb, rb, my, mx, mw, drag, b$
mki.CurShow = 1: Locate , , mki.CurShow, 7, mki.CurStyle ' Show cursor
Else
Do
string_pos = Pos(0) - ml ' Track text position from 0 to maxflen(mki.fld).
If InStr(restricted_keys$, LCase$(b$)) And Len(b$) = 1 Then
_MessageBox " Invalid character.", "File names cannot contain the following characters: " + restricted_keys$, "info"
b$ = ""
End If
If mki.myclose Then ' Self contained close on x click routine. Includes hover and left click release.
If my = mki.myclose And mx = mki.mxclose Or mhover_close Then
If mhover_close And lb = 2 Then Exit Do ' Close popup and exit input routine.
y = CsrLin: x = Pos(0)
s1color = _DefaultColor: s2color = _BackgroundColor
j = mhover_close
If my = mki.myclose And mx = mki.mxclose Then
If mhover_close = 0 Then Color mki.skin_bkg, 4: mhover_close = 1
Else
If mhover_close Then Color mki.skin_frg, mki.skin_bkg: mhover_close = 0
End If
If j <> mhover_close Then
Locate mki.myclose, mki.mxclose - 1: Print " x ";
Color s1color, s2color
Locate y, x
End If
End If
End If
If mhlinput Then If drag = 0 And lb = 0 Then mhlinput = 0 ' Quit mouse input line highlighting.
If lb > 0 Or drag Then ' Mouse button events.
Do
If drag Then
If my = yfield(mki.fld) Or mhlinput Then
If mx >= ml - hscr And mx <= ml + Len(text$(mki.fld)) - hscr Or mhlinput Then
mhlinput = -1
If drag > 0 Then
If mx > Pos(0) - 1 Then
shift% = -1: GoSub cursor_forward '|--------------->
string_pos = Pos(0) - ml
y = CsrLin: x = Pos(0)
End If
Else
If mx < Pos(0) Then
shift% = -1: GoSub cursor_back '|--------------->
string_pos = Pos(0) - ml
y = CsrLin: x = Pos(0)
End If
End If
End If
Exit Do
End If
End If
If lb = 1 Or clkcnt > 1 Then
For i = 1 To UBound(yfield) ' Find input line.
If my = yfield(i) And mx >= xfield(i) And mx <= xfield(i) + flen(i) Then ' Mouse cursor in an input field.
If hl Then GoSub hl_off '|--------------->
Rem If i <> 1 Then If text$(1) = "" Then Beep: Exit Do ' Uniqueue restriction when no text is present in first input field.
mki.fld = i
If clkcnt > 1 Then
GoSub select_all '|--------------->
Else
GoSub mouse_click_relocate '|--------------->
End If
y = CsrLin: x = Pos(0)
Exit For
End If
Next
Exit Do
End If
If lb = 2 Then ' Mouse button pressed and released.
'</----------------------- USER DEFINED ROUTINE -----------------------/>
Exit Do
End If
Exit Do
Loop
End If
If rb = 2 Then ' Right mouse button released.
If mki.mvar < 1 Then
If my <> yfield(mki.fld) Then ' Check for change input field click.
For i = 1 To UBound(yfield)
If my = yfield(i) Then ' Change input fields.
Rem If i <> 1 Then If text$(1) = "" Then Beep: Exit Do ' Uniqueue restriction when no text is present in first input field.
If i <> mki.fld Then ' Remove any highlighting if input line is being changed.
If hl Then GoSub hl_off '|--------------->
End If
mki.fld = i
GoSub mouse_click_relocate '|--------------->
Exit For
End If
Next
End If
popit = -1
End If
End If
Exit Do ' Flow through.
Loop
End If
If Len(b$) Then
Select Case b$
Case Chr$(27) ' Esc key.
Rem Exit Do ' Leave sub.
Case Chr$(9), Chr$(13) ' Tab or Enter key.
initiate = 1
If hl Then GoSub hl_off '|--------------->
autokey$ = Chr$(9)
Rem Exit Do ' Leave sub.
Case Chr$(8) ' Backspace key.
GoSub backspace '|--------------->
Case Chr$(0) + "S" ' Delete key.
GoSub delete '|--------------->
Case Chr$(0) + "M" ' Arrow right key.
GoSub cursor_forward '|--------------->
Case Chr$(0) + "K" ' Arrow left key.
GoSub cursor_back '|--------------->
Case Chr$(0) + "t" ' Ctrl + Arrow right key.
GoSub ctrl_rt '|--------------->
Case Chr$(0) + "s" ' Ctrl + Arrow left key.
GoSub ctrl_lt '|--------------->
Case Chr$(0) + "G" ' Home
GoSub cur_home '|--------------->
Case Chr$(0) + "O" ' End
GoSub cur_end '|--------------->
Case Chr$(0) + "R" ' Insert/overwrite toggel.
ovw = 1 - ovw
If ovw Then mki.CurStyle = 30 Else mki.CurStyle = 7
Locate , , mki.CurShow, 7, mki.CurStyle ' Change cursor appearance. Assumes cursor is shown, not hidden.
Case Chr$(22) ' Ctrl + V - Paste
GoSub paste '|--------------->
Case Chr$(3) ' Ctrl + C - Copy
GoSub copy '|--------------->
Case Chr$(24) ' Ctrl + X - Cut
GoSub cut '|--------------->
Case Chr$(1) ' Select all.
GoSub select_all '|--------------->
Case Chr$(32) To "z"
GoSub print_chr '|--------------->
End Select
y = CsrLin: x = Pos(0) ' Track cursor.
End If
Color restore_color1, restore_color2
Exit Sub
print_chr:
If hl Then GoSub cut '|--------------->
string_pos = Pos(0) - ml
If string_pos + ml < mr - 1 And Len(text$(mki.fld)) < flen(mki.fld) - 1 Then
If ml + Len(text$(mki.fld)) < mr Then
text$(mki.fld) = Mid$(text$(mki.fld), 1, string_pos) + b$ + Mid$(text$(mki.fld), string_pos + 1 + ovw)
Locate , ml: Print Space$(flen(mki.fld));: Locate , ml
Print text$(mki.fld);
Locate , ml + string_pos + 1
End If
Else ' Horizontal scrolling.
If Len(text$(mki.fld)) < maxflen(mki.fld) Then
If string_pos = flen(mki.fld) - 1 Or string_pos = flen(mki.fld) - 2 And string_pos < Len(text$(mki.fld)) - hscr - 1 Then
j = 1 ' At right margin.
Else
j = 0
End If
text$(mki.fld) = Mid$(text$(mki.fld), 1, hscr + string_pos) + b$ + Mid$(text$(mki.fld), hscr + string_pos + 1 + ovw)
hscr = hscr + j
Locate , ml
If ovw Then Print Space$(flen(mki.fld));: Locate , ml
Print Mid$(text$(mki.fld), hscr + 1, flen(mki.fld));
Locate , ml + string_pos + 1 - j
End If
End If
Return
backspace:
If hl And shift% = 0 Then GoSub cut: Return '|--------------->
If string_pos = 0 And hscr > 0 Or string_pos > 0 Then
If hl Then GoSub hl_off '|--------------->
text$(mki.fld) = Mid$(text$(mki.fld), 1, hscr + string_pos - 1) + Mid$(text$(mki.fld), hscr + string_pos + 1)
If hscr Then hscr = hscr - 1: j = 0 Else j = 1
Locate , ml: Print Space$(flen(mki.fld));
Locate , ml
Print Mid$(text$(mki.fld), hscr + 1, flen(mki.fld));
Locate , x - j
End If
Return
delete:
If hl Then
GoSub cut '|--------------->
Else
text$(mki.fld) = Mid$(text$(mki.fld), 1, hscr + string_pos) + Mid$(text$(mki.fld), hscr + string_pos + 2)
Locate , ml: Print Space$(flen(mki.fld));
Locate , ml
Print Mid$(text$(mki.fld), hscr + 1, flen(mki.fld));
Locate , x
End If
Return
cur_home:
Do
GoSub cursor_back '|--------------->
string_pos = Pos(0) - ml
Loop Until hscr = 0 And string_pos = 0
Return
cur_end:
Do
GoSub cursor_forward '|--------------->
string_pos = Pos(0) - ml
Loop Until string_pos + 1 > Len(text$(mki.fld)) - hscr
Return
cursor_forward:
If hl And shift% = 0 Then GoSub hl_off '|--------------->
If string_pos + 1 <= Len(text$(mki.fld)) - hscr Then
If ml + string_pos + 1 = mr And Len(text$(mki.fld)) >= flen(mki.fld) And shift% = 0 Then
hscr = hscr + 1
Locate , ml: Print Space$(flen(mki.fld));: Locate , ml
Print Mid$(text$(mki.fld), hscr + 1, flen(mki.fld));
If string_pos <> Len(text$(mki.fld)) - hscr Then Locate , Pos(0) - 1
ElseIf shift% And string_pos < Len(text$(mki.fld)) - hscr Then
If string_pos = flen(mki.fld) - 1 Then
hscr = hscr + 1
Color mki.input_frg, mki.input_bkg
Locate , ml: Print Space$(flen(mki.fld));: Locate , ml
If string_pos - hl > flen(mki.fld) Then
Print Mid$(text$(mki.fld), hscr + 1, (flen(mki.fld)) - 1);
Else
Print Mid$(text$(mki.fld), hscr + 1, string_pos - hl - 1);
End If
If hl < 0 Then Color mki.input_frg, mki.input_bkg Else Color mki.hl1, mki.hl2
hl = hl + 1
If Pos(0) = ml Then
Print Mid$(text$(mki.fld), hscr + 1, flen(mki.fld) - 1);
Else
Print Mid$(text$(mki.fld), hscr + 1 + string_pos - hl, (flen(mki.fld)) - (string_pos - hl) - 1);
End If
Else
If hl < 0 Then Color mki.input_frg Else Color mki.hl1, mki.hl2
hl = hl + 1
Print Mid$(text$(mki.fld), hscr + string_pos + 1, 1);
End If
Else
If hl Then GoSub hl_off '|--------------->
If Pos(0) < mr Then Locate , Pos(0) + 1
End If
Color mki.input_frg
End If
Return
cursor_back:
If hl And shift% = 0 Then GoSub hl_off '|--------------->
If string_pos = 0 And shift% = 0 Then
If hscr Then hscr = hscr - 1: Print Mid$(text$(mki.fld), hscr + 1, flen(mki.fld));: Locate , ml
ElseIf shift% Then
If string_pos = 0 Then
If hscr Then
hscr = hscr - 1
If hl > 0 Then Color mki.input_frg, mki.input_bkg Else Color mki.hl1, mki.hl2
hl = hl - 1
j = Abs(hl): If j > (flen(mki.fld)) Then j = flen(mki.fld)
Print Mid$(text$(mki.fld), hscr + 1, j);
Color mki.input_frg, mki.input_bkg: Print Mid$(text$(mki.fld), hscr + 1 + j, (flen(mki.fld)) - j);
Locate , ml
End If
Else
Locate , Pos(0) - 1
If hl > 0 Then Color mki.input_frg, mki.input_bkg Else Color mki.hl1, mki.hl2
Print Mid$(text$(mki.fld), hscr + string_pos, 1);
Locate , Pos(0) - 1
hl = hl - 1
End If
Color mki.input_frg, mki.input_bkg
Else
If hl Then GoSub hl_off '|--------------->
Locate , Pos(0) - 1
End If
Return
ctrl_rt:
Do
GoSub cursor_forward '|--------------->
string_pos = Pos(0) - ml
Loop Until Mid$(text$(mki.fld), hscr + string_pos, 1) = " " Or string_pos >= Len(text$(mki.fld)) - hscr
Return
ctrl_lt:
Do
GoSub cursor_back '|--------------->
string_pos = Pos(0) - ml
Loop Until Mid$(text$(mki.fld), hscr + string_pos, 1) = " " Or Pos(0) = ml And hscr = 0
Return
hl_off:
j = Pos(0)
Locate , ml
Color mki.input_frg, mki.input_bkg
Print Mid$(text$(mki.fld), hscr + 1, flen(mki.fld));
Locate , j
hl = 0
Return
cut:
Color mki.input_frg, mki.input_bkg
Select Case hl
Case Is > 0
If b$ = Chr$(24) Then _Clipboard$ = Mid$(text$(mki.fld), string_pos + 1 + hscr - hl, hl) ' Only copy to clipboard for 'cut' and not delete or paste over highlighted text calls.
j = ml + string_pos - hl
Locate , ml
Print Space$(flen(mki.fld));
text$(mki.fld) = Mid$(text$(mki.fld), 1, hscr + string_pos - hl) + Mid$(text$(mki.fld), hscr + string_pos + 1)
Locate , ml
If j < ml Then hscr = hscr + string_pos - hl: j = ml
Print Mid$(text$(mki.fld), hscr + 1, flen(mki.fld));
Locate , j
Case 0
' Do nothing
Case Is < 0
If b$ <> Chr$(0) + "S" Then _Clipboard$ = Mid$(text$(mki.fld), string_pos + 1 + hscr, Abs(hl))
Locate , ml
Print Space$(flen(mki.fld));
text$(mki.fld) = Mid$(text$(mki.fld), 1, hscr + string_pos) + Mid$(text$(mki.fld), hscr + string_pos + 1 + Abs(hl))
Locate , ml
Print Mid$(text$(mki.fld), hscr + 1, flen(mki.fld));
Locate , ml + string_pos
End Select
hl = 0 ' No need for hl_off.
Return
copy:
Select Case hl
Case Len(text$(mki.fld)) ' Select all.
_Clipboard$ = text$(mki.fld)
Case 1 To Len(text$(mki.fld)) - 1
_Clipboard$ = Mid$(text$(mki.fld), string_pos + 1 - hl, hl)
Case 0
' Do nothing
Case Is < 0
_Clipboard$ = Mid$(text$(mki.fld), string_pos + 1, Abs(hl))
End Select
Return
paste:
If Len(_Clipboard$) Then
If InStr(_Clipboard$, Chr$(13)) Then
tmp$ = "": j = 0
For i = 1 To Len(_Clipboard$)
x$ = Mid$(_Clipboard$, i, 1)
If x$ = Chr$(13) And j = 0 Then
tmp$ = tmp$ + " "
j = -1
Else
If Asc(x$) > 32 Then j = 0
If j = 0 Then tmp$ = tmp$ + x$
End If
Next
Else
tmp$ = _Clipboard$
End If
If Len(text$(mki.fld)) - Abs(hl) + Len(tmp$) <= Abs(hl) + Len(tmp$) Then
If hl Then GoSub cut '|--------------->
text$(mki.fld) = Mid$(text$(mki.fld), 1, hscr + string_pos) + tmp$ + Mid$(text$(mki.fld), hscr + string_pos + 1)
If Pos(0) + Len(tmp$) + 1 >= mr Then
i = hscr
hscr = hscr + Pos(0) + Len(tmp$) + 1 - mr
j = Pos(0) + Len(tmp$) - (hscr - i)
Else
j = Pos(0) + Len(tmp$)
End If
Locate , ml: Print Space$(flen(mki.fld));
Locate , ml: Print Mid$(text$(mki.fld), hscr + 1, flen(mki.fld));
Locate , j
Else
Beep ' Too many characters to paste.
End If
End If
Return
select_all:
GoSub cur_end '|--------------->
hl = Len(text$(mki.fld))
Locate , ml
Color mki.hl1, mki.hl2
Print Mid$(text$(mki.fld), hscr + 1, flen(mki.fld));
Color mki.input_frg, mki.input_bkg
Return
mouse_click_relocate:
If text$(mki.fld) = "" Then
Locate yfield(mki.fld), ml: Print Mid$(text$(mki.fld), 1, flen(mki.fld));
Else
If mx <= xfield(mki.fld) + Len(text$(mki.fld)) Then
Locate my, mx
Else
If Len(text$(mki.fld)) >= flen(mki.fld) - 1 Then
Locate yfield(mki.fld), xfield(mki.fld) + flen(mki.fld) - 1
Else
Locate yfield(mki.fld), xfield(mki.fld) + Len(text$(mki.fld))
End If
End If
End If
Return
End Sub
Sub MyInput_PopUp (mki As inputvars, menu$(), hl, popit, lb, mb, rb, my, mx, mw, drag, b$)
Static initiate, nomi, oldmy, cp1, cp2, cp3, cp4, cp5
Static atmp As String
Static menu_restrict()
Static MenuHL, MenuT, MenuR, MenuB, MenuL, myalt, mxalt
y = CsrLin: x = Pos(0)
restore_color1 = _DefaultColor: restore_color2 = _BackgroundColor
mki.CurShow = 0: Locate , , mki.CurShow ' Hide cursor
If initiate = 0 Then
initiate = 1
cp1 = 0 ' Available menu item.
cp2 = 5 ' Popup background. (Same as mki.skin_bkg)
cp3 = 7 ' Unavailable menu item.
cp4 = 7 ' Shadow.
cp5 = 8 ' Characters under shadow.
Restore PopupMenuData
PopupMenuData: ' eof must be lowercase.
Data Cut.........Ctrl+X,Copy........Ctrl+C,Paste.......Ctrl+V,Clear..........Del,Select All..Ctrl+A
Data Close..........Esc,eof
nomi = 0
Do
Read tmp$
If tmp$ = "eof" Then Exit Do
nomi = nomi + 1
ReDim _Preserve menu$(nomi)
menu$(nomi) = tmp$
Loop
End If
Do
mxalt = 0
If b$ = Chr$(0) + "H" Or mw = -1 Then
If (MenuHL - MenuT + 1) \ 2 > 1 Then
myalt = MenuHL - 2: mxalt = -1
End If
ElseIf b$ = Chr$(0) + "P" Or mw = 1 Then
If MenuHL = 0 Then
myalt = MenuT + 1: mxalt = -1
Else
If (MenuHL - MenuT + 1) \ 2 < nomi Then
myalt = MenuHL + 2: mxalt = -1
End If
End If
ElseIf b$ = Chr$(13) Or mb = 2 Then
If menu_restrict((MenuHL - MenuT + 1) \ 2) = 0 Then
mki.mvar = (MenuHL - MenuT + 1) \ 2
popit = 0
Exit Do
End If
End If
Select Case mki.mvar
Case -1 ' Hover.
If mxalt = 0 Then myalt = my: mxalt = mx
i = myalt > MenuT And myalt < MenuB And mxalt > MenuL And mxalt < MenuR
If i Or mxalt = -1 Then
i = (myalt - MenuT) \ 2 <> (myalt - MenuT) / 2 And myalt <> oldmy
If i Or mxalt = -1 Then ' Works for odd or even number top margins.
If MenuHL Then ' Remove highlighting from previous hover.
atmp = Space$(mki.mwidth - 2)
Mid$(atmp, 2, Len(menu$((MenuHL - MenuT + 1) \ 2))) = menu$((MenuHL - MenuT + 1) \ 2)
Locate MenuHL, MenuL + 2 - 1
If menu_restrict((MenuHL - MenuT + 1) \ 2) Then Color cp3, cp2 Else Color cp1, cp2
Print atmp
End If
atmp = Space$(mki.mwidth - 2)
Mid$(atmp, 2, Len(menu$((myalt - MenuT + 1) \ 2))) = menu$((myalt - MenuT + 1) \ 2)
Locate myalt, MenuL + 2 - 1
If menu_restrict((myalt - MenuT + 1) \ 2) Then Color cp2, cp3 Else Color cp2, cp1
Print atmp;
Color cp1, cp2
MenuHL = myalt
oldmy = my
End If
If lb = 2 Then
If menu_restrict((myalt - MenuT + 1) \ 2) = 0 Then
mki.mvar = (myalt - MenuT + 1) \ 2
popit = 0
Exit Do
End If
End If
Else
' Toggle close popup menu.
If lb = 1 Or rb = 1 Then
If myalt >= _ScreenY And my <= _ScreenY + 24 And mx >= _ScreenX + 36 And mx <= _ScreenX + 48 Then
popit = 0
mki.mvar = 0: Exit Do
Else
If myalt >= _ScreenY And my <= _ScreenY + _FontHeight * (_Height + 1) And mx >= _ScreenX And mx <= _ScreenX + _FontWidth * _Width Then
Else ' Outside of app win.
popit = 0
mki.mvar = 0: Exit Do
End If
End If
End If
End If
If Len(b$) Then
Select Case b$
Case Chr$(0) + "S", Chr$(22), Chr$(24), Chr$(1), Chr$(3): Exit Do
Case Chr$(27): b$ = "": mki.mvar = 0: popit = 0: Exit Do ' Simply close popup.
End Select
End If
Case Else ' Open the menu.
menu_variety = 1
h = 5 ' Variable to determine margin spaces from the right of menu.
If nomi > _Height - 2 Or Len(menu$(1)) > _Width - 4 Then nomi = 0: initiate = 0: Exit Sub ' Not enough room to open popup.
ReDim menu_restrict(nomi) ' Restrictions.
If text$(mki.fld) = "" Then
For i = 1 To nomi - 2: menu_restrict(i) = 1: Next
Else
If hl = 0 Then
For i = 1 To 4: menu_restrict(i) = 1: Next
End If
End If
If Len(_Clipboard$) Then menu_restrict(3) = 0 Else menu_restrict(3) = 1 ' End Restrictions.
For i = 1 To nomi
j = Len(menu$(i))
If j > k Then k = j
Next
mki.mwidth = k + h
mki.mheight = nomi * 2 + 1 ' Add one for the separate border element.
Select Case menu_variety
Case 0 ' Fixed menu to left.
MenuT = 3: MenuL = 1: MenuR = MenuL + mki.mwidth: MenuB = MenuT + mki.mheight
Case 1 ' Movable menu.
While _MouseInput: Wend
MenuT = _MouseY + 1 ' One below input line.
MenuL = _MouseX
If MenuT + mki.mheight >= _Height Then MenuT = _Height - mki.mheight - 1 ' -1 for shadow.
If MenuL + mki.mwidth >= _Width Then MenuL = _Width - mki.mwidth - 1 ' -1 for shadow.
MenuR = MenuL + mki.mwidth: MenuB = MenuT + mki.mheight
End Select
mki.mvar = -1 ' Identifies the menu is open.
PCopy 0, 1
Color cp1, cp2
Locate MenuT, MenuL
Print Chr$(218) + String$(mki.mwidth - 2, 196) + Chr$(191)
For i = 1 To mki.mheight - 2
Color cp1, cp2: Locate , MenuL
Print Chr$(179); Space$(mki.mwidth - 2) + Chr$(179);
Color cp2, cp4: Print Chr$(Screen(CsrLin, Pos(0))) + Chr$(Screen(CsrLin, Pos(0) + 1)): Color cp5, cp2
Next
Color cp1, cp2: Locate , MenuL
Print Chr$(192) + String$(mki.mwidth - 2, 196) + Chr$(217);
Color cp2, cp4: Print Chr$(Screen(CsrLin, Pos(0))) + Chr$(Screen(CsrLin, Pos(0) + 1))
Locate , MenuL + 2
For i = 1 To mki.mwidth
Print Chr$(Screen(CsrLin, Pos(0)));
Next
Locate MenuT + 2, MenuL + 2
For i = 0 To nomi - 1
Locate MenuT + 1 + i * 2, MenuL + 2
If menu_restrict(i + 1) Then Color cp3, cp2 Else Color cp1, cp2
Print menu$(i + 1)
Color cp1, cp2
Locate , MenuL
If i + 1 < nomi Then Print "Ã" + String$(mki.mwidth - 2, Chr$(196)) + "´";
Next
End Select
Exit Do
Loop
If popit = 0 Then PCopy 1, 0: MenuHL = 0
Color restore_color1, restore_color2
Locate y, x
_KeyClear
Select Case mki.mvar
Case 1: b$ = Chr$(24) ' Cut
Case 2: b$ = Chr$(3) ' Copy
Case 3: b$ = Chr$(22) ' Paste
Case 4: b$ = Chr$(0) + "S" ' Delete
Case 5: b$ = Chr$(1) ' Select All
Case 6 ' Do nothing. (Close Menu).
End Select
If mki.mvar > 0 Then mki.mvar = 0
End Sub
