Level Extreme platform
Subscription
Corporate profile
Products & Services
Support
Legal
Français
Hyperlink Textbox
Message
From
11/11/2003 10:50:40
 
 
To
11/11/2003 08:29:49
General information
Forum:
Visual FoxPro
Category:
COM/DCOM and OLE Automation
Miscellaneous
Thread ID:
00848655
Message ID:
00848722
Views:
25
This message has been marked as the solution to the initial question of the thread.
Hi, Claudio-

>V.F.P.6. S.P.5.
>
>How could I create (in a textbox or similar) an e-mail hyperlink inside a form object..

There are hyperlink classes in the Component Gallery under the Tools menu. Look under Foundation Classes | Internet.

(Edited original post)

I noticed after sending you want an email link. I copied, then modified the foundation class _Hyperlinkbase because it didn't work well for mail. Here's my changes:
**************************************************
*-- Class:        _hyperlinkbase 
*-- ParentClass:  _hyperlink 
*-- BaseClass:    hyperlink
*-- Time Stamp:   04/05/03 10:44:14 PM
*-- This class provides the functionality of an OLE Hyperlink and launches a Web Browser by executing the Follow method..
*
DEFINE CLASS _hyperlinkbase AS _hyperlink


	Height = 27
	Width = 25
	*-- URL of the current document location.
	clocationurl = ""
	*-- Object reference to instance of Internet Explorer linked.
	oie = .NULL.
	*-- A character string expression representing the document or URL to jump to.
	ctarget = ""
	*-- A character string expression specifying the location within the URL specified in cTarget to jump to. If cLocation is not specified, the default document will be jumped to.
	clocation = ""
	*-- A character string expression specifying the frame within the URL specified in cTarget to jump to. If cFrameName is not specified, the default frame will be jumped to.
	cframe = ""
	*-- Class name used to create link for oIE.
	cieclass = "InternetExplorer.Application"
	cshellexecuteclass = "_ShellExecute"
	cshellexecuteclasslibrary = "_Environ.vcx"
	Name = "_hyperlinkbase"

	*-- Specifies if navigating to a URL will create a new window (.T.) or navigate in the current Internet Explorer link.
	lnewwindow = .F.


	PROTECTED PROCEDURE clocationurl_access
		IF TYPE("this.oIE.LocationURL")=="C"
			RETURN this.oIE.LocationURL
		ENDIF
		RETURN this.cLocationURL
	ENDPROC


	PROTECTED PROCEDURE clocationurl_assign
		LPARAMETERS m.vNewVal

		this.cTarget=m.vNewVal
		this.NavigateTo
	ENDPROC


	*-- Executes a hyperlink jump to the specified cTarget URL.
	PROCEDURE follow
		RETURN this.NavigateTo()
	ENDPROC


	*-- Returns a valid URL from the specified URL.
	PROCEDURE validurl
		LPARAMETERS tcURL
		*!* 04/05/03 17:31:43 nf 2: added lcScheme
		*!*
		LOCAL lcURL, lcScheme

		IF EMPTY(tcURL)
			RETURN ""
		ENDIF
		lcURL=ALLTRIM(tcURL)

		*!* 04/05/03 17:31:53 nf 1: Added lcScheme. Check for valid schemes as per RFC 1738
		*!* (http://www.w3.org/Addressing/rfc1738.txt)
		*!* http://www.iana.org/assignments/uri-schemes
		lcScheme = LOWER(SUBSTR(lcURL,1,AT(":",lcURL)))
		*!* Examples of legitimate schemes:
		*!* INLIST(lcScheme,"","mailto:","file:","http:","https:","ftp:","news:","nntp:")

		*!* Don't assume http: as the original code did. New schemes can be added to the
		*!* URL specification
		*!* IF NOT LOWER(LEFT(lcURL,5))=="http:" AND NOT LOWER(LEFT(lcURL,5))=="file:" AND ;
		*!*	NOT LOWER(LEFT(lcURL,4))=="ftp." AND (LOWER(LEFT(lcURL,4))=="www." OR ;
		*!*	INLIST(LOWER(RIGHT(lcURL,4)),".com",".gov",".net") OR ;
		*!*	(NOT SUBSTR(lcURL,2,1)==":" AND NOT LEFT(lcURL,2)=="\\"))
		*!* 	lcURL="http://"+lcURL
		*!* ENDIF

		*!* 04/05/03 17:31:06 nf 1: It should be safe to just strtran any scheme this way
		*!* IF SUBSTR(PADR(lcURL,5),5,1)==":"
		lcURL=STRTRAN(STRTRAN(lcURL,"\","/"),"///","//")
		*!*	ELSE
		*!*		IF NOT LOWER(LEFT(lcURL,4))=="ftp."
		*!*			lcURL="file://"+STRTRAN(STRTRAN(STRTRAN(lcURL,"\","/"),"///","//"),"//","/")
		*!*		ENDIF
		*!*	ENDIF
		RETURN lcURL
	ENDPROC


	PROCEDURE getdefaultbrowser
		#DEFINE HKEY_CLASSES_ROOT		-2147483648
		#DEFINE	HTTP_PATH				"HTTP\shell\open\ddeexec\Application"
		#DEFINE ERROR_SUCCESS			0
		#DEFINE REG_SZ 					1

		LOCAL nHKey,cSubKey,nResult,lpszValueName,dwReserved
		LOCAL lpdwType,lpbData,lpcbData,lnErrCode,lnGetKey

		DECLARE Integer RegOpenKey IN Win32API ;
			Integer nHKey, String @cSubKey, Integer @nResult
		DECLARE Integer RegQueryValueEx IN Win32API ;
			Integer nHKey, String lpszValueName, Integer dwReserved,;
			Integer @lpdwType, String @lpbData, Integer @lpcbData
		DECLARE Integer RegCloseKey IN Win32API ;
			Integer nHKey
		lnGetKey=0
		lnErrCode=RegOpenKey(HKEY_CLASSES_ROOT,HTTP_PATH,@lnGetKey)
		IF lnErrCode#ERROR_SUCCESS
			RETURN ""
		ENDIF
		lpdwType=0
		lpbData=SPACE(256)
		lpcbData=LEN(lpbData)
		lnErrCode=RegQueryValueEx(lnGetKey,"",0,@lpdwType,@lpbData,@lpcbData)
		IF lnErrCode#ERROR_SUCCESS OR lpdwType#REG_SZ
			RegCloseKey(nGetKey)
			RETURN ""
		ENDIF
		RegCloseKey(lnGetKey)
		RETURN ALLTRIM(LEFT(lpbData,lpcbData-1))
	ENDPROC


	PROCEDURE GoForward
		IF TYPE("this.oIE.LocationURL")=="C"
			NODEFAULT
			this.oIE.GoForward
			RETURN
		ENDIF
	ENDPROC


	PROCEDURE GoBack
		IF TYPE("this.oIE.LocationURL")=="C"
			NODEFAULT
			this.oIE.GoBack
			RETURN
		ENDIF
	ENDPROC


	PROCEDURE NavigateTo
		LPARAMETERS cTarget, cLocation, cFrame
		LOCAL lcTarget,lcLocation,lcFrame,oShellExecute

		lcTarget=ALLTRIM(IIF(EMPTY(cTarget),THIS.cTarget,cTarget))
		lcLocation=ALLTRIM(IIF(EMPTY(cLocation),THIS.cLocation,cLocation))
		lcFrame=ALLTRIM(IIF(EMPTY(cFrame),THIS.cFrame,cFrame))
		NODEFAULT
		IF EMPTY(lcTarget)
			RETURN .F.
		ENDIF
		*!* 04/05/03 19:02:19 nf 7: I don't see why we're going through all of this instead
		*!* of simply using ShellExecute. Unfortunately, Navigate2 for the mailto scheme tries to
		*!* open a browser instance, which isn't appropriate in this case.
		*!*
		*!* IF (this.lNewWindow OR TYPE("this.oIE.LocationURL")#"C") AND LOWER(this.GetDefaultBrowser())=="iexplore"
		*!* 	this.oIE=CREATEOBJECT(this.cIEClass)
		*!* ENDIF
		*!* IF TYPE("this.oIE.LocationURL")#"C"
		* THIS.SetObjectRef("oShellExecute",THIS.cShellExecuteClass,THIS.cShellExecuteClassLibrary)
		*IF VARTYPE(THIS.oShellExecute)=="O"
		*!* 04/05/03 19:04:34 nf 2: Just use ShellExcecute Open
		* THIS.oShellExecute.ShellExecute(lcTarget)
		*RETURN
		*ENDIF
		*RETURN DODEFAULT(lcTarget,lcLocation,lcFrame)
		*!* 04/05/03 19:02:19 nf 6:
		*!* ENDIF
		*!* IF EMPTY(THIS.oIE.LocationURL)
		*!* 	lcFrame=""
		*!* ENDIF
		*!* THIS.oIE.Navigate2(lcTarget,0,lcFrame)
		*!* THIS.oIE.VISIBLE=.T.

		DECLARE INTEGER ShellExecute IN shell32.DLL ;
			INTEGER hndWin, STRING cAction, STRING cFileName, ;
			STRING cParams, STRING cDir, INTEGER nShowWin

		ShellExecute(0,"open",lcTarget,"","",1)
	ENDPROC


	PROCEDURE Error
		LPARAMETERS nError, cMethod, nLine

		IF nError=1733 AND LOWER(cMethod)=="navigateto"
			RETURN
		ENDIF
		RETURN DODEFAULT(nError,cMethod,nLine)
	ENDPROC


ENDDEFINE
*
*-- EndDefine: _hyperlinkbase
**************************************************
Previous
Next
Reply
Map
View

Click here to load this message in the networking platform