You are not logged in. You can browse in the PowerBASIC Community, but you must click Login (top right) before you can post. If this is your first visit, check out the FAQ or Sign Up.
Announcement
Collapse
No announcement yet.
Rich Edit control with Hyperlink support - please test
Peter's original example used links as opposed to URLs which the later 'upgrades' used.
The docs indicate that the technique that he used (EMN_LINK) was introduced with RichEdit20.dll but it does seem to work ok with RichEdit32.dll - or at least the emulation of RichEdit Ver 1.0 that is available on my pc (Win7) and is probably the same for those built into windows from Win2k onwards..?
Here's a stripped down version of his code that works on my PC (Win7)..
Code:
#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
'------------------/
Last edited by Dave Biggs; 18 Aug 2011, 08:24 AM.
Reason: Modify URL label display
Ok.
Any example to do simple words (not urls: http, ftp, mailto, etc) modify
cursor to "hand" and detect clic to event generate ?
Something like: Clic here to see ...
Case %WM_Notify
If CB.NmID = %ID_RichEdit AND CB.Nmcode = %EN_Link Then
RichEditHyperLink(hDlg, CB.lParam)
End If
what you posted, asking about, was this:
Code:
CASE %WM_Notify
IF CBCTL = %ID_RichEdit AND CBCTLMSG = %EN_Link THEN
RichEditHyperLink(hDlg, CBLPARAM)
END IF
My code was compiled in PBWin9. I don't have v8, but I think the CB.xx feature was new to v9. Help in v9 says:
These functions are only valid inside a Callback Function. The CB Callback functions replace CBMSG, CBHNDL, CBLPARAM, CBWPARAM, CBCTL, and CBCTLMSG . Note these functions may not be supported in future versions of PowerBASIC, so update your code to use the new syntax.
... reading more, I see also that WM_Notify wasn't available in v8.
Prior to version 9.0 of PowerBASIC for Windows, Control Callback Functions received only %WM_COMMAND messages. Beginning with PB 9.0, %WM_NOTIFY messages are sent as well. There are many situations where these added messages will prove to be very important. If your existing callback functions are written with complete error checking (ensuring that CB.MSG = %WM_COMMAND), this minor addition will cause no problems. It just presents additional information which can be acted upon, or just ignored. However, if callbacks were written without complete error checking, some ambiguity is possible. In this case, you should either update your Control Callback code, or suppress %WM_NOTIFY messages with a #MESSAGES COMMAND metastatement
Paulo,
This is what I use. The code demos how to turn the feature on and off.
Code:
'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
Originally posted by Edwin Knoppert: Newer versions of richedit supports hyperlinks.
Not in the form that the code posted attemts.
They do things like http://www.somewhere.org and mailto: , but not
"This is a link" and then link it to www.powerbasic.com
In short the text itself has to be a valid link.
seems to work fine on my Win2k, but not my NT4(sp4).
On the NT the "linktext" does not get colored/underlined, but
it flickers when the mouse is moved over it. The caption on
the menu-item is not updated when mouse is moved over a "linktext"
Both the URL and mailto functionality seems to be ok on both my platforms.
-p
Hi Per
Thanks a lot. It's those kind of things I want to fix.
I know why it flickers, and I think I know how to fix the underline/color issue.
I'll look into the missing mouseover text update.
seems to work fine on my Win2k, but not my NT4(sp4).
On the NT the "linktext" does not get colored/underlined, but
it flickers when the mouse is moved over it. The caption on
the menu-item is not updated when mouse is moved over a "linktext"
Both the URL and mailto functionality seems to be ok on both my platforms.
We process personal data about users of our site, through the use of cookies and other technologies, to deliver our services, and to analyze site activity. For additional details, refer to our Privacy Policy.
By clicking "I AGREE" below, you agree to our Privacy Policy and our personal data processing and cookie practices as described therein. You also acknowledge that this forum may be hosted outside your country and you consent to the collection, storage, and processing of your data in the country where this forum is hosted.
Leave a comment: