Download self extracting exe
#if 0
---------------------------- PowerBASIC v8.x
---| DASoft |------------------------------------------
---------------------------- Code DATE: 2005-03-03
| FILE NAME MenuDemo.bas | by
---------------------------- Don Schullian, Jr.
This code is released into the Public Domain
----------------------------------------------------------
No guarantee as to the viability, accuracy, or safety of
use of this code is implied, warranted, or guaranteed
----------------------------------------------------------
Use at your own risk!
----------------------------------------------------------
CONTACT AUTHOR AT d83@DASoftVSS.com
-------------------------------------------------------------------------
This code demonstrates the use of BITMAP COPY and the trapping of the mouse
without using SubClassing. There is also extensive use of the USER DATA AREA
available in PB's DDT code.
The code was originally written for a little educational game I'm working on
but as there has been some questions raised in the forums about the use of
BITMAP COPY and, in general, the new functions in PBwin v8 I thought it would
also make a good demo for some of them.
So... use it and/or abuse it at your own risk and I hope it proves useful.
Don
#endif
#COMPILE EXE
#COMPILER PBWIN 8
#DIM ALL
#DEBUG ERROR ON
%USEMACROS = 1
#INCLUDE "WIN32API.INC"
TYPE MenuTYPE
Dirs AS BYTE
Words AS BYTE
MinLen AS BYTE
MaxLen AS BYTE
END TYPE
%Left2Right = 1
%Down = 2
%DownRight = 4
%DownLeft = 8
%Right2Left = 16
%Up = 32
%UpRight = 64
%UpLeft = 128
$IDR_MainMenu = "mainmenu.bmp"
$IDR_BtnsOn = "buttons_on.bmp"
$IDR_BtnsOff = "buttons_off.bmp"
$IDR_GreenBtn = "greenbutton.bmp"
$IDR_SliderBar = "sliderbar.bmp"
DECLARE FUNCTION fGameMenu(hParent???,tM AS MenuTYPE) AS LONG
FUNCTION PBMAIN()
DIM tM AS LOCAL MenuTYPE
tM.Dirs = &b00001111
tM.MinLen = 10
tM.MaxLen = 10
tM.Words = 10
fGameMenu %HWND_DESKTOP, tM
END FUNCTION
'
'------------------------------------------------------------------------------
'
CALLBACK FUNCTION GameMenu_CB ()
DIM hWndSaveFocus AS STATIC DWORD
DIM SliderBtn AS STATIC LONG
DIM tM AS STATIC MenuTYPE PTR
DIM hBMP AS LOCAL DWORD
DIM Bx AS LOCAL LONG
DIM D AS LOCAL LONG
DIM tP AS LOCAL POINTL
DIM tR AS LOCAL RECT
DIM hTMP AS LOCAL DWORD
DIM Txt AS LOCAL STRING
DIM X AS LOCAL SINGLE
DIM Y AS LOCAL SINGLE
SELECT CASE AS LONG CBMSG
CASE %WM_INITDIALOG : DIALOG GET USER CBHNDL, 1 TO tM
GOSUB LoadMenuWindow
GOSUB ShowAllButtons
FOR Bx = 9 TO 11
GOSUB SetSlider
NEXT
SliderBtn = -2
DIALOG SHOW STATE CBHNDL, %SW_SHOW
CASE %WM_NCACTIVATE : IF ISFALSE CBWPARAM THEN
hWndSaveFocus = GetFocus()
ELSEIF hWndSaveFocus THEN
SetFocus(hWndSaveFocus)
hWndSaveFocus = 0
END IF
CASE %WM_SETCURSOR : GOSUB FindHit
SELECT CASE HI(WORD,CBLPARAM)
CASE &h200 : IF Bx = SliderBtn THEN ' Mouse movement
GOSUB Sliders
ELSEif SliderBtn <> -2 THEN
Bx = SliderBtn
SliderBtn = -2
GOSUB SetSlider
END IF
CASE &h201 : IF (Bx > 8) AND (Bx < 12) THEN ' Mouse down
SliderBtn = Bx
END IF
CASE &h202 : SELECT CASE Bx ' Mouse Up
CASE 0 TO 7 : BIT TOGGLE @tM.Dirs, Bx
D = 7 + BIT(@tM.Dirs,Bx)
GOSUB ShowButton
GOSUB ShowUpdate
CASE 8 : GOSUB ToggleButtons
CASE 12 : GRAPHIC WINDOW "Message", 100, 100, 180, 30 TO hTmp
GRAPHIC ATTACH hTmp, 0
GRAPHIC CLEAR %YELLOW
GRAPHIC COLOR %BLACK, -2
Txt = "You clicked the ""Word Lists"" button."
GRAPHIC TEXT SIZE Txt TO X, Y
X = MAX(0,(180-X)\2)
Y = MAX(0,( 30-Y)\2)
GRAPHIC SET POS (X,Y)
GRAPHIC PRINT Txt
SLEEP 3000
GRAPHIC WINDOW END
CASE 13 : DIALOG END CBHNDL, 1
CASE ELSE : IF SliderBtn <> -2 THEN
Bx = SliderBtn
SliderBtn = -2
GOSUB SetSlider
END IF
END SELECT
END SELECT
CASE %WM_COMMAND : IF CBCTL = 2 THEN DIALOG END CBHNDL, 0
END SELECT
EXIT FUNCTION
'
'----------------------------------------------
'---------- LOCAL GOODIES ---------------------
'----------------------------------------------
'
ToggleButtons:
@tM.Dirs = IIF(@tM.Dirs=0,255,0)
ShowAllButtons:
FOR Bx = 0 TO 7
GOSUB ReadOneBox
D = 7 + BIT(@tM.Dirs,Bx)
GOSUB ShowButton
NEXT
GOSUB ReadOneBox
D = 8 - SGN(@tM.Dirs)
GOSUB ShowButton
GOTO ShowUpdate
ShowButton:
DIALOG GET USER CBHNDL, D TO hTMP
X = (Bx * 31)
GRAPHIC COPY hTmp, 0, (X,0)-(X+30,30) TO (tR.nLeft, tR.nTop)
RETURN
SetSlider:
GOSUB LoadMenuWindow
GOSUB ReadOneBox ' Bx is incoming
SELECT CASE Bx
CASE 9 : D = @tM.MinLen
CASE 10 : D = @tM.MaxLen
CASE 11 : D = @tM.Words
END SELECT
tP.X = tR.nLeft + ((D-3) * 20.6667)
GOTO PutSlider
Sliders:
D = 3 + ((tP.X - tR.nLeft) / 20.6667)
D = MIN(15,D)
SELECT CASE SliderBtn
CASE 9 : @tM.MinLen = D
IF @tM.MinLen => @tM.MaxLen THEN
GOSUB PutSlider
@tM.MaxLen = @tM.MinLen
tR.nTop = tR.nTop + 55
GRAPHIC ATTACH hBMP, 0
END IF
CASE 10 : @tM.MaxLen = D
IF @tM.MaxLen =< @tM.MinLen THEN
GOSUB PutSlider
@tM.MinLen = @tM.MaxLen
tR.nTop = tR.nTop - 55
GRAPHIC ATTACH hBMP, 0
END IF
CASE 11 : @tM.Words = D
END SELECT
PutSlider:
IF D = 3 THEN
tP.X = tR.nLeft
ELSEif D = 15 THEN
tP.X = tR.nRight - 24
END IF
DIALOG GET USER CBHNDL, 6 TO hTmp ' Blank Slider Bar
GRAPHIC COPY hTmp, 0 TO (tR.nLeft,tR.nTop) ' copy to screen
DIALOG GET USER CBHNDL, 5 TO hTmp ' blank green button
GRAPHIC COPY hTmp, 0 TO (tP.X, tR.nTop) ' put the button on the screen
Txt = FORMAT$(D)
GRAPHIC FONT "Times New Roman", 12, 1
GRAPHIC COLOR %BLACK, -2
GRAPHIC TEXT SIZE Txt TO X, Y
X = tP.X + ((24 - X) / 2)
GRAPHIC SET POS (X,tR.nTop+1)
GRAPHIC PRINT Txt
ShowUpdate:
GRAPHIC ATTACH CBHNDL, 1000
GRAPHIC COPY hBMP,0
RETURN
FindHit:
GetCursorPos tP
ScreenToClient CBHNDL, tP
Bx = 13
DO
GOSUB ReadOneBox
IF (tP.X => tR.nLeft ) AND _
(tP.Y => tR.nTop ) AND _
(tP.X =< tR.nRight ) AND _
(tP.Y =< tR.nBottom) THEN
EXIT LOOP
END IF
DECR Bx
LOOP UNTIL Bx = -1
IF Bx < 0 THEN RETURN
LoadMenuWindow:
DIALOG GET USER CBHNDL, 4 TO hBMP
GRAPHIC ATTACH hBMP, 0
RETURN
ReadOneBox:
D = Bx * 4
INCR D : tR.nLeft = VAL(READ$(D))
INCR D : tR.nTop = VAL(READ$(D))
INCR D : tR.nRight = VAL(READ$(D))
INCR D : tR.nBottom = VAL(READ$(D))
RETURN
DATA 085, 050, 115, 080 : ' 00 Left2Right
DATA 050, 085, 080, 115 : ' 01 Down
DATA 085, 085, 115, 115 : ' 02 DownRight
DATA 015, 085, 045, 115 : ' 03 DownLeft
DATA 015, 050, 045, 080 : ' 04 Right2Left
DATA 050, 015, 080, 045 : ' 05 Up
DATA 085, 015, 115, 045 : ' 06 UpRight
DATA 015, 015, 045, 045 : ' 07 UpLeft
DATA 050, 050, 080, 080 : ' 08 All On/Off
DATA 015, 149, 287, 171 : ' 09 Min Letters
DATA 015, 204, 287, 226 : ' 10 Max Letters
DATA 015, 258, 287, 280 : ' 11 Game Words
DATA 143, 018, 277, 049 : ' 12 Word Lists
DATA 179, 065, 279, 099 : ' 13 Play
END FUNCTION
'
'------------------------------------------------------------------------------
'
FUNCTION fGameMenu(hParent AS DWORD , _
tM AS MenuTYPE ) AS LONG
DIM hBMPs(4) AS LOCAL DWORD
DIM hDlg AS LOCAL DWORD
DIM lRslt AS LOCAL LONG
DIM tTmp AS LOCAL MenuTYPE
DIM X1 AS LOCAL LONG
DIM Y1 AS LOCAL LONG
DIALOG GET LOC hParent TO X1, Y1
X1 = X1 + 61
Y1 = Y1 + 61
DIALOG NEW PIXELS, hParent, "", X1, Y1, 300, 300, %WS_POPUP OR %WS_CLIPSIBLINGS OR %WS_VISIBLE OR %DS_NOFAILCREATE OR %DS_SETFONT, %WS_EX_CONTROLPARENT OR %WS_EX_LEFT OR %WS_EX_LTRREADING OR %WS_EX_RIGHTSCROLLBAR, To hDlg
CONTROL ADD GRAPHIC, hDlg, 1000, "", 0, 0, 299, 299, %WS_CHILD Or %WS_VISIBLE OR %SS_NOTIFY
GRAPHIC BITMAP LOAD $IDR_BtnsOn , 279, 31 TO hBMPs(0)
GRAPHIC BITMAP LOAD $IDR_BtnsOff , 279, 31 TO hBMPs(1)
GRAPHIC BITMAP LOAD $IDR_SliderBar, 272, 22 TO hBMPs(2)
GRAPHIC BITMAP LOAD $IDR_GreenBtn , 24, 22 TO hBMPs(3)
GRAPHIC BITMAP LOAD $IDR_MainMenu , 300, 300 TO hBMPs(4)
DIALOG SET USER hDlg, 1, VARPTR(tM) ' menu return values
DIALOG SET USER hDlg, 4, hBMPs(4) ' copy of screen
DIALOG SET USER hDlg, 5, hBMPs(3) ' green button
DIALOG SET USER hDlg, 6, hBMPs(2) ' slider bar
DIALOG SET USER hDlg, 7, hBMPs(1) ' buttons off
DIALOG SET USER hDlg, 8, hBMPs(0) ' buttons on
TYPE SET tTmp = tM
DIALOG SHOW MODAL hDlg, CALL GameMenu_CB TO lRslt
FOR X1 = 0 TO 4
GRAPHIC ATTACH hBMPs(X1), 0 : GRAPHIC BITMAP END
NEXT
IF lRslt = 0 THEN TYPE SET tM = tTmp
FUNCTION = lRslt
END FUNCTION