And the links work
Code: Select all
; This code demonstrates of to make links usable in an editor gadget
; Made by Zapman First febr. 2020
; PureBasic 5.xx — Windows version
;
Procedure FindInRichEdit(REGadgetID.l,SearchString$,startPos.l=1,MATCHCASE.l=0,WHOLEWORD.l=0,UP.l=0)
; By Zapman
Protected FindParam.findtextex,Flags.l, Res.l
;
If startPos = 0 : startPos = 1 : EndIf
FindParam\chrg\cpMin = startPos-1
FindParam\chrg\cpMax = -1
FindParam\lpstrText = @SearchString$
Flags = (MatchCase*#FR_MATCHCASE) | (WHOLEWORD*#FR_WHOLEWORD)
If UP = 0 : Flags | #FR_DOWN : EndIf
Res = SendMessage_(REGadgetID, #EM_FINDTEXTEX , Flags, FindParam)
ProcedureReturn Res + 1
EndProcedure
;
Procedure WinCallback(hwnd, msg, wParam, lParam)
Protected *pnmhdr.NMHDR, *enl.ENLINK, txt.TEXTRANGE, link$, result.l
;
result = #PB_ProcessPureBasicEvents
Select msg
Case #WM_NOTIFY
*pnmhdr = lParam
If *pnmhdr\code = #EN_LINK
*enl = lParam
If *enl\msg = #WM_SETCURSOR
;
EndIf
If *enl\msg = #WM_LBUTTONDOWN
;*enl\chrg contient les bornes du lien sur lequel un clic vient d'avoir lieu.
;*enl\chrg contains limits of the clicked link.
txt\chrg = *enl\chrg
txt\lpstrText = AllocateMemory((*enl\chrg\cpMax-*enl\chrg\cpMin)*2 + 2)
; *pnmhdr\idFrom contains GadgetNumber
SendMessage_(GadgetID(*pnmhdr\idFrom), #EM_GETTEXTRANGE, 0, txt)
link$ = PeekS(txt\lpstrText)
If link$
FreeMemory(txt\lpstrText)
p = FindString(link$,"[<",0)
If p : link$ = Mid(link$,p+2): EndIf
p = FindString(link$,">]",0)
If p : link$ = Left(link$,p-1) : EndIf
If LCase(Left(link$,4)) = "http" Or LCase(Left(link$,4)) = "ftp." Or LCase(Left(link$,4)) = "www."
ShellExecute_(0,"open",link$, 0, 0, #SW_SHOWNORMAL)
EndIf
EndIf
EndIf
EndIf
EndSelect
ProcedureReturn result
EndProcedure
;
#CFM_HIDDEN = $0100
#CFE_HIDDEN = $0100
Procedure SetRichEditorText(REGadget,Tx$)
Protected Mask.l, p.l, p1.l, p2.l, mp.l, pstart.l, nbc.l, LinkDest$, LinkName$
Protected ReadOnlyGadget.l, cf1.CHARFORMAT2, cf2.CHARFORMAT2
;
SendMessage_(GadgetID(REGadget), #EM_AUTOURLDETECT, 1, 0) ; to autodetect URLs even if they are in a non-RTF text.
Mask = SendMessage_(GadgetID(REGadget), #EM_GETEVENTMASK, 0, 0)
SendMessage_(GadgetID(REGadget), #EM_SETEVENTMASK, 0, #ENM_LINK|Mask) ; to send notifications to WinCallback when cursor is over a link
;
p = 0
Repeat
; We'll replace RTF links by sendmessage calls with CHARFORMAT\dwEffects set to #CFE_LINK
p = FindString(tx$,"\fldinst",p+1) ; First, we look for RTF links
If p
mp = p
p = FindString(tx$,Chr(34),p)+1
p2 = FindString(tx$,Chr(34),p+1)
LinkDest$ = Mid(tx$,p,p2-p) ; here is the link destination (hhtp adress)
p = FindString(tx$,"\fldrslt",p)
If p
p = FindString(tx$,"{",p)+1
p2 = FindString(tx$,"}",p)
LinkName$ = Mid(tx$,p,p2-p) ; here us the link name
If LinkName$ = "" : LinkName$ = LinkDest$ : EndIf
;
p = mp
While p And Mid(tx$,p,Len("\field"))<>"\field" : p-1 : Wend
While p And Mid(tx$,p,1)<>"{" : p-1 : Wend
If p
pstart = p-1
p+1
nbc = 1
Repeat
p1 = FindString(tx$,"{",p+1)
p2 = FindString(tx$,"}",p+1)
If p1 And (p1<p2 Or p2=0)
nbc + 1
p = p1
ElseIf p2
nbc - 1
p = p2
EndIf
Until p = 0 Or nbc = 0
If nbc = 0
; we clean all the RTF syntax and just put 2 flags at the start and at the end of the LinkName$/LinkDest$ group
tx$ = Left(tx$,pstart)+"$lnstart"+LinkName$+"[<"+LinkDest$+">]"+"$lnend"+Mid(tx$,p+1)
p = pstart
EndIf
EndIf
EndIf
EndIf
Until p = 0
;
ReadOnlyGadget = GetGadgetAttribute(REGadget,#PB_Editor_ReadOnly)
SendMessage_(GadgetID(REGadget), #EM_SETREADONLY, #False, 0)
SetGadgetText(REGadget,tx$)
;
cf1\cbSize = SizeOf(cf1)
cf1\dwMask = #CFM_LINK | #CFM_PROTECTED
cf1\dwEffects = #CFE_LINK | #CFE_PROTECTED
cf2\cbSize = SizeOf(cf2)
cf2\dwMask = #CFM_LINK | #CFM_PROTECTED | #CFM_HIDDEN
cf2\dwEffects = #CFE_LINK | #CFE_PROTECTED | #CFE_HIDDEN
p = 0
Repeat
p = FindInRichEdit(GadgetID(REGadget),"$lnstart",p+1) ; Looks for our start flag
If p
mp = p
p = FindInRichEdit(GadgetID(REGadget),"[<",p) ; Looks for the start of LinkDest$
If p
p2 = FindInRichEdit(GadgetID(REGadget),">]",p+1)
If p2
SendMessage_(GadgetID(REGadget), #EM_SETSEL, p-1, p2+1)
SendMessage_(GadgetID(REGadget), #EM_SETCHARFORMAT, #SCF_SELECTION, cf2) ; Hides LinkDest$
EndIf
EndIf
p = mp
SendMessage_(GadgetID(REGadget), #EM_SETSEL, p-1, p-1+Len("$lnstart"))
SendMessage_(GadgetID(REGadget), #WM_CLEAR, 0, 0) ; Erases our start flag (but keep its position)
p2 = FindInRichEdit(GadgetID(REGadget),"$lnend",p+1)
If p2
SendMessage_(GadgetID(REGadget), #EM_SETSEL, p2-1, p2-1+Len("$lnend"))
SendMessage_(GadgetID(REGadget), #WM_CLEAR, 0, 0); Erases our end flag (but keep its position)
;
SendMessage_(GadgetID(REGadget), #EM_SETSEL, p-1, p2-1)
SendMessage_(GadgetID(REGadget), #EM_SETCHARFORMAT, #SCF_SELECTION, cf1) ; Gives #CFE_LINK attribute to the link
EndIf
EndIf
Until p = 0
SendMessage_(GadgetID(REGadget), #EM_SETSEL, 1, 1)
If ReadOnlyGadget
SendMessage_(GadgetID(REGadget), #EM_SETREADONLY, #True, 0)
EndIf
EndProcedure
MainWindow = OpenWindow(#PB_Any, 0, 0, 500, 200, "Active Hyperlinks", #PB_Window_SystemMenu|#PB_Window_ScreenCentered)
ActiveLinksEditorGadget = EditorGadget(#PB_Any, 0, 0, WindowWidth(MainWindow), WindowHeight(MainWindow), #PB_Editor_WordWrap)
SetWindowCallback(@WinCallback(),MainWindow)
; EXAMPLE OF RTF TEXT INCLUDING LINKS
tx$ = "{\rtf1 {\colortbl ;\red79\green129\blue189;\red0\green0\blue255;} {"
tx$ + "\pard\sa150\b\fs28 Uses RTF links in \cf1 PureBasic\cf0 !\b0\fs22\par "
tx$ + "This is an example of text formated in \i RTF\i0\par "
tx$ + "With an included RTF ''Friendly link'': {{\field{\*\fldinst{HYPERLINK "
tx$ + Chr(34)+"https://www.purebasic.com/"+Chr(34)+" }}{\fldrslt{PureBasic}}}}\par "
tx$ + "and a simple link: http://www.editions-humanis.com \par }"
tx$ + "\pard\fs20 Both of the links are active. \par }"
SetRichEditorText(ActiveLinksEditorGadget,Tx$)
Repeat
Select WaitWindowEvent()
Case #PB_Event_Gadget
Select EventGadget()
EndSelect
Case #PB_Event_CloseWindow
Break
EndSelect
ForEver
