10-11-2023, 03:15 PM
Here was my attempt from a year or so ago to do a resizable window that kept a minimum size for some features in the window. there's a whole bunch of stubs in here that aren't in this copy but nothing that impacts the functionality (such as it is). It's not very well documented and I'd likely do some things differently today but it has some of that snapping behavior and makes no external calls. This isn't presented as anything better, just how I tried it once.
Code: (Select All)
'$dynamic
$Resize:On
_Title "mypanelview"
'messing about with rescalable windows and overall gui stuff... there are stubs and variables for features that aren't here
'the footee and header sections have minimum heights and the sidebar has a minimum width
Randomize Timer
Type paneltype
sh As Long 'screen handle for the panel image
dx As Integer '
dy As Integer
pwid As Integer 'pixel width of panel source image
pht As Integer 'pixel height of panel source image
vx As Integer 'top X position of panel view
vy As Integer ' top Y posiiton of panel view
vwid As Integer ' view width of panel
vht As Integer 'view height of panel
scroll_on As String * 3 'YES _NO VRT and HRZ will be the valid flags , YES is on, HRZ menas horizontal scroll only, VRT means vertical scroll only
scroll_show As String * 3 ' YES _NO are the valid flags
scroll_xbar As String * 1 'text symbol for slider track
scroll_ybar As String * 1
scroll_xslider As String * 1 'text sysmbol for text stsyle sliders
scroll_yslider As String * 1
scroll_x As Integer 'scroll positon within window
scroll_y As Integer
bgk As _Unsigned Long 'background color for the panel
fgk As _Unsigned Long 'foreground color for panel.... really the pen color
txt_fgK As _Unsigned Long 'foreground color for text in panel
txt_bgK As _Unsigned Long 'background color for ascii text in panel
penx As Integer ' "x-pointer" for pen coordiantes within panel
peny As Integer ' "Y-pointer" for pen coordinates within panel
buttonlist As Integer 'first button this panel calls.
bar_on As String * 3 ' is top bar on for panel , not yet implenented may do so if panels as floating button pallettes added.
bar_ch As String * 1 'character used for top bar
bar_title As String * 32 'title text for to bar in panel
End Type
Dim Shared copyheader, copyfooter, copysidebar
Dim Shared mdisplay As paneltype
Dim Shared canvas As paneltype
Dim Shared header As paneltype
Dim Shared footer As paneltype
Dim Shared sidebar As paneltype
'build main display
mdisplay.dx = 0
mdisplay.dy = 0
mdisplay.pwid = 800
mdisplay.pht = 600
mdisplay.vx = 0
mdisplay.vy = 0
mdisplay.vwid = 800
mdisplay.vht = 600
mdisplay.sh = _NewImage(mdisplay.pwid, mdisplay.pht, 32)
mdisplay.scroll_on = "_NO"
mdisplay.scroll_show = "_NO"
mdisplay.scroll_xbar = "-"
mdisplay.scroll_ybar = "|"
mdisplay.scroll_xslider = "="
mdisplay.scroll_ybar = "="
mdisplay.scroll_x = 0
mdisplay.scroll_y = 0
mdisplay.bgk = _RGB32(0, 0, 0)
mdisplay.fgk = _RGB32(250, 250, 250)
mdisplay.txt_bgK = _RGB32(0, 0, 0)
mdisplay.txt_fgK = _RGB32(250, 250, 250)
mdisplay.penx = 0
mdisplay.peny = 0
mdisplay.bar_on = "_NO"
mdisplay.bar_ch = "="
mdisplay.bar_title = "MAIN"
'build canvas
canvas.dx = 0
canvas.dy = 0
canvas.pwid = 1600
canvas.pht = 1200
canvas.vx = 0
canvas.vy = 100
canvas.vwid = 700
canvas.vht = 400
canvas.sh = _NewImage(canvas.pwid, canvas.pht, 32)
canvas.scroll_on = "YES"
canvas.scroll_show = "YES"
canvas.scroll_xbar = "-"
canvas.scroll_ybar = "|"
canvas.scroll_xslider = "="
canvas.scroll_ybar = "="
canvas.scroll_x = 0
canvas.scroll_y = 0
canvas.bgk = _RGB32(130, 0, 0)
canvas.fgk = _RGB32(250, 250, 250)
canvas.txt_bgK = _RGB32(130, 0, 0)
canvas.txt_fgK = _RGB32(250, 250, 250)
canvas.penx = 0
canvas.peny = 0
canvas.bar_on = "_NO"
canvas.bar_ch = "="
canvas.bar_title = "Canvas"
'build header
header.dx = 0
header.dy = 0
header.pwid = 900
header.pht = 100
header.vx = 0
header.vy = 0
header.vwid = 800
header.vht = 100
header.sh = _NewImage(header.pwid, header.pht, 32)
header.scroll_on = "_NO"
header.scroll_show = "_NO"
header.scroll_xbar = "-"
header.scroll_ybar = "|"
header.scroll_xslider = "="
header.scroll_ybar = "="
header.scroll_x = 0
header.scroll_y = 0
header.bgk = _RGB32(0, 100, 0)
header.fgk = _RGB32(250, 250, 250)
header.txt_bgK = _RGB32(0, 100, 0)
header.txt_fgK = _RGB32(250, 250, 250)
header.penx = 0
header.peny = 0
header.bar_on = "YES"
header.bar_ch = "="
header.bar_title = "Panel View Demo"
'build footer
footer.dx = 0
footer.dy = 0
footer.pwid = 900
footer.pht = 600
footer.vx = 0
footer.vwid = mdisplay.pwid
footer.vht = 100
footer.vy = mdisplay.pht - footer.vht
footer.sh = _NewImage(footer.pwid, footer.pht, 32)
footer.scroll_on = "VRT"
footer.scroll_show = "YES"
footer.scroll_xbar = "-"
footer.scroll_ybar = "|"
footer.scroll_xslider = "="
footer.scroll_ybar = "="
footer.scroll_x = 0
footer.scroll_y = 0
footer.bgk = _RGB32(10, 10, 80)
footer.fgk = _RGB32(250, 250, 250)
footer.txt_bgK = _RGB32(10, 10, 80)
footer.txt_fgK = _RGB32(250, 250, 250)
footer.penx = 0
footer.peny = 0
footer.bar_on = "_NO"
footer.bar_ch = "="
footer.bar_title = "FOOTER"
'build sidebar
sidebar.dx = 0
sidebar.dy = 0
sidebar.pwid = 150
sidebar.pht = 400
sidebar.vx = 650
sidebar.vwid = 150
sidebar.vht = 400
sidebar.vy = 100
sidebar.sh = _NewImage(sidebar.pwid, sidebar.pht, 32)
sidebar.scroll_on = "_NO"
sidebar.scroll_show = "_NO"
sidebar.scroll_xbar = "-"
sidebar.scroll_ybar = "|"
sidebar.scroll_xslider = "="
sidebar.scroll_ybar = "="
sidebar.scroll_x = 0
sidebar.scroll_y = 0
sidebar.bgk = _RGB32(50, 50, 50)
sidebar.fgk = _RGB32(250, 250, 250)
sidebar.txt_bgK = _RGB32(50, 50, 50)
sidebar.txt_fgK = _RGB32(250, 250, 250)
sidebar.penx = 0
sidebar.peny = 0
sidebar.bar_on = "_NO"
sidebar.bar_ch = "+"
sidebar.bar_title = "MAIN"
Screen mdisplay.sh
'garbage
_Dest canvas.sh
Line (0, 0)-(canvas.pwid - 1, canvas.pht - 1), canvas.bgk, BF
Color canvas.txt_fgK, canvas.txt_bgK
Print "CANVAS"
_Dest header.sh
Line (0, 0)-(header.pwid - 1, header.pht - 1), header.bgk, BF
Color header.txt_fgK, header.txt_bgK
_PrintString (400, 10), "Hello"
Print
Print
Print "Press esc to quit"
_Dest footer.sh
Line (0, 0)-(footer.pwid - 1, footer.pht - 1), footer.bgk, BF
Color footer.txt_fgK, footer.txt_bgK
Print "footer"
_Dest sidebar.sh
Line (0, 0)-(sidebar.pwid - 1, sidebar.pht - 1), sidebar.bgk, BF
Color sidebar.txt_fgK, sidebar.txt_bgK
Print "Sidebar"
Do
_Limit 60
refresh_mdisplay
' _Display
If _Resize Then doresize
any$ = getkey$("abcdefghijklmnopqrstuvwxyz")
_Dest footer.sh
Locate 1, 1
Print _Width(mdisplay.sh), _Height(mdisplay.sh)
footer.dx = footer.dy + 12: If footer.dy > footer.pht - 100 Then footer.dy = footer.pht - 100
_Dest canvas.sh
cc = Int(Rnd * 13) + 1
mx = canvas.vwid
my = canvas.vht
For cx = 1 To cc
orb Int(Rnd * mx), Int(Rnd * my), Int(Rnd * 100) + 5, _RGB32(Int(Rnd * 256), Int(Rnd * 256), Int(Rnd * 256)), (Rnd * 7.5) + .2
Next cx
Loop Until any$ = Chr$(27)
'and we are done here
System
Function waitkey$ (klist$)
If klist$ = "" Then
Do
_Limit 30
a$ = InKey$
Loop Until a$ <> ""
Else
k$ = klist$ + Chr$(27)
Do
_Limit 30
a$ = InKey$
Loop Until a$ <> "" And InStr(k$, a$)
End If
waitkey$ = a$
End Function
Function getkey$ (klist$)
If klist$ = "" Then
a$ = InKey$
Else
k$ = klist$ + Chr$(27)
a$ = InKey$
If a$ <> "" And InStr(k$, a$) Then getkey$ = a$
End If
End Function
Function brighter& (ch&&, p)
r = _Red(ch&&)
b = _Blue(ch&&)
g = _Green(ch&&)
If p < 0 Then p = 0
If p > 100 Then p = 100
p = p / 100
rdif = 255 - r: rc = rdif * p: brr = Int(r + rc): If brr > 255 Then brr = 255
gdif = 255 - g: gc = gdif * p: bgg = Int(g + gc): If bgg > 255 Then bgg = 255
bdif = 255 - b: bc = bdif * p: bbb = Int(b + bc): If bbb > 255 Then bbb = 255
brighter& = _RGB(brr, bgg, bbb)
End Function
Sub orb (XX As Long, YY As Long, Rd As Long, KK As Long, brt As Integer)
'for false shaded 3-D look
'XX,YY arer screen position Rd is outermost radius of the orb KK is the startign color
'brt is the factor by which color will chnage it is the diffeence from KK to RGB(255,255,255)
'brt is applied each step so your orb will go to white if it is large or the brt value is high
Dim nk As Long
nk = KK ' this solves my problem along with changes to following lines to use nk instead of kk
ps = _Pi
p3 = _Pi / 3
p4 = _Pi / 4
If Rd < 10 Then ps = _Pi / 6 'so small radius orbs look cool too
rdc = p4 / Rd
For c = 0 To Int(Rd * .87) Step ps
nk = brighter&(nk, brt)
CircleFill XX, YY, Rd - (c), nk
XX = XX + rdc * (c * p3) ' could be fiddled with to move the center of the gradient
YY = YY - rdc * (c * 2 * p4) ' could be fiddled with to move the center of the gradient
Next c
End Sub
Sub CircleFill (CX As Long, CY As Long, R As Long, C As Long)
'sub by SMcNeill makes a filled circle without worrying about using the paint comamnd to fill an empty circle
Dim Radius As Long, RadiusError As Long
Dim X As Long, Y As Long
Radius = Abs(R)
RadiusError = -Radius
X = Radius
Y = 0
If Radius = 0 Then PSet (CX, CY), C: Exit Sub
' Draw the middle span here so we don't draw it twice in the main loop,
' which would be a problem with blending turned on.
Line (CX - X, CY)-(CX + X, CY), C, BF
While X > Y
RadiusError = RadiusError + Y * 2 + 1
If RadiusError >= 0 Then
If X <> Y + 1 Then
Line (CX - Y, CY - X)-(CX + Y, CY - X), C, BF
Line (CX - Y, CY + X)-(CX + Y, CY + X), C, BF
End If
X = X - 1
RadiusError = RadiusError - X * 2
End If
Y = Y + 1
Line (CX - X, CY - Y)-(CX + X, CY - Y), C, BF
Line (CX - X, CY + Y)-(CX + X, CY + Y), C, BF
Wend
End Sub
Sub doresize
'handle the resize of the program window
oldh = mdisplay.pht
oldW = mdisplay.pwid
temp = _NewImage(_ResizeWidth, _ResizeHeight, 32)
newW = _Width(mdisplay.sh): newH = _Height(mdisplay.sh)
If newH < 300 Or newW < 200 Then
If newH < 300 Then newH = 300
If newW < 300 Then newW = 300
temp = _NewImage(newW, newH, 32)
End If
Screen temp
_FreeImage mdisplay.sh
_Delay .25
mdisplay.sh = temp
mdisplay.pwid = newW
mdisplay.pht = newH
Hchange = oldh - newH
Wchange = oldW = newW
copyfooter = _CopyImage(footer.sh)
_FreeImage footer.sh
footer.vwid = newW
footer.vy = newH - footer.vht
If newW > footer.pwid Then footer.pwid = newW
footer.sh = _NewImage(footer.pwid, footer.pht, 32)
_Dest footer.sh
Line (0, 0)-(footer.pwid - 1, footer.pht - 1), footer.bgk, BF
_PutImage , footer.sh, copyfooter
canvas.vwid = newW - sidebar.vwid
canvas.vht = newH - (footer.vht)
copyheader = _CopyImage(header.sh)
_FreeImage header.sh
header.vwid = newW
If newW > header.pwid Then header.pwid = newW
header.sh = _NewImage(header.pwid, header.pht, 32)
_Dest header.sh
Line (0, 0)-(header.pwid - 1, header.pht - 1), header.bgk, BF
_PutImage (0, 0), copyheader, header.sh
sidebar.vx = newW - sidebar.vwid
sidebar.vht = newH - (footer.vht + header.vht)
copysidebar = _CopyImage(sidebar.sh)
_FreeImage sidebar.sh
If newH > sidebar.pht Then sidebar.pht = newH
sidebar.sh = _NewImage(sidebar.pwid, sidebar.pht, 32)
_Dest sidebar.sh
Line (0, 0)-(header.pwid - 1, sidebar.pht - 1), sidebar.bgk, BF
_PutImage (0, 0), copysidebar, sidebar.sh
refresh_mdisplay
_Dest footer.sh
Locate 1, 1
Print _Width(mdisplay.sh), _Height(mdisplay.sh)
Print "canvas w: "; canvas.vwid; " Canvas h: "; canvas.vht; " "
copyheader = _CopyImage(header.sh)
copysidebar = _CopyImage(sidebar.sh)
junk = _Resize 'clear the resize flag after manually setting the screen to the size we specified.
End Sub
Sub refresh_mdisplay
_Dest mdisplay.sh
_PutImage (canvas.vx, canvas.vy)-(canvas.vx + canvas.vwid - 1, canvas.vy + canvas.vht - 1), canvas.sh, mdisplay.sh, (0, 0)-(canvas.vwid - 1, canvas.vht - 1)
_PutImage (header.vx, header.vy)-(header.vx + header.vwid - 1, header.vy + header.vht - 1), header.sh, mdisplay.sh, (0, 0)-(header.vwid - 1, header.vht - 1)
_PutImage (sidebar.vx, sidebar.vy)-(sidebar.vx + sidebar.vwid - 1, sidebar.vy + sidebar.vht - 1), sidebar.sh, mdisplay.sh, (0, 0)-(sidebar.vwid - 1, sidebar.vht - 1)
_PutImage (footer.vx, footer.vy)-(footer.vx + footer.vwid - 1, footer.vy + footer.vht - 1), footer.sh, mdisplay.sh, (0, 0)-(footer.vwid - 1, footer.dy + footer.vht - 1)
_Display
End Sub