Enable Hyperlinks

Category: Controls - RichEdit

Date: 03-28-2012

Return to Index


 
'A RichEdit control has the ability to detect, highlight, and make active any URL entered
'into the control.
 
'Compiler Comments:
'This code is written to compile with PBWin10. To compile with PBWin9,
'add this line:
#Include "CommCtrl.inc"
 
'Primary Code:
'Credit: Borje Hagsten
'Two message must be sent to enable URL detection by the RichEdit control.
'1. The %ENM_SetEventMake message must used to activate capture of %ENM_LINK messages
      SendMessage hRichEdit, %EM_SETEVENTMASK, 0, %ENM_SELCHANGE Or %ENM_CHANGE Or %ENM_LINK
'2. The %EM_AutoURLDetect message is used to turn on/off URL detection
      Control Send hDlg, %ID_RICHEDIT, %EM_AUTOURLDETECT, %True, 0
      Control Send hDlg, %ID_RICHEDIT, %EM_AUTOURLDETECT, %False, 0
'3. The %WM_Notify message is sent when a URL is clicke
      Case %WM_Notify
         If CB.NmID = %ID_RichEdit AND CB.Nmcode = %EN_Link Then
            RichEditHyperLink(hDlg, CB.lParam)
         End If
'4. The URL must be extracted from the %WM_Notify message content
      Function RichEditHyperLink(ByVal hWnd As Dword, ByVal lpLink As DwordAs 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, %ID_RICHEDIT, %EM_GETTEXTRANGE, 0, VarPTR(tr)
          Select Case @enLinkPtr.Msg
              Case %WM_LButtonDown
                  ShellExecute(%NULL, "open", ByCopy linkText, "", "", %SW_Show)
                  Function = %True                    ' Signal that we processed this
              Case %WM_MouseMove
          End Select
      End Function
 
'Compilable Example:
'In this example, a button is used to toggle the display of active URLs.
#Compiler PBWin 10
#Compile EXE
#Dim All
#Include "win32api.inc
#Include "RichEdit.inc"
Global hDlg As Dword, hRichEdit As Dword
%ID_RichEdit = 500 : %IDC_Button = 501
 
Function PBMain() As Long
   Dialog New Pixels, 0, "URL Test",300,300,200,200, %WS_OverlappedWindow To hDlg
   RichEditCreate
   Control Add Button, hDlg, %IDC_Button, "Toggle URL Detect", 30,10,140,20
   Dialog Show Modal hDlg Call DlgProc
End Function
 
CallBack Function DlgProc() As Long
   Select Case CB.Msg
      Case %WM_Command
         If CB.Ctl = %IDC_Button AND CB.Ctlmsg = %BN_Clicked Then
            Static EnableURL&
            EnableURL& = EnableURL& XOR 1
            If EnableURL& Then
               Control Send hDlg, %ID_RICHEDIT, %EM_AUTOURLDETECT, %True, 0
               Control Set Text hDlg, %ID_RichEdit, "URL detect is on!" + $CrLf + $CrLf + " http://www.garybeene.com/"
            Else
               Control Send hDlg, %ID_RICHEDIT, %EM_AUTOURLDETECT, %False, 0
               Control Set Text hDlg, %ID_RichEdit, "URL detect is off!" + $CrLf + $CrLf + " http://www.garybeene.com/"
            End If
         End If
      Case %WM_Notify
         If CB.NmID = %ID_RichEdit AND CB.Nmcode = %EN_Link Then
            RichEditHyperLink(hDlg, CB.lParam)
         End If
   End Select
End Function
 
Sub RichEditCreate
   LoadLibrary("riched32.dll")
   Call InitCommonControls
   Control Add "RichEdit", hDlg, %ID_RichEdit, "", 20, 50, 160, 140, _
      %WS_Child Or %WS_Visible Or %ES_MultiLine Or %WS_VScroll Or %ES_AutoHScroll _
      Or %WS_HScroll Or %ES_AutoVScroll Or %ES_WantReturn Or %ES_NoHideSel Or %WS_TabStop, _
      %WS_Ex_ClientEdge
   Control Handle hDlg, %ID_RichEdit To hRichEdit
   SendMessage hRichEdit, %EM_SETEVENTMASK, 0, %ENM_SELCHANGE Or %ENM_CHANGE Or %ENM_LINK
End Sub
 
Function RichEditHyperLink(ByVal hWnd As Dword, ByVal lpLink As DwordAs 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, %ID_RICHEDIT, %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
 
'gbs_00225
'Date: 03-10-2012


created by gbSnippets
http://www.garybeene.com/sw/gbsnippets.htm