Announcement

Collapse
No announcement yet.

RTF Code : Friendly URL and Wide Spacing

Collapse
X
 
  • Filter
  • Time
  • Show
Clear All
new posts

  • RTF Code : Friendly URL and Wide Spacing

    I have need of combining wide spacing, friendly URLs and unfriendly URLs in a RichEdit. It can be done with a little shuffling of the code Pierre has provided (thanks Pierre). I had to separate out the needed pieces of RTF, but the code below seems to work fine. Here's what I did:

    This is a really wide line, but it helped me see separate out the pieces visually.

    Code:
    'RtfText = "{\rtf1\ansi\deff0 "+"{\expndtw360\expnd72 "+"Stuff before "+"{\colortbl;\red0\green0\blue255;}"+ +"{\field{\*\fldinst{HYPERLINK "+$Dq+"http://www.garybeene.com"+$Dq +"}}{\fldrslt{\ul "+"Friendly"+"}}}"+" Stuff after"+"\expnd0\expndtw0 "+"}"
    '          +------------------+ +---------------------+ +-------------+ +----------------------------------+ +----------------------------------+ +------------------------+ +---------------------+ +--------+ +---+ +------------+ +-----------------+ +-+
    '              rtf  prefix            wide char             content            color of hyperlink                        pre-hyperlink                 hyperlink text           post-hyperlink          frText   close    content       post wide char    suffix
    In the code below I broke the long line above into pieces for variable assignment.

    Code:
             A = "{\rtf1\ansi\deff0 "                             'rtf prefix
             B = "{\expndtw360\expnd72 "                          'wide char
             C = "Stuff before \par http://www.google.com \par"   'misc content, including non-friendly links
             D = " More stuff \par"                               'misc content
             E = "{\colortbl;\red0\green0\blue255;}"              'colors for hyperlink
             F = "{\field{\*\fldinst{HYPERLINK "+$Dq              'pre-hyperlink
             G = "http://www.garybeene.com"                       'hidden hyperlink
             H = $Dq + "}}{\fldrslt{\ul "+"Friendly"+"}}}"        'friendly hyperlink text
             I = "\par Stuff after"                               'misc content
             J = "\expnd0\expndtw0 "                              'close wide char
             K = "}"                                              'rtf suffix
    The one marked 'friendly hyperlink text probably needs to be split further. I'm just learning the needed RTF and will split up one I get smarter. I also have questions about some of the other pieces that I'll bring up tomorrow.

    Here a compilable version to play with (Win10). F1 lets you look at the RTF content as any time.
    Code:
    #Compile Exe
    #Dim All
    %Unicode=1
    #Include "win32api.inc"
    #Include "RichEdit.inc"
    Global hDlg As Dword, hRichEdit As Dword
    %IDC_RichEdit = 500
    
    %MultiLineREStyle = %WS_Child Or %WS_ClipSiblings Or %WS_Visible Or %ES_MultiLine Or %ES_AutoVScroll Or %WS_VScroll Or %ES_AutoHScroll Or %ES_WantReturn Or %ES_NoHideSel Or %WS_TabStop Or %ES_SaveSel
    
    Function PBMain() As Long
       Dialog Default Font "Tahoma", 18, 1
       Dialog New Pixels, 0, "Test Code",,,800,150, %WS_OverlappedWindow To hDlg
       LoadLibrary("msftedit.dll")
       Control Add "RichEdit50W", hDlg, %IDC_RichEdit, "",0,0,600,150, %MultilineREStyle, %WS_Ex_ClientEdge
       Control Handle hDlg, %IDC_RichEdit To hRichEdit
       SendMessage hRichEdit, %EM_SetEventMask, 0, %ENM_SelChange Or %ENM_Link
       SendMessage hRichEdit, %EM_AUTOURLDETECT, %True, 0  'ShowActiveLinks, 0
       SendMessage(hRichEdit, %EM_SETTARGETDEVICE, 0, 0) 'Enable wordwrap
       Dialog Show Modal hDlg Call DlgProc
    End Function
    
    CallBack Function DlgProc() As Long
       Local RTFText As String, wWidth,hHeight As Long
       Local a,b,c,d,e,f,g,h,i,j,k As String
       Select Case Cb.Msg
          Case %WM_InitDialog
             RtfText = "{\rtf1\ansi\deff0 "+"{\expndtw360\expnd72 "+"Stuff before http://www.google.com \par"+"{\colortbl;\red0\green0\blue255;}" _
                       +"{\field{\*\fldinst{HYPERLINK "+$Dq+"http://www.garybeene.com"+$Dq _
                       +"}}{\fldrslt{\ul "+"Friendly"+"}}}"+"\par Stuff after"+"\expnd0\expndtw0 "+"}"
    
    'RtfText = "{\rtf1\ansi\deff0 "+"{\expndtw360\expnd72 "+"Stuff before "+"{\colortbl;\red0\green0\blue255;}"+ +"{\field{\*\fldinst{HYPERLINK "+$Dq+"http://www.garybeene.com"+$Dq +"}}{\fldrslt{\ul "+"Friendly"+"}}}"+" Stuff after"+"\expnd0\expndtw0 "+"}"
    '          +------------------+ +---------------------+ +-------------+ +----------------------------------+ +----------------------------------+ +------------------------+ +---------------------+ +--------+ +---+ +------------+ +-----------------+ +-+
    '              rtf  prefix            wide char             content            color of hyperlink                        pre-hyperlink                 hyperlink text           post-hyperlink          frText   close    content       post wide char    suffix
    
             A = "{\rtf1\ansi\deff0 "                             'rtf prefix
             B = "{\expndtw360\expnd72 "                          'wide char
             C = "Stuff before \par http://www.google.com \par"   'misc content, including non-friendly links
             D = " More stuff \par"                               'misc content
             E = "{\colortbl;\red0\green0\blue255;}"              'colors for hyperlink
             F = "{\field{\*\fldinst{HYPERLINK "+$Dq              'pre-hyperlink
             G = "http://www.garybeene.com"                       'hidden hyperlink
             H = $Dq + "}}{\fldrslt{\ul "+"Friendly"+"}}}"        'friendly hyperlink
             I = "\par Stuff after"                               'misc content
             J = "\expnd0\expndtw0 "                              'close wide char
             K = "}"                                              'rtf suffix
    
    
             RtfText = A + B + C + D + E + F + G + H + I + J
             RESetRTF hRichedit,RTFText
    
          Case %WM_Size
             Dialog Get Size hDlg To wWidth,hHeight
             Control Set Size hdlg, %IDC_RichEdit, wWidth,hHeight
    
          Case %WM_Help
             ? REGetRtf(hRichEdit)
    
          Case %WM_Notify
             Select Case Cb.NmId
                Case %IDC_Richedit
                   Select Case Cb.NmCode
                      Case %EN_Link
                         REOpenLink(Cb.LParam)
                   End Select
             End Select
       End Select
    End Function
    
    '                     + $CrLf + "http://www.garybeene.com" _
    '                     + $CrLf + "next is hidden url" _
    '                     + $CrLf + $RtfA + "http://www.google.com" + $RtfB + "FriendlyURL" + $RtfC _
    
    Function REOpenLink(ByVal enLinkPtr As ENLINK Pointer) As Long
       Local temp$, Extension$, EZPart$
       If @enLinkPtr.Msg = %WM_LButtonUp Then
          Control Get Text hDlg, %IDC_RichEdit To temp$
          Replace $CrLf With $Lf In temp$
          temp$ = Mid$(temp$,@enLinkPtr.chrg.cpMin + 1 To @enLinkPtr.chrg.cpMax)
          ShellExecute(hDlg, "Open", (temp$), $Nul, $Nul, %SW_ShowNormal)
       End If
    End Function
    
    Function RESetRTF_Callback(ByVal pDwordArray As Dword Pointer, ByVal pRichEditBuffer As Dword, ByVal cb As Long, ByRef pcb As Long) As Long
       pcb = Min(@pDwordArray[1], cb)
       If pcb > 0 Then
          CopyMemory(pRichEditBuffer, @pDwordArray[0], pcb)
          @pDwordArray[0] = @pDwordArray[0] + pcb
          @pDwordArray[1] = @pDwordArray[1] - pcb
       End If
    End Function
    
    Function RESetRTF(ByVal hWin As Dword, ByVal RtfText As String) As Long   'Send rtf String to a RichEdit
       Local EditStreamInfo As EDITSTREAM
       Dim dwArray(0 To 1)  As Dword
       dwArray(0)                 = StrPtr(RtfText)
       dwArray(1)                 = Len(RtfText)
       EditStreamInfo.dwCookie    = VarPtr(dwArray(0))
       EditStreamInfo.pfnCallback = CodePtr(RESetRTF_Callback)
       Function = SendMessage(hWin, %EM_STREAMIN, %SF_RTF Or %SFF_PLAINRTF, VarPtr(EditStreamInfo))
    End Function
    
    Function REGetRTF( ByVal hWndRTF As Long ) As String
        Local ES As EDITSTREAM
        Local sBuffer As String
        es.dwCookie = VarPtr( sBuffer )
        es.pfnCallback = CodePtr( REGetRTFCallback )
        SendMessage( hWndRTF, %EM_STREAMOUT, %SF_RTF, VarPtr( es ) )
        Function = sBuffer
    End Function
    
    Function REGetRTFCallback( ByVal dwCookie As Dword, ByVal pbbuff As Byte Ptr, ByVal CB As Long, ByRef pcb As Long ) As Long
        Local psBuffer As String Ptr
        psBuffer = dwCookie
        If CB < 1 Then Exit Function
        @psBuffer = @psBuffer & Peek$( pbbuff, CB )
        pcb = CB
    End Function
Working...
X