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.
'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 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 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
'gbs_00639
'Date: 03-10-2012
http://www.garybeene.com/sw/gbsnippets.htm