Announcement

Collapse
No announcement yet.

Hover effect using a label control question

Collapse
X
Collapse
 
  • Page of 1
  • Filter
  • Time
  • Show
Clear All
new posts
Previous template Next
  • #1

    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
    Tags: None
  • #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?:
      PowerBASIC
      http://www.powerbasic.com/support/pbforums/showpost.php?p=170571&postcount=1
      Regards,
      Peter

      "Simplicity is a prerequisite for reliability"

      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

            "Simplicity is a prerequisite for reliability"

            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 (retired)
              Port Washington 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 [b]Pt As LONG[/b]) As Dword
Declare Function ChildWindowFromPointEx Lib "USER32.DLL" Alias "ChildWindowFromPointEx" _
  (ByVal hWnd As Dword, ByVal [b]Pt As LONG[/b], 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 (retired)
                Port Washington 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

                      Previous template Next
                      Working...
                      X

                      We process personal data about users of our site, through the use of cookies and other technologies, to deliver our services, and to analyze site activity. For additional details, refer to our Privacy Policy.

                      By clicking "I AGREE" below, you agree to our Privacy Policy and our personal data processing and cookie practices as described therein. You also acknowledge that this forum may be hosted outside your country and you consent to the collection, storage, and processing of your data in the country where this forum is hosted.

                      I Agree