Announcement

**Mike Doty** · 6 Jun 2015, 12:41 PM

Compile with PB10 (last error fixed)

Thank you Mike Simmonds for finding the last thing needed to be changed for PB10.

Very nice looking buttons compared to rectangles.

Code:

'Added a bunch of BYVAL's to get to compile, but having trouble with this line
' lresult = PtInRect(rgnRect, pt.x, pt.y) AND PtInRegion(hRgn, pt.x, pt.y)
'says a string operand expected  line 254
'Fixed by [B]Mike Simmonds[/B]:   6/7/15  and buttons now change color  when in focus
'lresult = PtInRect(rgnRect, pt) AND PtInRegion(hRgn, pt.x, pt.y)
  '--------------------------------------------------------------------------------
' Universal Button - beauty of HRGN
' Origional Author: Pavel A. Simakov
' Origional Code: [URL]http://codeguru.earthweb.com/buttonctrl/UniButton.shtml[/URL]
'
' MFC C++ to PowerBasic Conversion by Jules Marchildon. FEB.15th,2001
' email: [EMAIL="[email protected]"][email protected][/EMAIL]
' Compiler: PB/DLL version 6.0
'
' Thanks to:
' -Borje, Edwin, and Semen for helping me to trouble shoot the %BN_CLICKED event
' -Dominic, for helping me with the setup of the instance data functions
' -Cecil, for helping me with some of the MFC C++ gibberish
'
' Comments:
' The only part of this translation that made it difficult was how C++ handles
' it's member variables for instance maintenance. Based on a couple of books
' I have for custom controls and the help from Dominic Mitchell to add the final
' touches we created our own Instance Data handler. The rest was fairly straight
' forward. My favorite buttons are the "Merged" & "OverLapped" buttons. Also note
' the nice tip for trapping the double click message and substituting a single
' click to allow Rapid clicking of the Owner Draw button. I hope you can learn
' from this, I know I learned lots!!!!
'
' No warrenty applies, use at your own risk...
'--------------------------------------------------------------------------------
 
#COMPILE EXE
#INCLUDE "WIN32API.INC"
%RFLAG = %RDW_INVALIDATE OR %RDW_ERASE OR %RDW_UPDATENOW OR %RDW_ALLCHILDREN
'---
%IDBTN1     = 1001    ' rectangular region
%IDBTN2     = 1002    ' elliptic region
%IDBTN3     = 1003    ' half ellipse
%IDBTN4     = 1004    ' half ellipse, disable button
%IDBTN5     = 1005    ' region from text "$"
%IDBTN6     = 1006    ' region from text "@"
%IDBTN7     = 1007    ' rectangle, "Save", overlapped
%IDBTN8     = 1008    ' corner, overlapped by IDBTN7
%IDBTN9     = 1009    ' simple Polyline region, arrow
%IDBTN10    = 1010    ' complex region
%IDBTN11    = 1011    ' stretched ellipse
%IDBTN12    = 1012    ' merged buttons... "File"
%IDBTN13    = 1013    ' merged buttons... "Edit"
%IDBTN14    = 1014    ' merged buttons... "View"
%IDBTN15    = 1015    ' merged buttons... "Insert"
%IDBTN16    = 1016    ' merged buttons... "Tools"
%IDBTN17    = 1017    ' merged buttons... "Help"
%IDBTN18    = 1018    ' merged buttons... "Exit"
%NUMBTN     = 18      ' number of buttons created
 
'---
GLOBAL ghInst         AS LONG
GLOBAL ghMain         AS LONG
GLOBAL glpButtonProc  AS LONG
GLOBAL ghButton()     AS LONG
 
'--- temp
' there are some variables that need intializing before we create
' the instance data for the button control...
GLOBAL m_hRgn         AS LONG       'origional C++ button members
GLOBAL m_nColor       AS LONG       '           "
GLOBAL m_sColor       AS LONG       '           "
GLOBAL m_hColor       AS LONG       '           "
GLOBAL m_dColor       AS LONG       '           "
GLOBAL m_CenterPoint  AS POINTAPI   '           "
GLOBAL m_nBorder      AS LONG       '           "
 '---Private Button data per instance
TYPE tagCTLDATA
  nColor       AS LONG     'background color for button state: normal
  sColor       AS LONG     'background color for button state: selected
  hColor       AS LONG     'background color for button state: hover
  dColor       AS LONG     'background color for button state: disabled
  nBorder      AS LONG     'width of the border in pixels for 3D highlight
  lfEscapement AS LONG     'orientation of the caption (in 1/10 degree as in LOGFONT)
  pNormal      AS LONG     'bitmap handle, button image: normal   state
  pSelected    AS LONG     'bitmap handle, button image: selected state
  pHover       AS LONG     'bitmap handle, button image: hover    state
  pDisabled    AS LONG     'bitmap handle, button image: disabled state
  hRgn         AS LONG     'region in screen coordinates
  bHover       AS LONG     'indicates if mouse is over the button
  bCapture     AS LONG     'indicates that mouse is captured in the buton
  bMouseDown   AS LONG     'indicated that mouse is pressed down
  bNeedBitmaps AS LONG     'flag idicates that state bitmaps must be rebuild
  CenterPoint  AS POINTAPI 'button caption will be centered around this point
  hButton      AS LONG     'button handle
  idButton     AS LONG     'button ID
END TYPE
 '---
DECLARE SUB CtlDataDelete(hCtl AS LONG)
DECLARE SUB CreateButtonRegionDemo(BYVAL hParent AS LONG)
DECLARE SUB CheckHover(pt AS POINTAPI, BYVAL ptCD AS tagCTLDATA PTR)
DECLARE SUB PrepareSelectedState(pDC AS LONG,pMemDC AS LONG,pRect AS RECT,BYVAL ptCD AS tagCTLDATA PTR)
'DECLARE SUB PrepareHoverState(pDC AS LONG,pMemDC AS LONG,pRect AS RECT,ptCD AS tagCTLDATA PTR )
'DECLARE SUB PrepareDisabledState(pDC AS LONG, pMemDC AS LONG, pRect AS RECT, ptCD AS tagCTLDATA PTR)
'DECLARE SUB PrepareNormalState(pDC AS LONG,pMemDC AS LONG,pRect AS RECT,ptCD AS tagCTLDATA PTR)
'DECLARE SUB DrawButton(hWnd AS LONG, pDC AS LONG,pRect AS RECT, wstate AS LONG,ptCD AS tagCTLDATA PTR)
'DECLARE SUB FrameRgn3D(hDC AS LONG, hRgn AS LONG, bSunken AS LONG, ptCD AS tagCTLDATA PTR)
'DECLARE SUB DrawButtonCaption(hDC AS LONG,pRect AS RECT,bEnabled AS LONG,bSunken AS LONG,ptCD AS tagCTLDATA PTR)
DECLARE FUNCTION CtlDataCreate(hCtl AS LONG) AS LONG
DECLARE FUNCTION HitTest(hWnd AS LONG,pt AS POINTAPI) AS LONG
'PaintRgn is an API function, so I renamed to odPaintRgn...
'DECLARE FUNCTION odPaintRgn(pDC AS LONG, pMemDC AS LONG,pBitmap AS LONG, pcolor AS LONG,pRect AS RECT, bEnabled AS LONG,bSunken AS LONG, ptCD AS tagCTLDATA PTR) AS LONG
DECLARE FUNCTION InitPreCreateTheButton(szCaption AS ASCIIZ,BYVAL Wstyle AS DWORD,pt AS POINTAPI,BYVAL hrgn AS LONG,BYVAL hparent AS LONG,BYVAL ID AS INTEGER,BYVAL clr AS LONG ) AS LONG
DECLARE FUNCTION Init2PreCreateTheButton(szCaption AS ASCIIZ,BYVAL Wstyle AS DWORD,pt AS POINTAPI,BYVAL hrgn AS LONG,BYVAL hparent AS LONG,BYVAL ID AS INTEGER,BYVAL BORDER AS LONG, _
                 BYVAL nclr AS LONG,BYVAL sclr AS LONG,BYVAL hclr AS LONG,BYVAL dclr AS LONG) AS LONG
DECLARE FUNCTION PreCreateTheButton(szCaption AS ASCIIZ,BYVAL Wstyle AS DWORD,pt AS POINTAPI,BYVAL hRgn AS LONG,BYVAL hparent AS LONG,BYVAL ID AS INTEGER ) AS LONG
DECLARE FUNCTION FinalCreateTheButton(szCaption AS ASCIIZ,BYVAL Wstyle AS DWORD,rc AS RECT,BYVAL hparent AS LONG,BYVAL ID AS INTEGER) AS LONG
 
'-----------------------------------------------------------------------------
' Create instance data for control
' Optimized by Dominic Mitchell FEB/09/2001
'-----------------------------------------------------------------------------
FUNCTION CtlDataCreate(hCtl AS LONG) AS LONG
     LOCAL td        AS tagCTLDATA
    LOCAL ptCtlData AS tagCTLDATA PTR
     'Note:
    'Memory objects allocated with the GMEM_FIXED flag always have a lock
    'count of zero. For these objects, the value of the returned pointer
    'is equal to the value of the specified handle.
     'Reserve some new memory...
    ptCtlData = GlobalAlloc(%GMEM_FIXED OR %GMEM_ZEROINIT, SIZEOF(td))
     IF ISTRUE ptCtlData THEN
         'load the default data...
        IF ISTRUE m_nColor THEN
            @ptCtlData.nColor      = m_nColor           'pre
            m_nColor = 0
        ELSE
            @ptCtlData.nColor      = GetSysColor(%COLOR_BTNFACE)
        END IF
        IF ISTRUE m_sColor THEN
            @ptCtlData.sColor      = m_sColor           'pre
            m_sColor = 0
        ELSE
            @ptCtlData.sColor      = GetSysColor(%COLOR_BTNFACE)
        END IF
        IF ISTRUE m_hColor THEN
            @ptCtlData.hColor      = m_hColor           'pre
            m_hColor = 0
        ELSE
            @ptCtlData.hColor      = GetSysColor(%COLOR_BTNFACE)
        END IF
        IF ISTRUE m_dColor THEN
            @ptCtlData.dColor      = m_dColor           'pre
            m_dColor = 0
        ELSE
            @ptCtlData.dColor      = GetSysColor(%COLOR_BTNFACE)
        END IF
        IF ISTRUE m_nBorder THEN
            @ptCtlData.nBorder     = m_nBorder          'pre
            m_nBorder = 0
        ELSE
            @ptCtlData.nBorder     = 1
        END IF
        @ptCtlData.lfEscapement    = 0
        @ptCtlData.pNormal         = %NULL
        @ptCtlData.pSelected       = %NULL
        @ptCtlData.pHover          = %NULL
        @ptCtlData.pDisabled       = %NULL
        @ptCtlData.hRgn            = m_hRgn             'pre
        @ptCtlData.bHover          = %false
        @ptCtlData.bCapture        = %false
        @ptCtlData.bMouseDown      = %false
        @ptCtlData.bNeedBitmaps    = %true
        @ptCtlData.CenterPoint.x   = m_CenterPoint.x    'pre
        @ptCtlData.CenterPoint.y   = m_CenterPoint.y    'pre
        @ptCtlData.hButton         = 0
        @ptCtlData.idButton        = 0
         'NOTE:
        'There is no need to free memory that the system failed to allocate.
         'save pointer to the controls private UDT data
        CALL SetProp(hCtl,"ptCTLDATA",ptCtlData)
         FUNCTION = ptCtlData
     ELSE
        FUNCTION = %FALSE
    END IF
 END FUNCTION
 
'-----------------------------------------------------------------------------
' Free the instance data
' Optimized by Dominic Mitchell, FEB/09/2001
'-----------------------------------------------------------------------------
SUB CtlDataDelete(hCtl AS LONG)
     LOCAL ptCD  AS tagCTLDATA PTR
     'get the instance data for this control
    ptCD = GetProp(hCtl,"ptCTLDATA")
     'free the memory...
    IF ISTRUE ptCD THEN CALL GlobalUnlock(ptCD)
     'free the instance data pointer property
    CALL RemoveProp(hCtl,"ptCTLDATA")
 END SUB
 '------------------------------------------------------------------------------
' HitTest() -determines if point is inside the button region
'
'------------------------------------------------------------------------------
FUNCTION HitTest(hWnd AS LONG, pt AS POINTAPI) AS LONG
     LOCAL hRgn    AS LONG
    LOCAL rgnRect AS RECT
    LOCAL lresult AS LONG
     'create handle to a window region.
    hRgn = CreateRectRgn(0, 0, 0, 0)
     'copy this window region into it
    CALL GetWindowRgn(hWnd,hRgn)
     'get the bounding rect of this region
    CALL GetRgnBox(hRgn, rgnRect)
     'First check if point is in region bounding rect.
    'Then check if point is in the region in addition
    'to being in the bounding rect.
   'TYPE POINTAPI
  '  x AS LONG
  '  y AS LONG
  'END TYPE
'DECLARE FUNCTION PtInRect LIB "USER32.DLL" ALIAS "PtInRect"
' (lpRect AS RECT, BYVAL ptx AS LONG, BYVAL pty AS LONG) AS LONG
 
   'lresult = PtInRect(rgnRect, pt.x, pt.y) AND PtInRegion(hRgn, pt.x, pt.y)
   lresult = PtInRect(rgnRect, pt) AND PtInRegion(hRgn, pt.x, pt.y)
 
    'Clean up and exit.
    CALL DeleteObject(hRgn)
     FUNCTION = lresult
 END FUNCTION
 '------------------------------------------------------------------------------
