Announcement

Collapse
No announcement yet.

Textbox with "X" to clear content

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

  • Textbox with "X" to clear content

    Is there a way to display a label or icon inside/on top of a textbox?

    Click image for larger version

Name:	xsample.png
Views:	203
Size:	3.6 KB
ID:	783900
    I would like to create a input control that works like on a webpage using HTML5 <input type='search'>
    HTML example at: www.timpex.se/pbsample.html

    Below is what I have as a starting point, but as you see it is far from something that works.
    /Mikael

    Code:
    #COMPILE EXE
    #DIM ALL
    #INCLUDE "win32api.inc"
    
    %IDtbox = 1000
    %IDtext = 1001
    
    FUNCTION PBMAIN() AS LONG
       LOCAL hDlg AS DWORD
       DIALOG DEFAULT FONT "Segoe UI", 9, 0, %DEFAULT_CHARSET
       DIALOG NEW PIXELS, 0, "Hover test",400,300,200,100, %WS_OVERLAPPEDWINDOW TO hDlg
       CONTROL ADD TEXTBOX, hDlg, %IDtbox, "Some text",  10 ,10,100,20, %SS_NOTIFY OR %WS_BORDER
       CONTROL ADD LABEL, hDlg  , %IDtext, "X", 110,10, 10,20, %SS_NOTIFY OR %SS_CENTER OR %SS_CENTERIMAGE
       CONTROL HIDE hDlg, %IDtext
       DIALOG SHOW MODAL hDlg CALL DlgProc
    END FUNCTION
    
    CALLBACK FUNCTION DlgProc() AS LONG
      LOCAL MouseOver AS DWORD
      STATIC Tracker AS BYTE
       SELECT CASE CB.MSG
          CASE %WM_SETCURSOR
             MouseOver = GetDlgCtrlId(CB.WPARAM)
             SELECT CASE MouseOver
               CASE %IDtbox
                IF Tracker = 0 THEN             'To be added later, check if textbox empty
                  Tracker = 1
                  CONTROL NORMALIZE CB.HNDL, %IDtext
                END IF
               CASE ELSE
                IF Tracker = 1 THEN
                  Tracker = 0
                  CONTROL HIDE CB.HNDL, %IDtext
                END IF
             END SELECT
          CASE %WM_COMMAND
    '         'If I could get the "X" accessible inside the textbox, clears checkbox
    '         IF CB.CTL = %IDtext AND CB.CTLMSG = %STN_CLICKED THEN CONTROL SET TEXT CB.HNDL, %IDtbox, ""
       END SELECT
    END FUNCTION

  • #2
    No mouseover to make "X" appear, but try this:
    Code:
    #compile exe
    #dim all
    #include "win32api.inc"
    
    %IDtbox = 1000
    %IDtext = 1001
    %ID_ClearBtn = 1002
    function pbmain() as long
       local hDlg as dword
       dialog default font "Segoe UI", 9, 0, %DEFAULT_CHARSET
       dialog new pixels, 0, "Hover test",400,300,200,100, %ws_overlappedwindow to hDlg
       control add textbox, hDlg, %IDtbox, "Some text",  10 ,10,100,20 'SS_NOTIFY not a
                                               'textbox style, it equals %ES_NOHIDESEL
      ' CONTROL ADD LABEL, hDlg  , %IDtext, "X", 110,10, 10,20, %SS_NOTIFY OR %SS_CENTER OR %SS_CENTERIMAGE
      ' CONTROL HIDE hDlg, %IDtext
      control add button, hDlg, %ID_ClearBtn, "X", 110, 11, 18, 18, %bs_center or %bs_flat or _
         %bs_vcenter, %ws_ex_left
       dialog show modal hDlg call DlgProc
    end function
    
    callback function DlgProc() as long
      local MouseOver as dword
      static Tracker as byte
       select case cb.msg
          case %WM_SETCURSOR
             MouseOver = GetDlgCtrlId(cb.wparam)
             select case MouseOver
               case %IDtbox
                if Tracker = 0 then             'To be added later, check if textbox empty
                  Tracker = 1
                  control normalize cb.hndl, %IDtext
                end if
               case else
                if Tracker = 1 then
                  Tracker = 0
                  control hide cb.hndl, %IDtext
                end if
             end select
          case %wm_command
            if cb.ctl = %ID_ClearBtn and cb.ctlmsg = %bn_clicked then
              control set text cb.hndl, %IDtbox, ""
            end if
            'Z order can hide the "X" when inside the textbox. <<==========
    '         'If I could get the "X" accessible inside the textbox, clears checkbox
    '         IF CB.CTL = %IDtext AND CB.CTLMSG = %STN_CLICKED THEN CONTROL SET TEXT CB.HNDL, %IDtbox, ""
       end select
    end function
    Cheers,

    added - or maybe the mouseover to unhide button?
    Dale

    Comment


    • #3
      Use a simple trick:

      Create a Label control with the text (just "X") right adjusted so it appears on right side. Crate it with a border to. make sure it has the styles so it can be clicked and respond to a click. Define the text color as Red.

      Now create your edit control on top of the label, but just slightly smaller so it fits inside and you can see the Labels border. Make sure it is not as wide so the label's X is still visible.

      Now using 2 controls, you create what appears to be just one.
      Chris Boss
      Computer Workshop
      Developer of "EZGUI"
      http://cwsof.com
      http://twitter.com/EZGUIProGuy

      Comment


      • #4
        A very old post but most likely still very relevant: http://www.catch22.net/tuts/win32/20...edit-control/#
        Paul Squires
        FireFly Visual Designer (for PowerBASIC Windows 10+)
        Version 3 now available.
        http://www.planetsquires.com

        Comment


        • #5
          To explore Chris' excellent advice, using your original code and just for fun - here a small example that resizes textbox and shows/hides the X label depending on if text exist. Result on mouse over:
          Click image for larger version  Name:	HooverTest.jpg Views:	0 Size:	5.5 KB ID:	783939
          Code:
          #COMPILE EXE
          #DIM ALL
          #INCLUDE "win32api.inc"
          
          %IDtbox = 1000
          %IDtext = 1001
          GLOBAL hEdit AS DWORD
          
          FUNCTION PBMAIN() AS LONG
             LOCAL hDlg AS DWORD
             DIALOG DEFAULT FONT "Segoe UI", 9, 0, %DEFAULT_CHARSET
             DIALOG NEW PIXELS, 0, "Hover test",400,300,200,100, %WS_OVERLAPPEDWINDOW TO hDlg
          
             CONTROL ADD LABEL,   hDlg, %IDtext, "X ",        108, 10, 20, 20, _
                                  %SS_NOTIFY OR %SS_RIGHT OR %SS_CENTERIMAGE, %WS_EX_CLIENTEDGE
             CONTROL SET COLOR hDlg, %IDtext, %RED, GetSysColor(%COLOR_WINDOW)
             CONTROL HIDE hDlg, %IDtext
          
             CONTROL ADD TEXTBOX, hDlg, %IDtbox, "Some text", 10 ,10, 118, 20, %WS_CLIPSIBLINGS, %WS_EX_CLIENTEDGE
          
             DIALOG SHOW MODAL hDlg CALL DlgProc
          END FUNCTION
          
          
          CALLBACK FUNCTION DlgProc() AS LONG
            LOCAL MouseOver AS DWORD, sBuf AS STRING
            STATIC Tracker AS BYTE
          
            SELECT CASE CB.MSG
                CASE %WM_SETCURSOR
                   MouseOver = GetDlgCtrlId(CB.WPARAM)
                   CONTROL GET TEXT CB.HNDL, %IDtbox TO sBuf
                   SELECT CASE MouseOver
                     CASE %IDtbox, %IDtext
                      IF Tracker = 0 THEN
                        Tracker = 1
                        CONTROL NORMALIZE CB.HNDL, %IDtext
                        CONTROL SET SIZE CB.HNDL, %IDtbox, 100, 20
                      END IF
                     CASE ELSE
                      IF Tracker = 1 AND LEN(sBuf) THEN ' only show X if text exists
                        Tracker = 0
                        CONTROL HIDE CB.HNDL, %IDtext
                        CONTROL SET SIZE CB.HNDL, %IDtbox, 118, 20
                      END IF
                   END SELECT
          
                CASE %WM_COMMAND
                   IF CB.CTL = %IDtext AND CB.CTLMSG = %STN_CLICKED THEN
                       CONTROL SET TEXT CB.HNDL, %IDtbox, ""
                       CONTROL HIDE CB.HNDL, %IDtext
                       CONTROL SET SIZE CB.HNDL, %IDtbox, 118, 20
                       CONTROL SET FOCUS CB.HNDL, %IDtbox
                   END IF
          
             END SELECT
          END FUNCTION

          Comment


          • #6
            Brilliant Borje

            Comment


            • #7
              and with a slightly different look...

              Code:
              #compile exe
              #dim all
              #include "win32api.inc"
              
              %ID_Edit = 1000
              %ID_Label = 1001
              
              function pbmain() as long                                                          
                 local hDlg as dword       
                 dialog default font "Segoe UI", 9, 0, %DEFAULT_CHARSET
                 dialog new pixels, 0, "Hover test",400,300,200,100, %WS_OVERLAPPEDWINDOW to hDlg
                 CONTROL ADD LABEL, hDlg  , %ID_Label, "X", 10,10, 110,20, %SS_NOTIFY OR %SS_right
                 control add textbox, hDlg, %ID_Edit, "Some text",  10 ,10,100,20
                 control hide hDlg, %ID_Label
                 dialog show modal hDlg call DlgProc
              end function
              
              callback function DlgProc() as long
                 local MouseOver as long
                 local sBuf as string 
                 local pt as pointapi
                 STATIC Tracker AS BYTE
                 select case cb.msg                                                    
                    CASE %WM_SETCURSOR
                       MouseOver = GetDlgCtrlId(CB.WPARAM)
                       CONTROL GET TEXT CB.HNDL, %ID_Edit TO sBuf
                       SELECT CASE MouseOver
                         CASE %ID_Edit, %ID_Label
                            IF Tracker = 0 THEN
                               Tracker = 1
                               CONTROL NORMALIZE CB.HNDL, %ID_Label                             
                               CONTROL SET SIZE CB.HNDL, %ID_Edit, 100, 20
                            END IF
                         CASE ELSE
                            IF Tracker = 1 AND LEN(sBuf) THEN ' only show X if text exists
                               Tracker = 0
                               CONTROL HIDE CB.HNDL, %ID_Label
                               CONTROL SET SIZE CB.HNDL, %ID_Edit, 100, 20
                            END IF
                       END SELECT
                    case %wm_command 
                      if cb.ctl = %ID_Label and cb.ctlmsg = %STN_CLICKED then
                         GetCursorPos pt
                         if pt.x > 520 then 
                            control set text cb.hndl, %ID_Edit, ""
                            control hide cb.hndl, %ID_Label
                         else
                            control send cb.hndl, %ID_Edit, %EM_SETSEL, -1, 0  
                         end if
                      end if
                 end select
              end function

              Comment


              • #8
                Finally after a lot of testing and reading, I got something close enough to that I wanted.
                It even looks ok if you use XPTheme and it should not be hard to modify it to show a eye icon in password boxes.

                Thank you all for the inspirational suggestions. /Mikael

                Code:
                #COMPILE EXE
                #DIM ALL
                #INCLUDE "win32api.inc"
                '#RESOURCE MANIFEST, 1, "XPTheme.xml"
                
                %IDtbox = 1000
                %IDtext = 1001
                
                FUNCTION PBMAIN() AS LONG
                  LOCAL hDlg AS DWORD
                  DIALOG DEFAULT FONT "Segoe UI", 9, 0, %DEFAULT_CHARSET
                  DIALOG NEW PIXELS, 0, "Hover test",400,300,200,100, %WS_OVERLAPPEDWINDOW TO hDlg
                
                  CONTROL ADD TEXTBOX, hDlg, %IDtbox, "Some text", 10, 10, 130, 20, %WS_CHILD OR %WS_VISIBLE OR %WS_TABSTOP OR %ES_LEFT, %WS_EX_CLIENTEDGE
                  CONTROL ADD LABEL,hDlg, %IDtext, "X", 126, 14, 10, 12, %SS_NOTIFY OR %SS_RIGHT OR %SS_CENTERIMAGE
                  CONTROL SET COLOR hDlg, %IDtext, %RED, GetSysColor(%COLOR_WINDOW)
                  CONTROL HIDE hDlg, %IDtext
                
                  CONTROL ADD TEXTBOX, hDlg, 2000, "Standard textbox", 10, 60, 130, 20, %WS_CHILD OR %WS_VISIBLE OR %WS_TABSTOP OR %ES_LEFT, %WS_EX_CLIENTEDGE
                
                  DIALOG SHOW MODAL hDlg CALL DlgProc
                END FUNCTION
                
                CALLBACK FUNCTION DlgProc() AS LONG
                  LOCAL hSub, oldProc AS DWORD, sBuf AS STRING
                
                  SELECT CASE CB.MSG
                    CASE %WM_INITDIALOG
                      CONTROL HANDLE CB.HNDL, %IDtbox TO hSub                 '- Setup subclass
                      oldProc = SetWindowLong(hSub, %GWL_WNDPROC, CODEPTR(SubClassProc))
                      DIALOG SET USER CB.HNDL, 1, oldProc
                
                    CASE %WM_SETCURSOR
                      SELECT CASE GetDlgCtrlId(CB.WPARAM)
                        CASE %IDtbox                                          '- Mouse in
                          CONTROL GET TEXT CB.HNDL, %IDtbox TO sBuf
                          IF LEN(sBuf) THEN                                   '- Only show "X" if text exists
                            CONTROL NORMALIZE CB.HNDL, %IDtext
                          END IF
                        CASE ELSE                                             '- Mouse out
                          CONTROL HIDE CB.HNDL, %IDtext
                      END SELECT
                
                    CASE %WM_DESTROY                                          '- Dialog ends
                      DIALOG GET USER CB.HNDL, 1 TO oldProc
                      IF oldProc THEN                                         '- Remove subclass
                        CONTROL HANDLE CB.HNDL, %IDtbox TO hSub
                        SetWindowLong hSub, %GWL_WNDPROC, oldProc
                      END IF
                  END SELECT
                END FUNCTION
                
                '- %IDtbox SubClass procedure -
                FUNCTION SubClassProc(BYVAL hWnd AS DWORD, BYVAL wMsg AS DWORD, BYVAL wParam AS DWORD, BYVAL lParam AS LONG) AS LONG
                  LOCAL oldProc, hDlg AS DWORD, pt AS POINT, sBuf AS STRING
                
                  hDlg = GetParent(hWnd)                                      '- Get window handle
                  DIALOG GET USER hDlg, 1 TO oldProc
                  IF oldProc = 0 THEN EXIT FUNCTION
                
                  SELECT CASE AS LONG wMsg
                    CASE %WM_LBUTTONDOWN
                      GetCursorPos pt
                      ScreenToClient hDlg, pt
                      IF pt.x > 126 THEN                                      '- Clear textbox if "X" is clicked
                        CONTROL SET TEXT hDlg, %IDtbox, ""
                        CONTROL HIDE hDlg, %IDtext
                      END IF
                
                    CASE %WM_SETCURSOR                                        '- For better look and behaviour
                      GetCursorPos pt
                      ScreenToClient hDlg, pt
                      IF pt.x > 126 THEN
                        CONTROL GET TEXT hDlg, %IDtbox TO sBuf
                        IF LEN(sBuf) THEN                                     '- Mouse in on "X"
                          CONTROL NORMALIZE hDlg, %IDtext                     '- Only show "X" if text exists
                        END IF
                        MOUSEPTR 1                                            '- "X" hover, change mouse pointer
                        EXIT FUNCTION                                         '- and exit.
                      END IF
                  END SELECT
                
                  FUNCTION = CallWindowProc(oldProc, hWnd, wMsg, wParam, lParam)
                END FUNCTION

                Comment


                • #9
                  Improved and more flexible if you want to have more than one TEXTBOX.

                  There is probably a better way of doing this, suggestions are welcome.
                  Is there a easy way to check if a controll allready is visable?

                  /Mikael

                  Code:
                  #COMPILE EXE
                  #DIM ALL
                  #INCLUDE "win32api.inc"
                  '#RESOURCE MANIFEST, 1, "XPTheme.xml"
                  
                  %IDtbox = 1000
                  %IDtext = 1001
                  
                  FUNCTION PBMAIN() AS LONG
                    LOCAL hDlg AS DWORD
                    DIALOG DEFAULT FONT "Segoe UI", 9, 0, %DEFAULT_CHARSET
                    DIALOG NEW PIXELS, 0, "Hover test",400,300,200,100, %WS_OVERLAPPEDWINDOW TO hDlg
                  
                    '- Setup textbox with "X" function
                    CONTROL ADD TEXTBOX, hDlg, %IDtbox, "Some text", 10, 10, 130, 20, %ES_AUTOHSCROLL OR %WS_TABSTOP, %WS_EX_CLIENTEDGE
                    CONTROL SEND hDlg, %IDtbox, %EM_SETMARGINS, %EC_RIGHTMARGIN, MAK(DWORD, 0, 11)   'Make room for "X"
                    CONTROL ADD LABEL,hDlg, %IDtext, "X", 126, 14, 10, 12, %SS_NOTIFY OR %SS_RIGHT OR %SS_CENTERIMAGE
                    CONTROL SET COLOR hDlg, %IDtext, %RED, GetSysColor(%COLOR_WINDOW)
                    CONTROL HIDE hDlg, %IDtext
                  
                    '- Standard textbox
                    CONTROL ADD TEXTBOX, hDlg, 2000, "Standard textbox", 10, 60, 130, 20, %ES_AUTOHSCROLL OR %WS_TABSTOP, %WS_EX_CLIENTEDGE
                  
                    DIALOG SHOW MODAL hDlg CALL DlgProc
                  END FUNCTION
                  '--------------------------------------------------------------------------------------------------------------------------
                  
                  CALLBACK FUNCTION DlgProc() AS LONG                           '- Dialog callback
                    LOCAL hSub, oldProc AS DWORD
                  
                    SELECT CASE CB.MSG
                      CASE %WM_INITDIALOG
                        CONTROL HANDLE CB.HNDL, %IDtbox TO hSub                 '- Setup subclass for textbox control
                        oldProc = SetWindowLong(hSub, %GWL_WNDPROC, CODEPTR(SubClassProc))
                        CONTROL SET USER CB.HNDL, %IDtbox, 1, oldProc           'Save orgiginal control procedure
                        CONTROL SET USER CB.HNDL, %IDtbox, 2, %IDtext           'Label to act as "X"
                        CONTROL SET USER CB.HNDL, %IDtbox, 3, 114               'Where MOUSEPTR should change to arrow
                  
                      CASE %WM_DESTROY                                          '- Dialog ends
                        CONTROL GET USER CB.HNDL, %IDtbox, 1 TO oldProc
                        IF oldProc THEN                                         'Remove subclass
                          CONTROL HANDLE CB.HNDL, %IDtbox TO hSub
                          SetWindowLong hSub, %GWL_WNDPROC, oldProc
                        END IF
                    END SELECT
                  END FUNCTION
                  '--------------------------------------------------------------------------------------------------------------------------
                  
                  FUNCTION SubClassProc(BYVAL hWnd AS DWORD, BYVAL wMsg AS DWORD, BYVAL wParam AS DWORD, BYVAL lParam AS LONG) AS LONG
                    LOCAL oldProc, hDlg, CtrlID, Xmark, pxPoint AS DWORD        '- Textbox subclass procedure
                    LOCAL TME AS TRACKMOUSEEVENTAPI
                  
                    hDlg   = GetParent(hWnd)                                    'Get dialog window handle
                    CtrlID = GetDlgCtrlID(hWnd)                                 'Get control ID
                    CONTROL GET USER hDlg, CtrlID, 1 TO oldProc
                    IF oldProc = 0 THEN EXIT FUNCTION                           'Just to be sure
                    CONTROL GET USER hDlg, CtrlID, 2 TO Xmark                   'Label to act as "X"
                    CONTROL GET USER hDlg, CtrlID, 3 TO pxPoint                 'Where MOUSEPTR should change to arrow
                  
                    SELECT CASE AS LONG wMsg                                    '- Track mouse
                      CASE %WM_MOUSEMOVE
                        TME.cbSize      = SIZEOF(TME)                           'Size of TRACKMOUSEEVENTAPI structure
                        TME.dwFlags     = %TME_HOVER OR %TME_LEAVE              'Requested service
                        TME.hwndTrack   = hWnd                                  'Handle to tracked control
                        TME.dwHoverTime = 16                                    'Hover timeout in ms
                        TRACKMOUSEEVENT(TME)                                    'Call event function
                  
                      CASE %WM_MOUSEHOVER
                        IF GetWindowTextLength(hWnd) THEN                       'Only show "X" if text exists
                          CONTROL NORMALIZE hDlg, Xmark
                          IF GET_X_LPARAM(lParam) > 114 THEN
                            MOUSEPTR 1                                          '"X" hover, change mouse pointer
                            EXIT FUNCTION                                       'to pointer and exit.
                          END IF
                        END IF
                  
                      CASE %WM_MOUSELEAVE
                        CONTROL HIDE hDlg, Xmark
                        EXIT FUNCTION
                  
                      CASE %WM_LBUTTONDOWN
                        IF GET_X_LPARAM(lParam) > pxPoint THEN
                          CONTROL SET TEXT hDlg, CtrlID, ""                     'Clear textbox
                          CONTROL HIDE hDlg, Xmark                              'Reset/hide "X"
                        END IF
                    END SELECT
                                                                                'Call original procedure
                    FUNCTION = CallWindowProc(oldProc, hWnd, wMsg, wParam, lParam)
                  END FUNCTION
                  '--------------------------------------------------------------------------------------------------------------------------
                  Last edited by Mikael T; 19 Aug 2019, 07:03 PM.

                  Comment


                  • #10
                    Can use IsWindowVisible(hCtrl) to see if a window/control is visible. Some issues with your code - cursor flicker, plus "Arrow" cursor really should be a hand cursor, shouldn't it? As I understand it, the X should be there as soon as TextBox has or gets text. Tested a little and put together the following. Looked around at how it's supposed to work and noticed the "X-button" slides in. Hm, a bit of a challenge there, but ok. Also, one should probably create a superclassed edit control in the form of an include file to make it easy to create and use multiple edit controls with this feature. Will be put on my tiny todo-list, right after the 150000 items the wife has filled it with..

                    This code is not ready yet, but shows a way to get there. Don't have so much free time right now, but will expand on it when I can. Oh, and it uses a multi line edit control looking as a single line, to enable %EM_SETRECT. Not sure that will cause problem, but seems to work ok. Not so many comments, but that may come later too..
                    Code:
                    #COMPILE EXE
                    #DIM ALL
                    #INCLUDE "win32api.inc"
                    
                    %IDtbox = 1000
                    GLOBAL hEdit, oldTextProc AS DWORD, rcEdit, rcButn AS RECT
                    GLOBAL DrawX AS LONG
                    
                    '====================================================================
                    FUNCTION PBMAIN() AS LONG
                      LOCAL hDlg AS DWORD
                    
                      DIALOG DEFAULT FONT "Segoe UI", 9, 0, %DEFAULT_CHARSET
                      DIALOG NEW PIXELS, 0, "Hover test", , , 300, 100, %WS_CAPTION OR %WS_SYSMENU, TO hDlg
                    
                      CONTROL ADD TEXTBOX, hDlg, %IDtbox, "Some text", 10 ,10, 118, 20, _
                                           %ES_MULTILINE OR %WS_CLIPSIBLINGS, %WS_EX_CLIENTEDGE
                      CONTROL HANDLE hDlg, %IDtbox TO hEdit
                    
                    '--------------------------------------------------------------------
                    ' Set new formatting rectangle for text in multiline TextBox
                    '--------------------------------------------------------------------
                      CONTROL SEND hDlg, %IDtbox, %EM_GETRECT, 0, VARPTR(rcEdit)
                      rcButn = rcEdit : rcButn.nRight = rcButn.nRight + 4
                      rcButn.nLeft  = rcEdit.nRight - 14 : rcButn.nBottom = rcButn.nBottom + 2
                      rcEdit.nRight = rcEdit.nRight - 14
                      CONTROL SEND hDlg, %IDtbox, %EM_SETRECT, 0, VARPTR(rcEdit)
                    '--------------------------------------------------------------------
                    
                      DIALOG SHOW MODAL hDlg CALL DlgProc
                    
                    END FUNCTION
                    
                    
                    '====================================================================
                    CALLBACK FUNCTION DlgProc() AS LONG
                      LOCAL pt AS POINTAPI
                      STATIC hCur AS DWORD
                    
                      SELECT CASE CB.MSG
                      CASE %WM_INITDIALOG
                          hCur = LoadCursor(%NULL, BYVAL %IDC_HAND)
                          oldTextProc = SetWindowLong(hEdit, %GWL_WNDPROC, CODEPTR(TextProc))
                          CONTROL SEND CB.HNDL, %IDtbox, %EM_SETSEL, -1, 0
                          IF GetWindowTextLength(hEdit) THEN
                              DrawX = 1 : InvalidateRect(hEdit, BYVAL 0, 0) : UpdateWindow hEdit
                          END IF
                    
                      CASE %WM_COMMAND
                          SELECT CASE CB.CTL
                          CASE %IDtbox
                              IF CB.CTLMSG = %EN_UPDATE THEN
                    
                              END IF
                          END SELECT
                    
                      CASE %WM_DESTROY  ' un-subclass at exit
                          SetWindowLong hEdit, %GWL_WNDPROC, oldTextProc
                    
                      CASE %WM_MOUSEMOVE
                          IF GetWindowTextLength(hEdit) = 0 THEN
                              IF DrawX = 1 THEN DrawX = 0 : InvalidateRect(hEdit, BYVAL 0, 0) : UpdateWindow hEdit
                          END IF
                    
                      CASE %WM_SETCURSOR
                          IF CB.WPARAM = hEdit THEN
                              GetCursorPos pt
                              ScreenToClient hEdit, pt
                              IF PtInRect(rcButn, pt) THEN ' if in "button" part of edit ctrl
                                  IF GetCursor <> hCur THEN SetCursor hCur ' use hand cursor
                                  FUNCTION = 1 ' return 1 to tell windows we've taken charge
                              END IF
                          END IF
                    
                      END SELECT
                    END FUNCTION
                    
                    '====================================================================
                    ' Text control subclass procedure
                    '====================================================================
                    FUNCTION TextProc(BYVAL hWnd AS DWORD, BYVAL wMsg AS DWORD, _
                                      BYVAL wParam AS DWORD, BYVAL lParam AS LONG) AS LONG
                    
                      LOCAL ps AS PAINTSTRUCT, pt AS POINTAPI
                      LOCAL hDc AS DWORD, sBuf AS STRING, zTxt AS ASCIIZ * 3
                    
                      SELECT CASE wMsg
                      CASE %WM_PAINT
                          FUNCTION = CallWindowProc(oldTextProc, hWnd, wMsg, wParam, lParam)
                          hDC = GetWindowDC(hWnd)
                          rcButn.nTop = 2
                          FillRect(hDC, rcButn, GetSysColor(%COLOR_WINDOW))
                          SetTextColor hDC, %RED
                          IF DrawX THEN zTxt = "X " ELSE zTxt = ""
                          DrawText hDC, zTxt, LEN(zTxt), rcButn, _
                                   %DT_SINGLELINE OR %DT_RIGHT OR %DT_VCENTER
                          ReleaseDC hWnd, hDC
                          rcButn.nTop = 0
                          EXIT FUNCTION
                    
                      CASE %WM_CHAR, %WM_KEYUP
                          IF GetWindowTextLength(hWnd) THEN
                              IF drawX = 0 THEN DrawX = 1 : InvalidateRect(hWnd, BYVAL 0, 0) : UpdateWindow hWnd
                          ELSE
                              IF drawX = 1 THEN DrawX = 0 : InvalidateRect(hWnd, BYVAL 0, 0) : UpdateWindow hWnd
                          END IF
                    
                      CASE %WM_LBUTTONDOWN
                          GetCursorPos pt
                          ScreenToClient hEdit, pt
                          IF PtInRect(rcButn, pt) THEN
                              SetWindowText hEdit, ""
                              DrawX = 0 : InvalidateRect(hWnd, BYVAL 0, 0) : UpdateWindow hWnd
                          END IF
                    
                      CASE %WM_MOUSEMOVE
                          IF DrawX = 0 AND GetWindowTextLength(hWnd) THEN
                              DrawX = 1 : InvalidateRect(hWnd, BYVAL 0, 0) : UpdateWindow hWnd
                          END IF
                    
                      END SELECT
                    
                      FUNCTION = CallWindowProc(oldTextProc, hWnd, wMsg, wParam, lParam)
                    END FUNCTION

                    Comment


                    • #11
                      Got rid of the cursor flicker by adding WM_SETCURSOR and changing WM_MOUSEHOVER

                      Hej Börje, I really hope you will get some time to expand your example later on.
                      Looking forward to it.

                      /Mikael

                      Code:
                      #COMPILE EXE
                      #DIM ALL
                      #INCLUDE "win32api.inc"
                      '#RESOURCE MANIFEST, 1, "XPTheme.xml"
                      
                      %IDtbox = 1000
                      %IDtext = 1001
                      
                      FUNCTION PBMAIN() AS LONG
                        LOCAL hDlg AS DWORD
                        DIALOG DEFAULT FONT "Segoe UI", 9, 0, %DEFAULT_CHARSET
                        DIALOG NEW PIXELS, 0, "Hover test",400,300,200,100, %WS_OVERLAPPEDWINDOW TO hDlg
                      
                        '- Setup textbox with "X" function
                        CONTROL ADD TEXTBOX, hDlg, %IDtbox, "Some text", 10, 10, 130, 20, %ES_AUTOHSCROLL OR %WS_TABSTOP, %WS_EX_CLIENTEDGE
                        CONTROL SEND hDlg, %IDtbox, %EM_SETMARGINS, %EC_RIGHTMARGIN, MAK(DWORD, 0, 11)   'Make room for "X"
                        CONTROL ADD LABEL,hDlg, %IDtext, "X", 126, 14, 10, 12, %SS_NOTIFY OR %SS_RIGHT OR %SS_CENTERIMAGE
                        CONTROL SET COLOR hDlg, %IDtext, %RED, GetSysColor(%COLOR_WINDOW)
                        CONTROL HIDE hDlg, %IDtext
                      
                        '- Standard textbox
                        CONTROL ADD TEXTBOX, hDlg, 2000, "Standard textbox", 10, 60, 130, 20, %ES_AUTOHSCROLL OR %WS_TABSTOP, %WS_EX_CLIENTEDGE
                      
                        DIALOG SHOW MODAL hDlg CALL DlgProc
                      END FUNCTION
                      '--------------------------------------------------------------------------------------------------------------------------
                      
                      CALLBACK FUNCTION DlgProc() AS LONG                           '- Dialog callback
                        LOCAL hSub, oldProc AS DWORD
                      
                        SELECT CASE CB.MSG
                          CASE %WM_INITDIALOG
                            CONTROL HANDLE CB.HNDL, %IDtbox TO hSub                 '- Setup subclass for textbox control
                            oldProc = SetWindowLong(hSub, %GWL_WNDPROC, CODEPTR(SubClassProc))
                            CONTROL SET USER CB.HNDL, %IDtbox, 1, oldProc           'Save orgiginal control procedure
                            CONTROL SET USER CB.HNDL, %IDtbox, 2, %IDtext           'Label to act as "X"
                            CONTROL SET USER CB.HNDL, %IDtbox, 3, 114               'Where MOUSEPTR should change to arrow
                      
                          CASE %WM_DESTROY                                          '- Dialog ends
                            CONTROL GET USER CB.HNDL, %IDtbox, 1 TO oldProc
                            IF oldProc THEN                                         'Remove subclass
                              CONTROL HANDLE CB.HNDL, %IDtbox TO hSub
                              SetWindowLong hSub, %GWL_WNDPROC, oldProc
                            END IF
                        END SELECT
                      END FUNCTION
                      '--------------------------------------------------------------------------------------------------------------------------
                      
                      FUNCTION SubClassProc(BYVAL hWnd AS DWORD, BYVAL wMsg AS DWORD, BYVAL wParam AS DWORD, BYVAL lParam AS LONG) AS LONG
                        LOCAL oldProc, hDlg, CtrlID, Xmark, pxPoint AS DWORD        '- Textbox subclass procedure
                        LOCAL TME AS TRACKMOUSEEVENTAPI, pt AS POINT
                      
                        hDlg   = GetParent(hWnd)                                    'Get dialog window handle
                        CtrlID = GetDlgCtrlID(hWnd)                                 'Get control ID
                        CONTROL GET USER hDlg, CtrlID, 1 TO oldProc
                        IF oldProc = 0 THEN EXIT FUNCTION                           'Just to be sure
                        CONTROL GET USER hDlg, CtrlID, 2 TO Xmark                   'Label to act as "X"
                        CONTROL GET USER hDlg, CtrlID, 3 TO pxPoint                 'Where MOUSEPTR should change to arrow
                      
                        SELECT CASE AS LONG wMsg                                    '- Track mouse
                          CASE %WM_MOUSEMOVE
                            TME.cbSize      = SIZEOF(TME)                           'Size of TRACKMOUSEEVENTAPI structure
                            TME.dwFlags     = %TME_HOVER OR %TME_LEAVE              'Requested service
                            TME.hwndTrack   = hWnd                                  'Handle to tracked control
                            TME.dwHoverTime = 16                                    'Hover timeout in ms
                            TRACKMOUSEEVENT(TME)                                    'Call event function
                      
                          CASE %WM_MOUSEHOVER
                            IF GetWindowTextLength(hWnd) THEN                       'Only show "X" if text exists
                              CONTROL NORMALIZE hDlg, Xmark
                            END IF
                      
                          CASE %WM_MOUSELEAVE                                       'Mouse leaving, hide "X"
                            CONTROL HIDE hDlg, Xmark
                            EXIT FUNCTION
                      
                          CASE %WM_SETCURSOR
                            LOCAL hCur AS DWORD, pt AS POINT
                            GetCursorPos pt                                         'Get cursor position on screen and
                            ScreenToClient hWnd, pt                                 'convert to control coordinates.
                            IF pt.x > pxPoint AND GetWindowTextLength(hWnd) THEN    '"X" hover
                              hCur = LoadCursor(%NULL, BYVAL %IDC_ARROW)
                              IF GetCursor <> hCur THEN SetCursor hCur
                              EXIT FUNCTION                                         'and exit
                            END IF
                      
                          CASE %WM_LBUTTONDOWN
                            IF GET_X_LPARAM(lParam) > pxPoint THEN
                              CONTROL SET TEXT hDlg, CtrlID, ""                     'Clear textbox
                              CONTROL HIDE hDlg, Xmark                              'Reset/hide "X"
                            END IF
                        END SELECT
                                                                                    'Call original procedure
                        FUNCTION = CallWindowProc(oldProc, hWnd, wMsg, wParam, lParam)
                      END FUNCTION
                      '--------------------------------------------------------------------------------------------------------------------------
                      Last edited by Mikael T; 20 Aug 2019, 12:02 PM.

                      Comment

                      Working...
                      X