Date: 02-16-2022
Return to Index
created by gbSnippets
'Compilable Example: (Jose Includes)
#Compile Exe
#Dim All
%Unicode=1
#Include "win32api.inc"
#Include "RichEdit.inc"
#Resource Manifest, 1, "xptheme.xml"
Global hDlg As Dword, hRichEdit As Dword, REText$
%IDC_RichEdit = 500
Function PBMain() As Long
Dialog Default Font "Tahoma", 24, 1
Dialog New Pixels, 0, "Link Test",300,300,800,200, %WS_OverlappedWindow To hDlg
RichEditCreate
Dialog Show Modal hDlg Call DlgProc
End Function
CallBack Function DlgProc() As Long
Select Case Cb.Msg
Case %WM_InitDialog : SendMessage hRichEdit, %EM_SetSel, 0, 0
Case %WM_Notify
If Cb.NmId = %IDC_RichEdit And Cb.NmCode = %EN_Link Then OpenLink(Cb.LParam)
End Select
End Function
Sub RichEditCreate
REText$ = "Open this: http://www.garybeene.com" '24 chars in URL
LoadLibrary("msftedit.dll")
Control Add "RichEdit50W", hDlg, %IDC_RichEdit, REText$,0,0,800,200, _
%WS_Child Or %WS_ClipSiblings Or %WS_Visible Or %ES_MultiLine Or %WS_VScroll _
Or %ES_AutoVScroll Or %ES_WantReturn Or %ES_NoHideSel Or %WS_TabStop, %WS_Ex_ClientEdge
Control Handle hDlg, %IDC_RichEdit To hRichEdit
SendMessage hRichEdit, %EM_SETEVENTMASK, 0, %ENM_SELCHANGE Or %ENM_CHANGE Or %ENM_LINK
Control Send hDlg, %IDC_RICHEDIT, %EM_AUTOURLDETECT, %True, 0
End Sub
Function OpenLink(ByVal lpLink As Dword) As Long
Local enlinkPtr As ENLINK Ptr, linkText As String, iReturn As Long
enlinkPtr = lpLink
If @enLinkPtr.Msg = %WM_LButtonUp Then
LinkText = Mid$(REText$,@enLinkPtr.chrg.cpMin+1 To @enLinkPtr.chrg.cpMax)
LinkText = Remove$(LinkText, Any $Cr+$Lf+$Spc)
iReturn = ShellExecute(hDlg, "Open", (LinkText), $Nul, $Nul, %SW_ShowNormal)
End If
End Function
http://www.garybeene.com/sw/gbsnippets.htm