I've made some really nice popup menus in SCREEN 0, but since I started that graphics text app, I thought, oh hell, why not throw together something a little more along the lines that Notepad uses for cut/copy/paste options...
Updated to include right-click to open and close menu. (You need to right click somewhere on the blank screen.) Also, it opens approximately where you make your right click on the screen. A left click off the popup will close it.
Final update: Tightened up the code a bit and put the menu items into a data statement; so they can be easily added to or edited. The program keeps count of the items, so there is no need to change anything, except the data. Just be sure to keep the last data statement as "eof".
Now what's neat is you can easily go into the code and change the font size, where the popup appears, etc. Changing just the font size automatically keeps the popup proportions and dividers, plus all the hot spots for the mouse all together. Like Notepad, it uses mouse hover and click to select. I'll add some more improvements later, but the goal is to get it incorporated into the text routine.
You can download the font files, below or run it without and it will default to lucida console. If you don't have that one, it defaults to the QB 8x16 font.
Now if you will excuse me, one of my DEI hires is working on some sort of SELF DESTRUCT button. I have to keep a constant eye on him...
Doofenshmirtz Evil Incorporated (DEI)
Pete
Updated to include right-click to open and close menu. (You need to right click somewhere on the blank screen.) Also, it opens approximately where you make your right click on the screen. A left click off the popup will close it.
Final update: Tightened up the code a bit and put the menu items into a data statement; so they can be easily added to or edited. The program keeps count of the items, so there is no need to change anything, except the data. Just be sure to keep the last data statement as "eof".
Code: (Select All)
Type popup
nmi As Integer
setup As Integer
status As Integer
pr1 As Integer
pr2 As Integer
pc1 As Integer
pc2 As Integer
phshadow As Integer
pvshadow As Integer
pwdth As Integer
phght As Integer
pbgcolor As Integer
pbbxcolor As Integer
pbshdcolor As Integer
col_matrix As String
row_matrix As String
End Type
Dim pop As popup
Type textvar
nof As Integer ' Number of Fonts.
fsize As Integer ' Font Size.
chr_wdth As Integer ' Character Width in Pixels.
chr_hght As Integer ' Character Height in Pixels.
End Type
Dim tx As textvar
Type mousevar
mx As Integer
my As Integer
wh As Integer
lb As Integer
rb As Integer
action As Integer
lb_status As Integer
rb_status As Integer
oldmx As Integer
End Type
Dim m As mousevar
Screen _NewImage(600, 400, 32)
Color Black, _RGB32(255, 255, 255, 255)
Cls
_Display
_Delay .1
_ScreenMove _Middle
_Delay .1
Do
_Limit 30
mouse_driver m
popup_main tx, m, pop
_Display
Loop
Sub popup_main (tx As textvar, m As mousevar, pop As popup)
Static menu_item$(), fnum()
If m.rb_status = 1 And pop.status = 0 Then
m.rb_status = -1
pop.status = 1
End If
If pop.status = 2 Then
popup_engine tx, m, pop, menu_item$() ' Only to clear variables.
pop.status = 0
PCopy 100, _Display ' Removes popup and restores underlying screen.
Exit Sub
End If
If pop.status = 1 Then
pop.status = -1
PCopy _Display, 100
If pop.setup = 0 Then
pop.setup = -1
$Color:32
tx.nof = 4
Dim fnum(tx.nof) As Long
tx.fsize = 16
load_font tx, fnum()
_Font fnum(1)
tx.chr_wdth = _PrintWidth("A")
tx.chr_hght = _FontHeight
Restore popdata
pop.nmi = 0
Do
Read temp$
If LCase$(temp$) = "eof" Then Exit Do
pop.nmi = pop.nmi + 1
ReDim _Preserve menu_item$(pop.nmi)
menu_item$(pop.nmi) = temp$
Loop
temp$ = ""
End If
' Draw popup window.
pop.pbgcolor = 240
pop.pbbxcolor = 190
pop.pbshdcolor = 86
pop.phght = 2.5 * tx.chr_hght * (pop.nmi - 1) - tx.chr_hght \ 2
pop.pwdth = tx.chr_wdth * 16
pop.pc1 = m.mx + 1: If pop.pc1 + pop.pwdth > _Width - 5 Then pop.pc1 = _Width - 5 - pop.pwdth
pop.pr1 = m.my + 1: If pop.pr1 + pop.phght > _Height - 5 Then pop.pr1 = _Height - 5 - pop.phght
pop.pc2 = pop.pc1 + pop.pwdth
pop.pr2 = pop.pr1 + pop.phght
Line (pop.pc1, pop.pr1)-(pop.pc2, pop.pr2), _RGB32(pop.pbbxcolor, pop.pbbxcolor, pop.pbbxcolor, 255), B
Line (pop.pc1 + 2, pop.pr1 + 2)-(pop.pc2 - 2, pop.pr2 - 2), _RGB32(pop.pbgcolor, pop.pbgcolor, pop.pbgcolor, 255), BF
Line (pop.pc2 + 1, pop.pr1 + 7)-(pop.pc2 + 1, pop.pr2 + 0), _RGB32(pop.pbshdcolor, pop.pbshdcolor, pop.pbshdcolor, 180)
Line (pop.pc2 + 2, pop.pr1 + 7)-(pop.pc2 + 2, pop.pr2 + 0), _RGB32(pop.pbshdcolor, pop.pbshdcolor, pop.pbshdcolor, 180)
Line (pop.pc1 + 5, pop.pr2 + 1)-(pop.pc2 + 2, pop.pr2 + 1), _RGB32(pop.pbshdcolor, pop.pbshdcolor, pop.pbshdcolor, 180)
Line (pop.pc1 + 5, pop.pr2 + 2)-(pop.pc2 + 2, pop.pr2 + 2), _RGB32(pop.pbshdcolor, pop.pbshdcolor, pop.pbshdcolor, 180)
Color _RGB32(0, 0, 0, 190), _RGB32(pop.pbgcolor, pop.pbgcolor, pop.pbgcolor, 255)
pop.col_matrix = String$(_Width, Chr$(0)): pop.row_matrix = pop.col_matrix
j% = 2
For i% = 1 To pop.nmi
Mid$(pop.col_matrix, pop.pc1, pop.pwdth) = String$(pop.pwdth, "*")
Mid$(pop.row_matrix, pop.pr1 + tx.chr_hght \ 2 + ((i% - 1) * tx.chr_hght * 2)) = String$(tx.chr_hght, Chr$(i%))
_PrintString (pop.pc1 + tx.chr_wdth * 2, pop.pr1 + tx.chr_hght \ 2 + ((i% - 1) * tx.chr_hght * 2)), menu_item$(i%)
Next
Color _RGB32(230, 190), _RGB32(230, 190)
For i% = 1 To pop.nmi - 1
Line (pop.pc1 + tx.chr_wdth * 2, pop.pr1 + i% * tx.chr_hght * 2)-(pop.pc2 - tx.chr_wdth * 2, pop.pr1 + i% * tx.chr_hght * 2), _RGB32(200, 255)
Next
Else
If pop.status = -1 Then
popup_engine tx, m, pop, menu_item$()
End If
End If
popdata:
Data Cut
Data Copy
Data Paste
Data Delete
Data Select All
Data Hyperlink
Data eof
End Sub
Sub popup_engine (tx As textvar, m As mousevar, pop As popup, menu_item$())
Static c1, r1, c2, r2, oldmenu_item%
If pop.status = 2 Then ' Close popup.
c1 = 0: c2 = 0: r1 = 0: r2 = 0: oldmenu_item% = 0: pop.col_matrix$ = "": pop.row_matrix$ = ""
Exit Sub
End If
If pop.status = 0 Then Exit Sub
If m.mx < pop.pc1 Or m.mx > pop.pc2 Or m.my < pop.pr1 Or m.my > pop.pr2 Then ' Mouse is outside of popup window.
If m.lb_status = 1 Then pop.status = 2: Exit Sub ' Left click outside of popup will close window.
If m.rb_status = 1 Then m.rb_status = -1: pop.status = 2: Exit Sub ' Right click outside of popup will close wndow.
If oldmenu_item% Then
If m.mx < pop.pc1 Or m.mx > pop.pc2 Or m.my < pop.pr1 Or m.my > pop.pr2 Then
GoSub remove_menu_item_highlighting
End If
End If
Else ' Mouse is inside popup window.
If m.rb_status Then m.rb_status = 0: Exit Sub ' Disables right mouse click insdie menu.
If Mid$(pop.col_matrix, m.mx + 1, 1) = "*" And Mid$(pop.row_matrix, m.my + 1, 1) <> Chr$(0) Then
menu_item% = Asc(Mid$(pop.row_matrix, m.my + 1, 1))
If menu_item% <> oldmenu_item% Or m.lb_status = 1 Then
Select Case m.lb_status
Case -1: Exit Sub ' Do not repeat action until mouse button is released.
Case 1: If m.lb_status = 1 Then m.lb_status = -1
End Select
h% = _InStrRev(m.mx, pop.col_matrix, Chr$(0)) + 1
temp$ = Mid$(pop.col_matrix, h%)
temp$ = Mid$(temp$, 1, InStr(temp$, Chr$(0)) - 1)
i% = Len(temp$)
j% = _InStrRev(m.my, pop.row_matrix, Chr$(0)) + 1
temp$ = Mid$(pop.row_matrix, j%)
temp$ = Mid$(temp$, 1, InStr(temp$, Chr$(0)) - 1)
k% = Len(temp$)
GoSub remove_menu_item_highlighting
c1 = h% + tx.chr_wdth \ 2
r1 = j% - tx.chr_hght \ 4
c2 = h% + i% - tx.chr_wdth \ 2
r2 = j% + k% + tx.chr_hght \ 4
If m.lb_status = -1 Then _Display: _Delay .1
Line (c1, r1)-(c2, r2), _RGB32(0, 170, 250, 255), BF
Color _RGB32(0, 0, 0, 190), _RGB32(0, 170, 250, 255)
_PrintString (pop.pc1 + tx.chr_wdth * 2, pop.pr1 + tx.chr_hght \ 2 + ((menu_item% - 1) * tx.chr_hght * 2)), menu_item$(menu_item%)
If m.lb_status = -1 Then
Color _RGB32(120, 0, 0, 255), _RGB32(255, 255, 255, 255)
_PrintString (10, 1), "You selected: " + menu_item$(menu_item%) + " "
_Display: _Delay 1 Rem REMOVE LATER AFTER DEMO IS COMPLETED.
pop.status = 2 ' Close popup.
End If
oldmenu_item% = menu_item%
End If
End If
End If
Exit Sub '-------------------------------->
remove_menu_item_highlighting:
If c1 Then Line (c1, r1)-(c2, r2), _RGB32(pop.pbgcolor, 255), BF
Color _RGB32(0, 0, 0, 190), _RGB32(pop.pbgcolor, pop.pbgcolor, pop.pbgcolor, 255)
_PrintString (pop.pc1 + tx.chr_wdth * 2, pop.pr1 + tx.chr_hght \ 2 + ((oldmenu_item% - 1) * tx.chr_hght * 2)), menu_item$(oldmenu_item%)
Return
End Sub
Sub load_font (tx As textvar, fnum() As Long)
fnum(1) = _LoadFont("RobotoMono-regular.ttf", tx.fsize)
fnum(2) = _LoadFont("RobotoMono-bold.ttf", tx.fsize)
fnum(3) = _LoadFont("RobotoMono-italic.ttf", tx.fsize)
fnum(4) = _LoadFont("RobotoMono-bolditalic.ttf", tx.fsize)
For i% = 1 To tx.nof
If fnum(i%) <= 0 Then ' Try to load the Windows Lucida Console font.
fnum(1) = _LoadFont(Environ$("SYSTEMROOT") + "\Fonts\lucon.ttf", tx.fsize)
Exit For
End If
Next
If fnum(1) <= 0 Then
tx.fsize = 16 ' Default 8 x 16 font.
fnum(1) = tx.fsize
End If
End Sub
Sub mouse_driver (m As mousevar)
' Local vars: i%,j%
While _MouseInput
m.wh = m.wh + _MouseWheel
Wend
m.mx = _MouseX
m.my = _MouseY
m.lb = _MouseButton(1)
m.rb = _MouseButton(2)
Select Case m.lb
Case 0
Select Case m.lb_status
Case -1
m.lb_status = 0 ' An action occurred and the button was released.
Case 0
' Button has not been pressed yet.
Case 1
m.lb_status = 0 ' Button was released wth no action occurring.
End Select
Case -1
Select Case m.lb_status
Case -1
' An action occurred and the button is still down.
Case 0
m.lb_status = 1
Case 1
' The button is still down but no action occurred.
End Select
End Select
Select Case m.rb
Case 0
Select Case m.rb_status
Case -1
m.rb_status = 0 ' An action occurred and the button was released.
Case 0
' Button has not been pressed yet.
Case 1
m.rb_status = 0 ' Button was released wth no action occurring.
End Select
Case -1
Select Case m.rb_status
Case -1
' An action occurred and the button is still down.
Case 0
m.rb_status = 1
Case 1
' The button is still down but no action occurred.
End Select
End Select
m.oldmx = m.mx
End SubNow what's neat is you can easily go into the code and change the font size, where the popup appears, etc. Changing just the font size automatically keeps the popup proportions and dividers, plus all the hot spots for the mouse all together. Like Notepad, it uses mouse hover and click to select. I'll add some more improvements later, but the goal is to get it incorporated into the text routine.
You can download the font files, below or run it without and it will default to lucida console. If you don't have that one, it defaults to the QB 8x16 font.
Now if you will excuse me, one of my DEI hires is working on some sort of SELF DESTRUCT button. I have to keep a constant eye on him...
Pete
