It is currently Sat Sep 26, 2020 11:53 am

All times are UTC + 1 hour




Post new topic Reply to topic  [ 3 posts ] 
Author Message
 Post subject: EditorGadget with activ RTF hyperlinks
PostPosted: Mon Jan 13, 2020 8:32 pm 
Offline
User
User
User avatar

Joined: Tue Jan 07, 2020 7:27 pm
Posts: 13
Here is a example of an EditorGadget used as a RichEdit box, able to be set with an RTF text including hyperlinks.
And the links work :)

Code:
; 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


Last edited by Zapman on Sat Feb 15, 2020 8:47 pm, edited 3 times in total.

Top
 Profile  
Reply with quote  
 Post subject: Re: EditorGadget with activ RTF hyperlinks
PostPosted: Wed Jan 15, 2020 3:27 am 
Offline
Always Here
Always Here

Joined: Fri Oct 23, 2009 2:33 am
Posts: 6258
Location: Wales, UK
Nice work Zapman, thanks for sharing!

_________________
IdeasVacuum
If it sounds simple, you have not grasped the complexity.


Top
 Profile  
Reply with quote  
 Post subject: Re: EditorGadget with activ RTF hyperlinks
PostPosted: Sat Feb 01, 2020 12:39 pm 
Offline
User
User
User avatar

Joined: Tue Jan 07, 2020 7:27 pm
Posts: 13
Code has been edited.
Now, it's possible to use it for more than one EditorGadget with links in the same program.


Top
 Profile  
Reply with quote  
Display posts from previous:  Sort by  
Post new topic Reply to topic  [ 3 posts ] 

All times are UTC + 1 hour


Who is online

Users browsing this forum: Demivec and 7 guests


You cannot post new topics in this forum
You cannot reply to topics in this forum
You cannot edit your posts in this forum
You cannot delete your posts in this forum

Search for:
Jump to:  

 


Powered by phpBB © 2008 phpBB Group
subSilver+ theme by Canver Software, sponsor Sanal Modifiye