Example20: Create URL Hotspot

Category: Controls - Scintilla

Date: 03-28-2012

Return to Index


 
'The Windows RichEdit control has the ability to highlight, and make active,
'URL addresses.
 
'Since Scintilla does not have the ability built-in, and since lexers don't
'normally perform that task (they could), it's up the programmer to add the
'capability to the container application.
 
'Basically, the approach is to scan for URL text strings using regular expression
'and turn those into hotspots whose click action is to open the default browser
'with the word.
 
'With Scintilla, creation of a hotspot is accomplished by setting a range of
'text to a style whose hotspot attribute has been enabled. When a hotspot
'is clicked, the %SCN_HotSpotClick message is sent to the container.
 
 
'Primary Code:
'Any style can have it's hotspot attribute set. These messages set the hotspot attribute
'along with other visual attributes of a style designated as %Style_HotSpot
 
   SendMessage hSci, %SCI_StyleSetHotSpot, %Style_HotSpot, 1   'activate hotspot in %Style_HotSpot
   SendMessage hSci, %SCI_StyleSetHotSpot, %Style_HotSpot, 1   'activate hotspot in %Style_HotSpot
   SendMessage hSci, %SCI_SetHotSpotActiveFore, 1, %Blue       'blue FG when mouse hovers
   SendMessage hSci, %SCI_SetHotSpotActiveUnderline, 1, 0      'enable underlining
   SendMessage hSci, %SCI_SetHotSpotSingleLine, 1, 0               'do not allow wrap of hotspot
 
'Here's the regular expression this snippet uses to find URLs:
   FindText = "\<http.*\>" + Chr$(0)   'word starting with http
 
'Here's the code to respond to the click of a hotspot.
   Case %WM_Notify
      If CB.Ctl = %ID_Sci Then
         pNSC = CB.lParam
         Select Case @pNSC.hdr.Code
            Case %SCN_HotSpotClick
               'get URLText
               ? Str$(@pNSC.position)
        End Select
      End If
 
'And this code opens the URL in the default browser:
      Local iReturn As Long, URL As Asciiz * %Max_Path
      URL = "http://www.garybeene.com"
      iReturn = ShellExecute(hDlg, "Open", URL, $Nul, $Nul, %SW_ShowNormal)
 
 
'Compilable Example:
#Compiler PBWin 9, PBWin 10
#Compile EXE
#Dim All
#Include "Win32API.inc"
#Include "scintilla_gb.inc"
 
%ID_Sci = 1000 : %ID_BtnA = 1001 : %ID_BtnB = 1002 : %Style_HotSpot = 2
Global hDlg, hSci, hLib As DWord
Global FindStructure As Sci_TextToFind
 
Function PBMain() As Long
   hLib = LoadLibrary("SCILEXER.DLL")
   Dialog New Pixels, 0, "Scintilla Example",300,300,370,150, %WS_OverlappedWindow To hDlg
   Control Add Button, hDlg, %ID_BtnA, "PushA", 10,10,70,20, %WS_Child Or %WS_Visible
   Control Add Button, hDlg, %ID_BtnB, "PushB", 10,40,70,20, %WS_Child Or %WS_Visible
   Control Add "Scintilla", hDlg, %ID_Sci, "", 100,10,260,130, %WS_Child Or %WS_Visible
   Control Handle hDlg, %ID_Sci To hSci     'get handle to Scintilla window
   Dialog Show Modal hDlg Call DlgProc
End Function
 
CallBack Function DlgProc() As Long
   Local txt As String, iReturn As Long, URL As Asciiz * %Max_Path
   Local pNSC As SCNotification Ptr       ' // Scintilla notification messages
   txt = "Select Case var$ 'first line" + $CrLf + "End Select 'last line" + Chr$(0)
   Select Case CB.Msg
      Case %WM_InitDialog
         InitializeScintilla
         PostMessage hSci, %SCI_SetSel, 0,0 'unselect initially
      Case %WM_Command
         Select Case CB.Ctl
            Case %ID_BtnA : TestA
            Case %ID_BtnB : TestB
         End Select
      Case %WM_Notify
         Select Case CB.NmID
            Case %ID_SCi
               pNSC = CB.lParam
               Select Case @pNSC.hdr.Code
                  Case %SCN_HotSpotClick
                     URL = GetHotspotText(@pNSC.position)
                     iReturn = ShellExecute(hDlg, "Open", URL, $Nul, $Nul, %SW_ShowNormal)
               End Select
         End Select
      Case %WM_Size
         Control Set Size hDlg, %ID_Sci, Lo(Word, CB.lParam)-110, Hi(Word, CB.lParam)-20
      Case %WM_Destroy
         If hLib Then FreeLibrary hLib      'free the Scintilla library
   End Select
