+- QB64 Phoenix Edition (https://qb64phoenix.com/forum)
+-- Forum: QB64 Rising (https://qb64phoenix.com/forum/forumdisplay.php?fid=1)
+--- Forum: Code and Stuff (https://qb64phoenix.com/forum/forumdisplay.php?fid=3)
+---- Forum: Works in Progress (https://qb64phoenix.com/forum/forumdisplay.php?fid=9)
+---- Thread: myframeview - resizable program window (/showthread.php?tid=716)
myframeview - resizable program window - James D Jarvis - 08-02-2022
This is a resizable program screen demo. Grab the sides with the mouse to resize. The minimize and maximize buttons can inflicted odd changes on the size but it seems stable for now.
Been working on this on and off. The program I originally began this for has moved to the bottom of my fun programming pile for now but this part seems shareable at this point.
I surely used some code from the online examples or from somewhere else in the forums but I lost track of where,what, and who. I appologize for that lapse in record keeping.
Code: (Select All)
'myframeview
'By James D. Jarvis
' a very much in progress resizable program window example
' this creates a program with a 4 panels display with a header, a footer, a sidebar and a canvas all inside the mainframe
' there's a whole bunch of functionality planned for that is not built in yet. Someday each panel may be scrollable and i have the data format setup for that
' some commands have been commented out as I edit away but are still there because they worked in a previous itteration so they may return
' this is currently setup to use 32 bit color but there's nothign fancy goign on in that regaurd.
' this may or may not crash if you resize the window too small , in an earleir itteration it would crash when scaled from the top or minimzed
' that problem isn't in this version (not 100% sure how I fixed that)
'
'while _prinstring even locate would be functional some program logic would be needed to keep track of which frame/panel is being written too
'so I solved that issues as simply as i could with a printat command called prat (see the sub for more details there)
'
'a little barebones functionality is shown for now.there's a very simple easteregg of sorts buried in the program to show hwo writign to different panels can function
'
' in my programmer fantasy panels will be able to be added that can be moved and resized by the user not just hung on the borders likes shown here
'
'$dynamic
$Resize:On
_Title "myframeview"
Randomize Timer
Type paneltype
sh As Long 'screen handle
dx As Integer
dy As Integer
pwid As Integer
pht As Integer
vx As Integer
vy As Integer
vwid As Integer
vht As Integer
scroll_on As String * 3
scroll_show As String * 3
scroll_xbar As String * 1
scroll_ybar As String * 1
scroll_xslider As String * 1
scroll_yslider As String * 1
scroll_x As Integer
scroll_y As Integer
bgk As _Unsigned Long
fgk As _Unsigned Long
txt_fgK As _Unsigned Long 'text foreground color
txt_bgK As _Unsigned Long 'text background color
penx As Integer
peny As Integer
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
'treating the whole program display like a subpanel so functionality wil leventually scale throughout the program
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
'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
'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
'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
'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
Screen mdisplay.sh
'crude setup
_Dest canvas.sh
Line (0, 0)-(canvas.pwid - 1, canvas.pht - 1), canvas.bgk, BF
Color canvas.txt_fgK, canvas.txt_bgK
prat 1, 1, "CANVAS", "c"
_Dest header.sh
Line (0, 0)-(header.pwid - 1, header.pht - 1), header.bgk, BF
Color header.txt_fgK, header.txt_bgK
prat 1, 1, " HEADER HEADER HEADER HEADER HEADER HEADER HEADER HEADER HEADER HEADER ", "header"
prat 1, 4, "Press a letter to decorate the canvas, esc to quit", "header"
_Dest footer.sh
Line (0, 0)-(footer.pwid - 1, footer.pht - 1), footer.bgk, BF
Color footer.txt_fgK, footer.txt_bgK
prat 1, 1, "Footer", "footer"
_Dest sidebar.sh
Line (0, 0)-(sidebar.pwid - 1, sidebar.pht - 1), sidebar.bgk, BF
Color sidebar.txt_fgK, sidebar.txt_bgK
prat 1, 1, "Sidebar", "siddebar"
'==================================
'main program here
'===================================
'dimension variables for mainprogram
Dim Shared charcount
charcount = 0
Do
_Limit 60
refresh_mdisplay
' _Display
If _Resize Then doresize
any$ = getkey$("abcdefghijklmnopqrstuvwxyz")
txt$ = "Window Size: " + Str$(_Width(mdisplay.sh)) + "," + Str$(_Height(mdisplay.sh))
prat 1, 2, txt$, "footer"
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
If any$ <> "" Then charcount = charcount + cc
If any$ >= "a" Or any$ <= "z" Then
lastkeypressed$ = any$
For aax = 1 To cc
_PrintString (Int(Rnd * mx), Int(Rnd * my)), any$
Next
If any$ = "o" Then 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
End If
tt$ = "Last key pressed: " + lastkeypressed$
prat 3, 3, tt$, "footer"
prat 1, 4, "Character Count", "sidebar"
prat 1, 5, Str$(charcount), "sidebar"
Loop Until any$ = Chr$(27)
'and we are done here
'====================================================================
'any garbage collection or closing routines should be 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
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
' _AutoDisplay
oldh = mdisplay.pht
oldW = mdisplay.pwid
temp = _NewImage(_ResizeWidth, _ResizeHeight, 32)
Screen temp
_FreeImage mdisplay.sh
mdisplay.sh = temp
newW = _Width(mdisplay.sh): newH = _Height(mdisplay.sh)
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
copyheader = _CopyImage(header.sh)
copysidebar = _CopyImage(sidebar.sh)
'_Delay .25
dummy = _Resize 'clear the resize flag after manually setting the screen to the size 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
Sub prat (x, y, txt$, h$)
'prit at
'x and Y are text coordinates inside frame/panel h$
'curently haerdcoded: h= header, f=footer, s=sidebar, c = canvas
subh$ = _Trim$(LCase$(h$))
subh$ = Left$(subh$, 1)
xx = (x - 1) * 8
yy = (y - 1) * 16
Select Case subh$
Case "h"
_Dest header.sh
Color header.txt_fgK, header.txt_bgK
_PrintString (xx, yy), txt$
Case "f"
_Dest footer.sh
Color footer.txt_fgK, footer.txt_bgK
_PrintString (xx, yy), txt$
Case "s"
_Dest sidebar.sh
Color sidebar.txt_fgK, sidebar.txt_bgK
_PrintString (xx, yy), txt$
Case "c"
_Dest canvas.sh
Color canvas.txt_fgK, canvas.txt_bgK
_PrintString (xx, yy), txt$
End Select
End Sub