myframeview - resizable program window

[James D Jarvis]

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