Syslink control

[nico]

Ce control ne peut fonctionner que si vous avez WindowXP, oui autant dire que ce code ne servira jamais mais bon il existe.

Avant d'utiliser ce code, il faut impérativement activer les thèmes dans les Options et run en mode debug.

Code : Tout sélectionner

#CHR34=Chr(34)

a$="<a ID="+#CHR34+"idLaunchHelp"+#CHR34+">HelpCenter</a>," 
a$=a$+"<a ID="+#CHR34+"idHelpMenu+"+#CHR34+">Help Menu</a>,"
a$=a$+"<a HREF="+#CHR34+"http://www.help.com"+#CHR34+"> Website </a>"

Debug a$

; Structure INITCOMMONCONTROLSEX 
  ; dwSize.l 
  ; dwICC.l 
; EndStructure 
; 
; icex.INITCOMMONCONTROLSEX 
; #ICC_LINK_CLASS=$8000 
; icex\dwSize = SizeOf(INITCOMMONCONTROLSEX) 
; icex\dwICC  = #ICC_LINK_CLASS
; InitCommonControlsEx_(@icex)
; CoInitialize_(0)

#MAX_LINKID_TEXT=48
#L_MAX_URL_LENGTH=2083

Structure LITEM
  mask.l
  iLink.l
  state.l
  stateMask.l
  szID.w[#MAX_LINKID_TEXT]
  szUrl.w[#L_MAX_URL_LENGTH]
EndStructure 

Structure NMLINK 
  hdr.NMHDR
  item.LITEM 
EndStructure 

Procedure.s Uni2Ansi(*Unicode.l) 
  size.l = WideCharToMultiByte_(#CP_ACP, 0, *Unicode, -1, #Null, #Null, #Null, #Null) 
  ansi.s=Space(size) 
  WideCharToMultiByte_(#CP_ACP, 0, *Unicode, -1, @ansi, size, #Null, #Null) 
  ProcedureReturn ansi  
EndProcedure
   
Procedure WindowCallback(Hwnd,msg,wParam,lParam) 
  result = #PB_ProcessPureBasicEvents
  Select msg 
    Case #WM_NOTIFY
       *nmhdr.NMHDR=lParam
       Select *nmhdr\code
        Case #NM_CLICK
          *LINK.NMLINK = lParam

          *pointeur=AllocateMemory(100)
          CopyMemory(@*LINK\item\szID[0],*pointeur,100)
          chaine.s=Uni2Ansi(*pointeur)

          If chaine="idLaunchHelp" 
            Debug "idLaunchHelp"
          ElseIf chaine="idHelpMenu+"
            Debug "idHelpMenu+" 
          EndIf
          
          CopyMemory(@*LINK\item\szUrl[0],*pointeur,100)
          chaine.s=Uni2Ansi(*pointeur)
          If chaine="http://www.help.com" 
            Debug "http://www.help.com" 
          EndIf
          
          FreeMemory(*pointeur)
          
      EndSelect
  EndSelect
  ProcedureReturn result 
EndProcedure     
    
If OpenWindow(0, 100, 200, 400, 200, #PB_Window_SystemMenu | #PB_Window_MinimizeGadget | #PB_Window_MaximizeGadget, "PureBasic Window")
Hsyslink=CreateWindowEx_(0, "SysLink", a$, #WS_CHILD | #WS_TABSTOP|#WS_VISIBLE, 10, 10, 200, 40, WindowID(0), 2, 0, 0) 
Debug Hsyslink  
SetWindowCallback(@WindowCallback()) 
  
  Repeat
    EventID.l = WaitWindowEvent()
    If EventID = #PB_Event_CloseWindow  
      ;CoUninitialize_()
      Quit = 1
    EndIf
  Until Quit = 1
EndIf