#COMPILE EXE
#DIM ALL
#INCLUDE "WIN32API.INC"
#INCLUDE "COMMCTRL.INC"
#INCLUDE "RICHEDIT.INC"
%ID_RICHEDIT = 500
%ID_URLLABEL = 502
DECLARE CALLBACK FUNCTION DlgCallback()
'------------------/
FUNCTION PBMAIN
LOCAL hDlg AS DWORD
LoadLibrary("RICHED32.DLL") ' RichEd Ver 1.0 (or emulation)
CALL InitCommonControls
DIALOG NEW 0, "DDT RichEdit Hyperlink demo",,, 320, 140, %WS_CAPTION OR %WS_SYSMENU TO hDlg
CONTROL ADD LABEL, hDlg, %ID_URLLABEL, " ", 10, 5, 100, 15
CONTROL ADD "RichEdit", hDlg, %ID_RICHEDIT, "This is a HyperLink for testing"+$CRLF, 10, 20, 300, 110, _
%WS_CHILD OR %WS_VISIBLE OR %ES_MULTILINE OR %ES_WANTRETURN OR %ES_NOHIDESEL, %WS_EX_CLIENTEDGE
' Enable EN_LINK notifications
CONTROL SEND hDlg, %ID_RICHEDIT, %EM_SETEVENTMASK, 0, %ENM_LINK ' Supposed to be RE Ver 2.0 and later ie not < win2K ??
' - included in later OS Ver 1.0 emulations anyway?
CONTROL SET FOCUS hDlg, %ID_RICHEDIT
DIALOG SHOW MODAL hDlg CALL DlgCallback
END FUNCTION
'------------------/
CALLBACK FUNCTION DlgCallback()
LOCAL enlnk AS ENLINK
LOCAL enlinkPtr AS ENLINK PTR
LOCAL hHandCur AS DWORD
SELECT CASE CBMSG
CASE %WM_INITDIALOG
LOCAL cf AS CHARFORMAT2
' Select text and apply CFM_LINK effects
CONTROL SEND CBHNDL, %ID_RICHEDIT, %EM_SETSEL, 10, 19 ' select chars for link effects
cf.cbSize = LEN( cf ) ' Length of charformat structure
cf.dwMask = %CFM_LINK ' Set mask to link
cf.dwEffects = %CFE_LINK
CONTROL SEND CBHNDL, %ID_RICHEDIT, %EM_SETCHARFORMAT, %SCF_SELECTION, VARPTR( cf ) ' apply effects
CONTROL SEND CBHNDL, %ID_RICHEDIT, %EM_SETSEL, -1, -1 ' finished with char selection
CASE %WM_NOTIFY
enlinkPtr = CBLPARAM ' Pointer to the ENLINK structure
enlnk = @enlinkPtr
IF enlnk.nmhdr.code = %EN_LINK AND enlnk.nmhdr.idFrom = %ID_RICHEDIT THEN
SELECT CASE enLnk.msg
CASE %WM_LBUTTONDOWN
CALL ShellExecute(%NULL,"open","[URL="http://www.powerbasic.com","","",%SW_SHOW"]www.powerbasic.com","","",%SW_SHOW[/URL])
CASE %WM_MOUSEMOVE
CONTROL SET TEXT CBHNDL, %ID_URLLABEL, "[URL="http://www.powerbasic.com"]www.powerbasic.com[/URL]"
hHandCur = GetCursor()
END SELECT
END IF
CASE %WM_SETCURSOR
IF GetCursor <> hHandCur THEN
CONTROL SET TEXT CBHNDL, %ID_URLLABEL, " "
END IF
END SELECT
END FUNCTION
'------------------/
CASE %WM_Notify
IF CBCTL = %ID_RichEdit AND CBCTLMSG = %EN_Link THEN
RichEditHyperLink(hDlg, CBLPARAM)
END IF
Case %WM_Notify
If CB.NmID = %ID_RichEdit AND CB.Nmcode = %EN_Link Then
RichEditHyperLink(hDlg, CB.lParam)
End If
CASE %WM_Notify
IF CBCTL = %ID_RichEdit AND CBCTLMSG = %EN_Link THEN
RichEditHyperLink(hDlg, CBLPARAM)
END IF
'Compilable Example:
'In this example, a button is used to toggle the display of active URLs.
#Compile Exe
#Dim All
#Include "Win32API.inc"
#Include "RichEdit.inc"
#Include "CommCtrl.inc"
Global hDlg As Dword, hRichEdit As Dword
%ID_RichEdit = 500 : %IDC_Button = 501
Function PBMain() As Long
Dialog New Pixels, 0, "URL Test",300,300,200,200, %WS_OverlappedWindow To hDlg
RichEditCreate
Control Add Button, hDlg, %IDC_Button, "Toggle URL Detect", 30,10,140,20
Dialog Show Modal hDlg Call DlgProc
End Function
CallBack Function DlgProc() As Long
Select Case CB.Msg
Case %WM_Command
If CB.Ctl = %IDC_Button AND CB.Ctlmsg = %BN_Clicked Then
Static EnableURL&
EnableURL& = EnableURL& XOR 1
If EnableURL& Then
Control Send hDlg, %ID_RICHEDIT, %EM_AUTOURLDETECT, %True, 0
Control Set Text hDlg, %ID_RichEdit, "URL detect is on!" + $CrLf + $CrLf + " http://www.garybeene.com/"
Else
Control Send hDlg, %ID_RICHEDIT, %EM_AUTOURLDETECT, %False, 0
Control Set Text hDlg, %ID_RichEdit, "URL detect is off!" + $CrLf + $CrLf + " http://www.garybeene.com/"
End If
End If
Case %WM_Notify
If CB.NmID = %ID_RichEdit AND CB.Nmcode = %EN_Link Then
RichEditHyperLink(hDlg, CB.lParam)
End If
End Select
End Function
Sub RichEditCreate
LoadLibrary("riched32.dll")
Call InitCommonControls
Control Add "RichEdit", hDlg, %ID_RichEdit, "", 20, 50, 160, 140, _
%WS_Child Or %WS_Visible Or %ES_MultiLine Or %WS_VScroll Or %ES_AutoHScroll _
Or %WS_HScroll Or %ES_AutoVScroll Or %ES_WantReturn Or %ES_NoHideSel Or %WS_TabStop, _
%WS_Ex_ClientEdge
Control Handle hDlg, %ID_RichEdit To hRichEdit
SendMessage hRichEdit, %EM_SETEVENTMASK, 0, %ENM_SELCHANGE Or %ENM_CHANGE Or %ENM_LINK
End Sub
Function RichEditHyperLink(ByVal hWnd As Dword, ByVal lpLink As Dword) As Long
Local enlinkPtr As ENLINK Ptr, tr As TEXTRANGE, linkText As String
enlinkPtr = lpLink
tr.chrg = @enLinkPtr.chrg
linkText = Space$(tr.chrg.cpMax - tr.chrg.cpMin + 2)
tr.lpstrText = StrPTR(linkText)
Control Send hWnd, %ID_RICHEDIT, %EM_GETTEXTRANGE, 0, VarPTR(tr)
Select Case @enLinkPtr.Msg
Case %WM_LButtonDown
ShellExecute(%NULL, "open", ByCopy linkText, "", "", %SW_Show)
Function = %True ' Signal that we processed this
Case %WM_MouseMove
End Select
End Function
'gbs_00225
Leave a comment: