Announcement

Collapse
No announcement yet.

RichEdit - AutoURLDetect Update

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

  • RichEdit - AutoURLDetect Update

    This is not Source Code worthy, just a change to the OpenLink function that I've use in prior posts where AutoURLDetect was used in a RichEdit Control.

    Code:
    'Compilable Example:
    #Compile Exe
    #Dim All
    %Unicode=1
    #Include "win32api.inc"
    #Include "RichEdit.inc"
    #Resource Manifest, 1, "xptheme.xml"
    
    Global hDlg As Dword, hRichEdit As Dword, REText$
    %IDC_RichEdit = 500
    
    Function PBMain() As Long
       Dialog Default Font "Tahoma", 24, 1
       Dialog New Pixels, 0, "Link Test",300,300,800,200, %WS_OverlappedWindow To hDlg
       RichEditCreate
       Dialog Show Modal hDlg Call DlgProc
    End Function
    
    CallBack Function DlgProc() As Long
       Select Case Cb.Msg
          Case %WM_InitDialog : SendMessage hRichEdit, %EM_SetSel, 0, 0
          Case %WM_Notify
             If Cb.NmId = %IDC_RichEdit And Cb.NmCode = %EN_Link Then OpenLink(Cb.LParam)
       End Select
    End Function
    
    Sub RichEditCreate
       REText$ = "Open this: http://www.garybeene.com"   '24 chars in URL
       LoadLibrary("msftedit.dll")
       Control Add "RichEdit50W", hDlg, %IDC_RichEdit, REText$,0,0,800,200, _
                %WS_Child Or %WS_ClipSiblings Or %WS_Visible Or %ES_MultiLine Or %WS_VScroll _
                Or %ES_AutoVScroll Or %ES_WantReturn Or %ES_NoHideSel Or %WS_TabStop, %WS_Ex_ClientEdge
       Control Handle hDlg, %IDC_RichEdit To hRichEdit
       SendMessage hRichEdit, %EM_SETEVENTMASK, 0, %ENM_SELCHANGE Or %ENM_CHANGE Or %ENM_LINK
       Control Send hDlg, %IDC_RICHEDIT, %EM_AUTOURLDETECT, %True, 0
    End Sub
    
    Function OpenLink(ByVal lpLink As Dword) As Long
       Local enlinkPtr As ENLINK Ptr, linkText As String, iReturn As Long
       enlinkPtr  = lpLink
       If @enLinkPtr.Msg = %WM_LButtonUp Then
          LinkText = Mid$(REText$,@enLinkPtr.chrg.cpMin+1 To @enLinkPtr.chrg.cpMax)
          iReturn  = ShellExecute(hDlg, "Open", (LinkText), $Nul, $Nul, %SW_ShowNormal)
       End If
    End Function
    In earlier posted snippets/code, I've used this next function, which I'm sure was purloined from somewhere on the forum. I was playing with it tonight and the simpler version above came to mind. I'm not sure why the longer code of the older version was required.

    Code:
    Function RichEditHyperLink(ByVal hWnd As Dword, ByVal lpLink As Dword) As Long
       Local enlinkPtr As ENLINK Ptr, tr As TEXTRANGE, linkText As String
       enlinkPtr    = lpLink
       tr.chrg      = @enLinkPtr.chrg
       linkText     = Space$(tr.chrg.cpMax - tr.chrg.cpMin + 2)
       tr.lpstrText = StrPtr(linkText)
       Control Send hWnd, %IDC_Comments, %EM_GETTEXTRANGE, 0, VarPtr(tr)
       Select Case @enLinkPtr.Msg
          Case %WM_LButtonUp
             ShellExecute(%NULL, "open", ByCopy linkText, "", "", %SW_Show)
             Function = %True                    ' Signal that we processed this
          Case %WM_MouseMove
       End Select
    End Function

  • #2
    Gary,
    The reason is because your text alignment is not jacked up by $CRLF.

    Try this and you'll see that the link no longer works:
    REText$ = $CRLF + $CRLF + $CRLF + "Open this: " + "https://www.google.com/webhp" '28 chars in URL

    You'll need a smarter LinkText calculation to figure that out.

    This seems to work...

    Code:
    '_________________________________________________________________
    '
    ' FUNCTION OpenLink                                           xBot
    '_________________________________________________________________
    
    FUNCTION OpenLink(BYVAL lpLink AS DWORD) AS LONG
       LOCAL enlinkPtr  AS ENLINK PTR
       LOCAL linkText   AS STRING
       LOCAL iReturn    AS LONG
       LOCAL TotalText  AS STRING
    
    
       enlinkPtr  = lpLink
       IF @enLinkPtr.Msg = %WM_LBUTTONUP THEN
           TotalText = gsCmdMessages
           REPLACE $CRLF WITH " " IN TotalText
           LinkText = MID$(TotalText, @enLinkPtr.chrg.cpMin+1 TO @enLinkPtr.chrg.cpMax)
           ? "]" + LinkText + "["
           iReturn  = ShellExecute(hWndMain, "Open", (LinkText), $NUL, $NUL, %SW_SHOWNORMAL)
       END IF
    END FUNCTION

    Comment


    • #3
      Hey Gary, if you want to simplify a little more...
      Code:
      FUNCTION OpenLink(BYVAL enLinkPtr AS ENLINK POINTER) AS LONG
      
       IF @enLinkPtr.Msg = %WM_LBUTTONUP THEN
         ShellExecute(hDlg, "Open", MID$(REText$,@enLinkPtr.chrg.cpMin + 1 _
                      TO @enLinkPtr.chrg.cpMax), $NUL, $NUL, %SW_SHOWNORMAL)
       END IF
      
      END FUNCTION

      Comment


      • #4
        Good catch Pierre

        Comment


        • #5
          Hey Pierre/Jim!
          Thanks for the response to the older post, although, code we write within the last decade always seems to find a home and this one was only a few months old!

          Gosh, Pierre,
          That last function is so short, it's hardly worth a Function of it's own! But I do use it in multiple locations so into my RichEdit.INC file it goes!

          Comment


          • #6
            Pierre,
            I was looking at this again tonight. Your #9 post works fine for the one line example, where no $CRLF are found in the REText$. In a multiline case, a replacement such as Jim mentions is needed, yes?

            Jim/Pierre,
            The examples above use REText$, whose current value should be obtained real-time from the RichEdit control in case a user edited the text.

            In cases of very large RichEdit control content, I'd expect it to be faster if EM_GetTextRange were used to retrieve the text directly, something like this ...

            Code:
            Function OpenLink_SDK(ByVal enLinkPtr As ENLINK Pointer) As Long
               Local T As TextRange, LinkText$
               If @enLinkPtr.Msg = %WM_LButtonUp Then
                  T.chrg = @enLinkPtr.chrg
                  LinkText$ = Space$(T.chrg.cpMax-T.chrg.cpMin+1)
                  T.lpstrText  = StrPtr(LinkText$)
                  SendMessage hRichEdit, %EM_GetTextRange, ByVal 0, VarPtr(T)
                  ? LinkText$
                  ShellExecute(hDlg, "Open", (LinkText$), $Nul, $Nul, %SW_ShowNormal)
               End If
            End Function
            ... except that this function doesn't seem to work as I would have expected. Not sure why at the moment (I use %Unicode=1)

            ... added fix to the mentioned issue by filling LinkText$ with spaces.
            Last edited by Gary Beene; 9 Jan 2019, 12:28 AM. Reason: Fixed issue..

            Comment


            • #7
              Looking more closely, I realize what was your problem, I often forget myself to use only CR in re and no CRLF.
              Case solved!

              Code:
              #COMPILE EXE
              #DIM ALL
              %Unicode=1
              #INCLUDE "Win32Api.inc"
              #INCLUDE "RichEdit.inc"
              #RESOURCE MANIFEST, 1, "xpTheme.xml"
              
              GLOBAL hDlg      AS DWORD
              GLOBAL hRichEdit AS DWORD
              GLOBAL sText     AS STRING
              
              %RichEdit01 = 101
              '_____________________________________________________________________________
              
              FUNCTION PBMAIN() AS LONG
               LOCAL hLib  AS DWORD
               LOCAL hIcon AS DWORD
              
               DIALOG DEFAULT FONT "Tahoma", 18, 1
               DIALOG NEW PIXELS, %HWND_DESKTOP, "Link Test", , , 600, 250, _
               %WS_CAPTION OR %WS_MINIMIZEBOX OR %WS_SYSMENU, 0 TO hDlg
              
               sText = "Click http://www.garybeene.com " & $CR & _
                       "and click" & $CR & " https://msdn.microsoft.com/microsoft-sdks-msdn " & $CR & "web site." & _
                       "And click again" & $CR & " http://www.powerbasic.com " & $CR & "web site."
              
               hLib = LoadLibrary("msftedit.dll")
               CONTROL ADD "RichEdit50W", hDlg, %RichEdit01, sText, 0, 0, 600, 250, _
               %WS_CHILD OR %WS_CLIPSIBLINGS OR %WS_VISIBLE OR %ES_MULTILINE OR %WS_VSCROLL OR _
               %ES_AUTOVSCROLL OR %ES_WANTRETURN OR %ES_NOHIDESEL OR %WS_TABSTOP, %WS_EX_CLIENTEDGE
              
               hRichEdit = GetDlgItem(hDlg, %RichEdit01)
               SendMessage(hRichEdit, %EM_SETEVENTMASK, 0, %ENM_SELCHANGE OR %ENM_CHANGE OR %ENM_LINK)
              
               CONTROL SEND hDlg, %RichEdit01, %EM_AUTOURLDETECT, %TRUE, 0
               SendMessage(hRichEdit, %EM_AUTOURLDETECT, %TRUE, 0)
              
               hIcon = ExtractIcon(GetModuleHandle(""), "Shell32.dll", 13)
               SetClassLong(hDlg, %GCL_HICON, hIcon)
              
               DIALOG SHOW MODAL hDlg CALL DlgProc
              
               FreeLibrary(hLib)
               DestroyIcon(hIcon)
              
              END FUNCTION
              '_____________________________________________________________________________
              
              CALLBACK FUNCTION DlgProc() AS LONG
               LOCAL enLinkPtr AS ENLINK POINTER
              
               SELECT CASE CBMSG
              
                 CASE %WM_INITDIALOG
                   SendMessage(hRichEdit, %EM_SetSel, 0, 0)
              
                 CASE %WM_NOTIFY
                   IF CBNMID = %RichEdit01 AND CBNMCODE = %EN_Link THEN
                     enLinkPtr = CBLPARAM
                     IF @enLinkPtr.Msg = %WM_LBUTTONUP THEN
                       ShellExecute(hDlg, "Open", MID$(sText,@enLinkPtr.chrg.cpMin + 1 _
                                    TO @enLinkPtr.chrg.cpMax), $NUL, $NUL, %SW_SHOWNORMAL)
                     END IF
                   END IF
              
               END SELECT
              
              END FUNCTION
              '_____________________________________________________________________________
              '

              Comment


              • #8
                Howdy, Pierre!
                Ok, I think we're in sync. When fed a 2-byte word delimiter, a RichEdit converts it to 1 byte and reports character positions based on a 1-byte word delimiter. Code that deals with character positioning must likewise be based on 1-byte word delimiters. Some of the tricks to the trade are to use a 1-byte delimiter in the original string, convert the extracted string delimiter pairs to a single byte (such as received by Control Get Text) or by using the RichEdit API to get a string (such as the GetTextRange API, which acts based on a 1-byte delimiter).

                It's only recently that I caught on to the 2-byte/1-byte conversion issue.

                Comment

                Working...
                X