Tweet
Another favorite button to use. This is only one button, but the hit testing is split into
four areas to give the effect of four different button click messages giving you a direction
response of North, South, East, West.
I am Not sure were origional C code came from or who is the Author. If anyone recoginizes
it please let me know. Thanks!
Regards,
Jules
'---
To get the Button bitmaps, please forward email me <[email protected]> and I will supply them.
'---
Bitmap resource file...
Source...
four areas to give the effect of four different button click messages giving you a direction
response of North, South, East, West.
I am Not sure were origional C code came from or who is the Author. If anyone recoginizes
it please let me know. Thanks!
Regards,
Jules
'---
To get the Button bitmaps, please forward email me <[email protected]> and I will supply them.
'---
Bitmap resource file...
Code:
#include "resource.h" ALLUP BITMAP allup.bmp EDOWN BITMAP edown.bmp WDOWN BITMAP wdown.bmp NDOWN BITMAP ndown.bmp SDOWN BITMAP sdown.bmp
Code:
'--------------------------------------------------------------------------------
' Four-in-One Owner-Draw button demo.
' C to PowerBasic Translation by Jules Marchildn Feb.18th, 2001
'
' Comments:
' I have also added the Rapid button click handler to improve quality of life.
'--------------------------------------------------------------------------------
#COMPILE EXE
#INCLUDE "WIN32API.INC"
#RESOURCE "DIRBUT.PBR"
%IDC_DIRBTN = 201
GLOBAL ghInst AS LONG
GLOBAL ghMAin AS LONG
GLOBAL ghDirBtn AS LONG
GLOBAL giDIR AS INTEGER
GLOBAL glpButtonProc AS LONG
'------------------------------------------------------------------------------
' Routine for painting the bitmap on ownerdraw button
'
'------------------------------------------------------------------------------
SUB PaintBitmap (hDC AS lONG, hBitmap AS LONG)
LOCAL bmp AS BITMAP
LOCAL hMemoryDC AS LONG
hMemoryDC = CreateCompatibleDC(hDC)
Call GetObject(hBitmap, sizeof(bmp), bmp)
Call SelectObject(hMemoryDC, hBitmap)
Call BitBlt(hDC, 0, 0, bmp.bmWidth, bmp.bmHeight,hMemoryDC, 0, 0, %SRCCOPY)
Call DeleteDC(hMemoryDC)
Call DeleteObject(hBitmap)
END SUB
'--------------------------------------------------------------------------------
' load the bitmap for an up direction button
'
'--------------------------------------------------------------------------------
SUB DrawButtonUp (ByVal hInstance AS LONG, ByVal hDC AS LONG, ByVal ButtonID AS INTEGER)
LOCAL hBitmap AS LONG
Select Case ButtonID
case %IDC_DIRBTN
hBitmap = LoadBitmap (hInstance, "ALLUP")
End Select
CAll PaintBitmap(hDC, hBitmap)
END SUB
'--------------------------------------------------------------------------------
' load the bitmap for a selected direction according to giDIR flag
'
'--------------------------------------------------------------------------------
SUB DrawButtonDown (ByVal hInstance AS LONG, ByVal hDC AS LONG, ByVal ButtonID AS INTEGER)
LOCAL hBitmap As LONG
Select Case ButtonID
case %IDC_DIRBTN:
Select Case giDIR
case 1
'load right triangle down bitmap
hBitmap = LoadBitmap (hInstance, "EDOWN")
case 2
'load left triangle down bitmap
hBitmap = LoadBitmap (hInstance, "WDOWN")
case 3
'load lower triangle down bitmap
hBitmap = LoadBitmap (hInstance, "SDOWN")
case 4
'load upper triangle down bitmap
hBitmap = LoadBitmap (hInstance, "NDOWN")
End Select
End Select
Call PaintBitmap(hDC, hBitmap)
END SUB
'-------------------------------------------------------------------------
' Button SubClassed procedure
'
'-------------------------------------------------------------------------
FUNCTION ButtonProc(BYVAL hWnd AS LONG, BYVAL wMsg AS LONG,BYVAL wParam AS LONG, BYVAL lParam AS LONG) AS LONG
SELECT CASE wMsg
CASE %WM_LBUTTONDBLCLK
'forward this for rapid button clicking...
Call SendMessage(hWnd,%WM_LBUTTONDOWN,wParam,lParam)
FUNCTION = 0 :EXIT FUNCTION
CASE %WM_ERASEBKGND
FUNCTION = 1 : EXIT FUNCTION
END SELECT
FUNCTION = CallWindowProc(glpButtonProc, hWnd, wMsg, wParam, lParam)
END FUNCTION
'-------------------------------------------------------------------------------
'
'
'-------------------------------------------------------------------------------
FUNCTION WINMAIN(BYVAL hCurInstance AS LONG,BYVAL hPrevInstance AS LONG, _
lpszCmdLine AS ASCIIZ PTR, BYVAL nCmdShow AS LONG) AS LONG
LOCAL szAppName AS ASCIIZ*25
LOCAL tMsg AS tagMSG
LOCAL lhWnd AS LONG
LOCAL twndClass AS WNDCLASSEX
ghInst = hCurInstance
szAppName = "ODBTNHRGNS"
twndClass.cbSize = SIZEOF(twndClass)
twndClass.style = %CS_HREDRAW OR %CS_VREDRAW
twndClass.lpfnWndProc = CODEPTR(WndMainProc)
twndClass.cbClsExtra = 0
twndclass.cbWndExtra = 0
twndClass.hInstance = hCurInstance
twndClass.hIcon = LoadIcon(%NULL, BYVAL %IDI_APPLICATION)
tWndClass.hIconsm = LoadIcon(%NULL, BYVAL %IDI_APPLICATION)
twndClass.hCursor = LoadCursor (%NULL, BYVAL %IDC_ARROW)
twndClass.hbrBackground = GetStockObject (%LTGRAY_BRUSH)
twndClass.lpszMenuName = VARPTR(szAppName)
twndClass.lpszClassName = VARPTR(szAppName)
CALL RegisterClassEx(tWndClass)
lhWnd = CreateWindow(szAppName, _
"Four-In-One Direction Button", _
%WS_OVERLAPPEDWINDOW, _
300, _
200, _
320, _
200, _
%NULL, %NULL, _
hCurInstance, %NULL)
Call ShowWindow(lhWnd, %SW_SHOW)
Call UpdateWindow(lhWnd)
ghMain = lhWnd
DO WHILE GetMessage(tMsg, %NULL, 0&, 0&)
IF ISFALSE IsDialogMessage(lhWnd, tMsg) THEN
Call TranslateMessage(tMsg)
Call DispatchMessage(tMsg)
END IF
LOOP
FUNCTION = tMsg.wParam
END FUNCTION
'------------------------------------------------------------------------------
'
'
'------------------------------------------------------------------------------
FUNCTION WndMainProc (BYVAL hWnd AS LONG, BYVAL wMsg AS LONG, _
BYVAL wParam AS LONG, BYVAL lParam AS LONG) AS LONG
LOCAL lpdis AS DRAWITEMSTRUCT PTR
LOCAL pt AS POINTAPI
'---
Select Case wMsg
case %WM_CREATE
'create a direction button
ghDirBtn = CreateWindowEx(0,"BUTTON", "", _
%BS_OWNERDRAW OR %WS_CHILD OR %WS_VISIBLE, _
136, 72, 48, 48, _
hWnd, %IDC_DIRBTN, ghInst, ByVal %NULL)
'Subclass all the buttons to the same procedure...
glpButtonProc = GetWindowLong(ghDirBtn, %GWL_WNDPROC)
Call SetWindowLong(ghDirBtn, %GWL_WNDPROC, CODEPTR(ButtonProc))
Function = 0 :Exit Function
case %WM_DRAWITEM
'save the current cursor position as (pt.x, pt.y)
'when direction button was pushed
Call GetCursorPos(pt)
'convert the cursor position from screen coordinate
'into client coordinate
Call ScreenToClient(ghDirBtn, pt)
'if the cursor position is inside the right triangle
'set iDir flag equal to 1
If((pt.x > pt.y) AND (pt.x + pt.y > 48)) Then giDIR = 1
'if the cursor position is inside the left triangle
'set iDir flag equal to 2
If((pt.x < pt.y) AND (pt.x + pt.y < 48)) Then giDIR = 2
'if the cursor position is inside the lower triangle
'set iDir flag equal to 3
If((pt.x < pt.y) AND (pt.x + pt.y > 48)) Then giDIR = 3
'if the cursor position is inside the upper triangle
'set iDir flag equal to 4
If((pt.x > pt.y) AND (pt.x + pt.y < 48)) Then giDIR = 4
'draw direction button
lpdis = lParam
If(@lpdis.itemState AND %ODS_SELECTED) THEN
'draw a down button according to iDir flag
Call DrawButtonDown(ghInst, @lpdis.hDC, @lpdis.CtlID)
Else
'draw an up button if not selected
Call DrawButtonUp(ghInst, @lpdis.hDC, @lpdis.CtlID)
END IF
Function = 0 :Exit Function
case %WM_COMMAND
Select Case LOWRD(wParam)
case %IDC_DIRBTN
Select Case giDIR
case 1 'things to do when right triangle is pushed
'msgbox "Right"
case 2 'things to do when left triangle is pushed
'msgbox "left"
case 3 'things to do when lower triangle is pushed
'msgbox "lower"
case 4 'things to do when upper triangle is pushed
'msgbox "upper"
End Select
End Select
Function = 0 : Exit Function
case %WM_DESTROY
'UnSubclass the button...
IF ISTRUE glpButtonProc THEN Call SetWindowLong(ghDirBtn, %GWL_WNDPROC,glpButtonProc)
CALL PostQuitMessage(0)
FUNCTION = 0 :EXIT FUNCTION
END SELECT
FUNCTION = DefWindowProc(hWnd, wMsg, wParam, lParam)
END FUNCTION