Announcement

**Gary Beene** · 15 May 2023, 01:58 PM

I was playing with some code that uses the TrackMouseEvent API, to use as a means of detecting when a mouse is over the dialog - as a means of giving blind/low vision users a verbal message when they move their mouse over the dialog ... like this .. where the message is spoken only once when the mouse first goes over the dialog, then not spoken again until the mouse moves off the dialog and returns to the dialog. It's kind of like a verbal tooltip.

The large font size I created was just so a low vision user might be better able to see the content of the dialog.

In this example, I just draw a "Y" directly on the dialog. When the user moves the mouse over the dialog it speaks "Inside", then speaks "Outside" when the mouse moves off the dialog.

Code:

'Compilable Example:
#Include "win32api.inc"
#Include "sapi.inc"

Global hDlg,hFont As Dword, Letter$
Global psp As ISpVoice, TextToSpeak$$

Function PBMain() As Long
   Local w,h As Long
   Desktop Get Size To w,h
   Dialog New Pixels, 0, "PowerBASIC",(w-400)/2,0,400,300, %WS_Popup To hDlg
   Dialog Set Color hDlg, %Black, %rgb_LightGray
   Dialog Show Modal hDlg Call DlgProc
End Function

CallBack Function DlgProc() As Long
   Local trackMouseC As TrackMouseEventAPI
   Static MouseInC As Dword
   Local rc As Rect, ps As PaintStruct

   Select Case Cb.Msg
      Case %WM_InitDialog
         psp = NewCom "SAPI.SpVoice"
         Letter$ = " Y "
         hFont = MakeFont("Arial",288,"B")

      Case %WM_MouseMove
         If MouseInC = %False Then
            MouseInC = %TRUE
            trackMouseC.cbSize = SizeOf(trackMouseC)
            trackMouseC.dwFlags = %TME_LEAVE
            trackMouseC.hwndTrack = hDlg
            TrackMouseEvent(trackMouseC)
            Speak "Inside"
         End If

      Case %WM_MouseLeave
         MouseInC = %FALSE
         Speak "Outside"

      Case %WM_Paint
         BeginPaint hDlg, ps
         hFont = SelectObject(ps.hDC, hFont)
         SetBkMode ps.hDC, %Transparent
         SetTextColor ps.hDC, %Black
         TextOut ps.hDC, -35,-60, ByVal StrPtr(Letter$), Len(Letter$)
         EndPaint hDlg, ps

      Case %WM_ContextMenu : Dialog End hDlg

      Case %WM_Destroy
   End Select
End Function

Sub Speak(temp$)
   TextToSpeak$$ = temp$
   pSp.Speak(ByVal StrPtr(TextToSpeak$$), %SPF_Async, ByVal %Null)
End Sub

Function MakeFont(ByVal fName As String, ByVal ptSize As Long, _
      Opt ByVal attr As String) As Dword
   '--------------------------------------------------------------------
   ' Create a desired font and return its handle.
   ' attr = "biu" for bold, italic, and underlined (any order)
   '--------------------------------------------------------------------
   Local hDC As Dword, CharSet As Long, CyPixels As Long
   Local Bold, italic, uLine As Long
   If Len(attr) Then
      If InStr(LCase$(attr), "b") Then Bold = %FW_BOLD
      If InStr(LCase$(attr), "i") Then italic = 1
      If InStr(LCase$(attr), "u") Then uLine = 1
   End If
   hDC = GetDC(%HWND_Desktop)
   CyPixels  = GetDeviceCaps(hDC, %LOGPIXELSY)
   ReleaseDC %HWND_Desktop, hDC
   PtSize = 0 - (ptSize * CyPixels) \ 72
   Function = CreateFont(ptSize, 0, 0, 0, Bold, italic, uLine, _
      %FALSE, CharSet, %OUT_TT_PRECIS, _
      %CLIP_DEFAULT_PRECIS, %DEFAULT_QUALITY, _
      %FF_DONTCARE , ByCopy fName)
End Function

**Brian Alvarez** · 15 May 2023, 03:55 PM

Gary, try:

Code:

hFont = StockObjects(%DEFAULT_GUI_FONT)

And fix this line:

Code:

hFont = SelectObject(ps.hDC, hFont)

You are storing a stock object into your loaded font, making it impossible to get rid of it later, leaving a resource leak.

maybe something like this:

Code:

LOCAL hOldFont AS DWORD
BeginPaint hDlg, ps
hOldFont = SelectObject(ps.hDC, hFont) ' Set the new font and store old font for later.
SetBkMode ps.hDC, %Transparent
SetTextColor ps.hDC, %Black
TextOut ps.hDC, -35,-60, ByVal StrPtr(Letter$), Len(Letter$)
SelectObject(hDC, hOldFont) ' Restore old font to the DC, leaving the custom font handle untouched.
EndPaint hDlg, ps

**Brian Alvarez** · 15 May 2023, 04:10 PM

Nevermind, i see you used a HUGE font size, there is nothing like that in the stock fonts. But there are some ways to make the makefont function smaller.

Some thoughts: You are leaving the charset as 0 always. There is no need for the charset variable. Usually you need to create an enum function to get a valid charset ID, like this:

Code:

Function myEnumCharSet (ELF As ENUMLOGFONT, TM As NEWTEXTMETRIC, ByVal FontType As Long, CharSet As Long) As Long
CharSet = ELF.elfLogFont.lfCharSet
End Function

And invoke it like this:

Code:

hDC = GetDC(%HWND_Desktop)
EnumFontFamilies hDC, ByVal StrPtr(fName), CodePtr(myEnumCharSet), ByVal VarPtr(CharSet)
CyPixels = GetDeviceCaps(hDC, %LOGPIXELSY)
ReleaseDC %HWND_Desktop, hDC

But since you are using a zero value (not very safe), you can leave it to 0.

Maybe something like this:

Code:

Function MakeFont(ByVal fName As String) As Dword
Local hDC AS DWORD
hDC = GetDC(%HWND_Desktop)
Function = CreateFont(INT(0 - (144 * GetDeviceCaps(hDC, %LOGPIXELSY)) \ 72), 0, 0, 0, %FW_BOLD, 0, 0,%FALSE, 0, %OUT_TT_PRECIS, %FF_DONTCARE, ByCopy fName)
ReleaseDC %HWND_Desktop, hDC
End Function

The TrackPopupMenu trick is clever. I usually use SetCapture(), ReleaseCapture(), GetCursorPos() and WindowFromPoint() to detect when the pointer enters or leaves a dialog

**Michael Mattias** · 15 May 2023, 04:36 PM

You could try the DDT command FONT NEW. The downside is, you'd have to use DDT printing commands because the hFont returned by FONT NEW is a proprietary handle (can't be used with GDI printing calls such as TextOut()).

Announcement

Print Directly on a Dialog

Print Directly on a Dialog

Comment

Comment

Comment

Comment