I seem to always be able to find something else to do with Borje's Graphic Buttons code.(when I should be doing something else
)

Code:
'==================================================================== ' gWinButtons.bas - Graphic Window Mouse and Keyboard support. ' Compiles as it is with PBWIN10, PBCC6, PBWIN9 and PBCC5. ' Public Domain by Borje Hagsten, May 2013. ' ' Shows a way to paint buttons in a graphic window and trap both ' Mouse and Keyboard actions for each "button". Also shows a way ' to center the Graphic Window on Desktop and how to define our ' own User-Defined Data Type (UDT), here for use in an array of ' Button area coordinates. ' ' To learn more about each command used in the code, select it and ' press F1 to bring up context sensitive help. For example, if you ' select GRAPHIC BOX and then press F1, it will bring up the help ' page for the GRAPHIC BOX statement with more detailed information ' about its features. '-------------------------------------------------------------------- '==================================================================== 'Almost all of Borje Hagsten's delightful code is left intact, but 'fragmented and adjusted to suit the addition of: ' MOUSE HOVERING ' EXTENDED KEYBOARD CHARACTERS ' A PSEUDO-CALLBACK section complete with suitable variable type ' Listing each action on a separate line ' Borje Hagsten's original code found at: ' http://forum.powerbasic.com/forum/user-to-user-discussions/source-code/54302-graphic-window-buttons '-------------------------------------------------------------------- #COMPILE EXE #IF %DEF(%PB_CC32) ' if to be compiled with PBCC6 or PBCC5, then #CONSOLE OFF ' this example doesn't need the console window #ENDIF #INCLUDE ONCE "WIN32API.INC" %GW_BTN_CLICK = 1 %GW_KEY_PRESS = 2 %GW_EXT_KEY_PRESS = 3 %GW_FINISH = 4 %GW_MOUSE_HOVER = 5 %GW_SET_FOCUS = 6 TYPE BTNRECT ' User-Defined Data Type (UDT) for Button area L AS SINGLE ' Left side T AS SINGLE ' Top R AS SINGLE ' Right side B AS SINGLE ' Bottom END TYPE TYPE CARRIER HNDL AS LONG 'window handle ITEM AS LONG 'in this example, the button of interest EVNT AS LONG 'the message to process FPAR AS LONG 'an if needed parameter SPAR AS LONG 'another if needed parameter END TYPE '==================================================================== ' Program begins here '-------------------------------------------------------------------- FUNCTION PBMAIN () AS LONG LOCAL c, cmd, hDC AS LONG LOCAL hFont, hWin, Hfnt AS DWORD LOCAL mp, gp AS POINT LOCAL h, w, x, y, cw, ch, flg, cntr, focuss AS LONG LOCAL gw AS CARRIER LOCAL sTemp, tmp AS STRING DIM btn(1 TO 4) AS BTNRECT ' array for 4 button areas, 1 to 4 focuss=1 '------------------------------------------------------------------ ' Create a centered Graphic Window and set its colors '------------------------------------------------------------------ w = 450 : h = 280 ' desired dialog size DESKTOP GET LOC TO x, y ' in case taskbar is on Left/Up side DESKTOP GET CLIENT TO cw, ch ' need DeskTop clien size x = x + ((cw - w) / 2) ' calculate centered x y = y + ((ch - h) / 2) ' calculate centered y GRAPHIC WINDOW "Graphic Window Buttons", x, y, w, h TO hWin GRAPHIC ATTACH hWin, 0 GRAPHIC WINDOW STABILIZE hWin GRAPHIC COLOR %RGB_GOLD, %RGB_MAROON GRAPHIC CLEAR '------------------------------------------------------------------ ' Create buttons and some extra for info texts '------------------------------------------------------------------ FONT NEW "Comic Sans MS", 11, 1 TO hFont GRAPHIC SET FONT hFont ' Define Button areas: Left, Top, Right, Bottom btn(1).L = 10 : btn(1).T = 10 : btn(1).R = 110 : btn(1).B = 40 btn(2).L = 120 : btn(2).T = 10 : btn(2).R = 220 : btn(2).B = 40 btn(3).L = 230 : btn(3).T = 10 : btn(3).R = 330 : btn(3).B = 40 btn(4).L = 340 : btn(4).T = 10 : btn(4).R = 440 : btn(4).B = 40 ' Call SUB GRAPHIC_BUTTON, where the "buttons" are created GRAPHIC_BUTTON ("Button 1", btn(1), %RGB_GRAY, %RGB_LIGHTGRAY, %RGB_BLACK) GRAPHIC_BUTTON ("Button 2", btn(2), %RGB_GRAY, %RGB_LIGHTGRAY, %RGB_BLACK) GRAPHIC_BUTTON ("Button 3", btn(3), %RGB_GRAY, %RGB_LIGHTGRAY, %RGB_BLACK) GRAPHIC_BUTTON ("Quit", btn(4), %RGB_GRAY, %RGB_LIGHTGRAY, %RGB_BLACK) ' following GRAPHIC commands are for the example's info text GRAPHIC GET CLIENT TO cw, ch ' only need ch (dialog client height) GRAPHIC TEXT SIZE " " TO w, h ' only need h (text height) GRAPHIC COLOR %RGB_LIGHTGRAY, %RGB_MAROON GRAPHIC SET POS (10, ch - h - 5) GRAPHIC PRINT "Keys: Press 1 to 3 for Button 1 to 3. Press Esc to quit." GRAPHIC SET POS (10, ch - 2*h - 5) GRAPHIC PRINT "Mouse: Click on the Buttons." GRAPHIC SET POS (10, ch-3*h-5) GRAPHIC PRINT "Shift Focus Left <, Right >, Acitivate with Up Arrow" GRAPHIC COLOR %RGB_GOLD, %RGB_MAROON GRAPHIC WIDTH 2 GRAPHIC LINE (-1, ch - 3*h - 10) - (cw, ch - 3*h - 10) FONT END hFont '------------------------------------------------------------------ FONT NEW "Comic Sans MS", 14, 1 TO Hfnt 'font for big info text GRAPHIC SET FONT Hfnt GRAPHIC TEXT SIZE " " TO c, h 'only need h GRAPHIC COLOR %RGB_GOLD, %RGB_MAROON 'colors for info text gw.hndl=hWin '------------------------------------------------------------------ ' Main program loop '------------------------------------------------------------------ DO SLEEP 1 ' short sleep needed too let processor (CPU) breathe GetCursorPos(gp) ScreenToClient(hWin, gp) IF gw.evnt<>%GW_MOUSE_HOVER THEN FOR cntr=1 TO 4 IF ISTRUE twixt(btn(cntr),gp.x,gp.y) THEN gw.evnt=%GW_MOUSE_HOVER gw.item=cntr gw.fpar=gp.x gw.spar=gp.y EXIT FOR END IF NEXT cntr END IF '-------------------------------------------------------------- ' Mouse support '-------------------------------------------------------------- GRAPHIC WINDOW CLICK hWin TO c, x, y ' see if Mouse was clicked IF c THEN gw.evnt=%GW_BTN_CLICK ' if it was clicked gw.item=0 gw.fpar=x gw.spar=y SELECT CASE y CASE btn(1).T TO btn(1).B ' if in buttons vertical area SELECT CASE AS LONG x ' which button was clicked? CASE btn(1).L TO btn(1).R : gw.item = 1 ' Button 1 area CASE btn(2).L TO btn(2).R : gw.item = 2 ' Button 2 area CASE btn(3).L TO btn(3).R : gw.item = 3 ' Button 3 area CASE btn(4).L TO btn(4).R : gw.item = 4 ' Button 4 area (Quit) gw.evnt=%GW_FINISH END SELECT END SELECT END IF '-------------------------------------------------------------- ' Keyboard support '-------------------------------------------------------------- GRAPHIC INKEY$ TO sTemp 'if a key is pressed IF LEN(sTemp) = 1 THEN 'if it's a standard key gw.evnt=%GW_KEY_PRESS SELECT CASE sTemp 'following are the keys used here CASE "1" : gw.item = 1 '1 is our shortcut key for button 1 CASE "2" : gw.item = 2 '2 is our shortcut key for button 2 CASE "3" : gw.item = 3 '3 is our shortcut key for button 3 CASE CHR$(27) : gw.item = 4 'Esc key has ANSI code 27 (Quit) gw.evnt=%GW_FINISH END SELECT sTemp = "" 'clear receiving string variable ELSEIF LEN(sTemp) = 2 THEN 'if it's an extended key SELECT CASE ASC(stemp,2) CASE 72 ' up arrow gw.evnt=%GW_EXT_KEY_PRESS gw.item=focuss gw.fpar=1 CASE 75 'left arrow gw.evnt=%GW_SET_FOCUS DECR focuss IF focuss=0 THEN focuss=4 END IF gw.item=focuss gw.fpar=0 GRAPHIC SET FONT hFont FOR cntr=1 TO 4 IF cntr<4 THEN tmp="Button"+STR$(cntr) ELSEIF cntr=4 THEN tmp="Quit" END IF FOCUS_BUTTON (tmp, btn(cntr), %RGB_LIGHTGRAY, %RGB_LIGHTGRAY, %RGB_BLACK, focuss, cntr) NEXT cntr GRAPHIC SET FONT Hfnt GRAPHIC COLOR %RGB_GOLD, %RGB_MAROON CASE 77 'right arrow gw.evnt=%GW_SET_FOCUS INCR focuss IF focuss=5 THEN focuss=1 END IF gw.item=focuss gw.fpar=0 GRAPHIC SET FONT hFont FOR cntr=1 TO 4 IF cntr<4 THEN tmp="Button"+STR$(cntr) ELSEIF cntr=4 THEN tmp="Quit" END IF FOCUS_BUTTON (tmp, btn(cntr), %RGB_LIGHTGRAY, %RGB_LIGHTGRAY, %RGB_BLACK, focuss, cntr) NEXT cntr GRAPHIC SET FONT Hfnt GRAPHIC COLOR %RGB_GOLD, %RGB_MAROON END SELECT END IF '-------------------------------------------------------------- ' Resulting action - command center '-------------------------------------------------------------- IF gw.evnt THEN IF gw.evnt<4 THEN GRAPHIC SET POS (10, (gw.evnt+1)*h) 'to show what cmd we got ELSE GRAPHIC SET POS (10, (gw.evnt)*h) END IF SELECT CASE gw.evnt CASE %GW_BTN_CLICK SELECT CASE gw.item CASE 1 : GRAPHIC PRINT "Button 1 was triggered via mouse click. " CASE 2 : GRAPHIC PRINT "Button 2 was triggered via mouse click. " CASE 3 : GRAPHIC PRINT "Button 3 was triggered via mouse click. " CASE 4 : EXIT DO 'Exit loop = end program END SELECT CASE %GW_KEY_PRESS SELECT CASE gw.item CASE 1 : GRAPHIC PRINT "Button 1 was triggered via the keyboard. " CASE 2 : GRAPHIC PRINT "Button 2 was triggered via the keyboard. " CASE 3 : GRAPHIC PRINT "Button 3 was triggered via the keyboard. " CASE 4 : EXIT DO 'Exit loop = end program END SELECT CASE %GW_EXT_KEY_PRESS SELECT CASE gw.item CASE 1 : GRAPHIC PRINT "Button 1 was triggered via the Up arrow. " CASE 2 : GRAPHIC PRINT "Button 2 was triggered via the Up arrow. " CASE 3 : GRAPHIC PRINT "Button 3 was triggered via the Up arrow. " CASE 4 : EXIT DO 'Exit loop = end program END SELECT CASE %GW_FINISH EXIT DO CASE %GW_MOUSE_HOVER SELECT CASE gw.item CASE 1 : GRAPHIC PRINT "Hovering on Button 1. " CASE 2 : GRAPHIC PRINT "Hovering on Button 2. " CASE 3 : GRAPHIC PRINT "Hovering on Button 3. " CASE 4 : GRAPHIC PRINT "Hovering on Button 4. " END SELECT CASE %GW_SET_FOCUS SELECT CASE gw.item CASE 1 : GRAPHIC PRINT "Focus is on Button 1. " CASE 2 : GRAPHIC PRINT "Focus is on Button 2. " CASE 3 : GRAPHIC PRINT "Focus is on Button 3. " CASE 4 : GRAPHIC PRINT "Focus is on Button 4. " END SELECT END SELECT gw.evnt = 0 'Clear command variable END IF 'need a way out of loop if user exits via system menu or X GRAPHIC GET DC TO hDC 'if hDC becomes 0, program is closing LOOP UNTIL hDC = 0 FONT END hFont FONT END Hfnt GRAPHIC WINDOW END END FUNCTION ' <- Program ends here '==================================================================== ' Button creation procedure ' Draws a box from L,T to R,B using given colors and prints ' the given sCaption string centered inside the box area. '-------------------------------------------------------------------- SUB GRAPHIC_BUTTON (BYVAL sCaption AS STRING, BYVAL btn AS BTNRECT, _ BYVAL BorderColor AS LONG, BYVAL FillColor AS LONG, _ BYVAL TextColor AS LONG) '------------------------------------------------------------------ LOCAL w, h, x, y AS SINGLE GRAPHIC BOX (btn.L, btn.T) - (btn.R, btn.B), 20, BorderColor, FillColor, 0 GRAPHIC COLOR TextColor, FillColor ' set text colors GRAPHIC TEXT SIZE sCaption TO w, h ' need text size x = btn.L + ((btn.R - btn.L - w) / 2) ' centered text x y = btn.T + ((btn.B - btn.T - h) / 2) ' centered text y GRAPHIC SET POS (x, y-1) ' set text position GRAPHIC PRINT sCaption ' and print text (caption) END SUB '==================================================================== ' Focus development procedure for use within a loop. ' Draws a box from L-2,T-2 to R+2,B+2 using specific colors and prints ' the given sCaption string centered inside the box area. ' Same as GRAPHIC_BUTTON with two more parameters and the first IF/THEN/ELSE/END IF block. '-------------------------------------------------------------------- SUB FOCUS_BUTTON (BYVAL sCaption AS STRING, BYVAL btn AS BTNRECT, _ BYVAL BorderColor AS LONG, BYVAL FillColor AS LONG, _ BYVAL TextColor AS LONG, BYVAL focuss AS LONG, BYVAL nstnc AS LONG) '------------------------------------------------------------------ LOCAL w, h, x, y AS SINGLE IF focuss=nstnc THEN GRAPHIC BOX (btn.L-2, btn.T-2) - (btn.R+2, btn.B+2), 20, %WHITE, FillColor, 0 ELSE GRAPHIC BOX (btn.L-2, btn.T-2) - (btn.R+2, btn.B+2), 20, %RGB_MAROON, FillColor, 0 END IF GRAPHIC BOX (btn.L, btn.T) - (btn.R, btn.B), 20, BorderColor, FillColor, 0 GRAPHIC COLOR TextColor, FillColor ' set text colors GRAPHIC TEXT SIZE sCaption TO w, h ' need text size x = btn.L + ((btn.R - btn.L - w) / 2) ' centered text x y = btn.T + ((btn.B - btn.T - h) / 2) ' centered text y GRAPHIC SET POS (x, y-1) ' set text position GRAPHIC PRINT sCaption ' and print text (caption) END SUB FUNCTION twixt(BYVAL btn AS BTNRECT, BYVAL x AS LONG, BYVAL y AS LONG) AS LONG IF (x>=btn.L AND x<=btn.R) AND (y>=btn.T AND y<=btn.B) THEN FUNCTION =1 EXIT FUNCTION END IF FUNCTION=0 END FUNCTION
Comment