Announcement

Collapse
No announcement yet.

Time to celebrate!

Collapse
X
 
  • Filter
  • Time
  • Show
Clear All
new posts

  • Time to celebrate!

    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:

    Code:
     ' 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
    Attached Files
    Last edited by Chris Holbrook; 19 Oct 2008, 03:57 PM. Reason: wrong code posted!
Working...
X