It is currently Mon Jan 27, 2020 10:34 am

All times are UTC + 1 hour




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

Joined: Tue Jan 07, 2020 7:27 pm
Posts: 4
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:
Enumeration
  #MainWindow=10
  #Editor
EndEnumeration
;
Procedure FindInRichEdit(REGadgetID.l,SearchString$,startPos.l=1,MATCHCASE.l=0,WHOLEWORD.l=0,UP.l=0)
  ; By Zapman
  If startPos = 0 : startPos = 1 : EndIf
  FindParam.findtext\chrg\cpMin = startPos-1
  FindParam.findtext\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)
  result = #PB_ProcessPureBasicEvents
  Select msg
    Case #WM_NOTIFY
      *pnmhdr.NMHDR = lParam
      If *pnmhdr\code = #EN_LINK
        *enl.ENLINK = 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
          txt.TEXTRANGE\chrg = *enl\chrg
          txt\lpstrText = AllocateMemory((*enl\chrg\cpMax-*enl\chrg\cpMin)*2 + 2)
          SendMessage_(GadgetID(#Editor), #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$)
  ;
  SendMessage_(GadgetID(#Editor), #EM_AUTOURLDETECT, 1, 0) ; to autodetect URLs even if they are in a non-RTF text.
  Mask = SendMessage_(GadgetID(#Editor), #EM_GETEVENTMASK, 0, 0)
  SendMessage_(GadgetID(#Editor), #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.CHARFORMAT2\cbSize = SizeOf(cf1)
  cf1\dwMask = #CFM_LINK | #CFM_PROTECTED
  cf1\dwEffects = #CFE_LINK | #CFE_PROTECTED
  cf2.CHARFORMAT2\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

OpenWindow(#MainWindow, 0, 0, 500, 200, "Activ Hyperlinks", #PB_Window_SystemMenu|#PB_Window_ScreenCentered)

EditorGadget(#Editor, 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 activ. \par }"
SetRichEditorText(#Editor,Tx$)

Repeat
  Select WaitWindowEvent()
    Case #PB_Event_Gadget
      Select EventGadget()

      EndSelect
    Case #PB_Event_CloseWindow
      Break
  EndSelect
ForEver


Last edited by Zapman on Wed Jan 15, 2020 11:21 am, edited 1 time 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: 5961
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  
Display posts from previous:  Sort by  
Post new topic Reply to topic  [ 2 posts ] 

All times are UTC + 1 hour


Who is online

Users browsing this forum: No registered users and 2 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