Date: 02-16-2022
Return to Index
created by gbSnippets
'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: (Jose Includes)
#Compiler PBWin 9, PBWin 10
#Compile EXE
#Dim All
%Unicode=1
#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 Long) As 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 Long) As 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
http://www.garybeene.com/sw/gbsnippets.htm