' CheckHover() -is mouse hover inside region, display Hover bmp
'
'------------------------------------------------------------------------------
SUB CheckHover(pt AS POINTAPI, BYVAL ptCD AS tagCTLDATA PTR)   'added byval
 
    IF  HitTest(@ptCD.hButton,pt) = %true THEN
        IF @ptCD.bCapture = %false THEN
            CALL SetCapture(@ptCD.hButton)
            @ptCD.bCapture = %true
        END IF
        IF @ptCD.bHover = %false THEN
            @ptCD.bHover = %true
            CALL RedrawWindow(@ptCD.hButton, BYVAL %NULL, %NULL, %RFLAG)
        END IF
    ELSE
        IF @ptCD.bCapture = %true THEN
            CALL ReleaseCapture()
            @ptCD.bCapture = %false
        END IF
        @ptCD.bHover = %FALSE
        CALL RedrawWindow(@ptCD.hButton, BYVAL %NULL, %NULL, %RFLAG)
    END IF
 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
   LOCAL pt   AS POINTAPI
  LOCAL ptCD AS tagCTLDATA PTR
   'get the instance data
  ptCD = GetProp(hWnd,"ptCTLDATA")
   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
     CASE %WM_MOUSEMOVE
         pt.x = LOWRD(lParam)
        pt.y = HIWRD(lParam)
        IF ISFALSE @ptCD.bMouseDown  THEN
            CALL CheckHover(pt,BYVAL ptCD)
        END IF
     CASE %WM_LBUTTONDOWN
         'record that mouse is down
        @ptCD.bMouseDown = %true
        IF  ISFALSE @ptCD.bCapture  THEN
            CALL SetCapture(hWnd)
            @ptCD.bCapture = %true
        END IF
     CASE %WM_LBUTTONUP
         'record that mouse is released, this allows %BN_CLICKED to fire!
        CALL CallWindowProc(glpButtonProc, hWnd, wMsg, wParam, lParam)
         pt.x = LOWRD(lParam)
        pt.y = HIWRD(lParam)
         @ptCD.bMouseDown = %false
        IF ISTRUE @ptCD.bCapture  THEN
           CALL ReleaseCapture()
           @ptCD.bCapture = %false
        END IF
       CALL CheckHover(pt,BYVAL ptCD)
 
    CASE %WM_CAPTURECHANGED  '<ToDo: add SafeCaptureExit()>
     'CASE %WM_DESTROY   '<-- we will let the parent clean up for us...
   END SELECT
     FUNCTION = CallWindowProc(glpButtonProc, hWnd, wMsg, wParam, lParam)
 END FUNCTION
  
 '-------------------------------------------------------------------------------
