Files
Pusher_2.0/MyPopup.bas
2023-09-18 06:43:57 -06:00

342 lines
8.6 KiB
QBasic

B4A=true
Group=Default Group
ModulesStructureVersion=1
Type=Class
Version=11
@EndOfDesignText@
' Popup menu class by Kevin Stainsby 2019.
' Works in b4a and b4i
' Needs JavaObject library for Android
' v1.1
Sub Class_Globals
Private Callback As Object
Private Event As String
Private btnList As List
Private anchorView As View
Private maxWidth, maxHeight As Int = 0
Dim borderWidth As Int = 1
Dim btnPadding As Int = 5dip
Dim btnSpacing As Int = 3dip
Dim btnBorderColour As Int = Colors.white
Private pnl As Panel
Private sv As ScrollView
Private maxX, maxY As Int
Private const ANCHOR_BOTTOMMIDDLE As Int = 1
Private const ANCHOR_TOPLEFT As Int = 2
Private showingMenu As Boolean
Dim btnTextColour As Int = Colors.black
Private btnHeight As Int = 45dip
Private btnRadius As Int = 5dip
#if b4i
Private myPanel As Panel
Dim btnColour As Int = Colors.white
Private const animTime As Int = 1000
Private useThisFont As Font
#else if b4a
Dim myActivity As Activity
Dim btnBackgroundColour As Int = Colors.LightGray
Dim btnFontSize As Float = 18.0
Private const animTime As Int = 300
Dim useThisTypeFace As Typeface
#End If
End Sub
'Initializes the popup. Pass a list of strings for the buttons text.
#if b4i
Public Sub Initialize( rootPnl As Panel, CallbackModule As Object, EventName As String, btnText As List, mX As Int, mY As Int, theFont As Font )
useThisFont = theFont
#else if b4A
Public Sub Initialize( anActivity As Activity, CallbackModule As Object, EventName As String, btnText As List, mX As Int, my As Int, theTypeface As Typeface )
useThisTypeFace = theTypeface
#End If
maxX = mX
maxY = my
Callback = CallbackModule
Event = EventName
#if b4i
myPanel = rootPnl
#else if b4A
myActivity = anActivity
#End If
btnList.Initialize
pnl.Initialize("Pnl")
pnl.Color = Colors.Transparent
#if b4i
sv.Initialize("sv", 1, 1)
#else if b4A
sv.Initialize(1)
#End If
sv.Color = Colors.Transparent
For Each s As String In btnText
Dim aBtn As Button
#if b4i
aBtn.Initialize("Btn",aBtn.STYLE_SYSTEM)
aBtn.CustomLabel.Font = useThisFont
aBtn.Text = s
aBtn.SetBorder( borderWidth, btnBorderColour, btnRadius )
aBtn.SetShadow(Colors.black,3dip,3dip,0.7,False)
aBtn.SizeToFit
aBtn.Color = btnColour
SetButtonTextColor(aBtn, btnTextColour )
#else if b4A
aBtn.Initialize("Btn")
setBorder(aBtn, borderWidth, btnRadius, btnBorderColour, btnBackgroundColour)
aBtn.TextSize = btnFontSize
aBtn.SingleLine = True
aBtn.Ellipsize = "END"
aBtn.Gravity = Gravity.CENTER_VERTICAL
aBtn.Padding = Array As Int (btnPadding, btnPadding, btnPadding, btnPadding)
aBtn.Typeface = theTypeface
SetButtonTextColor(aBtn, btnTextColour )
aBtn.Text = s
sv.Panel.AddView( aBtn, 0,0,1,btnHeight)
setButtonWidth( aBtn )
#End If
If aBtn.Width + (btnPadding*2) > maxWidth Then maxWidth = aBtn.Width + (btnPadding *2)
If aBtn.Height + (btnPadding*2) > maxHeight Then maxHeight = aBtn.Height + (btnPadding *2)
btnList.Add(aBtn)
Next
#if b4i
For Each b As Button In btnList
sv.Panel.AddView( b, 0,0,1,btnHeight)
b.SizeToFit
Next
#End If
'Resize to same width (max)..
For Each b As Button In btnList
If b.Width < maxWidth Then b.Width = maxWidth
If b.Height < maxHeight Then b.Height = maxHeight
Next
Dim currY As Int = 0
For Each b As Button In btnList
b.Left = btnSpacing
b.Width = maxWidth
currY = currY + btnSpacing
b.Top = currY
b.Height = maxHeight
currY = currY + maxHeight
Next
currY = currY + btnSpacing
#if b4i
sv.ContentHeight = currY
sv.ContentWidth = maxWidth + 2*btnSpacing
#else if b4a
sv.panel.Height = currY
sv.panel.Width = maxWidth + 2*btnSpacing
#End If
End Sub
'Call in page resize event, to reset the screen coordinates
public Sub Resize(screenX As Int, screenY As Int)
maxX = screenX
maxY = screenY
pnl.Width = maxX
pnl.Height = maxY
End Sub
'Shows the popup menu, anchored to the parent view
'If already displaying, calling it show again will hide the menu.
public Sub Show(parent As View )
showPopup(parent, ANCHOR_BOTTOMMIDDLE)
End Sub
'Same as show, but popup anchored to top left corner of view instead.
'If already displaying, calling it show again will hide the menu.
Public Sub Show2(parent As View)
showPopup(parent, ANCHOR_TOPLEFT)
End Sub
private Sub showPopup(parent As View, anchorPoint As Int)
If showingMenu Then
Hide
Return
End If
anchorView = parent
Dim anchorViewTop, anchorViewLeft, anchorViewHeight, anchorViewWidth As Int
anchorViewHeight = anchorView.Height 'Take a copy b4 abs coord call (problem in b4i)
anchorViewWidth = anchorView.Width
Dim leftTop() As Float = GetPageLeftAndTop( anchorView )
#if b4i
Dim leftTop2() As Float = GetPageLeftAndTop( myPanel )
#else
Dim leftTop2() As Float = GetPageLeftAndTop( myActivity )
#End If
anchorViewLeft = leftTop(0) - leftTop2(0)
anchorViewTop = leftTop(1) - leftTop2(1)
Dim left, top As Int
Select anchorPoint
Case ANCHOR_BOTTOMMIDDLE
left = anchorViewLeft + (anchorViewWidth / 2)
If left + maxWidth + 2*btnSpacing > maxX Then left = maxX - maxWidth - 2*btnSpacing
If anchorViewTop > 0.5*maxY Then
#if b4i
top = anchorViewTop - sv.ContentHeight
#else if b4a
top = anchorViewTop - sv.panel.Height
#End If
If top < 0 Then top = 0
Else
top = anchorViewTop + anchorViewHeight
If top + maxHeight > maxY Then top = Max(maxY - maxHeight, 0)
End If
Case ANCHOR_TOPLEFT
left = anchorViewLeft
If left + maxWidth > maxX Then left = maxX - maxWidth
If anchorViewTop > 0.5*maxY Then
#if b4i
top = anchorViewTop - sv.ContentHeight
#else if b4a
top = anchorViewTop - sv.panel.Height
#End If
If top < 0 Then top = 0
Else
top = anchorViewTop + anchorViewHeight
If top + maxHeight > maxY Then top = Max(maxY - maxHeight, 0)
End If
End Select
#if b4i
myPanel.AddView(pnl, 0, 0, maxX, maxY)
#else if b4A
pnl.RemoveView
myActivity.AddView(pnl, 0, 0, maxX, maxY)
pnl.Elevation = 99.0 'ignore
#End If
pnl.BringToFront
pnl.Color = Colors.ARGB(80,255,255,255)
'Start of animation point in top left of anchorview..
pnl.AddView(sv, anchorViewLeft, anchorViewTop, 1, 1)
pnl.Visible = True
sv.Visible = True
sv.Color = Colors.ARGB(10,255,255,255)
#if b4i
If top + sv.ContentHeight <= maxY Then
sv.SetLayoutAnimated(animTime, 0.5, left, top, sv.ContentWidth, sv.ContentHeight )
Else
sv.SetLayoutAnimated(animTime, 0.5, left, top, sv.ContentWidth, maxY - top )
End If
#else if b4a
If top + sv.panel.Height <= maxY Then
sv.SetLayoutAnimated(animTime, left, top, sv.panel.Width, sv.panel.Height )
Else
sv.SetLayoutAnimated(animTime, left, top, sv.panel.Width, maxY - top )
End If
sv.BringToFront
#End If
showingMenu = True
End Sub
' Hides the popup menu
public Sub Hide
pnl.SendToBack
pnl.RemoveAllViews
#if b4A
pnl.RemoveView
#End If
showingMenu = False
End Sub
Private Sub Btn_Click
Dim b As Button = Sender
Dim txt As String = b.Text
#if b4i
If SubExists(Callback, Event & "_BtnClick", 1) Then
CallSub2(Callback, Event & "_BtnClick", txt )
End If
#else if b4a
If SubExists(Callback, Event & "_BtnClick") Then
CallSub2(Callback, Event & "_BtnClick", txt )
End If
#End If
Hide
End Sub
private Sub Pnl_Click
Hide
End Sub
private Sub SetButtonTextColor(btn As Button, clr As Int)
#if b4i
Dim no As NativeObject = btn
no.RunMethod("setTitleColor:forState:", Array(no.ColorToUIColor(clr), 1))
#else if b4a
btn.TextColor = clr
#End If
End Sub
#if b4i
#else if b4A
'Sets the button to be wide enough to fit its text.
private Sub setButtonWidth(btn As Button)
Dim w As Int
Dim wMargin As Int = Max( btn.Width * 0.1, 10 ) 'say
Dim bmpTest As Bitmap
bmpTest.InitializeMutable(1, 1) 'ignore
Dim cvsTest As Canvas
cvsTest.Initialize2(bmpTest)
w = cvsTest.MeasureStringWidth(btn.Text, useThisTypeFace, btn.TextSize)
btn.Width = w + 2* wMargin
End Sub
#End If
Sub GetPageLeftAndTop(v As View) As Float()
#if b4i
Dim tl(2) As Float
Do While GetType(v) <> "B4IMainView"
'' Log("View type = " & GetType(v))
'' Dim no As NativeObject = v
tl(0) = tl(0) + v.Left
If v Is ScrollView Then
Dim s As ScrollView = v
tl(1) = tl(1) + v.Top - s.ScrollOffsetY
Else
tl(1) = tl(1) + v.Top
End If
'' v = no.GetField("superview")
''v = v.Parent
If v.Parent.IsInitialized Then
v = v.Parent
Else
Exit
End If
Loop
Return tl
#else if b4A
Dim leftTop(2) As Int
Dim JO As JavaObject = v
JO.RunMethod("getLocationOnScreen", Array As Object(leftTop))
Dim ret(2) As Float
ret(0) = leftTop(0)
ret(1) = leftTop(1)
Return ret
#End If
End Sub
#if b4A
Sub setBorder(v As View, width As Int, cornerRadius As Int, borderColor As Int, backgroundColor As Int)
Dim c As ColorDrawable
c.Initialize2(backgroundColor,cornerRadius,width,borderColor)
v.Background = c
End Sub
#End If