Tweet
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