Announcement

Collapse

Forum Guidelines

This forum is for finished source code that is working properly. If you have questions about this or any other source code, please post it in one of the Discussion Forums, not here.
See more
See less

Four Way Button

Collapse
X
 
  • Filter
  • Time
  • Show
Clear All
new posts

  • Four Way Button

    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...
    Code:
    #include "resource.h"
       
    ALLUP    BITMAP allup.bmp
    EDOWN    BITMAP edown.bmp
    WDOWN    BITMAP wdown.bmp
    NDOWN    BITMAP ndown.bmp
    SDOWN    BITMAP sdown.bmp
    Source...
    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
    Best regards
    Jules
    www.rpmarchildon.com
Working...
X