'
'
'-------------------------------------------------------------------------------
FUNCTION WINMAIN(BYVAL hCurInstance  AS LONG,BYVAL hPrevInstance AS LONG, _
                 BYVAL 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, _
                         "OwnerDraw Button with Regions:", _
                         %WS_OVERLAPPEDWINDOW, _
                         300, _
                         200, _
                         400, _
                         400, _
                         %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 ptCD          AS tagCTLDATA PTR
    DIM ptDrawItem      AS DRAWITEMSTRUCT PTR
     SELECT CASE(wMsg)
            CASE %WM_CREATE
                 'save handles for easy clean up later
                DIM ghButton(%NUMBTN)
                 'Create the Owner-Draw/Regions button Demo...
                CALL CreateButtonRegionDemo(hWnd)
                 FUNCTION = 0 :EXIT FUNCTION
            CASE %WM_COMMAND
                 SELECT CASE LOWRD(wParam)
                       CASE %IDBTN1 :IF HIWRD(wParam) = %BN_CLICKED THEN MSGBOX "Button 1"
                       CASE %IDBTN2
                       CASE %IDBTN3
                       CASE %IDBTN4
                       CASE %IDBTN5
                       CASE %IDBTN6
                       CASE %IDBTN7
                       CASE %IDBTN8
                       CASE %IDBTN9
                       CASE %IDBTN10
                       CASE %IDBTN11
                       CASE %IDBTN12
                       CASE %IDBTN13
                       CASE %IDBTN14
                       CASE %IDBTN15
                       CASE %IDBTN16
                       CASE %IDBTN17
                       CASE %IDBTN18
                END SELECT
                 'FUNCTION = 0 :EXIT FUNCTION
            CASE %WM_DRAWITEM
                 'get the pointer to the item-drawing info
                ptDrawItem = lParam
                 'get a pointer to the controls instance data
                ptCD = GetProp(GetDlgItem(hWnd,wParam),"ptCTLDATA")
                 LOCAL rc AS RECT
                'Call GetClientRect(GetDlgItem(hWnd,wParam),rc)
                rc = @ptDrawItem.rcItem
                 'prepare bitmaps if they need to be prepared
                IF ISTRUE @ptCD.bNeedBitmaps  THEN
                  CALL PrepareStateBitmaps(@ptDrawItem.hDC,rc,BYVAL ptCD)
                END IF
                 'draw the button to the screen
                CALL DrawButton(GetDlgItem(hWnd,wParam),@ptDrawItem.hDC,rc,@ptDrawItem.itemState,BYVAL ptCD)
                 FUNCTION = 0 :EXIT FUNCTION
            CASE %WM_DESTROY
                 'Clean up buttons demo...
                FOR i& = 0 TO %NUMBTN -1
                    IF ISTRUE ghButton(i&)  THEN
                       'get the controls instance data...
                       ptCD = GetProp(ghButton(i&),"ptCTLDATA")
                       'Delete all bitmap objects...
                       CALL DeleteObject(@ptCD.pNormal)
                       CALL DeleteObject(@ptCD.pSelected)
                       CALL DeleteObject(@ptCD.pHover)
                       CALL DeleteObject(@ptCD.pDisabled)
                       CALL DeleteObject(@ptCD.hRgn)
                       'Free instance data memory...
                       CALL CtlDataDelete(ghButton(i&))
                       'UnSubclass the buttons...
                       IF ISTRUE glpButtonProc THEN CALL SetWindowLong(ghButton(i&), %GWL_WNDPROC,glpButtonProc)
                    END IF
                NEXT
                 CALL PostQuitMessage(0)
                FUNCTION = 0 :EXIT FUNCTION
    END SELECT
     FUNCTION = DefWindowProc(hWnd, wMsg, wParam, lParam)
END FUNCTION
 
'------------------------------------------------------------------------------
' Create the Owner-Draw push buttons using specified Region types
'
'------------------------------------------------------------------------------
SUB CreateButtonRegionDemo(BYVAL hParent AS LONG)
     '----%IDBTN1  ' rectangular region
    LOCAL r   AS LONG
    LOCAL pt  AS POINTAPI
    LOCAL clr AS LONG
     r    = CreateRectRgn(0,0,63,31)
    pt.x = 15
    pt.y = 15
    clr  = RGB(255,255,0)  'Hover state Color
    m_nBorder = 1
     ghButton(0) = InitPreCreateTheButton("Btn 1", _                 ' caption
                                        %WS_CHILD OR %WS_VISIBLE, _ ' style
                                        pt, _                       ' top/left corner
                                        r, _                        ' region
                                        hParent, _                  ' parent hWnd
                                        %IDBTN1, _                  ' ID
                                        clr)                        ' color
     CALL DeleteObject(r)
    ':::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
     '----%IDBTN2  ' elliptic region
    LOCAL nclr   AS LONG
    LOCAL sclr   AS LONG
    LOCAL hclr   AS LONG
    LOCAL dclr   AS LONG
    LOCAL BORDER AS LONG
     r    = CreateEllipticRgn(0,0,63,31)
    pt.x = 95
    pt.y = 15
    nclr = GetSysColor(%COLOR_BTNFACE) 'normal state
    sclr = RGB(0,255,0)                'selected state
    hclr = RGB(0,255,0)                'hover state
    dclr = nclr                        'disabled state
    BORDER = 2
     ghButton(1) = Init2PreCreateTheButton("Btn 2", _                  ' caption
                                          %WS_CHILD OR %WS_VISIBLE, _ ' style
                                          pt, _                       ' top/left corner
                                          r, _                        ' region
                                          hParent, _                  ' parent hWnd
                                          %IDBTN2, _                  ' ID
                                          BORDER, _                ' border width
                                          nclr, _                     ' normal color
                                          sclr, _                     ' selected color
                                          hclr, _                     ' hover color
                                          dclr )                      ' disabled color
     CALL DeleteObject(r)
    '::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
     '----%IDBTN3  ' half ellipse, left and right buttons splitting ellipse in half
    LOCAL rgnR AS LONG
    LOCAL rgnE AS LONG
     rgnR = CreateRectRgn(0,0,127,31)
    rgnE = CreateEllipticRgn(0,0,127,31)
    CALL OffsetRgn(rgnR, 63, 0)
    CALL CombineRgn(rgnE,rgnE,rgnR, %RGN_DIFF)
     pt.x = 175
    pt.y = 15
    nclr = GetSysColor(%COLOR_BTNFACE) 'normal state
    sclr = RGB(156,175,194)            'selected state
    hclr = RGB(237,175,15)             'hover state
    dclr = nclr                        'disabled state
    BORDER = 2
     ghButton(2) = Init2PreCreateTheButton("  Btn 3", _                ' caption
                                          %WS_CHILD OR %WS_VISIBLE, _ ' style
                                          pt, _                       ' top/left corner
                                          rgnE, _                     ' region
                                          hParent, _                  ' parent hWnd
                                          %IDBTN3, _                  ' ID
                                          BORDER, _                   ' border width
                                          nclr, _                     ' normal color
                                          sclr, _                     ' selected color
                                          hclr, _                     ' hover color
                                          dclr )                      ' disabled color
     '----%IDBTN4 continued...  ' half ellipse, disabled button
     rgnR = CreateRectRgn(0,0,127,31)
    rgnE = CreateEllipticRgn(0,0,127,31)
    CALL OffsetRgn(rgnR,-63,0)
    CALL CombineRgn(rgnE,rgnE,rgnR,%RGN_DIFF)
     pt.x = 175+64
    pt.y = 15
     ghButton(3) = Init2PreCreateTheButton("Btn 4  ", _                ' caption
                          %WS_DISABLED OR %WS_CHILD OR %WS_VISIBLE, _ ' style
                                          pt, _                       ' top/left corner
                                          rgnE, _                     ' region
                                          hParent, _                  ' parent hWnd
                                          %IDBTN4, _                  ' ID
                                          BORDER, _                   ' border width
                                          nclr, _                     ' normal color
                                          sclr, _                     ' selected color
                                          hclr, _                     ' hover color
                                          dclr )                      ' disabled color
 
    CALL DeleteObject(rgnE)
    CALL DeleteObject(rgnR)
    ':::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
     '----%IDBTN5  ' region from text "$"
    LOCAL hDC      AS LONG
    LOCAL lf       AS LOGFONT
    LOCAL rgnC     AS LONG
    LOCAL hFont    AS LONG
    LOCAL hOldFont AS LONG
    LOCAL nOldMode AS INTEGER
     hDC = CreateCompatibleDC(GetDC(ghMain))
     CALL GetObject(GetStockObject(%ANSI_VAR_FONT),SIZEOF(lf),lf)
    lf.lfHeight = -100
    lf.lfWidth  =  70
    lf.lfWeight =  1000
    hFont = CreateFontIndirect (lf)
    hOldFont = SelectObject(hDC, hFont)
     rgnC = CreateRectRgn(0,0,0,0)
     nOldMode = SetBkMode(hDC, %TRANSPARENT)
     CALL BeginPath(hDC)
    LOCAL szChar AS ASCIIZ*2
    szChar = "$"
    CALL TextOut(hDC, 0 , 0 , szChar, LEN(szChar))
    CALL EndPath(hDC)
     rgnC = PathToRegion(hDC)
    CALL SetBkMode(hDC, nOldMode)
     pt.x = 15
    pt.y = 63
    hclr =  RGB(255,255,0)
     ghButton(4) =  InitPreCreateTheButton("", _
                                         %WS_CHILD OR %WS_VISIBLE, _
                                         pt, _
                                         rgnC, _
                                         hParent, _
                                         %IDBTN5,_
                                         hclr )
     '----%IDBTN6  continued... ' region from text "@"
     'rgnC = CreateRectRgn(0,0,0,0)
    nOldMode = SetBkMode(hDC, %TRANSPARENT)
     CALL BeginPath(hDC)
    'LOCAL szChar AS ASCIIZ*2
    szChar = "@"
    CALL TextOut(hDC, 0 , 0 , szChar, LEN(szChar))
    CALL EndPath(hDC)
     rgnC = PathToRegion(hDC)
    CALL SetBkMode(hDC, nOldMode)
     pt.x = 15+84
    pt.y = 63
    hclr =  RGB(255,0,255)
     ghButton(5) =  InitPreCreateTheButton("", _
                                         %WS_CHILD OR %WS_VISIBLE, _
                                         pt, _
                                         rgnC, _
                                         hParent, _
                                         %IDBTN6,_
                                         hclr )
     '*note: hDC is still Valid, allow to flow down
     CALL SelectObject(hDC, hOldFont)
    CALL DeleteObject(hFont)
    CALL DeleteObject(rgnC)
    ':::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
 
    '----%IDBTN7  ' rectangle, "Save", overlapped
    LOCAL rgnCR AS LONG
     CALL BeginPath(hDC) '<--'*note, hDC already created above
    CALL MoveToEx(hDC, 0, 0, BYVAL %NULL)
    CALL LineTo(hDC, 64, 0)
    CALL LineTo(hDC, 64, 16)
    CALL LineTo(hDC, 48, 32)
    CALL LineTo(hDC, 0, 32)
    CALL LineTo(hDC, 0, 0)
    CALL EndPath(hDC)
    rgnCR = CreateRectRgn(0, 0, 63, 63)
    rgnCR = PathToRegion(hDC)
     pt.x = 55 + 64 + 128
    pt.y = 63
     ghButton(6)= Init2PreCreateTheButton("Save  ", _
                                %WS_CHILD OR %WS_VISIBLE, _
                                pt, _
                                rgnCR, _
                                hParent, _
                                %IDBTN7, _
                                1, _
                                RGB(254, 247, 211), _
                                RGB(211, 247, 254), _
                                RGB(211, 247, 254), _
                                GetSysColor(%COLOR_BTNFACE))
     '----%IDBTN8  continued... ' corner, overlapped by IDBTN7
     CALL BeginPath(hDC)
    CALL MoveToEx(hDC, 64, 16, BYVAL %NULL)
    CALL LineTo(hDC, 64, 32)
    CALL LineTo(hDC, 48, 32)
    CALL LineTo(hDC, 64, 16)
    CALL EndPath(hDC)
    rgnCR = PathToRegion(hDC)
     pt.x =  55 + 64 + 128 + 48
    pt.y =  63 + 16
     ghButton(7) = Init2PreCreateTheButton("", _
                                %WS_CHILD OR %WS_VISIBLE, _
                                pt, _
                                rgnCR, _
                                hParent, _
                                %IDBTN8, _
                                1, _
                                RGB(247, 211, 254), _
                                RGB(211, 247, 254), _
                                RGB(211, 247, 254), _
                                GetSysColor(%COLOR_BTNFACE))
 
    CALL DeleteObject(rgnCR)
    ':::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
  
     '----%IDBTN9  ' simple Polyline region, arrow
 
    CALL BeginPath(hDC) '*note: hDC is still Valid from above
    CALL MoveToEx(hDC, 0, 32, BYVAL %NULL)
    CALL LineTo(hDC, 48, 32)
    CALL LineTo(hDC, 48, 16)
    CALL LineTo(hDC, 96, 48)
    CALL LineTo(hDC, 48, 80)
    CALL LineTo(hDC, 48, 64)
    CALL LineTo(hDC, 0, 64)
    CALL LineTo(hDC, 0, 32)
    CALL EndPath(hDC)
    rgnCR = CreateRectRgn(0, 0, 63, 63)
    rgnCR = PathToRegion(hDC)
     pt.x = 32 + 64 + 96
    pt.y = 63 + 16 + 128
     ghButton(8) = Init2PreCreateTheButton("Btn 9", _
                                    %WS_CHILD OR %WS_VISIBLE, _
                                    pt, _
                                    rgnCR, _
                                    hParent, _
                                    %IDBTN9, _
                                    2, _
                                    RGB(250, 207, 194), _
                                    RGB(255, 0, 0), _
                                    RGB(255, 0, 0), _
                                    GetSysColor(%COLOR_BTNFACE))
     CALL DeleteObject(rgnCR)
    CALL DeleteObject(hDC)
    ':::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
     '----%IDBTN10 ' complex region
     hDC = CreateCompatibleDC(GetDC(ghMain))
     CALL BeginPath(hDC)
    CALL MoveToEx(hDC, 31, 15, BYVAL %NULL)
     DIM cpt(7) AS POINTAPI        'CPoint p[7]
    cpt(0).x = 5  : cpt(0).y = 0  'CPoint(5, 0)
    cpt(1).x = 0  : cpt(1).y = 55 'CPoint(0, 55)
    cpt(2).x = 0  : cpt(2).y = 28 'CPoint(0, 28)
    cpt(3).x = 31 : cpt(3).y = 64 'CPoint(31, 64)
    cpt(4).x = 59 : cpt(4).y = 55 'CPoint(59, 55)
    cpt(5).x = 59 : cpt(5).y = 0  'CPoint(59, 0)
    cpt(6).x = 31 : cpt(6).y = 15 'CPoint(31, 15)
     CALL PolyBezier(hDC, cpt(0), 7)
    CALL EndPath(hDC)
     rgnCR = CreateRectRgn(0, 0, 63, 63)
    rgnCR = PathToRegion(hDC)
     pt.x = 15
    pt.y = 63 + 16 + 64 + 64
     ghButton(9) = Init2PreCreateTheButton("Btn 10", _
                                   %WS_CHILD OR %WS_VISIBLE, _
                                   pt, _
                                   rgnCR, _
                                   hParent, _
                                   %IDBTN10, _
                                   2, _
                                   RGB(151, 244, 219), _
                                   RGB(211, 247, 254), _
                                   RGB(211, 247, 254), _
                                   GetSysColor(%COLOR_BTNFACE))
     CALL DeleteObject(rgnCR)
    CALL DeleteObject(hDC)
    '::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
     '----%IDBTN11 ' stretched ellipse
    LOCAL rgn1 AS LONG
    LOCAL rgn2 AS LONG
     rgnC = CreateRectRgn(16, 0, 80, 31)
    rgn1 = CreateEllipticRgn(0, 0, 32, 32)
    rgn2 = CreateEllipticRgn(64, 0, 96, 32)
    CALL CombineRgn(rgnC, rgnC, rgn1, %RGN_OR)
    CALL CombineRgn(rgnC, rgnC, rgn2, %RGN_OR)
     pt.x =  15 + 64
    pt.y =  63 + 32 + 64 + 64
     ghButton(10) = Init2PreCreateTheButton("Btn 11", _
                                  %WS_CHILD OR %WS_VISIBLE, _
                                  pt, _
                                  rgnC, _
                                  hParent, _
                                  %IDBTN11, _
                                  2, _
                                  GetSysColor(%COLOR_BTNFACE), _
                                  RGB(211, 247, 254), _
                                  RGB(211, 247, 254), _
                                  GetSysColor(%COLOR_BTNFACE))
     CALL DeleteObject(rgnC)
    CALL DeleteObject(rgn1)
    CALL DeleteObject(rgn2)
    '::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
     '----%IDBTN12 ' merged buttons... "File"
    LOCAL hr1 AS LONG
    LOCAL hr2 AS LONG
    LOCAL hc  AS LONG
     hc = CreateRectRgn(8, 0, 55, 31)
    hr1 = CreateEllipticRgn(48, 8, 15 + 48, 15 + 8)
    CALL CombineRgn(hc, hc, hr1, %RGN_OR)
     pt.x = 16 : pt.y = 63 + 32 + 64 + 128
    ghButton(11) = Init2PreCreateTheButton("File", %WS_CHILD OR %WS_VISIBLE, pt, hc, hParent, %IDBTN12, 1, RGB(151, 219, 244), RGB(211, 247, 254), RGB(211, 247, 254), GetSysColor(%COLOR_BTNFACE))
     '----%IDBTN13 ' merged buttons... "Edit"
     hr1 = CreateEllipticRgn(0, 8, 15, 15 + 8)
    CALL CombineRgn(hc, hc, hr1, %RGN_DIFF)
     pt.x = 16 + 48 : pt.y = 63 + 32 + 64 + 128
    ghButton(12) = Init2PreCreateTheButton("Edit", %WS_CHILD OR %WS_VISIBLE, pt, hc, hParent, %IDBTN13, 1, RGB(151, 219, 244), RGB(211, 247, 254), RGB(211, 247, 254), GetSysColor(%COLOR_BTNFACE))
 
    '----%IDBTN14 ' merged buttons... "View"
     pt.x = 16 + 48 + 48 : pt.y = 63 + 32 + 64 + 128
    ghButton(13) = Init2PreCreateTheButton("View", %WS_CHILD OR %WS_VISIBLE, pt, hc, hParent, %IDBTN14, 1, RGB(151, 219, 244), RGB(211, 247, 254), RGB(211, 247, 254), GetSysColor(%COLOR_BTNFACE))
     '----%IDBTN15 ' merged buttons... "Insert"
     pt.x = 16 + 48 + 48 + 48 : pt.y = 63 + 32 + 64 + 128
    ghButton(14) = Init2PreCreateTheButton("Insert",%WS_CHILD OR %WS_VISIBLE, pt, hc, hParent, %IDBTN15, 1, RGB(151, 219, 244), RGB(211, 247, 254), RGB(211, 247, 254), GetSysColor(%COLOR_BTNFACE))
 
    '----%IDBTN16 ' merged buttons... "Tools"
     pt.x =  16 + 48 + 48 + 48 + 48 : pt.y = 63 + 32 + 64 + 128
    ghButton(15) = Init2PreCreateTheButton("Tools", %WS_CHILD OR %WS_VISIBLE, pt, hc, hParent, %IDBTN16, 1, RGB(151, 219, 244), RGB(211, 247, 254), RGB(211, 247, 254), GetSysColor(%COLOR_BTNFACE))
 
    '----%IDBTN17 ' merged buttons... "Help"
     pt.x = 16 + 48 + 48 + 48 + 48 + 48 : pt.y = 63 + 32 + 64 + 128
    ghButton(16) = Init2PreCreateTheButton("Help",  %WS_CHILD OR %WS_VISIBLE, pt, hc, hParent, %IDBTN17, 1, RGB(151, 244, 219), RGB(211, 247, 254), RGB(211, 247, 254), GetSysColor(%COLOR_BTNFACE))
     '----%IDBTN18 ' merged buttons... "Exit"
     hc = CreateRectRgn(8, 0, 63, 31)
    hr1 = CreateEllipticRgn(0, 8, 15, 15 + 8)
    CALL CombineRgn(hc, hc, hr1, %RGN_DIFF)
     pt.x = 16 + 48 + 48 + 48 + 48 + 48 + 48 : pt.y =  63 + 32 + 64 + 128
    ghButton(17) = Init2PreCreateTheButton("Exit",  %WS_CHILD OR %WS_VISIBLE, pt, hc, hParent, %IDBTN18, 1, RGB(244, 151, 219), RGB(211, 247, 254), RGB(211, 247, 254), GetSysColor(%COLOR_BTNFACE))
     CALL DeleteObject(hc)
    CALL DeleteObject(hr1)
    '::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
 END SUB
 
'-----------------------------------------------------------------------------
' Step One: <<Version 1>> Button region creation.
'
'-----------------------------------------------------------------------------
FUNCTION InitPreCreateTheButton(szCaption AS ASCIIZ, _            ' caption
                                BYVAL Wstyle AS DWORD, _          ' sytle
                                pt AS POINTAPI, _                 ' top/left corner
                                BYVAL hrgn AS LONG, _             ' region
                                BYVAL hparent AS LONG, _          ' parent hWnd
                                BYVAL ID AS INTEGER, _            ' ID
                                BYVAL clr AS LONG ) AS LONG       ' color
     LOCAL hButton AS LONG
     m_sColor = RGB(255,250,120)  'selected state color
    m_hColor = clr               'Hover state color
     hbutton = PreCreateTheButton(szCaption, _
                                 Wstyle, _
                                 pt, _
                                 hrgn, _
                                 hparent, _
                                 ID )
     FUNCTION = hButton     'return the handle
 END FUNCTION
 '-----------------------------------------------------------------------------
' Step One: <<Version 2>> Button region creation.
' This is based on origional C++ code, <ToDo: optimize nested creates>
'-----------------------------------------------------------------------------
FUNCTION Init2PreCreateTheButton(szCaption AS ASCIIZ, _           ' caption
                                BYVAL Wstyle AS DWORD, _          ' sytle
                                pt AS POINTAPI, _                 ' top/left corner
                                BYVAL hrgn AS LONG, _             ' region
                                BYVAL hparent AS LONG, _          ' parent hWnd
                                BYVAL ID AS INTEGER, _            ' ID
                                BYVAL border AS LONG, _           ' border width
                                BYVAL nclr AS LONG, _             ' normal color
                                BYVAL sclr AS LONG, _             ' selected color
                                BYVAL hclr AS LONG, _             ' hover color
                                BYVAL dclr AS LONG ) AS LONG      ' disabled color
     LOCAL hButton AS LONG
     'change default data...
    m_nBorder =  BORDER
    m_nColor  =  nclr
    m_sColor  =  sclr
    m_hColor  =  hclr
    m_dColor  =  dclr
     hbutton = PreCreateTheButton(szCaption, _
                                 Wstyle, _
                                 pt, _
                                 hrgn, _
                                 hparent, _
                                 ID )
     FUNCTION = hButton     'return the handle
 END FUNCTION
 '-----------------------------------------------------------------------------
' Step Two: Button region creation.
'
'-----------------------------------------------------------------------------
FUNCTION PreCreateTheButton(szCaption AS ASCIIZ, _            ' caption
                            BYVAL Wstyle AS DWORD, _          ' sytle
                            pt AS POINTAPI, _                 ' top/left corner
                            BYVAL hRgn AS LONG, _             ' region
                            BYVAL hparent AS LONG, _          ' parent hWnd
                            BYVAL ID AS INTEGER ) AS LONG     ' ID
 
    LOCAL hButton AS LONG
    LOCAL rc AS RECT
     'store region in member variable
    CALL DeleteObject(m_hRgn)
    m_hRgn = CreateRectRgn(0,0,31,31) 'not sure what effect 31,31 has ???
     IF m_hRgn <> 0 THEN CALL CombineRgn(m_hRgn, hRgn ,0, %RGN_COPY)
     'make sure that region bounding Rect is located in (0,0)
    CALL GetRgnBox(m_hRgn, rc)
    CALL OffsetRgn(m_hRgn, -rc.nLeft, -rc.nTop)
    CALL GetRgnBox(m_hRgn, rc)
     'update position of region center for caption output
    w& = rc.nRight  - rc.nLeft
    h& = rc.nBottom - rc.nTop
    m_CenterPoint.x = (rc.nLeft + w&) \2
    m_CenterPoint.y = (rc.nTop  + h&) \2
 
    CALL OffsetRect(rc,pt.x,pt.y)
     '---
    'I added this adjustment to correct the button size, I am not
    'sure why in the C++ does not show this. Maybe it happens behind
    'the scene in C++??? (OR maybe my conversion is incorrect?)
    rc.nRight  = rc.nRight  - pt.x
    rc.nBottom = rc.nBottom - pt.y
    '---
     hbutton = FinalCreateTheButton(szCaption, _
                                   Wstyle, _
                                   rc, _
                                   hparent, _
                                   ID )
     FUNCTION = hButton     'return the handle
 END FUNCTION
 '-----------------------------------------------------------------------------
' Step Three: -Create the button, Subclass it,
'             -Create the instance data,
'             -and Return the new buttons handle.
'-----------------------------------------------------------------------------
FUNCTION FinalCreateTheButton(szCaption AS ASCIIZ, _            ' caption
                              BYVAL Wstyle AS DWORD, _          ' style
                              rc AS RECT, _                     ' top/left corner
                              BYVAL hparent AS LONG, _          ' parent hWnd
                              BYVAL ID AS INTEGER) AS LONG      ' ID
 
    LOCAL hButton  AS LONG
    LOCAL dWstyle  AS DWORD
    LOCAL ptCD     AS tagCTLDATA PTR
     'default style...
    dWstyle = %BS_OWNERDRAW OR %WS_TABSTOP OR _
              %BS_PUSHBUTTON OR %BS_NOTIFY 'OR %WS_DISABLED
     dwstyle = dWstyle OR Wstyle
     'Create the owner-draw push button...
    hButton  =  CreateWindowEx(0,"BUTTON", _
                               szCaption, _
                               dWstyle, _
                               rc.nLeft, rc.nTop, _
                               rc.nRight, rc.nBottom, _
                               hparent, ID, _
                               ghInst, BYVAL %NULL )
 
    'Subclass all the buttons to the same procedure...
    glpButtonProc = GetWindowLong(hButton, %GWL_WNDPROC)
    CALL SetWindowLong(hButton, %GWL_WNDPROC, CODEPTR(ButtonProc))
     'assign new region to a window
    CALL SetWindowRgn(hButton, m_hRgn, %true)
     'create this controls instance data...
    CALL CtlDataCreate(hButton)
     'add the final updates to instance data
    ptCD = GetProp(hButton,"ptCTLDATA")
    @ptCD.hButton  = hButton
    @ptCD.idbutton = ID
     FUNCTION = hButton     'return the handle
 END FUNCTION
 
'-----------------------------------------------------------------------------
' PrepareStateBitmaps() -prepares bitmaps for button states
'
'-----------------------------------------------------------------------------
SUB PrepareStateBitmaps(pDC AS LONG, pRect AS RECT, BYVAL ptCD AS tagCTLDATA PTR)
     LOCAL pMemDC AS LONG
     'prepare memory DC
    pMemDC = CreateCompatibleDC(pDC)
     'prepare bitmaps for all button states and for the mask
    CALL PrepareNormalState(pDC, pMemDC, pRect,BYVAL ptCD)
    CALL PrepareSelectedState(pDC, pMemDC, pRect,BYVAL ptCD)
    CALL PrepareHoverState(pDC, pMemDC, pRect,BYVAL ptCD)
    CALL PrepareDisabledState(pDC, pMemDC, pRect,BYVAL ptCD)
     'clean up
    CALL DeleteDC(pMemDC)
     @ptCD.bNeedBitmaps = %false
 END SUB
 '-----------------------------------------------------------------------------
' PrepareNormalState() -prepare normal state button bitmap
'
'-----------------------------------------------------------------------------
SUB PrepareNormalState(pDC AS LONG,pMemDC AS LONG,pRect AS RECT,BYVAL ptCD AS tagCTLDATA PTR)
     'prepare MYBS_NORMAL state bitmap
    IF ISTRUE @ptCD.pNormal THEN CALL DeleteObject(@ptCD.pNormal)
     @ptCD.pNormal = 0 'new CBitmap
     @ptCD.pNormal = odPaintRgn(pDC,pMemDC,@ptCD.pNormal,@ptCD.nColor,pRect,%true,%false,BYVAL ptCD)
 
END SUB
 '-----------------------------------------------------------------------------
' PrepareSelectedState() -prepare selectedstate button bitmap
'
'-----------------------------------------------------------------------------
SUB PrepareSelectedState(pDC AS LONG,pMemDC AS LONG,pRect AS RECT,BYVAL ptCD AS tagCTLDATA PTR)
     'prepare MYBS_SELECTED state bitmap
    IF ISTRUE @ptCD.pSelected THEN CALL DeleteObject(@ptCD.pSelected)
     @ptCD.pSelected = 0 'new CBitmap
     CALL odPaintRgn(pDC,pMemDC,@ptCD.pSelected,@ptCD.sColor,pRect,%true,%true,BYVAL ptCD)
 END SUB
 '-----------------------------------------------------------------------------
' PrepareHoverState()   -prepare hover state button bitmap
'
'-----------------------------------------------------------------------------
SUB PrepareHoverState(pDC AS LONG,pMemDC AS LONG,pRect AS RECT,BYVAL ptCD AS tagCTLDATA PTR )
     'prepare MYBS_HOVER state bitmap
    IF ISTRUE @ptCD.pHover THEN CALL DeleteObject(@ptCD.pHover)
     @ptCD.pHover = 0 'new CBitmap
     CALL odPaintRgn(pDC,pMemDC,@ptCD.pHover,@ptCD.hColor,pRect,%true,%false,BYVAL ptCD)
 END SUB
 '-----------------------------------------------------------------------------
' PrepareDisabledState() - prepare disabled state button bitmap
'
'-----------------------------------------------------------------------------
SUB PrepareDisabledState(pDC AS LONG, pMemDC AS LONG, pRect AS RECT, BYVAL ptCD AS tagCTLDATA PTR)
     'prepare MYBS_DISABLED state bitmap
    IF ISTRUE @ptCD.pDisabled THEN CALL DeleteObject(@ptCD.pDisabled)
     @ptCD.pDisabled = 0 'new CBitmap
     CALL odPaintRgn(pDC,pMemDC,@ptCD.pDisabled,@ptCD.dColor,pRect,%false,%false,BYVAL ptCD)
 END SUB
 '-----------------------------------------------------------------------------
' odPaintRgn() -paint button
' This was origionally named PainRgn(), but conflicts with API PaintRgn() so
' I renamed to odPaintRgn, od = Owner-Draw.
'-----------------------------------------------------------------------------
FUNCTION odPaintRgn(pDC AS LONG, pMemDC AS LONG, _
                    pBitmap AS LONG, pcolor AS LONG, _
                    pRect AS RECT, bEnabled AS LONG, _
                    bSunken AS LONG,BYVAL ptCD AS tagCTLDATA PTR) AS LONG
     LOCAL hRgn       AS LONG
    LOCAL hBrush     AS LONG
    LOCAL pOldBitmap AS LONG
    LOCAL pWidth     AS LONG
    LOCAL pHeight    AS LONG
     'create bitmap
    pWidth  = pRect.nRight  - pRect.nLeft
    pHeight = pRect.nBottom - pRect.nTop
     pBitmap    = CreateCompatibleBitmap(pDC, pWidth, pHeight)
    pOldBitmap = SelectObject(pMemDC,pBitmap)
     'prepare region
    hRgn = CreateRectRgn(0, 0, 0, 0)
    CALL GetWindowRgn(@ptCD.hButton,hRgn)
     'fill rect with transparent color and fill rgn
    hBrush = CreateSolidBrush(pcolor)
     CALL FillRect(pMemDC,pRect, RGB(0, 0, 0))
    CALL FillRgn(pMemDC, hRgn, hBrush)
    CALL DeleteObject(hBrush)
     'draw 3D border and text
    CALL DrawButtonCaption(pMemDC, pRect, bEnabled, bSunken,BYVAL ptCD)
     CALL FrameRgn3D(pMemDC, hRgn, bSunken,BYVAL ptCD)
     'clean up
    CALL DeleteObject(hRgn)
    CALL SelectObject(pMemDC,pOldBitmap)
     FUNCTION = pBitmap
 END FUNCTION
 '-----------------------------------------------------------------------------
' DrawButtonCaption() -draws button caption
'
'-----------------------------------------------------------------------------
SUB DrawButtonCaption(hDC AS LONG,pRect AS RECT,bEnabled AS LONG,bSunken AS LONG,BYVAL ptCD AS tagCTLDATA PTR)
     LOCAL nOldMode AS INTEGER
    LOCAL stext    AS STRING
    LOCAL pt       AS POINTAPI
    LOCAL hFont    AS LONG
    LOCAL hOldFont AS LONG
    LOCAL lf       AS LOGFONT
    LOCAL tm       AS TEXTMETRIC
    LOCAL nLen     AS LONG
     'select parent font
    nOldMode = SetBkMode(hDC, %TRANSPARENT)
     nLen = GetWindowTextLength(@ptCD.hButton)
    sText = SPACE$(nLen + 1) 'create a buffer...
    CALL GetWindowText(@ptCD.hButton,BYVAL STRPTR(sText), nLen + 1)
     CALL GetObject(GetStockObject(%ANSI_VAR_FONT),SIZEOF(lf),lf)
    hFont = CreateFontIndirect (lf)
     hOldFont = SelectObject(hDC, hFont)
     'determine point where to output text
    CALL GetTextMetrics(hDC, tm)
     pt.x = @ptCD.CenterPoint.x
    pt.y = @ptCD.CenterPoint.y + tm.tmHeight \ 2
     IF bSunken = %TRUE  THEN
        pt.x = pt.x + @ptCD.nBorder
        pt.y = pt.y + @ptCD.nBorder
    END IF
     'draw button caption depending upon button state
    IF bEnabled = %TRUE THEN
        CALL SetTextColor(hDC, GetSysColor(%COLOR_BTNTEXT))
        CALL SetTextAlign(hDC, %TA_CENTER OR %TA_BOTTOM)
        CALL TextOut(hDC, pt.x, pt.y, BYVAL STRPTR(stext), nLen)
    ELSE
        CALL SetTextColor(hDC, GetSysColor(%COLOR_3DHILIGHT))
        CALL TextOut(hDC, pt.x + 1, pt.y + 1, BYVAL STRPTR(stext), nLen)
        CALL SetTextColor(hDC, GetSysColor(%COLOR_3DSHADOW))
        CALL TextOut(hDC, pt.x, pt.y, BYVAL STRPTR(stext), nLen)
    END IF
     CALL SelectObject(hDC, hOldFont)
    CALL DeleteObject(hFont)
    CALL SetBkMode(hDC, nOldMode)
 END SUB
 '-----------------------------------------------------------------------------
'  FrameRgn3D() -frames region to show 3D shadows
'
'-----------------------------------------------------------------------------
SUB FrameRgn3D(hDC AS LONG, hRgn AS LONG, bSunken AS LONG,BYVAL  ptCD AS tagCTLDATA PTR)
     'we need two different regions to keep base region and border region
    LOCAL hBrush AS LONG
    LOCAL hBaseRgn AS LONG
     hBaseRgn = CreateRectRgn(0, 0, 0, 0)
     'colors of inner and outer shadow for top-left and right-bottom corners
    LOCAL ltOuter AS LONG
    LOCAL ltInner AS LONG
    LOCAL rbOuter AS LONG
    LOCAL rbInner AS LONG
     'decide on color scheme
    IF ISFALSE(bSunken)  THEN                  '!bSunken = NOT(bSunken)
        ltOuter = GetSysColor(%COLOR_3DLIGHT)
        ltInner = GetSysColor(%COLOR_3DHILIGHT)
        rbOuter = GetSysColor(%COLOR_3DDKSHADOW)
        rbInner = GetSysColor(%COLOR_3DSHADOW)
    ELSE
        rbInner = GetSysColor(%COLOR_3DLIGHT)
        rbOuter = GetSysColor(%COLOR_3DHILIGHT)
        ltInner = GetSysColor(%COLOR_3DDKSHADOW)
        ltOuter = GetSysColor(%COLOR_3DSHADOW)
    END IF
     'offset highlight and shadow regions
    'substract them from the base region
    SELECT CASE  @ptCD.nBorder
         CASE 2
            CALL CombineRgn(hBaseRgn, hRgn, 0, %RGN_COPY)
            CALL OffsetRgn(hBaseRgn, 2, 2)
            CALL CombineRgn(hBaseRgn, hRgn, hBaseRgn, %RGN_DIFF)
            hBrush = CreateSolidBrush(ltInner)
            CALL FillRgn(hDC, hBaseRgn, hBrush)
            CALL DeleteObject(hBrush)
             CALL CombineRgn(hBaseRgn, hRgn, 0, %RGN_COPY)
            CALL OffsetRgn(hBaseRgn, -2, -2)
            CALL CombineRgn(hBaseRgn, hRgn, hBaseRgn, %RGN_DIFF)
            hBrush = CreateSolidBrush(rbInner)
            CALL FillRgn(hDC, hBaseRgn, hBrush)
            CALL DeleteObject(hBrush)
             CALL CombineRgn(hBaseRgn, hRgn, 0, %RGN_COPY)
            CALL OffsetRgn(hBaseRgn, 1, 1)
            CALL CombineRgn(hBaseRgn, hRgn, hBaseRgn, %RGN_DIFF)
            hBrush = CreateSolidBrush(ltOuter)
            CALL FillRgn(hDC, hBaseRgn, hBrush)
            CALL DeleteObject(hBrush)
             CALL CombineRgn(hBaseRgn, hRgn, 0, %RGN_COPY)
            CALL OffsetRgn(hBaseRgn, -1, -1)
            CALL CombineRgn(hBaseRgn, hRgn, hBaseRgn, %RGN_DIFF)
            hBrush = CreateSolidBrush(rbOuter)
            CALL FillRgn(hDC, hBaseRgn, hBrush)
            CALL DeleteObject(hBrush)
            EXIT SELECT 'break;
         'default:
        CASE ELSE
            CALL CombineRgn(hBaseRgn, hRgn, 0, %RGN_COPY)
            CALL OffsetRgn(hBaseRgn, 1, 1)
            CALL CombineRgn(hBaseRgn, hRgn, hBaseRgn, %RGN_DIFF)
            hBrush = CreateSolidBrush(ltInner)
            CALL FillRgn(hDC, hBaseRgn, hBrush)
            CALL DeleteObject(hBrush)
             CALL CombineRgn(hBaseRgn, hRgn, 0, %RGN_COPY)
            CALL OffsetRgn(hBaseRgn, -1, -1)
            CALL CombineRgn(hBaseRgn, hRgn, hBaseRgn, %RGN_DIFF)
            hBrush = CreateSolidBrush(rbOuter)
            CALL FillRgn(hDC, hBaseRgn, hBrush)
            CALL DeleteObject(hBrush)
            EXIT SELECT 'break;
         END SELECT
     'clean up regions
    CALL DeleteObject(hBaseRgn)
 END SUB
 
'-----------------------------------------------------------------------------
' DrawButton() -draws button to the screen
' note: wstate =  @tDrawItem.itemState
'-----------------------------------------------------------------------------
SUB DrawButton(hWnd AS LONG,pDC AS LONG,pRect AS RECT, wstate AS LONG,BYVAL ptCD AS tagCTLDATA PTR)
     LOCAL pWidth     AS LONG
    LOCAL pHeight    AS LONG
    LOCAL pOldBitmap AS LONG
    LOCAL pMemDC     AS LONG
    LOCAL hRgn       AS LONG
     'create memory DC
    pMemDC = CreateCompatibleDC(pDC)
     'get region
    hRgn = CreateRectRgn(0, 0, 0, 0)
    CALL GetWindowRgn(hWnd,hRgn)
     'select bitmap to paint depending upon button state
    IF (wstate AND %ODS_DISABLED)  THEN
        pOldBitmap = SelectObject(pMemDC,@ptCD.pDisabled)
    ELSE
        IF (wstate AND %ODS_SELECTED)   THEN
            pOldBitmap = SelectObject(pMemDC,@ptCD.pSelected)
        ELSE
            IF @ptCD.bHover = %TRUE THEN
                pOldBitmap = SelectObject(pMemDC,@ptCD.pHover)
            ELSE
                pOldBitmap = SelectObject(pMemDC,@ptCD.pNormal)
            END IF
        END IF
    END IF
     'paint using region for clipping
    CALL SelectClipRgn(pDC, hRgn)
     pWidth  = pRect.nRight  - pRect.nLeft
    pHeight = pRect.nBottom - pRect.nTop
     CALL BitBlt(pDC,0,0,pWidth,pHeight,pMemDC,0,0,%SRCCOPY)
     'remove a device-context's clipping region,
    CALL SelectClipRgn(pDC, %NULL)
     'clean up...
    CALL ReleaseDC(@ptCD.hButton,pMemDC)
    CALL DeleteObject(hRgn)
    CALL SelectObject(pMemDC,pOldBitmap)
    CALL DeleteDC(pMemDC)
 END SUB

Attached Files

**Mike Simmonds** · 7 Jun 2015, 03:14 AM

Hi Mike.

I think this is another decare mismatch error. I have version 10.04

The PB winapi (WinUser.inc) has

Code:

DECLARE FUNCTION PtInRect LIB "User32.dll" ALIAS "PtInRect" (lpRect AS RECT, _
    BYVAL pt AS POINT) AS LONG

This matches the Win7 SDK docs.

So your code should be

Code:

lresult = PtInRect(rgnRect, pt) AND PtInRegion(hRgn, pt.x, pt.y)

The declare for PtInRegion looks to be ok. (WinGDI.inc).

I have not actually recompiled with this edit, just suggesting.

Cheers, Mike

**Hans-Dieter Veit** · 13 Dec 2016, 12:00 AM

I tried this sample.
Unforunatly the buttons made from characterss ([email protected]) don't work under Win10. There are only little square buttons without any caption displayed.
Does anybody know what to change to make them work on Win10?
It's way beyond my abilities to figure it out by myself.
Thanks
Hans

Announcement

Forum Guidelines

OwnerDraw Button & Regions demo

OwnerDraw Button & Regions demo

Comment

Comment

Comment