New XP Control: SysLink

The SysLink control is part of VO 2.7.  The implementation in VO 2.7 is slightly different to the one here, in particular the way the text is displayed and the linking is handled.
Way back in 1998 I wrote a class called FixedTextHyperlink. This class would display text as a hyperlink which when clicked on would cause an action to occur, such as opening of a web browser. The source for FixedTextHyperlink is available in the VO Forum Library that can be download from this site, or from http://www.knowvo.com.

Now with Windows XP there is a new control called SysLink and it provides similar functionality to FixedTextHyperLink. This article describes how to use SysLink from VO applications.

Because SysLink is only available with Windows XP, in particular version 6 of the common controls, care needs to be taken. The aim of the technique presented here is to ensure that your application can still run on earlier versions of Windows, albeit without the full functionality of SysLink. The code to support SysLink has been designed to be consistent with the way VO handles other controls. In summary the steps we need to follow are:

  1. create a SysLink class
  2. write a supporting class WinDLLVersion to determine which version of the common controls is in use
  3. write ControlNotify methods for DialogWindow and DataWindow
  4. write a function to convert the UniCode information from SysLink to ANSI text
  5. create LinkClickEvent class
  6. write a LinkClick method for the Window class
  7. show how to create a SysLink object at runtime

Full details about the SysLink control can be seen at http://msdn.microsoft.com/library/en-us/shellcc/platform/commctls/syslink/syslinkovrvw.asp.

SysLink Class

Note that the SysLink class will only work with at least version 6 of the Windows common controls. That means you need to have enabled the Windows XP styles, as described in my article Using XP Visual Styles with VO. If you do not have the Visual Styles enabled Windows XP will actually use version 5 of the common controls and you will not get the SysLink functionality.

CLASS SysLink INHERIT TextControl
METHOD Init(oOwner, xId, oPoint, oDimension, cText, lDataAware, kStyle) CLASS SysLink
    LOCAL cClass AS STRING
    
    // If the SysLink control is not supported we
    // make it into a plain text control by giving a class of Static
    IF WinDLLVersion{"COMCTL32"}:major >= 6
        cClass := "SysLink"
        IF ! IsNil(cText)
            cWindowName  := cText
        ENDIF
    
    ELSE
        cClass := "Static"
        IF ! IsNil(cText)
            cWindowName  := SELF:StripLink(cText)
        ENDIF

    ENDIF
        
    SUPER:Init(oOwner, xId, oPoint, oDimension, cClass, kStyle, lDataAware)
METHOD StripLink(cText) CLASS SysLink
    LOCAL nPos AS DWORD
    LOCAL cNew AS STRING
    
    IF ( nPos := AtC("<a href=",cText) ) > 0 .or. ;
             ( nPos := AtC("<a id=",cText) ) > 0
        cNew := Left(cText,nPos-1)
        cText := SubStr(cText,nPos+8)
        IF ( nPos := AtC(">",cText) ) > 0
            cText := SubStr(cText,nPos+1)
        ENDIF
        IF ( nPos := AtC("</a>",cText) ) > 0
            cNew += Left(cText,nPos-1) + SubStr(cText,nPos+4)
        ENDIF
    ELSE
        cNew := cText
    ENDIF

    RETURN cNew
METHOD __SetText(cNew) CLASS SysLink
    // If the Windows version doesn't support the SysLink control
    // we change it to a plain TextControl
    IF ! Upper(SELF:cClassName) == "SYSLINK"    
        // Convert to plain text so that link information
        // doesn't appear
        cNew := SELF:StripLink(cNew)
    ENDIF

    RETURN SUPER:__SetText(cNew)
STRUCT _winLITEM ALIGN 1
    MEMBER mask AS DWORD
    MEMBER iLink AS INT
    MEMBER state AS DWORD
    MEMBER stateMask AS DWORD
    MEMBER DIM szID[MAX_LINKID_TEXT] AS WORD
    MEMBER DIM szUrl[L_MAX_URL_LENGTH] AS WORD
STRUCT _winNMLINK ALIGN 1
    MEMBER hdr IS _winNMHDR
    MEMBER item IS _winLITEM
DEFINE L_MAX_URL_LENGTH := 2083
DEFINE MAX_LINKID_TEXT := 48


WinDLLVersion 

CLASS WinDLLVersion
    INSTANCE DLLName AS STRING
    PROTECT MajorVersion AS DWORD
    PROTECT MinorVersion AS DWORD
    PROTECT Build AS DWORD
    PROTECT PlatformId AS DWORD
ACCESS Build CLASS WinDLLVersion
    RETURN SELF:Build

ASSIGN DLLName(cDLL) CLASS WinDLLVersion
    LOCAL hDLL AS PTR
    LOCAL hFunc AS PTR
    LOCAL pVersionInfo AS _WINDLLVERSIONINFO

    SELF:DLLName := cDLL

    IF ! (hDLL := GetModuleHandle(PSZ(cDLL))) == NULL_PTR
        IF ! (hFunc := GetProcAddress(hDLL,PSZ("DllGetVersion"))) == NULL_PTR
            pVersionInfo := MemAlloc(_sizeof(_winDLLVERSIONINFO))
            pVersionInfo.cbSize := _sizeof(_winDLLVERSIONINFO)
            IF PCALL(hFunc,pVersionInfo) == 0
                SELF:MajorVersion := pVersionInfo.dwMajorVersion
                SELF:MinorVersion := pVersionInfo.dwMinorVersion
                SELF:Build := pVersionInfo.dwBuildNumber
                SELF:PlatformId := pVersionInfo.dwPlatformId
            ENDIF
            MemFree(pVersionInfo)
        ENDIF
    ENDIF
    
