Time to celebrate!

[Chris Holbrook]

Before I get heavily embroiled in PBCC V5, and can no longer see the wood for the trees, I must say that it is really very good indeed.

A non-windows programmer (as I sometimes wish I still was) can create a whole GUI application inside a GRAPHIC WINDOW without a thought for Windows - well maybe a couple of API calls, but without the old familiar Windows program structure. In other words, you can concentrate on the job in hand, not on fighting the whole M$ empire.

FWIW, here is my first attempt, please advise improvements:

 ' PBCC V5 try-out program by Chris Holbrook Oct 2008
' just to experiment with GRAPHIC WINDOW commands
' and to discover that you don't need to know Windows programming
' to make it work
'
#INCLUDE "WIN32API.INC"
' <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
' graphic "windlet" stack stuff
' these two arrays work together
' first contains bitmap strings of graphics windows
' second contains coordinates of overlaid graphics objects
GLOBAL grstack() AS STRING
GLOBAL grectstack() AS QUAD
'-------------------------------------------------------------------------
' push a windlet on th stack
MACRO mpushgr ( r )
    MACROTEMP i, q
    
    LOCAL i AS LONG
    LOCAL q AS QUAD
    q = MAK(QUAD,MAK(DWORD,r.nleft, r.ntop),MAK(DWORD,r.nright, r.nbottom))

    i = UBOUND(grstack) + 1
    REDIM grstack(0 TO i) AS GLOBAL STRING
    GRAPHIC GET BITS TO grstack(i)
    REDIM grectstack(0 TO i) AS GLOBAL QUAD
    grectstack(i) = q
END MACRO
'-------------------------------------------------------------------------
' pop a windlet from the stack
MACRO mpopgr
    MACROTEMP i
    LOCAL i AS LONG
    i = UBOUND(grstack)
    GRAPHIC SET BITS grstack(i)
    REDIM grstack(0 TO i-1) AS GLOBAL STRING
    REDIM grectstack(0 TO i-1) AS GLOBAL QUAD
END MACRO
'>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
'-------------------------------------------------------------------------
' display a vertical menu in the current graphic window
' a selection can be made by kbd or mouse
' a mouse click outside the menu will also return to the caller
' The returned value is a QUAD integer which contains
' the selection (if any), together with the click coordinates
FUNCTION vmenu (hGW AS DWORD, x AS LONG, y AS LONG, s AS STRING) AS QUAD
    LOCAL clicked, clickX, clickY, i, j, chigh, cwide, cpxwide, cpxhigh, lchoice, noptions, pxwide, pxhigh AS LONG
    LOCAL skey AS STRING
    LOCAL pt AS POINTAPI
    LOCAL r  AS RECT
    '
    noptions = PARSECOUNT(s)
    FOR i = 1 TO noptions
        j = LEN(PARSE$(s,i))
        IF j > cwide THEN cwide = j
    NEXT
    GRAPHIC CHR SIZE TO cpxwide, cpxhigh
    pxwide = cwide * cpxwide
    pxhigh = noptions * cpxhigh

    r.nleft   = x + cpxwide
    r.ntop    = y + cpxhigh
    r.nright  = x + pxwide + cpxwide*3
    r.nbottom = y + pxhigh+ cpxhigh*2
    ' push the gr screen on entry on the GR stack
    mpushgr ( r)
    r.nleft   = x
    r.ntop    = y
    r.nright  = x + pxwide + cpxwide*2
    r.nbottom = y + pxhigh + cpxhigh
    ' push the gr screen on entry on the GR stack
    mpushgr(r)
    GRAPHIC BOX (x, y) - (x + pxwide + cpxwide*2, y + pxhigh+ cpxhigh), 20, %BLUE, %WHITE
    FOR i = 1 TO noptions
        GRAPHIC SET POS (x + cpxwide, y + cpxhigh/2 + (i-1)*cpxhigh )
        IF lchoice = i THEN
            GRAPHIC COLOR %RED, %WHITE
        ELSE
            GRAPHIC COLOR 0, %WHITE
        END IF
        GRAPHIC PRINT PARSE$(s, i)
    NEXT
    skey = ""
    WHILE skey <> $ESC
        IF LEN(skey) = 1 THEN
            SELECT CASE skey
                CASE "U"' up
                    DECR lchoice
                    IF lchoice < 1 THEN lchoice = noptions
                CASE "D"'down
                    INCR lchoice
                    IF lchoice > noptions THEN lchoice = 1
            END SELECT
        END IF

        FOR i = 1 TO noptions
            GRAPHIC SET POS (x + cpxwide, y + cpxhigh/2 + (i-1)*cpxhigh )
            IF lchoice = i THEN
                GRAPHIC COLOR %BLACK,&HD0D0D0
            ELSE
                GRAPHIC COLOR 0, %WHITE
            END IF
            GRAPHIC PRINT PARSE$(s, i)
        NEXT
        GRAPHIC INKEY$ TO skey
        IF LEN(skey) THEN ? STR$(LEN(skey))
        IF LEN(skey) = 0 THEN
            getcursorpos BYVAL VARPTR(pt)
            screentoclient(hGW, BYVAL VARPTR(pt))
            ' is the cursor position inside the menu box?
            IF (pt.x > x + cpxwide) AND (pt.x < x + pxwide + cpxwide*3) THEN
                IF ( pt.y > (y + cpxhigh/2)) AND (pt.y < y + pxhigh+ cpxhigh*1.5) THEN
                    lchoice = (pt.y - y - cpxhigh/2) / cpxhigh
                    INCR lchoice
                END IF
            END IF
        END IF
        GRAPHIC WINDOW CLICK TO clicked, clickX, clickY
        IF clicked = 1 THEN
            FUNCTION = lchoice
            ' pop the underlying screen off the GR stack
            mpopgr' pop shadow
            mpopgr' pop menu
            FUNCTION = MAK(QUAD, lchoice, MAK(DWORD, clickX, clickY))
            EXIT FUNCTION
        END IF
    WEND