End Function
 
Sub TestA
   CreateURLHotSpots
End Sub
 
Sub TestB
   SendMessage hSci, %SCI_StyleSetHotSpot, %Style_HotSpot, 0   'activate hotspot in %Style_HotSpot
End Sub
 
Sub InitializeScintilla
   Local txt As String
   txt = "If x = 2 Then" + $CrLf + "   'go to http://www.garybeene.com" + $CrLf
   txt = txt + "Else" + $CrLf + "   'go to http://www.google.com" + $CrLf + "End If" + Chr$(0)
   SendMessage hSci, %SCI_SetText, 0, StrPTR(txt)
   SendMessage hSci, %SCI_SetMarginWidthN, 0, 20
End Sub
 
Sub CreateURLHotSpots
   'set hotspot for each URL
   'action is to call default browser with that word
 
   'create a style to contain hotspot attributes
   SendMessage hSci, %SCI_StyleSetHotSpot, %Style_HotSpot, 1   'activate hotspot in %Style_HotSpot
   SendMessage hSci, %SCI_SetHotSpotActiveFore, 1, %Blue       'blue FG when mouse hovers
   SendMessage hSci, %SCI_SetHotSpotActiveUnderline, 1, 0      'enable underlining
   SendMessage hSci, %SCI_SetHotSpotSingleLine, 1, 0               'do not allow wrap of hotspot
 
   'search repeatedly for all words starting with http://
   Local iResult, i As Long
   iResult = FindNextURL  'find next occurrence of http://
   Do While iResult > -1
      SendMessage hSci, %SCI_StartStyling, FindStructure.ChrgText.cpmin, 31
      SendMessage hSci, %SCI_SetStyling, FindStructure.ChrgText.cpmax - FindStructure.ChrgText.cpmin, %Style_HotSpot
      iResult = FindNextURL
   Loop
End Sub
 
Function FindNextURL() As Long
   Static NewPos As Long
   Local iResult As Long
   Local FindURLText As String
   FindURLText = "\<http.*\>" + Chr$(0)   'word starting with http
   '   FindText = "\<(?:(?:https?|ftp|file)://|www\.|ftp\.)[-A-Z0-9+&@#/%=~_|$?!:,.]*[A-Z0-9+&@#/%=~_|$]" + Chr$(0) ... in work
   FindStructure.Chrg.cpMin = NewPos
   FindStructure.Chrg.cpMax = SendMessage(hSci,%SCI_GetLength,0,0)
   FindStructure.lpstrText = StrPTR(FindURLText)
   iResult = SendMessage (hSci, %SCI_FindText, %SCFind_RegExp, VarPTR(FindStructure))
   NewPos = FindStructure.Chrgtext.cpmax
   Function = iResult    ' -1 if not found, otherwise is start position
End Function
 
Function GetHotSpotText (iPos As LongAs String
   Local TR As Sci_TextRange
   Local i,iMax,iStyle,iNewStyle,iStart,iEnd As Long
   Local URL As String
   iStyle = SendMessage(hSci, %SCI_GetStyleAt, iPos, 0)
   iMax = SendMessage(hSci, %SCI_GetLength, 0, 0)
 
   'go up to get the right-most character with the style
   i = iPos : iNewStyle = iStyle : iEnd = iPos
   While (iStyle = iNewStyle) AND (i < iMax)
      iEnd = i
      Incr i
      iNewStyle = SendMessage(hSci, %SCI_GetStyleAt,i,0)
   Wend
 
   'go down to get left-most character with the style
   i = iPos : iNewStyle = iStyle : iStart = iPos
   While (iStyle = iNewStyle) AND (i > -1)
      iStart = i
      Decr i
      iNewStyle = SendMessage(hSci, %SCI_GetStyleAt,i,0)
   Wend
 
   'get the text
   TR.chrg.cpmin = iStart    'first character to get
   TR.chrg.cpmax = iEnd + 1  'last character to get
   TR.lpstrText = StrPTR(URL)
   SendMessage hSci, %SCI_GetTextRange, 0, VarPTR(TR)  'get range of text
   Function = TR.@lpstrText
End Function
 
'gbs_00639
'Date: 03-10-2012


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