Announcement

Collapse

New Sub-Forum

In an effort to help make sure there are appropriate categories for topics of discussion that are happening, there is now a sub-forum for databases and database programming under Special Interest groups. Please direct questions, etc., about this topic to that sub-forum moving forward. Thank you.
See more
See less

Hover effect using a label control question

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

  • Hover effect using a label control question

    'Below are the WM_INITDIALOG AND WM_CTLCOLORSTATIC areas of my dialog callback procedure
    'ID's 1501-1512 I've predefined as labels that have the %SS_NOTIFY style and
    'Question:
    'Is this the best way to get a hover effect. The purpose of the code in WM_CTLCOLORSTATIC is to get the label to
    'turn red and underlined when the cursor is over it as well as change the cursor to a handcursor.
    'Sometimes if these labels are too close, they don't turn off when the other turns on (rarely).
    'I'm probably not doing this the right way.
    'The WM_SETCURSOR code just tells when the cursor has moved away from a control onto the background of the dialog
    'and signals a redraw of that control to return to normal. When the cursor moves over another control id in the
    'range of 1501 to 1512 it triggers a redraw of the current control to turn it red and underlined. When clicked, other
    'code is fired to do the work.

    'Any suggestions?

    Code:
        SELECT CASE CBMSG
          CASE %WM_INITDIALOG
              hFontlb = MakeFont("Tahoma",9)
              hFontlbul = MakeFontul("Tahoma",9)
              LOCAL Lb AS LOGBRUSH
              Lb.lbstyle = %BS_SOLID                                                    ' DOS BASIC COLORS
              Lb.lbColor = RGB(0,0,0)       : V_Brush(0)  = CreateBrushIndirect(Lb)       ' 0 black
              Lb.lbColor = RGB(0,0,128)     : V_Brush(1)  = CreateBrushIndirect(Lb)       ' 1 blue
              Lb.lbColor = RGB(0,128,0)     : V_Brush(2)  = CreateBrushIndirect(Lb)       ' 2 green
              Lb.lbColor = RGB(0,128,128)   : V_Brush(3)  = CreateBrushIndirect(Lb)       ' 3 cyan 'was 0,128,128
              Lb.lbColor = RGB(196,0,0)     : V_Brush(4)  = CreateBrushIndirect(Lb)       ' 4 red (maroon)
              Lb.lbColor = RGB(128,0,128)   : V_Brush(5)  = CreateBrushIndirect(Lb)       ' 5 magenta
              Lb.lbColor = RGB(128,64,0)    : V_Brush(6)  = CreateBrushIndirect(Lb)       ' 6 brown
              Lb.lbColor = RGB(224,224,224) : V_Brush(7)  = CreateBrushIndirect(Lb)       ' 7 l gray
              Lb.lbColor = RGB(128,128,128) : V_Brush(8)  = CreateBrushIndirect(Lb)       ' 8 gray
              Lb.lbColor = RGB(0,0,196)     : V_Brush(9)  = CreateBrushIndirect(Lb)       ' 9 l blue
              Lb.lbColor = RGB(0,255,0)     : V_Brush(10) = CreateBrushIndirect(Lb)       ' 10 l green
              Lb.lbColor = RGB(0,255,255)   : V_Brush(11) = CreateBrushIndirect(Lb)       ' 11 l cyan
              Lb.lbColor = RGB(255,0,0)     : V_Brush(12) = CreateBrushIndirect(Lb)       ' 12 l red
              Lb.lbColor = RGB(255,0,255)   : V_Brush(13) = CreateBrushIndirect(Lb)       ' 13 l magenta
              Lb.lbColor = RGB(255,255,0)   : V_Brush(14) = CreateBrushIndirect(Lb)       ' 14 yellow
              lb.lbColor = RGB(255,255,255) : V_Brush(15) = CreateBrushIndirect(Lb)       ' 15 b white
              lb.lbColor = RGB(128,255,128) : V_Brush(16) = CreateBrushIndirect(Lb)       ' 16
              'User defined Background,Title and Active field
              lb.lbColor = PB_BACK&         : V_Brush(17) = CreateBrushIndirect(Lb)       ' Created in program using colorpicker
              lb.lbColor = PB_TITL&         : V_Brush(18) = CreateBrushIndirect(Lb)       ' Created in program using colorpicker
              lb.lbColor = PB_ACTV&         : V_Brush(19) = CreateBrushIndirect(Lb)       ' Created in program using colorpicker
              
              
          CASE %WM_CTLCOLORSTATIC
              SELECT CASE GetDlgCtrlID(CBLPARAM)  'Standard Captions  and extended captions
                CASE 1501 TO 1512
                  IF GetDlgCtrlID(CBLPARAM) = CUR_CTRL_ID&  THEN
                    SetCursor HandMousePointer
                    SelectObject CBWPARAM, hFontlbul
                    SetTextColor CBWPARAM, V_COLOR(4) ' change red when hover
                  ELSE
                    SelectObject CBWPARAM, hFontlb
                    SetTextColor CBWPARAM, V_COLOR(1)
                  END IF
                  SetBkColor CBWPARAM, V_COLOR(15)
                  SetBkMode CBWPARAM, %Transparent
                  FUNCTION = V_Brush(17)
          CASE %WM_SETCURSOR
              CUR_CTRL_ID& = GetDlgCtrlID(CBWPARAM)
              IF CUR_CTRL_ID& >= 1501 AND CUR_CTRL_ID& <= 1512 THEN
                CONTROL HANDLE CBHNDL, CUR_CTRL_ID& TO CUR_CTRL&
                RedrawWindow CUR_CTRL&, BYVAL 0, 0, %RDW_ERASE OR %RDW_INVALIDATE
                PRESS_ENTER_ON = -1
                PRV_BUT_ID& = CUR_CTRL_ID&
              ELSEIF ABS(CUR_CTRL_ID&) > 100000& AND PRESS_ENTER_ON THEN
                CONTROL HANDLE CBHNDL, PRV_BUT_ID& TO PRV_BUT&
                RedrawWindow PRV_BUT&, BYVAL 0, 0, %RDW_ERASE OR %RDW_INVALIDATE
                PRESS_ENTER_ON = 0
              END IF
    Bob Mechler
    Last edited by BOB MECHLER; 18 Dec 2007, 03:29 PM. Reason: More info

  • #2
    Hello Bob,
    I tried to get your code to run but had to hack it about so much that it's own mother wouldn't know it. How about a running e.g.?

    Comment


    • #3
      Have you seen this example?:
      http://www.powerbasic.com/support/pb...71&postcount=1
      Regards,
      Peter

      Comment


      • #4
        Yes I saw that example, but couldn't get it to compile. I'll try it again.

        Bob Mechler

        Comment


        • #5
          Here is a compilable sample of what I ended up with. Is this the best way to implement lables that highlight red and underlined and act as buttons.



          Code:
          #PBFORMS CREATED V1.50
          '------------------------------------------------------------------------------
          ' The first line in this file is a PB/Forms metastatement.
          ' It should ALWAYS be the first line of the file. Other
          ' PB/Forms metastatements are placed at the beginning and
          ' end of "Named Blocks" of code that should be edited
          ' with PBForms only. Do not manually edit or delete these
          ' metastatements or PB/Forms will not be able to reread
          ' the file correctly.  See the PB/Forms documentation for
          ' more information.
          ' Named blocks begin like this:    #PBFORMS BEGIN ...
          ' Named blocks end like this:      #PBFORMS END ...
          ' Other PB/Forms metastatements such as:
          '     #PBFORMS DECLARATIONS
          ' are used by PB/Forms to insert additional code.
          ' Feel free to make changes anywhere else in the file.
          '------------------------------------------------------------------------------
          
          #COMPILE EXE
          #DIM ALL
          
          '------------------------------------------------------------------------------
          '   ** Includes **
          '------------------------------------------------------------------------------
          #PBFORMS BEGIN INCLUDES
          #IF NOT %DEF(%WINAPI)
              #INCLUDE "WIN32API.INC"
          #ENDIF
          #PBFORMS END INCLUDES
          '------------------------------------------------------------------------------
          
          '------------------------------------------------------------------------------
          '   ** Constants **
          '------------------------------------------------------------------------------
          #PBFORMS BEGIN CONSTANTS
          %IDD_DIALOG1  =  101
          %LBL_LABEL1   = 1001
          %LBL_LABEL2   = 1002
          %LBL_LABEL3   = 1003
          %TXT_TEXTBOX1 = 1004
          #PBFORMS END CONSTANTS
          '------------------------------------------------------------------------------
          
          '------------------------------------------------------------------------------
          '   ** Declarations **
          '------------------------------------------------------------------------------
          DECLARE CALLBACK FUNCTION ShowDIALOG1Proc()
          DECLARE FUNCTION ShowDIALOG1(BYVAL hParent AS DWORD) AS LONG
          #PBFORMS DECLARATIONS
          '------------------------------------------------------------------------------
          
          '------------------------------------------------------------------------------
          '   ** Main Application Entry Point **
          '------------------------------------------------------------------------------
          GLOBAL CUR_CTRL_ID AS LONG,CUR_CTRL AS LONG,PRESS_BUTTON_ON AS INTEGER, hFontlb AS LONG, hFontlbul AS LONG,V_BRUSH AS LONG
          FUNCTION MakeFont(BYVAL CFont AS STRING, BYVAL PointSize AS LONG) AS LONG
          
            LOCAL hDC      AS LONG
            LOCAL CyPixels AS LONG
          
            hDC = GetDC(%HWND_DESKTOP)
            CyPixels  = GetDeviceCaps(hDC, %LOGPIXELSY)
            ReleaseDC %HWND_DESKTOP, hDC
          
            PointSize = (PointSize * CyPixels) \ 72
            FUNCTION = CreateFont(0 - PointSize, 0, 0, 0, %FW_NORMAL, 0, 0, 0, _
                      %ANSI_CHARSET, %OUT_TT_PRECIS, %CLIP_DEFAULT_PRECIS, _
                      %DEFAULT_QUALITY, %FF_DONTCARE, BYCOPY CFONT)
          END FUNCTION
          FUNCTION MakeFontUL(BYVAL CFont AS STRING, BYVAL PointSize AS LONG) AS LONG
          
            LOCAL hDC      AS LONG
            LOCAL CyPixels AS LONG
          
            hDC = GetDC(%HWND_DESKTOP)
            CyPixels  = GetDeviceCaps(hDC, %LOGPIXELSY)
            ReleaseDC %HWND_DESKTOP, hDC
          
            PointSize = (PointSize * CyPixels) \ 72
            FUNCTION = CreateFont(0 - PointSize, 0, 0, 0, %FW_NORMAL, 0, -1, 0, _
                      %ANSI_CHARSET, %OUT_TT_PRECIS, %CLIP_DEFAULT_PRECIS, _
                      %DEFAULT_QUALITY, %FF_DONTCARE, BYCOPY CFONT)
          END FUNCTION
          FUNCTION PBMAIN()
              ShowDIALOG1 %HWND_DESKTOP
          END FUNCTION
          '------------------------------------------------------------------------------
          
          '------------------------------------------------------------------------------
          '   ** CallBacks **
          '------------------------------------------------------------------------------
          CALLBACK FUNCTION ShowDIALOG1Proc()
          
              SELECT CASE AS LONG CBMSG
                  CASE %WM_INITDIALOG
                    LOCAL lb AS LOGBRUSH
                    lb.lbstyle=  %BS_SOLID
                    lb.lbcolor = RGB(224,224,224)
                    V_Brush = CreateBrushIndirect(Lb)
                    hFontlb = MakeFont("Tahoma",9)
                    hFontlbul = MakeFontul("Tahoma",9)
                      ' Initialization handler
                  CASE %WM_DESTROY
                    DeleteObject hFontlb
                    DeleteObject hFontlbul
          
                  CASE %WM_NCACTIVATE
                      STATIC hWndSaveFocus AS DWORD
                      IF ISFALSE CBWPARAM THEN
                          ' Save control focus
                          hWndSaveFocus = GetFocus()
                      ELSEIF hWndSaveFocus THEN
                         ' Restore control focus
                          SetFocus(hWndSaveFocus)
                          hWndSaveFocus = 0
                      END IF
                  CASE %WM_CTLCOLORSTATIC
                      SELECT CASE GetDlgCtrlID(CBLPARAM)
                        CASE %LBL_LABEL1 TO %LBL_LABEL3
                           IF GetDlgCtrlID(CBLPARAM) = CUR_CTRL_ID&  THEN
                              'SetCursor HandMousePointer
                              SelectObject CBWPARAM, hFontlbul
                              SetTextColor CBWPARAM, RGB(196,0,0) ' change red when over
                           ELSE
                              SelectObject CBWPARAM, hFontlb
                              SetTextColor CBWPARAM, RGB(0,0,0)
                           END IF
                        SetBkColor CBWPARAM, RGB(128,128,128)
                        SetBkMode CBWPARAM, %Transparent
                        FUNCTION = V_BRUSH
                      END SELECT
                  CASE %WM_SETCURSOR
                    
                      CUR_CTRL_ID& = GetDlgCtrlID(CBWPARAM)
                      IF CUR_CTRL_ID& >= %LBL_LABEL2 AND CUR_CTRL_ID& <= %LBL_LABEL3 THEN
                        CONTROL HANDLE CBHNDL, CUR_CTRL_ID& TO CUR_CTRL&
                        RedrawWindow CUR_CTRL&, BYVAL 0, 0, %RDW_ERASE OR %RDW_INVALIDATE
                        PRESS_BUTTON_ON = -1
                      ELSEIF CUR_CTRL_ID& = 0 AND PRESS_BUTTON_ON = -1 THEN
                        RedrawWindow CBHNDL, BYVAL 0, 0, %RDW_INVALIDATE  '@@@@@
                        PRESS_BUTTON_ON = 0
                      END IF
          
                  CASE %WM_COMMAND
                      ' Process control notifications
                      SELECT CASE AS LONG CBCTL
                          CASE %LBL_LABEL1
          
                          CASE %TXT_TEXTBOX1
          
                          CASE %LBL_LABEL2
                            CONTROL SET TEXT CBHNDL,%TXT_TEXTBOX1,"Do this"
          
                          CASE %LBL_LABEL3
                            CONTROL SET TEXT CBHNDL,%TXT_TEXTBOX1,"Do that"
          
                      END SELECT
              END SELECT
          END FUNCTION
          '------------------------------------------------------------------------------
          
          '------------------------------------------------------------------------------
          '   ** Dialogs **
          '------------------------------------------------------------------------------
          FUNCTION ShowDIALOG1(BYVAL hParent AS DWORD) AS LONG
              LOCAL lRslt AS LONG, CNT AS LONG
          
          #PBFORMS BEGIN DIALOG %IDD_DIALOG1->->
              LOCAL hDlg  AS DWORD
          
              DIALOG NEW  hParent, "Button highlight demo", 70, 70, 267, 142, %WS_POPUP _
                  OR %WS_BORDER OR %WS_DLGFRAME OR %WS_SYSMENU OR %WS_CLIPSIBLINGS OR _
                  %WS_VISIBLE OR %DS_MODALFRAME OR %DS_3DLOOK OR %DS_NOFAILCREATE OR _
                  %DS_SETFONT, %WS_EX_WINDOWEDGE OR %WS_EX_CONTROLPARENT OR _
                  %WS_EX_LEFT OR %WS_EX_LTRREADING OR %WS_EX_RIGHTSCROLLBAR, TO hDlg
              DIALOG SET COLOR hDlg, -1, RGB(224,224,224)
              CONTROL ADD LABEL,   hDlg, %LBL_LABEL1, "Field 1", 15, 15, 40, 10
              CONTROL ADD TEXTBOX, hDlg, %TXT_TEXTBOX1, "TextBox1", 60, 15, 75, 10
              CONTROL ADD LABEL,   hDlg, %LBL_LABEL2, "Do this", 40, 100, 45, 10, _
                  %WS_CHILD OR %WS_VISIBLE OR %SS_LEFT OR %SS_NOTIFY, %WS_EX_LEFT OR _
                  %WS_EX_LTRREADING
              CONTROL SEND hdlg,%LBL_LABEL2 , %WM_SETFONT, hFontlb, %True
              CONTROL ADD LABEL,   hDlg, %LBL_LABEL3, "Do that", 125, 100, 40, 10, _
                  %WS_CHILD OR %WS_VISIBLE OR %SS_LEFT OR %SS_NOTIFY, %WS_EX_LEFT OR _
                  %WS_EX_LTRREADING
              CONTROL SEND hdlg,%LBL_LABEL3 , %WM_SETFONT, hFontlb, %True
          #PBFORMS END DIALOG
          
              DIALOG SHOW MODAL hDlg, CALL ShowDIALOG1Proc TO lRslt
          
          #PBFORMS BEGIN CLEANUP %IDD_DIALOG1
          #PBFORMS END CLEANUP
          
              FUNCTION = lRslt
          END FUNCTION
          '------------------------------------------------------------------------------

          Comment


          • #6
            Yes I saw that example, but couldn't get it to compile. I'll try it again.
            It compiles fine here (8.04). Don't forget to change the two incorrect win32api entries mentioned in the post...
            Regards,
            Peter

            Comment


            • #7
              >Don't forget to change the two incorrect win32api entries mentioned in the post...

              Those are not "incorrect."

              They are DECLARE statements compatible with PB/Windows compilers prior to version 7x, which was the first release which supported the passing of UDTs "BY VALUE."

              MCM
              Michael Mattias
              Tal Systems Inc. (retired)
              Racine WI USA
              [email protected]
              http://www.talsystems.com

              Comment


              • #8
                Compatible with PB/DLL-Win 5x, 6x, 7x, 8x (and cc/1 thru cc/4) :

                Code:
                Declare Function ChildWindowFromPoint   Lib "USER32.DLL" Alias "ChildWindowFromPoint" _
                   (ByVal hwndParent As Dword, ByVal Pt As LONG) As Dword
                Declare Function ChildWindowFromPointEx Lib "USER32.DLL" Alias "ChildWindowFromPointEx" _
                  (ByVal hWnd As Dword, ByVal Pt As LONG, ByVal uFlags As Dword) As Dword
                
                
                UNION ptAPILong
                  L  AS LONG
                  pt AS PointAPI
                END UNION 
                
                
                  LOCAL U AS PtApiLong
                  ...
                     U.pt.x    = x value
                     U.pt.y    = y value
                     [uFlags   = flag value]
                     Call ChildWindowFromPoint[Ex] (hWnd, u.l [,uflags])

                MCM
                Michael Mattias
                Tal Systems Inc. (retired)
                Racine WI USA
                [email protected]
                http://www.talsystems.com

                Comment


                • #9
                  Thanks for the feedback. I'll try the example and see if it does the trick. Someone who was testing via remote desktop said my sample code sometimes left both buttons red too long. On my desktop my example works fine but does not mean it is the best way.

                  Bob Mechler

                  Comment


                  • #10
                    Kevin Peel's code is better than mine by a long shot. More reliable, more compact. I can implement as an INCLUDE with only an init call and change LABEL to $HOVERBTNCLASS.

                    The code at http://www.powerbasic.com/support/pb...=HOVERBTNCLASS supports the raised appearance. I found the other code of Kevin's in Poffs. Both are nice, useful variations.



                    Code:
                        CONTROL ADD $HOVERBTNCLASS, hDlg, %LBL_LABEL4, "Check Button", 10, 70, 50, 14, %HBS_NORMAL
                        CONTROL SEND hDlg, %LBL_LABEL4, %HBM_SETCOLORS, %BLUE,RGB(224,224,224)
                        CONTROL SEND hDlg, %LBL_LABEL4, %HBM_SETHOVERCOLORS, %RED,RGB(224,224,224)
                        CONTROL ADD $HOVERBTNCLASS, hDlg, %LBL_LABEL5, "Check Button", 60, 70, 50, 14, %HBS_NORMAL
                        CONTROL SEND hDlg, %LBL_LABEL5, %HBM_SETCOLORS, %BLUE,RGB(224,224,224)
                        CONTROL SEND hDlg, %LBL_LABEL5, %HBM_SETHOVERCOLORS, %RED,RGB(224,224,224)
                        CONTROL SEND hDlg, %LBL_LABEL5, %HBM_SETFOCUSCOLOR, -1,RGB(224,224,224)
                    This version supports the turning red and underlined look when the mouse passes over.

                    Code:
                    Section of CTLBTN.INC that is different for underlined or raised hover buttons is marked:
                    This is only the %WM_PAINT section. The rest of the CTLBTN.INC is the same as that referenced in the hyperlink above.
                    
                            CASE %WM_PAINT
                                 ' Draw text and style...
                                 fd = GetWindowLong(hWnd, 0)
                                 gwl = GetWindowLong(hWnd, %GWL_STYLE)
                                 BeginPaint hWnd, ps
                                 GetClientRect hWnd, rc
                                 ' Draw control background...
                                 IF (gwl AND %HBS_ORIGINAL) THEN
                                    IF (@fd.bHasBkClr) THEN
                                       clrBack = @fd.cBack
                                    ELSE
                                       clrBack = GetSysColor(%COLOR_BTNFACE)
                                    END IF
                                 ELSE
                                    IF (@fd.bHasBkClr) THEN
                                       clrBack = IIF&(@fd.bIsOver, @fd.cHovBk, @fd.cBack)
                                    ELSE
                                       clrBack = GetSysColor(IIF&(@fd.bIsOver, %COLOR_BTNHIGHLIGHT, %COLOR_BTNFACE))
                                    END IF
                                 END IF
                    
                                 ' Set back color (this is chosen above)...
                                 hBack = SelectObject(ps.hDC, CreateSolidBrush(clrBack))
                    
                                 ' Set border color (white for focussed control)...
                                 ' Note: Focus border is not used with HBS_ORIGINAL,
                                 ' we use DrawFocusRect instead...
                                 IF (GetFocus = hWnd) AND ((gwl AND %HBS_ORIGINAL) = 0) THEN clrBack = @fd.cFocus
                    
                                 ' Increase border pen width for checked or hovered
                                 ' items (it is obscured otherwise)...
                                 IF (@fd.bCheck) OR (@fd.bIsDown) OR (@fd.bIsOver) THEN i = 3 ELSE i = 1
                                 hPen = SelectObject(ps.hDC, CreatePen(%PS_INSIDEFRAME, i, clrBack))
                    
                                 ' Draw the control...
                                 Rectangle ps.hDc, ps.rcPaint.nLeft, ps.rcPaint.nTop, ps.rcPaint.nRight, ps.rcPaint.nBottom
                    
                                 ' Clear up GDI objects...
                                 DeleteObject SelectObject(ps.hDC, hBack)
                                 DeleteObject SelectObject(ps.hDC, hPen)
                    
                                 ' Draw border...
                                 IF (@fd.bCheck) OR (@fd.bIsDown) THEN
                                    ' Always sunken if checked or mouse down...
                                    DrawEdge ps.hdc, rc, %EDGE_SUNKEN, %BF_RECT
                                 ELSE
                                    ' Determine from mousemovements and style...
                                    IF (gwl AND %HBS_ORIGINAL) THEN
                                       DrawEdge ps.hdc, rc, %EDGE_RAISED, %BF_RECT
                                    ELSE
                    'Next line produces a raised edge on the $HOVERBUTTON
                                       'IF @fd.bIsOver THEN DrawEdge ps.hdc, rc, %BDR_RAISEDOUTER, %BF_RECT
                    '
                    'Next section removed or later added to provide the underline effect
                    '
                                        IF @fd.bIsOver THEN
                                          @fd.lfFont.lfUnderline = -1
                                        ELSE
                                          @fd.lfFont.lfUnderline = 0
                                        END IF
                                    END IF
                                 END IF
                    
                                 ' Draw text if the control has text...
                                 IF LEN(@fd.zText) THEN
                                    ' Only trap this if no border and not a checkbox...
                                    IF @fd.bIsDown = 0 THEN
                                       IF ((gwl AND %HBS_CHECKBOX) <> %HBS_CHECKBOX) AND ((gwl AND %HBS_ORIGINAL) <> %HBS_ORIGINAL) AND (@fd.bIsOver <> 0) THEN
                                          rc.nLeft = rc.nLeft - 2: rc.ntop = rc.nTop - 2
                                       END IF
                                    END IF
                                    ' Only track if not in checkbox mode...
                                    IF @fd.bIsDown THEN rc.nLeft = rc.nLeft + 3: rc.ntop = rc.nTop + 3
                                    fnt = SelectObject(ps.hDc, CreateFontIndirect(@fd.lfFont))
                                    SetBkMode ps.hDc, %Transparent
                                    IF IsWindowEnabled(hWnd) THEN
                                       IF (gwl AND %HBS_ORIGINAL) THEN
                                          SetTextColor ps.hDc, IIF&(@fd.bHasTxtClr, @fd.cText, GetSysColor(%COLOR_BTNTEXT))
                                       ELSE
                                          SetTextColor ps.hDc, IIF&(@fd.bHasTxtClr, IIF&(@fd.bIsOver, @fd.cHovTxt, @fd.cText), GetSysColor(IIF&(@fd.bIsOver, %COLOR_HIGHLIGHTTEXT, %COLOR_BTNTEXT)))
                                       END IF
                                    ELSE
                                       SetTextColor ps.hDc, GetSysColor(%COLOR_GRAYTEXT)
                                    END IF
                                    IF (gwl AND %HBS_LEFT) = %HBS_LEFT THEN
                                       dwAlign = %DT_LEFT
                                       rc.nLeft = rc.nLeft + 4
                                    ELSEIF (gwl AND %HBS_RIGHT) = %HBS_RIGHT THEN
                                       dwAlign = %DT_RIGHT
                                       rc.nRight = rc.nRight - 4
                                    ELSE
                                       dwAlign = %DT_CENTER
                                    END IF
                                    DrawText ps.hDc, @fd.zText, LEN(@fd.zText), rc, %DT_NOPREFIX OR %DT_SINGLELINE OR %DT_VCENTER OR dwAlign
                                    DeleteObject SelectObject(ps.hDc, fnt)
                                 END IF
                    
                                 ' Special case for HBS_ORIGINAL style, draw focus rect?...
                                 IF (GetFocus = hWnd) AND (gwl AND %HBS_ORIGINAL) THEN
                                    GetClientRect hWnd, rc
                                    InflateRect rc, -3, -3
                                    DrawFocusRect ps.hDC, rc
                                 END IF
                    
                                 EndPaint hWnd, ps
                                 EXIT FUNCTION
                    Hope this helps others as they research this topic.

                    Bob Mechler
                    Last edited by BOB MECHLER; 24 Dec 2007, 10:48 AM. Reason: More editing

                    Comment


                    • #11
                      Compilable example if you copy the CTLBTN.INC from the reference in the previous post and modify the area in the Paint section I also posted and it will show the red underlined when over ability.

                      Code:
                      #PBFORMS CREATED V1.50
                      '------------------------------------------------------------------------------
                      ' The first line in this file is a PB/Forms metastatement.
                      ' It should ALWAYS be the first line of the file. Other
                      ' PB/Forms metastatements are placed at the beginning and
                      ' end of "Named Blocks" of code that should be edited
                      ' with PBForms only. Do not manually edit or delete these
                      ' metastatements or PB/Forms will not be able to reread
                      ' the file correctly.  See the PB/Forms documentation for
                      ' more information.
                      ' Named blocks begin like this:    #PBFORMS BEGIN ...
                      ' Named blocks end like this:      #PBFORMS END ...
                      ' Other PB/Forms metastatements such as:
                      '     #PBFORMS DECLARATIONS
                      ' are used by PB/Forms to insert additional code.
                      ' Feel free to make changes anywhere else in the file.
                      '------------------------------------------------------------------------------
                      
                      #COMPILE EXE
                      #DIM ALL
                      
                      '------------------------------------------------------------------------------
                      '   ** Includes **
                      '------------------------------------------------------------------------------
                      #PBFORMS BEGIN INCLUDES
                      #IF NOT %DEF(%WINAPI)
                          #INCLUDE "WIN32API.INC"
                      #ENDIF
                      #INCLUDE"CTLBTN1.INC"
                      #PBFORMS END INCLUDES
                      '------------------------------------------------------------------------------
                      
                      '------------------------------------------------------------------------------
                      '   ** Constants **
                      '------------------------------------------------------------------------------
                      #PBFORMS BEGIN CONSTANTS
                      %IDD_DIALOG1  =  101
                      %LBL_LABEL1   = 1001
                      %LBL_LABEL2   = 1002
                      %LBL_LABEL3   = 1003
                      %LBL_LABEL4   = 1004
                      %LBL_LABEL5   = 1005
                      %LBL_LABEL6   = 1006
                      %LBL_LABEL7   = 1007
                      %LBL_LABEL8   = 1008
                      %LBL_LABEL9   = 1009
                      %TXT_TEXTBOX1 = 1010
                      #PBFORMS END CONSTANTS
                      '------------------------------------------------------------------------------
                      
                      '------------------------------------------------------------------------------
                      '   ** Declarations **
                      '------------------------------------------------------------------------------
                      DECLARE CALLBACK FUNCTION ShowDIALOG1Proc()
                      DECLARE FUNCTION ShowDIALOG1(BYVAL hParent AS DWORD) AS LONG
                      #PBFORMS DECLARATIONS
                      '------------------------------------------------------------------------------
                      
                      '------------------------------------------------------------------------------
                      '   ** Main Application Entry Point **
                      '------------------------------------------------------------------------------
                      GLOBAL CUR_CTRL_ID AS LONG,CUR_CTRL AS LONG,PRESS_BUTTON_ON AS INTEGER, hFontlb AS LONG, hFontlbul AS LONG,V_BRUSH AS LONG
                      GLOBAL hdlg AS LONG
                      FUNCTION MakeFont(BYVAL CFont AS STRING, BYVAL PointSize AS LONG) AS LONG
                      
                        LOCAL hDC      AS LONG
                        LOCAL CyPixels AS LONG
                      
                        hDC = GetDC(%HWND_DESKTOP)
                        CyPixels  = GetDeviceCaps(hDC, %LOGPIXELSY)
                        ReleaseDC %HWND_DESKTOP, hDC
                      
                        PointSize = (PointSize * CyPixels) \ 72
                        FUNCTION = CreateFont(0 - PointSize, 0, 0, 0, %FW_NORMAL, 0, 0, 0, _
                                  %ANSI_CHARSET, %OUT_TT_PRECIS, %CLIP_DEFAULT_PRECIS, _
                                  %DEFAULT_QUALITY, %FF_DONTCARE, BYCOPY CFONT)
                      END FUNCTION
                      FUNCTION MakeFontUL(BYVAL CFont AS STRING, BYVAL PointSize AS LONG) AS LONG
                      
                        LOCAL hDC      AS LONG
                        LOCAL CyPixels AS LONG
                      
                        hDC = GetDC(%HWND_DESKTOP)
                        CyPixels  = GetDeviceCaps(hDC, %LOGPIXELSY)
                        ReleaseDC %HWND_DESKTOP, hDC
                      
                        PointSize = (PointSize * CyPixels) \ 72
                        FUNCTION = CreateFont(0 - PointSize, 0, 0, 0, %FW_NORMAL, 0, -1, 0, _
                                  %ANSI_CHARSET, %OUT_TT_PRECIS, %CLIP_DEFAULT_PRECIS, _
                                  %DEFAULT_QUALITY, %FF_DONTCARE, BYCOPY CFONT)
                      END FUNCTION
                      MACRO M_txtwdth
                        hDC = GetDC(hdlg)
                        hfont = SelectObject(hDC&,hFontlb)
                        GetTextExtentPoint32 hDC, BYVAL STRPTR(btext$), LEN(btext$),lpsize 
                        SelectObject hDC, hFont
                        ReleaseDC hdlg, hDC
                        WdPix = lpSize.cx + 9
                        HtPix = lpSize.cy + 1
                        DIALOG PIXELS hdlg, WdPix, HtPix TO UNITS WdPix, HtPix
                        btextl = WdPix
                      END MACRO                
                      FUNCTION PBMAIN()
                          ShowDIALOG1 %HWND_DESKTOP
                      END FUNCTION
                      '------------------------------------------------------------------------------
                      
                      '------------------------------------------------------------------------------
                      '   ** CallBacks **
                      '------------------------------------------------------------------------------
                      CALLBACK FUNCTION ShowDIALOG1Proc()
                      
                          SELECT CASE AS LONG CBMSG
                              CASE %WM_INITDIALOG
                                LOCAL lb AS LOGBRUSH
                                lb.lbstyle=  %BS_SOLID
                                lb.lbcolor = RGB(224,224,224)
                                V_Brush = CreateBrushIndirect(Lb)
                                hFontlb = MakeFont("Tahoma",9)
                                hFontlbul = MakeFontul("Tahoma",9)
                                  ' Initialization handler
                              CASE %WM_DESTROY
                                DeleteObject hFontlb
                                DeleteObject hFontlbul
                      
                              CASE %WM_NCACTIVATE
                                  STATIC hWndSaveFocus AS DWORD
                                  IF ISFALSE CBWPARAM THEN
                                      ' Save control focus
                                      hWndSaveFocus = GetFocus()
                                  ELSEIF hWndSaveFocus THEN
                                     ' Restore control focus
                                      SetFocus(hWndSaveFocus)
                                      hWndSaveFocus = 0
                                  END IF
                              CASE %WM_CTLCOLORSTATIC
                                  SELECT CASE GetDlgCtrlID(CBLPARAM)
                                    CASE %LBL_LABEL1 TO %LBL_LABEL3
                                       IF GetDlgCtrlID(CBLPARAM) = CUR_CTRL_ID&  THEN
                                          'SetCursor HandMousePointer
                                          SelectObject CBWPARAM, hFontlbul
                                          SetTextColor CBWPARAM, RGB(196,0,0) ' change red when over
                                       ELSE
                                          SelectObject CBWPARAM, hFontlb
                                          SetTextColor CBWPARAM, RGB(0,0,0)
                                       END IF
                                    SetBkColor CBWPARAM, RGB(128,128,128)
                                    SetBkMode CBWPARAM, %Transparent
                                    FUNCTION = V_BRUSH
                                  END SELECT
                              CASE %WM_SETCURSOR
                      
                                  CUR_CTRL_ID& = GetDlgCtrlID(CBWPARAM)
                                  IF CUR_CTRL_ID& >= %LBL_LABEL2 AND CUR_CTRL_ID& <= %LBL_LABEL3 THEN
                                    CONTROL HANDLE CBHNDL, CUR_CTRL_ID& TO CUR_CTRL&
                                    RedrawWindow CUR_CTRL&, BYVAL 0, 0, %RDW_ERASE OR %RDW_INVALIDATE
                                    PRESS_BUTTON_ON = -1
                                  ELSEIF CUR_CTRL_ID& = 0 AND PRESS_BUTTON_ON = -1 THEN
                                    RedrawWindow CBHNDL, BYVAL 0, 0, %RDW_INVALIDATE  '@@@@@
                                    PRESS_BUTTON_ON = 0
                                  END IF
                      
                              CASE %WM_COMMAND
                                  ' Process control notifications
                                  SELECT CASE AS LONG CBCTL
                                      CASE %LBL_LABEL1
                      
                                      CASE %TXT_TEXTBOX1
                      
                                      CASE %LBL_LABEL2
                                        CONTROL SET TEXT CBHNDL,%TXT_TEXTBOX1,"Do this"
                      
                                      CASE %LBL_LABEL3
                                        CONTROL SET TEXT CBHNDL,%TXT_TEXTBOX1,"Do that"
                      
                                      CASE %LBL_LABEL4
                                        CONTROL SET TEXT CBHNDL,%TXT_TEXTBOX1,"kp1"
                      
                                      CASE %LBL_LABEL5
                                        CONTROL SET TEXT CBHNDL,%TXT_TEXTBOX1,"kp2"
                      
                                  END SELECT
                          END SELECT
                      END FUNCTION
                      '------------------------------------------------------------------------------
                      
                      '------------------------------------------------------------------------------
                      '   ** Dialogs **
                      '------------------------------------------------------------------------------
                      FUNCTION ShowDIALOG1(BYVAL hParent AS DWORD) AS LONG
                          HoverBtn_Initialize
                          LOCAL lRslt AS LONG, CNT AS LONG
                      
                      #PBFORMS BEGIN DIALOG %IDD_DIALOG1->->
                          LOCAL btext AS STRING,btextl AS INTEGER,nlm AS INTEGER
                          LOCAL hFont AS LONG, hDC AS LONG, WdPix AS LONG, HtPix AS LONG, lpSize AS SIZEL
                          DIALOG NEW  hParent, "Button highlight demo", 70, 70, 267, 142, %WS_POPUP _
                              OR %WS_BORDER OR %WS_DLGFRAME OR %WS_SYSMENU OR %WS_CLIPSIBLINGS OR _
                              %WS_VISIBLE OR %DS_MODALFRAME OR %DS_3DLOOK OR %DS_NOFAILCREATE OR _
                              %DS_SETFONT, %WS_EX_WINDOWEDGE OR %WS_EX_CONTROLPARENT OR _
                              %WS_EX_LEFT OR %WS_EX_LTRREADING OR %WS_EX_RIGHTSCROLLBAR, TO hDlg
                          DIALOG SET COLOR hDlg, -1, RGB(224,224,224)
                          CONTROL ADD LABEL,   hDlg, %LBL_LABEL1, "Field 1", 15, 15, 40, 10
                          CONTROL ADD TEXTBOX, hDlg, %TXT_TEXTBOX1, "TextBox1", 60, 15, 75, 10
                          btext$ = "Do this"
                          nlm = 15 + btextl + 1
                          M_txtwdth
                          CONTROL ADD LABEL,   hDlg, %LBL_LABEL2, btext$, nlm ,100, btextl, 10, _
                              %WS_CHILD OR %WS_VISIBLE OR %SS_LEFT OR %SS_NOTIFY, %WS_EX_LEFT OR _
                              %WS_EX_LTRREADING
                          CONTROL SEND hdlg,%LBL_LABEL2 , %WM_SETFONT, hFontlb, %True
                          btext$ = "Do that"
                          nlm = 15 + btextl + 1
                          M_txtwdth                                       
                          CONTROL ADD LABEL,   hDlg, %LBL_LABEL3, btext$, nlm, 100, btextl, 10, _
                              %WS_CHILD OR %WS_VISIBLE OR %SS_LEFT OR %SS_NOTIFY, %WS_EX_LEFT OR _
                              %WS_EX_LTRREADING
                          CONTROL SEND hdlg,%LBL_LABEL3 , %WM_SETFONT, hFontlb, %True
                          CONTROL ADD $HOVERBTNCLASS, hDlg, %LBL_LABEL4, "Check Button", 10, 70, 50, 14, %HBS_NORMAL
                          CONTROL SEND hDlg, %LBL_LABEL4, %HBM_SETCOLORS, %BLUE,RGB(224,224,224)
                          CONTROL SEND hDlg, %LBL_LABEL4, %HBM_SETHOVERCOLORS, %RED,RGB(224,224,224)
                          CONTROL ADD $HOVERBTNCLASS, hDlg, %LBL_LABEL5, "Check Button", 60, 70, 50, 14, %HBS_NORMAL
                          CONTROL SEND hDlg, %LBL_LABEL5, %HBM_SETCOLORS, %BLUE,RGB(224,224,224)
                          CONTROL SEND hDlg, %LBL_LABEL5, %HBM_SETHOVERCOLORS, %RED,RGB(224,224,224)
                          CONTROL SEND hDlg, %LBL_LABEL5, %HBM_SETFOCUSCOLOR, -1,RGB(224,224,224)
                      #PBFORMS END DIALOG
                      
                          DIALOG SHOW MODAL hDlg, CALL ShowDIALOG1Proc TO lRslt
                      
                      #PBFORMS BEGIN CLEANUP %IDD_DIALOG1
                      #PBFORMS END CLEANUP
                      
                          FUNCTION = lRslt
                      END FUNCTION
                      '------------------------------------------------------------------------------
                      BOB MECHLER

                      Comment

                      Working...
                      X