How can the HyperLinkGadget get the keyboard focus?

[Little John]

Hi all,

when running the code below, clicking at the HyperLinkGadget with the mouse works as expected, but that gadget doesn't get the keyboard focus – when pressing [Tab], it is skipped (tested with PB 6.11 LTS (x64) on Windows 11).
How must the code be changed, so that the HyperLinkGadget can receive the keyboard focus?

Code: Select all

; Windows only

EnableExplicit

Macro SetUIState (_hwnd_)
   SendMessage_(_hwnd_, #WM_UPDATEUISTATE, $30002, 0)
EndMacro

#winMain = 0

Enumeration
   #gadCheck
   #gadLink
   #gadButton
EndEnumeration

Define.i event

If OpenWindow(#winMain, 400, 100, 200, 150, "Demo") = 0
   MessageRequester("Fatal error", "Can't open main window.")
   End
EndIf

CheckBoxGadget(#gadCheck, 20, 10, 80, 30, "CheckBox")
HyperLinkGadget(#gadLink, 20, 50, 80, 30, "Hyperlink", RGB(0,0,255), #PB_HyperLink_Underline)
ButtonGadget(#gadButton , 20, 90, 80, 30, "Button")

SetActiveGadget(#gadCheck)
SetUIState(WindowID(#winMain))  ; initially show focus rectangle

Repeat
   event = WaitWindowEvent()
   
   Select event
      Case #PB_Event_Gadget
         Select EventGadget()
            Case #gadCheck
               Debug "CheckBox"
            Case #gadLink   
               Debug "Hyperlink"
            Case #gadButton
               Debug "Button"
         EndSelect   
   EndSelect
Until event = #PB_Event_CloseWindow

[Little John]

My hope was/is, that one of our WinAPI experts has a solution for this.
When I first encountered this behaviour of the HyperLinkGadget, I thought that it might be intended. But in the meantime I think that it's a bug in PureBasic, especially since Quin pointed out that it causes a serious problem for screenreaders.

[Justin]

This does it, windows only:

Code: Select all

; Windows only

EnableExplicit

Macro SetUIState (_hwnd_)
   SendMessage_(_hwnd_, #WM_UPDATEUISTATE, $30002, 0)
EndMacro

#winMain = 0

Enumeration
   #gadCheck
   #gadLink
   #gadButton
EndEnumeration

Global.i g_hl_oldProc

Procedure addWindowStyle(hwnd.i, style.l)
	Protected.l oldStyle
	
	oldStyle = GetWindowLong_(hwnd, #GWL_STYLE)
	SetWindowLong_(hwnd, #GWL_STYLE, oldStyle | style)
EndProcedure

Procedure drawFocus(hwnd.i)
	Protected.RECT rc
	Protected.i hdc
	
	hdc = GetDC_(hwnd)
	GetClientRect_(hwnd, @rc)
	DrawFocusRect_(hdc, @rc)
	ReleaseDC_(hwnd, hdc)
EndProcedure

Procedure.i hl_proc(hwnd.i, msg.l, wparam.i, lparam.i)
	Select msg			
		Case #WM_KEYUP
			If wparam = #VK_SPACE
				PostEvent(#PB_Event_Gadget, #PB_Any, GetProp_(hwnd, "PB_ID"))
			EndIf
			
		Case #WM_LBUTTONDOWN
			SetFocus_(hwnd)
			
		Case #WM_SETFOCUS
			drawFocus(hwnd)
			ProcedureReturn 0
			
		Case #WM_PAINT
			CallWindowProc_(g_hl_oldProc, hwnd, msg, wparam, lparam)
			If GetFocus_() = hwnd
				drawFocus(hwnd)
			EndIf
			ProcedureReturn 0

		Case #WM_KILLFOCUS
			InvalidateRect_(hwnd, #Null, #True)
			ProcedureReturn 0
			
		Case #WM_NCDESTROY
			SetWindowLongPtr_(hwnd, #GWLP_WNDPROC, g_hl_oldProc)
	EndSelect
	
	ProcedureReturn CallWindowProc_(g_hl_oldProc, hwnd, msg, wparam, lparam)
EndProcedure

Define.i event

If OpenWindow(#winMain, 400, 100, 200, 150, "Demo") = 0
   MessageRequester("Fatal error", "Can't open main window.")
   End
EndIf

CheckBoxGadget(#gadCheck, 20, 10, 80, 30, "CheckBox")
HyperLinkGadget(#gadLink, 20, 50, 80, 30, "Hyperlink", RGB(0,0,255), #PB_HyperLink_Underline)
ButtonGadget(#gadButton , 20, 90, 80, 30, "Button")

addWindowStyle(GadgetID(#gadLink), #WS_TABSTOP)
g_hl_oldProc = SetWindowLongPtr_(GadgetID(#gadLink), #GWLP_WNDPROC, @hl_proc())

SetActiveGadget(#gadCheck)
SetUIState(WindowID(#winMain))  ; initially show focus rectangle

Repeat
   event = WaitWindowEvent()
   
   Select event
      Case #PB_Event_Gadget
         Select EventGadget()
            Case #gadCheck
               Debug "CheckBox"
            Case #gadLink   
               Debug "Hyperlink"
            Case #gadButton
               Debug "Button"
         EndSelect   
   EndSelect
Until event = #PB_Event_CloseWindow

[Little John]

This does it, windows only:

That's impressive, thank you!
However, when the button has the focus and I press [Space], then the HyperLinkGadget disappears.

[RASHAD]

Simplify things

Code: Select all

; Windows only

Global result

Macro SetUIState (_hwnd_)
  SendMessage_(_hwnd_, #WM_UPDATEUISTATE, $30002, 0)
EndMacro

#winMain = 0

Enumeration
  #gadCheck
  #gadLink
  #gadButton
EndEnumeration

Define.i event

If OpenWindow(#winMain, 400, 100, 200, 150, "Demo") = 0
  MessageRequester("Fatal error", "Can't open main window.")
  End
EndIf

CheckBoxGadget(#gadCheck, 20, 10, 80, 30, "CheckBox")
HyperLinkGadget(#gadLink, 20, 50, 80, 30, "Hyperlink", RGB(0,0,255), #PB_HyperLink_Underline)
SetWindowLongPtr_(GadgetID(#gadLink), #GWL_STYLE, GetWindowLongPtr_(GadgetID(#gadLink),#GWL_STYLE)|#WS_TABSTOP)
ButtonGadget(#gadButton , 20, 90, 80, 30, "Button")

SetActiveGadget(#gadCheck)
SetUIState(WindowID(#winMain))  ; initially show focus rectangle

Repeat
  event = WaitWindowEvent()
  
  Select event
    Case #WM_KEYDOWN
      keyp = EventwParam()
      If  keyp = 9
        If GetActiveGadget() = 1 And result = 0
          hdc = GetDC_(GadgetID(1))
          GetClientRect_(GadgetID(1), r.RECT)
          result = DrawFocusRect_(hdc, r.RECT)
          ReleaseDC_(GadgetID(1), hdc)            	   
        EndIf
        If GetActiveGadget() <> 1 And result = 1
          result = 0
          hdc = GetDC_(GadgetID(1))
          GetClientRect_(GadgetID(1), r.RECT)
          DrawFocusRect_(hdc, r.RECT)
          ReleaseDC_(GadgetID(1), hdc)            	   
        EndIf
      EndIf 
      If (keyp = 32 Or keyp = 13) And GetActiveGadget() = 1
        Debug "Hyperlink"
      EndIf 
      
    Case #PB_Event_Gadget
      Select EventGadget()
        Case #gadCheck
          Debug "CheckBox"
        Case #gadLink   
          Debug "Hyperlink"
        Case #gadButton
          Debug "Button"
      EndSelect   
  EndSelect
Until event = #PB_Event_CloseWindow

[Justin]

This does it, windows only:

That's impressive, thank you!
However, when the button has the focus and I press [Space], then the HyperLinkGadget disappears.

That's because i did put FreeGadget(#gadLink) after the button click for testing, i forgot to remove it, it's fixed now.

[Quin]

both solutions (including corrections) seem to work on my machine with NVDA. Although I haven't extensively tested the button behavior yet like LittleJohn.

[Little John]

@RASHAD:
Thank you!

That's because i did put FreeGadget(#gadLink) after the button click for testing, i forgot to remove it, it's fixed now.

Fix confirmed.
By the way, in your procedure addWindowStyle(), it should be GetWindowLongPtr_() and SetWindowLongPtr_().
Thanks again!

[Mesa]

If transparency is not important, you can use a canvasgadget as a container like that(multiplatform):

Code: Select all

; EnableExplicit


#winMain = 0

Enumeration
  #gadCheck
  #gadLink
  #gadButton
EndEnumeration

Define.i event

If OpenWindow(#winMain, 400, 100, 200, 150, "Demo") = 0
  MessageRequester("Fatal error", "Can't open main window.")
  End
EndIf
SetWindowColor(#winMain,#White)
CheckBoxGadget(#gadCheck, 20, 10, 80, 30, "CheckBox")
cv=CanvasGadget(#PB_Any,20,50,80,30,#PB_Canvas_DrawFocus|#PB_Canvas_Container|#PB_Canvas_Keyboard )
HyperLinkGadget(#gadLink, 5, 5, 70, 20, "Hyperlink", RGB(0,0,255), #PB_HyperLink_Underline)
CloseGadgetList() 

ButtonGadget(#gadButton , 20, 90, 80, 30, "Button")

SetGadgetColor(#gadLink,#PB_Gadget_BackColor, #White)
SetGadgetColor(#gadLink,#PB_Gadget_FrontColor, #Blue)

SetActiveGadget(cv)


Repeat
  event = WaitWindowEvent()
  
  Select event
    Case #PB_Event_Gadget
      Select EventGadget()
        Case #gadCheck
          Debug "CheckBox"
        Case cv
          Select EventType() 
            Case #PB_EventType_Focus           
            Case #PB_EventType_KeyUp
              If GetGadgetAttribute(cv, #PB_Canvas_Key)=#PB_Shortcut_Space     
                Debug "Hyperlink cv"
              EndIf
          EndSelect
        Case #gadLink   
          Debug "Hyperlink"
        Case #gadButton
          Debug "Button"
      EndSelect   
  EndSelect
Until event = #PB_Event_CloseWindow

Mesa.

[Quin]

If transparency is not important, you can use a canvasgadget as a container like that(multiplatform):

Code: Select all

; EnableExplicit


#winMain = 0

Enumeration
  #gadCheck
  #gadLink
  #gadButton
EndEnumeration

Define.i event

If OpenWindow(#winMain, 400, 100, 200, 150, "Demo") = 0
  MessageRequester("Fatal error", "Can't open main window.")
  End
EndIf
SetWindowColor(#winMain,#White)
CheckBoxGadget(#gadCheck, 20, 10, 80, 30, "CheckBox")
cv=CanvasGadget(#PB_Any,20,50,80,30,#PB_Canvas_DrawFocus|#PB_Canvas_Container|#PB_Canvas_Keyboard )
HyperLinkGadget(#gadLink, 5, 5, 70, 20, "Hyperlink", RGB(0,0,255), #PB_HyperLink_Underline)
CloseGadgetList() 

ButtonGadget(#gadButton , 20, 90, 80, 30, "Button")

SetGadgetColor(#gadLink,#PB_Gadget_BackColor, #White)
SetGadgetColor(#gadLink,#PB_Gadget_FrontColor, #Blue)

SetActiveGadget(cv)


Repeat
  event = WaitWindowEvent()
  
  Select event
    Case #PB_Event_Gadget
      Select EventGadget()
        Case #gadCheck
          Debug "CheckBox"
        Case cv
          Select EventType() 
            Case #PB_EventType_Focus           
            Case #PB_EventType_KeyUp
              If GetGadgetAttribute(cv, #PB_Canvas_Key)=#PB_Shortcut_Space     
                Debug "Hyperlink cv"
              EndIf
          EndSelect
        Case #gadLink   
          Debug "Hyperlink"
        Case #gadButton
          Debug "Button"
      EndSelect   
  EndSelect
Until event = #PB_Event_CloseWindow

Mesa.

Maybe part of the overarching feature request should be to be able to call SetGadgetText() on a CanvasGadget...
It doesn't work if I put this near your color setting lines, like ButtonImageGadget().

Code: Select all

SetGadgetText(#gadLink, "hyperlink")

[Little John]

If transparency is not important, you can use a canvasgadget as a container like that(multiplatform):

Very cool. Thank you, Mesa!
The CanvasGadget seems to be a Jack of all trades.

[Little John]

Maybe part of the overarching feature request should be to be able to call SetGadgetText() on a CanvasGadget...
It doesn't work if I put this near your color setting lines, like ButtonImageGadget().

Code: Select all

SetGadgetText(#gadLink, "hyperlink")

This works here with Mesa's code on Windows 11, using the built-in screenreader:

Code: Select all

[...]
cv = CanvasGadget(#PB_Any, 20, 50, 80, 24, #PB_Canvas_DrawFocus|#PB_Canvas_Container|#PB_Canvas_Keyboard)
HyperLinkGadget(#gadLink, 2, 2, 70, 18, "Hyperlink", RGB(0,0,255), #PB_HyperLink_Underline)
CloseGadgetList() 
SetGadgetText(cv, "HyperLink")
[...]

[Justin]

If transparency is not important, you can use a canvasgadget as a container like that(multiplatform):

It won't work on linux as is, you will need to handle tab key presses by yourself. The canvas gadget is outside the focus ring as i mentioned here:
https://www.purebasic.fr/english/viewtopic.php?t=84388
Actually i think doing it by yourself is a good thing and should not be removed, but having an option to do it by the os would be nice too.

[Quin]

Actually i think doing it by yourself is a good thing and should not be removed, but having an option to do it by the os would be nice too.

I completely agree, this is how all of PB's accessibility/keyboard focus infrastructure should be IMO

[Mesa]

by Justin » Sat Jul 06, 2024 6:17 pm

If transparency is not important, you can use a canvasgadget as a container like that(multiplatform):

It won't work on linux as is, you will need to handle tab key presses by yourself. The canvas gadget is outside the focus ring as i mentioned

Does this module managing the tab key work under Linux?
https://www.purebasic.fr/english/viewto ... 54#p598854

M.