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