Example20B: Create URL Hotspot - Single Line Version

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.
 
'This snippet is similar to the previous one, except that the functions are
'written to work on a single line at a time - making them compatible with working
'with Scintilla lexers (which ask for lexing a line at a time).
 
'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, hFont As DWord
Global FindStructure As Sci_TextToFind
 
Function PBMain() As Long
   hLib = LoadLibrary("SCILEXER.DLL")
   Dialog New Pixels, 0, "Scintilla Example",300,300,500,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, iPos, iLine 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
               iPos = SendMessage( hSci, %SCI_GetCurrentPos, 0, 0)  'get current position
               iLine  = SendMessage( hSci, %SCI_LineFromPosition, iPos, 0)  'line that contains iCaretPos
               Dialog Set Text hDlg, Str$(iLine) + Str$(iPos)
 
               pNSC = CB.lParam
               Select Case @pNSC.hdr.Code
                  Case %SCN_HotSpotClick
                     URL = GetHotspotText(@pNSC.position)
                     ? URL
                     '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
   Local i, nLines As Long
   nLines = SendMessage( hSci, %SCI_GetLineCount, 0, 0)
   For i = 0 To 4
      CreateURLHotSpots(i)
   Next i
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 + "http://www  xxx  http://www" + $CrLf
   txt = txt + "Else" + $CrLf + "   http://www" + $CrLf + "End If" + Chr$(0)
   SendMessage hSci, %SCI_SetText, 0, StrPTR(txt)
   SendMessage hSci, %SCI_SetMarginWidthN, 0, 20
 
   Local F As String
   F = "Courier" + Chr$(0)
   SendMessage hSci, %SCI_StyleSetFont, %Style_Default, StrPTR(F)
   SendMessage hSci, %SCI_StyleSetSize, %Style_Default, 8
 
   'create a style to contain hotspot attributes
   SendMessage hSci, %SCI_StyleSetFont, %Style_HotSpot, StrPTR(F)
   SendMessage hSci, %SCI_StyleSetFore, %Style_HotSpot, %rgb_DarkBlue 'dark blue FG
   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
 
End Sub
 
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
 
Sub CreateURLHotSpots(iLine As Long)
   'set hotspot for each URL in the given line
   Local iResult, i, iStartPos, iLength, iEndPos As Long
   iStartPos = SendMessage(hSci,%SCI_PositionFromLine,iLine,0)      'first char in line
   iEndPos = SendMessage( hSci, %SCI_GetLineEndPosition, iLine, 0)  'last char in line
 
   iResult = FindNextURL(iStartPos, iEndPos)  '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(iStartPos,iEndPos)
      If iResult > -1 Then ? Str$(FindStructure.chrgtext.cpmin) + Str$(FindStructure.chrgtext.cpmax)
      If iResult > -1 Then iStartPos = FindStructure.chrgtext.cpmax
   Loop
End Sub
 
Function FindNextURL(iStartPos As Long, iEndPos As LongAs Long
   Local iResult As Long
   Local FindURLText As String
   FindURLText = "\<http://[.:/#%A-za-z]*" + Chr$(0)   'word starting with http
   FindStructure.Chrg.cpMin = iStartPos
   FindStructure.Chrg.cpMax = iEndPos
   FindStructure.lpstrText = StrPTR(FindURLText)
   Function = SendMessage (hSci, %SCI_FindText, %SCFind_RegExp, VarPTR(FindStructure))  '-1 if not found, otherwise start pos
End Function
 
'gbs_00688
'Date: 03-10-2012


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