END FUNCTION
'-------------------------------------------------------
' draw a CLOSEME box on the current graphic window
' parameter is # of pixels on each side of the box
' suggest 15 or 10 (not less) here
' and return its coordinates in a QUAD integer
FUNCTION  DrawCloseMeBox ( l AS LONG)AS QUAD
    LOCAL  i, x, y, xofs AS LONG
    LOCAL r AS rect
    LOCAL dw AS DWORD

    xofs = l \ 5 ' offset of X inside box in pixels
    ' get the width of the current object from the rectstack array
    i = UBOUND(grectstack)
    dw = LO(DWORD,grectstack(i))
    Y = HI(WORD,dw)
    dw = HI(DWORD,grectstack(i))
    X = LO(WORD,dw)
    '
    r.nleft   = x - 1.33*l
    r.ntop    = y + l/3
    r.nright  = x - l/3
    r.nbottom = y + (l * 1.33)
    GRAPHIC BOX (r.nleft, r.ntop) - (r.nright, r.nbottom ), 0, %RED, %RED, 0
    GRAPHIC WIDTH 2
    GRAPHIC LINE (r.nleft + xofs , r.ntop + xofs) - (r.nright - xofs, r.nbottom - xofs), %WHITE
    GRAPHIC LINE ( r.nright-xofs, r.ntop +xofs) - (r.nleft + xofs, r.nbottom - xofs), %WHITE
    ' return the box coordinates an a QUAD
    FUNCTION = MAK(QUAD, MAK(DWORD,r.nleft, r.ntop),MAK(DWORD,r.nright, r.nbottom))
