Announcement

Collapse
No announcement yet.

Hover effect using a label control question

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

  • BOB MECHLER
    replied
    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

    Leave a comment:


  • BOB MECHLER
    replied
    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, 11:48 AM. Reason: More editing

    Leave a comment:


  • BOB MECHLER
    replied
    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

    Leave a comment:


  • Michael Mattias
    replied
    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

    Leave a comment:


  • Michael Mattias
    replied
    >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

    Leave a comment:


  • Peter Lameijn
    replied
    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...

    Leave a comment:


  • BOB MECHLER
    replied
    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
    '------------------------------------------------------------------------------

    Leave a comment:


  • BOB MECHLER
    replied
    Yes I saw that example, but couldn't get it to compile. I'll try it again.

    Bob Mechler

    Leave a comment:


  • Peter Lameijn
    replied
    Have you seen this example?:
    http://www.powerbasic.com/support/pb...71&postcount=1

    Leave a comment:


  • Chris Holbrook
    replied
    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.?

    Leave a comment:


  • BOB MECHLER
    started a topic Hover effect using a label control question

    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, 04:29 PM. Reason: More info
Working...
X