METHOD init(cDLL) CLASS WinDLLVersion
    SELF:DLLName := cDLL
    
ACCESS IsWinNT() CLASS WinDLLVersion
    RETURN SELF:PlatformId == DLLVER_PLATFORM_NT

ACCESS Major CLASS WinDLLVersion
    RETURN SELF:MajorVersion

ACCESS Minor CLASS WinDLLVersion
    RETURN SELF:MinorVersion

ACCESS Platform CLASS WinDLLVersion
    RETURN SELF:PlatformId
STRUCTURE _winDLLVERSIONINFO
    MEMBER cbSize AS DWORD
    MEMBER dwMajorVersion AS DWORD
    MEMBER dwMinorVersion AS DWORD
    MEMBER dwBuildNumber AS DWORD
    MEMBER dwPlatformId AS DWORD

DEFINE DLLVER_PLATFORM_NT              := 0x00000002      // Windows NT

DEFINE DLLVER_PLATFORM_WINDOWS         := 0x00000001      // Windows 9x

ControlNotify for DialogWindow and DataWindow 

METHOD ControlNotify(oCNEvent) CLASS DataWindow
    LOCAL oTargetWnd AS OBJECT
    LOCAL lDone AS LOGIC

    IF (IsInstanceOf(SELF, #__FormDialogWindow) .and. IsInstanceOf(oParent, #__FormFrame))
        oTargetWnd := IVarGet(oParent, #DataWindow)
        oTargetWnd:EventReturnValue := 0
    ELSEIF (IsInstanceOf(SELF, #__FormFrame))
        oTargetWnd := IVarGet(SELF, #DataWindow)
        oTargetWnd:EventReturnValue := 0
    ELSE
        oTargetWnd := SELF
    ENDIF

    IF IsInstanceOf(oCNEvent:control,#SysLink)
        IF oCNEvent:NotifyCode == NM_RETURN .or. oCNEvent:NotifyCode == NM_CLICK
            IF IsMethod(oTargetWnd,#LinkClick)
                lDone := TRUE
                Send(oTargetWnd,#LinkClick,LinkClickEvent{oCNEvent})
            ENDIF
        ENDIF
    ENDIF    

    IF ! lDone
        SUPER:ControlNotify(oCNEvent)
    ENDIF

    RETURN NIL

METHOD ControlNotify(oCNEvent) CLASS DialogWindow
    LOCAL oTargetWnd AS OBJECT
    LOCAL lDone AS LOGIC

    oTargetWnd := SELF

    IF IsInstanceOf(oCNEvent:control,#SysLink)
        IF oCNEvent:NotifyCode == NM_RETURN .or. oCNEvent:NotifyCode == NM_CLICK
            IF IsMethod(oTargetWnd,#LinkClick)
                lDone := TRUE
                Send(oTargetWnd,#LinkClick,LinkClickEvent{oCNEvent})
            ENDIF
        ENDIF
    ENDIF    

    IF ! lDone
        SUPER:ControlNotify(oCNEvent)
    ENDIF

    RETURN NIL

Unicode to ANSI 

FUNCTION SmallUnicode2Ansi(pUnicode AS PTR) AS STRING
    LOCAL iNumAChars AS INT
    LOCAL pAnsiBuffer AS PTR
    LOCAL cAnsi AS STRING

    iNumAChars := 255 // SMALL_ANSI_BUFFER_SIZE

     pAnsiBuffer := MemAlloc( iNumAChars + 1 )
    MemClear(pAnsiBuffer, iNumAChars + 1 )
    WideCharToMultiByte(CP_ACP,0,pUnicode,-1,pAnsiBuffer,
;
                                                  iNumAChars, NULL_PTR, NULL_PTR )
    cAnsi := Psz2String(pAnsiBuffer)
    MemFree(pAnsiBuffer)

    RETURN cAnsi

LinkClickEvent Class

CLASS LinkClickEvent INHERIT ControlNotifyEvent
    PROTECT cId AS STRING
    PROTECT cLink AS STRING
    
METHOD init(oCNEvent) CLASS LinkClickEvent
    LOCAL pNMLink AS _winNMLINK

    SUPER:init(oCNEvent)

    pNMLink := PTR(_CAST,oCNEvent:lParam)
    SELF:cId := SmallUnicode2Ansi(PTR(_CAST,@pNMLink.item.szId))
    SELF:cLink := SmallUnicode2Ansi(PTR(_CAST,@pNMLink.item.szURL))

ACCESS hyperlink CLASS LinkClickEvent
    RETURN SELF:cLink
    
ACCESS id CLASS LinkClickEvent
    RETURN SELF:cId

LinkClick Method for Window

METHOD LinkClick(oLCEvent) CLASS Window
    IF ! Empty(oLCEvent:hyperlink)
        ShellExecute(SELF:handle(),PSZ("open"),
;
              
PSZ(oLCEvent:hyperlink),;
              
NULL,NULL,SW_SHOWNORMAL)
    ENDIF

Example SysLink Usage

METHOD PostInit() CLASS NewWindow
    LOCAL oSysLink AS OBJECT
    LOCAL s AS STRING

   
// For this example we need to check for oLCEvent:id in
   
// the window LinkClick event - nothing happens automatically

    s := '
This is a program link - <a id="idLaunchHelp">Help</a>'
    oSysLink := SysLink{SELF, -1, Point{10,5}, Dimension{300,20}, s}
    oSysLink:Show()        

   
// This example will by default cause the email program to
   
// open up

    s := '
Email: <a href="mailto:paul@piko.com.au">paul@piko.com.au</a>'
    oSysLink := SysLink{SELF, -1, Point{10,125}, Dimension{300,20}, s}
    oSysLink:Show()