END FUNCTION
'-------------------------------------------------------
' SR to display a message box and wait for a keypress before clearing it
' lots of assumptions, no wordwrap, etc
SUB mymsgbox ( msg AS STRING)
    LOCAL clicked, clickX, clickY,l, x, y, pxcwide, pxchigh AS LONG
    LOCAL r AS rect

    GRAPHIC WINDOW CLICK TO clicked, clickX, clickY
    l = LEN(msg)
    GRAPHIC GET CLIENT TO x, y
    GRAPHIC CHR SIZE TO pxcwide, pxchigh
    r.nleft   = ( x - l*pxcwide - 2*pxcwide)\2
    r.ntop    = ( y - 2*pxchigh) \ 2
    r.nright  = r.nleft + pxcwide*2 + pxcwide*l
    r.nbottom = r.ntop + 2 * pxchigh
    mpushgr(r)
    GRAPHIC BOX  (r.nleft, r.ntop) - (r.nright, r.nbottom), 10, -1, &Hd0d0ff
    GRAPHIC SET POS (r.nleft + pxcwide, r.ntop + pxchigh/2)
    GRAPHIC COLOR %BLUE, &Hd0d0ff
    GRAPHIC PRINT msg
    drawclosemebox (10)
    WHILE clicked = 0
        GRAPHIC WINDOW CLICK TO clicked, clickX, clickY
        SLEEP 10
    WEND
    mpopgr
END SUB
'-------------------------------------------------------
' CLOSEME returns TRUE if the menucoords place
' the click in the Closemecoords box
FUNCTION CLOSEME ( menucoords AS QUAD, closemecoords AS QUAD) AS LONG
    LOCAL x, y AS LONG
    LOCAL r AS RECT
    LOCAL pt AS POINTAPI
    LOCAL dw AS LONG
    
    dw = HI(DWORD,menucoords)
    pt.x = LO(WORD,dw): pt.y = HI(WORD,dw)
    '
    dw = LO(DWORD,closemecoords)
    r.nleft = LO(WORD,dw): r.ntop = HI(WORD, dw)
    dw = HI(DWORD,closemecoords)
    r.nright = LO(WORD, dw): r.nbottom = HI(WORD, dw)
    '
    FUNCTION = ptinrect( BYVAL VARPTR(r), pt.x, pt.y)
END FUNCTION
'----------------------------------------------------------
FUNCTION ConsoleHandler(BYVAL dwEvent AS DWORD) AS LONG
  'Alt + F4 not trapped here, Ctrl-C not working either
  SELECT CASE dwEvent
    CASE %CTRL_BREAK_EVENT
      PRINT "Ctrl-Break pressed"
    CASE %CTRL_CLOSE_EVENT
      PRINT "[x] Close clicked"
    CASE %CTRL_LOGOFF_EVENT
      PRINT "User logging off or restarting"
    CASE %CTRL_SHUTDOWN_EVENT
      PRINT "System shutting down"
  END SELECT
  SLEEP 500
END FUNCTION
'-------------------------------------------------------
FUNCTION PBMAIN () AS LONG
    LOCAL bigx, bigy, thisW, thisH AS LONG
    LOCAL menuchoice, closemecoords AS QUAD
    LOCAL r AS RECT
    LOCAL dw AS DWORD
    LOCAL smenu AS STRING
    LOCAL hGW AS DWORD

    SetConsoleCtrlHandler CODEPTR(ConsoleHandler), 1
    DESKTOP GET SIZE TO bigx, bigy
    thisW = 200: thisH = 200
    GRAPHIC WINDOW "", (bigx - thisw)/2, (bigY - thisH)/2, 200, 200 TO hGW
    GRAPHIC ATTACH hGW, 0
    setrect BYVAL VARPTR(r), 0, 0, thisW, thisH
    mpushgr(r)
    GRAPHIC BOX (r.nleft, r.ntop) - (r.nright, r.nbottom), 0, -1, %BLUE, 4

    GRAPHIC FONT "COURIER NEW", 10, 0
    closemecoords = drawclosemebox(15)

    smenu = "red, blue, green, yellow, white, black"
    menuchoice = vmenu (hGW, 20, 20, smenu)
    IF CloseME(menuchoice, closemecoords) THEN
        mymsgbox("you clicked CLOSEME!")
    ELSE
        dw = LO(DWORD, menuchoice)
        mymsgbox "you chose "+ PARSE$(smenu,dw)
    END IF
    mpopgr
    SetConsoleCtrlHandler CODEPTR(ConsoleHandler), 0
END FUNCTION