Announcement

Collapse
No announcement yet.

another GRAPHIC WINDOW based "control"

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

  • another GRAPHIC WINDOW based "control"

    Here's a very MK1 "character mode" listview on a PBCC GRAPHIC WINDOW.

    The idea is that the ListBox function is library code and the developer passes to it, amongst other parameters, a pointer to a function which returns one line for the listbox, or &HFF if the data source is exhausted. In the example, this function just returns the string of its argument, which is the line number requested.

    The listbox responds only to up and down keys and does not actually do anything.

    One little problem, it's very slow, at least on my memory-challenged PC. Any suggestions on how to make it faster would be welcome.

    Code:
    ' PBCC V5 try-out program by Chris Holbrook Oct 2008
    ' Listbox POC for GRAPHIC WINDOW 
    '
    #INCLUDE "WIN32API.INC"
    '----------------------------------------------------------
    FUNCTION ConsoleHandler(BYVAL dwEvent AS DWORD) AS LONG
      END
    END FUNCTION
    '----------------------------------------------------------
    ' param: line number
    ' return string function of the line number, &HFF at 200+th record.
    FUNCTION getlineproc(i AS LONG) AS STRING
        IF i <= 200 THEN
            FUNCTION = "record #" + STR$(i)
        ELSE
            FUNCTION = CHR$(255)
        END IF
    END FUNCTION
    '----------------------------------------------------------
    ' first dword of result is result, second is click location
    ' params : location (X, Y), size(W, H), title, "get line" process pointer
    ' ESC to end 
    FUNCTION listbox (X AS LONG, Y AS LONG, W AS LONG, H AS LONG, stitles AS STRING, glineproc AS DWORD ) AS QUAD
        LOCAL i, nlines, pxcwide, pxchigh, top, hilit, lastline AS LONG
        LOCAL r AS rect
        LOCAL s, skey, stempbits AS STRING
        LOCAL hbottombmp AS DWORD
    
        GRAPHIC WIDTH 1
        GRAPHIC CHR SIZE TO pxcwide, pxchigh
        setrect r, x + pxcwide, y + pxchigh, x + W + pxcwide*2, y + H + pxchigh
        'draw shadow box
        GRAPHIC BOX (r.nleft, r.ntop) - (r.nright, r.nbottom), 0, 0, 0
        setrect  ( r, x, y, x + w, y + h)
        GRAPHIC FONT "Courier"
        ' draw box around control
        GRAPHIC BOX  (r.nleft, r.ntop) - (r.nright, r.nbottom), 0, %BLUE, %BLUE, 0 '&Hd0d0ff
        GRAPHIC COLOR %WHITE, %BLUE
        GRAPHIC SET POS (X + 2, y + 2): GRAPHIC PRINT stitles
        GRAPHIC COLOR %BLACK, %WHITE
    
        ' draw line under title
        GRAPHIC LINE (X, Y + pxchigh + 2) - (X + W,Y + pxchigh + 2)
        GRAPHIC BOX (X, Y + pxchigh + 2) - (r.nright, r.nbottom), 0, %BLUE, %WHITE, 0
        nlines = ((h - pxchigh - 5) \ pxchigh) -1
        top = 1
        lastline = 10^6
        hilit = 1' the highlighted row
        FOR i = 1 TO top + nlines
            GOSUB drawcontents
        NEXT
        WHILE skey <> $ESC
            SLEEP 1
            GRAPHIC INKEY$ TO skey
            IF LEN(skey) = 2 THEN
                SELECT CASE MID$(skey,2,1)
                    CASE CHR$(&H48)' up
                        IF hilit > 1 THEN DECR hilit
                        IF hilit < top THEN DECR top
                        IF top < 1 THEN top = 1
                    CASE CHR$(&H50)'down
                        IF hilit < lastline THEN
                            INCR hilit
                        END IF
                        IF hilit > top + nlines THEN INCR top
                END SELECT
                GRAPHIC BOX (X, Y + pxchigh + 2) - (r.nright, r.nbottom), 0, %BLUE, %WHITE, 0
                FOR i = top TO top + nlines
                    GOSUB drawcontents
                NEXT i
                GRAPHIC LINE  (r.nleft, r.nbottom - 1) - (r.nright, r.nbottom - 1)
                GRAPHIC BOX   (r.nleft + pxcwide, r.nbottom ) - (r.nright + pxcwide*2, r.nbottom + pxchigh), 0,0,0,0
            END IF
        WEND
        EXIT FUNCTION
    drawcontents:
        CALL DWORD glineproc USING getlineproc(i) TO s
        IF LEFT$(s,1) = CHR$(255) THEN
            lastline = i - 1
            IF hilit > lastline THEN DECR hilit
            RETURN
        END IF
        GRAPHIC SET POS (X + 4, Y + pxchigh + 4 + ((i - top) * pxchigh))
        IF i = hilit THEN
            GRAPHIC COLOR 0, %CYAN
        ELSE
            GRAPHIC COLOR 0, %WHITE
        END IF
        GRAPHIC PRINT s;
    RETURN
    
    END FUNCTION
    
    '-------------------------------------------------------
    FUNCTION PBMAIN () AS LONG
        LOCAL bigx, bigy, thisW, thisH AS LONG
        LOCAL r AS RECT
        LOCAL dw AS DWORD
        LOCAL hGW AS DWORD
    
    
        SetConsoleCtrlHandler CODEPTR(ConsoleHandler), 1
        DESKTOP GET SIZE TO bigx, bigy
        thisW = 400: thisH = 300
        GRAPHIC WINDOW "Listbox", (bigx - thisw)/2, (bigY - thisH)/2, ThisW, ThisH TO hGW
        GRAPHIC ATTACH hGW, 0
        setrect r, 0, 0, 400, 300
        GRAPHIC BOX (r.nleft, r.ntop) - (r.nright, r.nbottom), 0, -1, %BLUE, 4
    
        Listbox(100, 20, 200, 100, "my first PBCC listbox", CODEPTR(getlineproc))
        SetConsoleCtrlHandler CODEPTR(ConsoleHandler), 0
    END FUNCTION

  • #2
    similar but using a CLASS

    Code:
    '
    ' using a CLASS for GRAPHIC WINDOW listbox
    ' Chris Holbrook Nov 2008
    '
    #COMPILE EXE
    #DIM ALL
    
    #INCLUDE "WIN32API.INC"
    
    ' graphic "winlet" stack stuff
    ' these two arrays work together
    ' first contains bitmap strings of graphics windows
    ' second contains coordinates of overlaid graphics objects
    GLOBAL grstack() AS DWORD
    GLOBAL grectstack() AS QUAD
    
    
    '-------------------------------------------------------------------------
    ' push a winlet on th stack
    MACRO mpushgr ( hGR, 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 PRESERVE grstack(0 TO i) AS GLOBAL DWORD
        GRAPHIC BITMAP NEW r.nright - r.nleft, r.nbottom - r.ntop TO grstack(i)
        GRAPHIC ATTACH grstack(i), 0
        ' copy the area to the smaller GW
        GRAPHIC COPY hGR, 0, (r.nleft, r.ntop) - (r.nright , r.nbottom) TO (0, 0)
        GRAPHIC ATTACH hGR, 0
        REDIM PRESERVE grectstack(0 TO i) AS GLOBAL QUAD
        grectstack(i) = q
    END MACRO
    '-------------------------------------------------------------------------
    ' pop a winlet from the stack
    MACRO mpopgr
        MACROTEMP dw, i, r, q
        LOCAL i AS LONG
        LOCAL r AS rect
        LOCAL q AS QUAD
        LOCAL dw AS DWORD
    
        i = UBOUND(grstack)
        q = grectstack(i)
        dw = LO(DWORD,q)
        r.nleft = LO(WORD,dw): r.ntop = HI(WORD,dw)
        dw = HI(DWORD,q)
        r.nright = LO(WORD,dw): r.nbottom = HI(WORD,dw)
        GRAPHIC COPY grstack(i), 0, (0, 0) - (r.nright - r.nleft, r.nbottom - r.ntop) TO (r.nleft, r.ntop)
        DECR i
        REDIM PRESERVE grstack(0 TO i) AS GLOBAL DWORD
        REDIM PRESERVE grectstack(0 TO i) AS GLOBAL QUAD
    END MACRO
    '>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
    ' this is a getlineproc, called with a line number, returning a string
    ' to display in the listbox, or chr$(255) if no data is available
    '----------------------------------------------------------
    FUNCTION getlineproc(i AS LONG) AS STRING
        LOCAL s AS STRING
    
        IF i <= 20 THEN
            s = "record #" + STR$(i)
            FUNCTION = LEFT$(s + SPACE$(16), 24)
        ELSE
            FUNCTION = CHR$(255)
        END IF
    
    END FUNCTION
    
    '-----------------------------------------------------------------------
    CLASS myListBoxclass
        INSTANCE nlines, pxcwide, pxchigh, top, hilit AS LONG
        INSTANCE r, rCtlBox AS RECT
        INSTANCE hGW AS DWORD
        INSTANCE LBX, LBY, LBW, LBH AS LONG
        INSTANCE lastline AS LONG
        INSTANCE stitles AS STRING
        INSTANCE getalineproc AS DWORD
        INSTANCE pt AS POINTAPI
        INSTANCE X, Y, W, H AS LONG
        INSTANCE lastTOP AS LONG ' the TOP value when the data part of the LB was last drawn
        INSTANCE skey AS STRING ' the key/mouse return code encoded like PBCC's INKEY$
        INSTANCE clicked, clickX, clickY AS LONG ' mouse stuff returned by GRAPHIC WINDOW CLICK
        INSTANCE rslidetop, rslidebottom, rslider AS rect
        '---------------------------------------------------------
        CLASS METHOD drawcontents (linex AS LONG)
            LOCAL s AS STRING
    
            CALL DWORD getalineproc USING getlineproc(linex) TO s
            IF LEFT$(s,1) = CHR$(255) THEN
                RETURN
            END IF
            GRAPHIC SET POS (X + 4, Y + pxchigh + 4 + ((linex - top) * pxchigh))
            IF linex = hilit THEN
                GRAPHIC COLOR 0, %CYAN
            ELSE
                GRAPHIC COLOR 0, %WHITE
            END IF
            GRAPHIC PRINT s;
        END METHOD
        '---------------------------------------------------------
        CLASS METHOD drawall()
            LOCAL I AS LONG
            FOR i = top TO top + nlines
                IF i <= lastline THEN
                    me.drawcontents(i)
                END IF
            NEXT i
        END METHOD
        '--------------------------------------------------------
        CLASS METHOD drawCtlBox()
            ' this box goes around the interactive part of the control
            ' (a click outside it will exit the control)
            IF lasttop <> -1 THEN ' always redraw first time through
                IF LastTop = top THEN EXIT METHOD
            END IF
            lastTop = top
    
            setrect rCtlBox, X, Y + pxchigh + 2, X + W, Y + H
            GRAPHIC BOX (rCtlBox.nleft, rCtlBox.ntop) - (rCtlBox.nright, rCtlBox.nbottom), 0, %BLUE, %WHITE, 0
        END METHOD
        '--------------------------------------------------------
        CLASS METHOD getclick() AS STRING
        'exit method
    
            LOCAL clickcount, lstart, lend AS LONG
            clickcount = 0
            clicked = 0
            lstart = gettickcount
            lend = lstart + 600
            SLEEP 1 ' just a bit of a delay
            GRAPHIC WINDOW CLICK TO clicked, clickX, clickY
            IF clicked = 0 THEN ' no click was waiting, don't enter loop
                skey = ""
                EXIT METHOD
            END IF
            clickcount = 1
            WHILE gettickcount < lend
                GRAPHIC WINDOW CLICK TO clicked, clickX, clickY
                IF clicked THEN
                    INCR clickcount
                    clicked = 0
                END IF
            WEND
            SELECT CASE clickcount
                CASE 0: skey = ""
                CASE 1: skey = CHR$(255) + CHR$(255) + CHR$(4) + CHR$(1)
                CASE 2: skey = CHR$(255) + CHR$(255) + CHR$(2) + CHR$(1)
            END SELECT
    
        END METHOD
        '---------------------------------------------------------
        ' this is called by both loadngo and by warmstart
        ' warmstart provides a parameter, load_n_go a dummy parameter
        ' parameter is X,Y of mouse click
        ' result low DWORD is line number selected or zero if no selection
        ' result hi DWORD is (lo)X, (hi)Y of cursor pos if no selection made
        CLASS METHOD getLBselection ( dwclk AS DWORD) AS QUAD
            LOCAL s AS STRING
            LOCAL i, firsttime AS LONG
    
            WHILE skey <> $ESC
                skey = ""
                GRAPHIC INSTAT TO i
                IF i THEN
                    GRAPHIC INKEY$ TO skey
                    IF LEN(skey) = 2 THEN
                        '? hex$(asc(MID$(skey,2,1)))
                        SELECT CASE ASC(MID$(skey,2,1))
                            CASE &H48' up
                                IF hilit > 1 THEN DECR hilit
                                IF hilit < top THEN DECR top
                                IF top < 1 THEN top = 1
                            CASE &H50'down
                                IF hilit < lastline THEN
                                    INCR hilit
                                END IF
                                IF hilit > top + nlines THEN INCR top
                            CASE &H49 ' page up
                                hilit = hilit - nlines
                                IF hilit < 1 THEN
                                    hilit = 1
                                    top = 1
                                    EXIT SELECT
                                END IF
                                IF hilit < top THEN top = hilit
                            CASE &H51 ' page down
                                hilit = hilit + nlines
                                hilit = MIN(hilit,lastline)
                                IF hilit > top + nlines THEN top = hilit
                            CASE &H47 ' home
                                hilit = 1 : top = 1
                            CASE &H4F ' end
                                 hilit = lastline
                                 top = lastline
                        END SELECT
                        ME.drawCtlBox()
                        ME.drawall()
                    END IF
                ELSE
                    IF firsttime = 0 THEN
                        IF dwclk <> 0 THEN
                            clicked = 1
                            clickX = LO(WORD,dwclk)
                            clickY = HI(WORD,dwclk)
                        END IF
                        INCR firsttime
                    ELSE
                        me.getclick 'clicked = 0
                    END IF
                    IF skey = "" THEN ITERATE LOOP ' no key was pressed
    
                    pt.X = clickX: pt.Y = ClickY
                    IF ptinrect( BYVAL VARPTR(rCtlBox), pt.x, pt.Y) = 0 THEN ' clicked outside the box
                        METHOD = MAK(QUAD,0,MAK(DWORD,ClickX,ClickY))
                        EXIT METHOD
                    END IF
                    ' now we have a click inside the control,
                    ' what line is it on?
                    i = -2 + (clicky / pxchigh)
                    ' double click? then exit fn
                    IF RIGHT$(skey$,2) = CHR$(2) + CHR$(1) THEN
                        METHOD = MAK(QUAD,i + top -1, 0)
                        EXIT METHOD
                    END IF
                    hilit = i + top -1
                    IF hilit > lastline THEN hilit = lastline
                    IF hilit > top + nlines THEN hilit = top + nlines
                    ME.drawall()
                END IF
            WEND
            METHOD = 0
            EXIT METHOD
    
        END METHOD
        'IIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIII
        INTERFACE MyLB
            INHERIT IUNKNOWN
            ' result is the same as GetLBSelection
            METHOD load_n_go (hGW AS DWORD, LBX AS LONG, LBY AS LONG, LBW AS LONG, LBH AS LONG, _
                               LBlastline AS LONG, LBstitles AS STRING, LBglineproc AS DWORD ) AS QUAD
                LOCAL r AS RECT
                LOCAL i AS LONG
    
                GRAPHIC FONT "Courier"
                X = LBX: Y = LBY : W = LBW: H = LBH
                lastline     = LBLastline
                stitles      = LBStitles
                getalineproc = LBglineproc
                lasttop = -1
                GRAPHIC WIDTH 1
                GRAPHIC CHR SIZE TO pxcwide, pxchigh
                setrect r, x + pxcwide, y + pxchigh, x + W + pxcwide*2, y + H + pxchigh
                ' push the gr screen on entry on the GR stack before drawing the shadow
                mpushgr (hGW, r)
                'draw shadow box
                GRAPHIC BOX (r.nleft, r.ntop) - (r.nright, r.nbottom), 0, 0, 0
                setrect  ( r, x, y, x + w, y + h)
                mpushgr(hGW, r)
                ' draw box around control
                GRAPHIC BOX  (r.nleft, r.ntop) - (r.nright, r.nbottom), 0, %BLUE, %BLUE, 0 '&Hd0d0ff
                GRAPHIC COLOR %WHITE, %BLUE
                GRAPHIC SET POS (X + 2, y + 2): GRAPHIC PRINT stitles
                GRAPHIC COLOR %BLACK, %WHITE
    
                ' draw line under title
                GRAPHIC LINE (X, Y + pxchigh + 2) - (X + W,Y + pxchigh + 2)
                me.drawCtlBox
                nlines = ((h - pxchigh - 5) \ pxchigh) -1
                top = 1
                hilit = 1' the highlighted row
                FOR i = 1 TO top + nlines
                    me.drawcontents(i)
                NEXT
    
                METHOD = me.getLBSelection(0)
            END METHOD
            '
            METHOD remove ()
                mpopgr
                mpopgr
            END METHOD
            '
            ' user has navigated to the LB.
            ' parameter contains click coordinates
            METHOD warmstart ( clk AS DWORD) AS QUAD
                me.getLBSelection (clk)
            END METHOD
    
        END INTERFACE
        'IIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIII
    END CLASS
    '------------------------------------------------------------------------------------
    FUNCTION formloop AS LONG
        STATIC mLB AS myLB
        LOCAL hstatic AS DWORD
        LOCAL bigx, bigy, thisW, thisH AS LONG
        LOCAL menuchoice, closemecoords AS QUAD
        LOCAL r AS RECT
        LOCAL dw AS DWORD
        LOCAL skey, smenu AS STRING
        LOCAL hGW AS DWORD
        LOCAL qresult AS QUAD
    
        MLB = CLASS "MyListBoxClass"
        DESKTOP GET SIZE TO bigx, bigy
        thisW = 500: thisH = 400
        GRAPHIC WINDOW "listbox", (bigx - thisw)/2, (bigY - thisH)/2, 300, 300 TO hGW
        GRAPHIC ATTACH hGW, 0
        setrect r, 0, 0, 400, 400
        GRAPHIC BOX (r.nleft, r.ntop) - (r.nright, r.nbottom), 0, -1, %BLUE, 4
        mpushgr(hGW, r)
    
        qresult = MLB.load_n_go( hGW, 50, 20, 200, 100, 20, "listbox", CODEPTR(getlineproc))
        GRAPHIC SET POS (20, 180)
    '    GRAPHIC PRINT "returned value=" + STR$(LO(DWORD, qresult)) + "at" + _
    '                  STR$(LO(WORD,HI(DWORD,qresult))) + "," + _
    '                  STR$(HI(WORD,HI(DWORD,qresult)))
        WHILE skey <> $ESC
            GRAPHIC WAITKEY$ TO skey
        WEND
        MLB.remove()
    '
    END FUNCTION
    
    '-------------------------------------------------------
    FUNCTION PBMAIN () AS LONG
    '
        FormLoop
    END FUNCTION

    Comment

    Working...
    X