Automatic Font Control

[Gösta H. Lovgren-2]

Thanks Dave. I will give it a try.

<later>

Here's the code I ended up with. Works a charm. Note for now I am only usiing Normal or Bold weights.

'Michael Matthias via Poffs  
'http://www.powerbasic.com/support/pbforums/showthread.php?p=294981#post294981
Function Font_Choose(Font_Name$, Font_Size&, Font_Weight&) As Long
 Local cf As ChooseFontApi       ' comdlg32 
 Local lf As LogFont
   cf.lstructSize  = SizeOf(cf)
   cf.flags        = %CF_EFFECTS Or _
                     %CF_SCREENFONTS Or _ 'screen fonts only
                     %CF_INITTOLOGFONTSTRUCT 'initialize with lf.lfFaceName
 
  Local hDC As Long 'ala Dave Biggs
  Local CyPixels As Long 
    hDC = GetDC(%HWND_DESKTOP)
     CyPixels  = GetDeviceCaps(hDC, %LOGPIXELSY)
     ReleaseDC %HWND_DESKTOP, hDC
     Font_Size& = 0 - (Font_Size& * CyPixels) / 72
 
   cf.lpLogFont    = VarPtr(lf)  
 
    'For display - only use Normal and Bold
   If Font_Weight& = 0 Then 
      Font_Weight& = 400 'normal
     Else
      Font_Weight& = 700 'bold
   End If   
   
   
  'send to initialize
   lf.lfFaceName = Trim$(Font_Name$) & $Nul 'Works
   lf.lfWeight = Font_Weight& 
   lf.lfHeight = Font_Size&
   Function = ChooseFont(cf)   
   
   'in case of changes
   Font_Name$ = lf.lfFaceName  
   Font_Size& = cf.iPointSize / 10'seems to work
   Font_Weight& = lf.lfWeight
   
      ' for PB Font use
   If Font_Weight& < 401 Then 
      Font_Weight& = 0 'normal
     Else
      Font_Weight& = 1 'bold
   End If   
End Function

Now if I could only position where the control pops up {sighing grin}.
================================
An open foe may prove a curse;
but a pretended friend is worse.
Ben Franklin
================================

[Michael Mattias]

>Now if I could only position where the control pops up {sighing grin}.

'-------------------------------------------------------------------------------
'   CHOOSE_FONT.BAS for PB/DLL 6.11
'   AUTHOR: Michael Mattias Racine WI
'   Test ChooseFont Common DialogBox.
'   Written: 6/23/02
'   WORKS TERRIFIC. Can add options with CfhookProc if I want to do something else.
'   Like.. command line option "printer fonts, screen fonts, "printer & screen fonts"
'-------------------------------------------------------------------------------
' 08.31.08     v 1.1.0   Add hook proc to locate the font dialog where desired
'                              Recompile with PB/Win 8.03 


#COMPILE       EXE
#DEBUG ERROR ON
#REGISTER     NONE

#INCLUDE  "WIN32API.INC"    ' file date: 21 Feb '05
#INCLUDE "COMDLG32.INC"    ' file date: 11 Mar '03 
#RESOURCE "CHOOSE_FONT.PBR" ' totally optional


FUNCTION WINMAIN (BYVAL hInstance     AS LONG, _
                  BYVAL hPrevInstance AS LONG, _
                  BYVAL lpCmdLine     AS ASCIIZ PTR, _
                  BYVAL iCmdShow      AS LONG) AS LONG
  ' and the incredibly complicated code for what WinMain does:
  
  LOCAL cf AS choosefontapi       ' comdlg32
  cf.lstructSize  = SIZEOF(cf)
  cf.flags        = %CF_BOTH OR %CF_EFFECTS
  ' -----  to enable the hook procedure--------------
  cf.flags        = cf.flags OR %CF_ENABLEHOOK
  cf.lpfnhook    = CODEPTR(CfHookProc)
' -------------------------------------------------  
  FUNCTION = ChooseFont(cf)

  FUNCTION = 5


END FUNCTION

'Return Value
'If the hook procedure returns zero, the default dialog box procedure processes the message.
'If the hook procedure returns a nonzero value, the default dialog box procedure ignores the message.

FUNCTION  CfHookPRoc (BYVAL hWnd AS LONG, BYVAL wMsg AS LONG, BYVAL wParam AS LONG, BYVAL lParam AS LONG ) AS LONG
    
    SELECT CASE AS LONG   wMsg
         CASE %WM_INITDIALOG
             'CALL CenterWindow (HWnd)    ' OK
              SetWindowPos  hWnd, %HWND_TOP, 600, 600, %NULL, %NULL, %SWP_NOSIZE   ' also OK
    END SELECT
    
    FUNCTION = 0  ' allow the rest of the default processing
    
END FUNCTION


FUNCTION CenterWindow ALIAS "CenterWindow" (BYVAL hWnd AS LONG) EXPORT AS LONG
   ' centers given Window on the desktop and forces to top
   LOCAL rDW AS RECT, rDlg AS RECT
   GetClientRect GetDesktopWindow, Rdw
   GetWindowRect hWnd, rDlg
   SetWindowPos hWnd,_
        %HWND_TOP,_
       ((rDW.nright - rDW.nleft + 1) - (rDlg.nright - rDlg.nleft +1)) \2, _
       ((rDw.nBottom - rDW.nTop + 1) - (rDlg.nbottom - rDlg.nTop + 1)) \ 2, _
       0&,_
       0&, _
       %SWP_NOSIZE
END FUNCTION

[Gösta H. Lovgren-2]

<laughing> Of course you positioned it. And in true MCM style - in such a way as I wouldn't know how to use it. <and now you're laughing>

I suppose it would work if I created a dialog for the Font Control to go on. but more than I want to get involved with today. What I was hoping for was to be able to set a position when calling ChooseFont(cf).

Oh well. I'm still chuckling anyway.

=========================================
Never let the future disturb you.
You will meet it, if you have to,
with the same weapons of reason
which today arm you against the present.
Marcus Aurelius Antoninus (121-180 A.D.)
=========================================

[Michael Mattias]

.. What I was hoping for was to be able to set a position when calling ChooseFont(cf).

Are you yanking my chain or what?

That's exactly what this code does, it positions the ChooseFont() Dialog before it's shown!

Pretty much all the common dialogs have hook options to change the default presentations. eg:

Explorer-Style hook Procedures for OpenFileDialog and SaveFileDialog 3-31-07



MCM

[Gösta H. Lovgren-2]

Originally Posted by Michael Mattias

Are you yanking my chain or what?

No I couldn't ever do that Michael. Being on a chain implies a measure of control.

That's exactly what this code does, it positions the ChooseFont() Dialog before it's shown!

Actually no it doesn't. If you run the code shown, it does nothing. Absolutely nothing. And requires the Task Mgr to shut it down.

However, upon reflection, I just may be able to fold parts of it into my own code.

So, in summary, while I would never dare touch your chain, Mike, I might consider rattling your cage once in awhile. {grin}

================================================== ==========
"A little inaccuracy sometimes saves a ton of explanation."
H. H. Munro (Saki) (1870-1916)
================================================== ==========

[Michael Mattias]

Actually no it doesn't. If you run the code shown, it does nothing. Absolutely nothing. And requires the Task Mgr to shut it down

???

I cut and pasted it from the working code here.

???

[Dave Biggs]

As posted code uses SetWindowPos and may be displaying out of sight on Gösta's system? (Look for it in the taskbar).
Ideed the code does work (quite nifty I thought )

[Gösta H. Lovgren-2]

As posted code uses SetWindowPos and may be displaying out of sight on Gösta's system? (Look for it in the taskbar).

I C&P'd the code MCM posted (Post 17) and it runs but doesn't show anything. (No Dialog created). (Icon on taskbar okay but does nothing. Have use Task Mgr to close it.)

Ideed the code does work (quite nifty I thought )

I wouldn't doubt it. However I don't see how it would fit into my existing dialog. Maybe if I fool with it some ... (Create another dialog I guess and pass a starting position to it.)

===============================================
It is dangerous to be right in matters
on which the established authorities are wrong.
~ Voltaire
===============================================

[Dave Biggs]

Gösta, If your screen resolution is 800 x 600 the ChooseFont window will be off the bottom of your screen. Change your screen res to 1024 x 768 and it'll be visible. Better yet change the code to..

SetWindowPos  hWnd, %HWND_TOP, 200, 200, %NULL, %NULL, %SWP_NOSIZE

(BTW If you can see the icon in the taskbar you could right-click / Close it without needing to resort to the Task Manager).

Thing is, calling ChooseFont() with the flag %CF_ENABLEHOOK set, tells the function to pass it's dialog messages through a callback procedure that we nominate, before the Default Proc does it's thing.
Once we have access to the messages for the ChooseFont dialog (that are normally happening behind the scenes) we can do things like set the position upon the %WM_INITDIALOG msg being received. (Returning '0' tells the Deafult Proc that message has been handled already).

No need to create an extra dialog - just get to grips with the one created by ChooseFont().

HTH

[Gösta H. Lovgren-2]

Thanks Dave. I do use 800x600. I will follow up with your suggestions today. What I am doing is completely rewriting in PB9 a database program that was the first progam I wrote in PBWin(6?) when I started with it some years ago when I didn't have the (compleat?) grasp of the windows concept I have today {he said tongue in cheek}.

Never thought about right clicking the icon. Just natural for me to ACD the task mgr. Have to do it so often when programming, you know. {grin}.

Ah'll be bock!

=================================
"Research is what I'm doing when
I don't know what I'm doing."
Wernher Von Braun (1912-1977)
=================================

[Michael Mattias]

I guess I should have left in the "CenterWindow" instead of the "SetWindowPos," huh?

I tested both and just left the last version I tested.

I tested the SetWindowPos because when I tested the CenterWindow, it looked pretty close to what I got with no hook and I wanted to be sure it worked, lest I cause any confusion. Well, I guess that didn't work out quite the way I expected....

[Gösta H. Lovgren-2]

Okay, Thanks to Dave's guidance and Mike's clever code, everything is working hunky dory.

I used Globals for positioning as I'm not comfortable enough with WinApi to pass variables on my own. I suppose I might be able use something in the LogFont or ChooseFontApi but for now, the Globals are fine.

Thanks Mike & Dave for a nifty routine.

Here's the routine. With only minimal adaption, most any PB'er should be able to just C&P it into his own code.

'Michael Matthias via Poffs  
'http://www.powerbasic.com/support/pbforums/showthread.php?p=294981#post294981
'
'Send these values for current Font and set g_Font_Col & g_Font_Row to where
'you want the Font Control to display on your dialog
Function Font_Choose(Font_Name$, Font_Size&, Font_Weight&) As Long
  Common_Locals 'my locals - just rem
 
 Local cf As ChooseFontApi       ' comdlg32 
 Local lf As LogFont
   cf.lstructSize  = SizeOf(cf)
   cf.flags        = %CF_EFFECTS Or _
                     %CF_SCREENFONTS Or _ 'screen fonts only
                     %CF_INITTOLOGFONTSTRUCT 'to use to pass values
 
  ' -----  to enable the hook procedure--------------
  cf.flags        = cf.flags Or %CF_ENABLEHOOK 'add hook to flags
  cf.lpfnhook    = CodePtr(CfHookProc)
  ' -------------------------------------------------  
 
  Local hDC As Long 'ala Dave Biggs
  Local CyPixels As Long 
    hDC = GetDC(%HWND_DESKTOP)
     CyPixels  = GetDeviceCaps(hDC, %LOGPIXELSY)
     ReleaseDC %HWND_DESKTOP, hDC
     Font_Size& = 0 - (Font_Size& * CyPixels) / 72 'to send to font control display
 
 
    'For display in Font Control
   If Font_Weight& = 0 Then 
      Font_Weight& = 400 'normal
     Else
      Font_Weight& = 700 'bold
   End If   
 
  'send to initialize
   cf.lpLogFont    = VarPtr(lf) 'to pass values
   lf.lfFaceName = Trim$(Font_Name$) & $Nul 'Works
   lf.lfWeight = Font_Weight& 
   lf.lfHeight = Font_Size&
 
   Function = ChooseFont(cf)   'call Font Control
 
   'Returned values
   Font_Name$ = lf.lfFaceName  
   Font_Size& = cf.iPointSize / 10'seems to work
   Font_Weight& = lf.lfWeight
 
      ' for PB Font use
   If Font_Weight& < 401 Then 
      Font_Weight& = 0 'normal
     Else
      Font_Weight& = 1 'bold
   End If   
End Function
'''''''''''''''''''''''''''''''''''''''''''''''''''
'Return Value
'If the hook procedure returns zero, the default dialog box procedure processes the message.
'If the hook procedure returns a nonzero value, the default dialog box procedure ignores the message.
Function  CfHookPRoc (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    '<<- g_Font_Col, g_Font_Row are set before calling this
    Select Case As Long   wMsg
         Case %WM_INITDIALOG
             'CALL CenterWindow (HWnd)    ' OK
              SetWindowPos  hWnd, %HWND_TOP, g_Font_Col, g_Font_Row, %Null, %Null, %SWP_NOSIZE   ' also OK
    End Select
 
    Function = 0  ' allow the rest of the default processing
 
End Function
 
 
Function CenterWindow Alias "CenterWindow" (ByVal hWnd As Long) Export As Long
   ' centers given Window on the desktop and forces to top
   Local rDW As RECT, rDlg As RECT
   GetClientRect GetDesktopWindow, Rdw
   GetWindowRect hWnd, rDlg
   SetWindowPos hWnd,_
        %HWND_TOP,_
       ((rDW.nright - rDW.nleft + 1) - (rDlg.nright - rDlg.nleft +1)) \2, _
       ((rDw.nBottom - rDW.nTop + 1) - (rDlg.nbottom - rDlg.nTop + 1)) \ 2, _
       0&,_
       0&, _
       %SWP_NOSIZE
End Function
'***************************************************
'***************************************************
'**********************************************************************

[Michael Mattias]

I used Globals for positioning as I'm not comfortable enough with WinApi to pass variables on my own. I suppose I might be able use something in the LogFont or ChooseFontApi but for now

Right you are, sir.

#COMPILE EXE
#DEBUG ERROR ON
#REGISTER NONE
#INCLUDE  "WIN32API.INC"    ' file date: 2/25/02 (PB version date).
#INCLUDE "COMDLG32.INC"
#RESOURCE "CHOOSE_FONT.PBR" ' totally optional

%FONT_ROW      =    100      ' in pixels
%FONT_COL      =    400      ' also in pixels


FUNCTION WINMAIN (BYVAL hInstance     AS LONG, _
                  BYVAL hPrevInstance AS LONG, _
                  BYVAL lpCmdLine     AS ASCIIZ PTR, _
                  BYVAL iCmdShow      AS LONG) AS LONG
  ' and the incredibly complicated code for what WinMain does:

  LOCAL cf AS choosefontapi       ' comdlg32
  cf.lstructSize  = SIZEOF(cf)
  cf.flags        = %CF_BOTH OR %CF_EFFECTS
  ' -----  to enable the hook procedure------
  cf.flags        = cf.flags OR %CF_ENABLEHOOK
  cf.lpfnhook     = CODEPTR(CfHookProc)
  
  ' --- to use available 'lparam' to hold desired row and column ----
  ' since neither value will exceed 65536, we'll just pack this info
  ' into the available (LONG) integer

  cf.lCustData   =  MAKLNG(%FONT_ROW, %FONT_COL) 
  ' ---------------------------------------------
  FUNCTION = ChooseFont(cf)

  FUNCTION = 5


END FUNCTION

'Return Value
'If the hook procedure returns zero, the default dialog box procedure processes the message.
'If the hook procedure returns a nonzero value, the default dialog box procedure ignores the message.

FUNCTION  CfHookPRoc (BYVAL hWnd AS LONG, BYVAL wMsg AS LONG, BYVAL wParam AS LONG, BYVAL lParam AS LONG ) AS LONG
    
  LOCAL pCF   AS ChooseFontAPI PTR, iRow AS LONG, iCol AS LONG

    SELECT CASE AS LONG   wMsg
         CASE %WM_INITDIALOG
             pCF    = lparam     ' on WM_INITDIALOG, lparam is PTR to CHOOSEFONT structure
                                 ' with which the ChoosefFont() function was called
                                 
             iRow = LOWRD(@pCF.lcustdata)   ' unpack row and column....
             iCol = HIWRD(@pCF.lcustdata)
             
              SetWindowPos  hWnd, %HWND_TOP, iRow, icol, %NULL, %NULL, %SWP_NOSIZE   ' also OK
    END SELECT

    FUNCTION = 0  ' allow the rest of the default processing

END FUNCTION

[Gösta H. Lovgren-2]

Originally Posted by Michael Mattias

Right you are, sir.

Another Jim Dandy addition.

================================================== ============
"A doctor can bury his mistakes
but an architect can only advise his clients to plant vines."
Frank Lloyd Wright (1868-1959)
================================================== ============

[Gösta H. Lovgren-2]

While it is neat to pack two integers into one

 ' --- to use available 'lparam' to hold desired row and column ----
  ' since neither value will exceed 65536, we'll just pack this info
  ' into the available (LONG) integer                         
  cf.lCustData   =  MakLng(FONT_COL&, FONT_ROW&)

And *generally* works well, it has, however, one drawback. It won't pass negative numbers (or probably will but I just don't know how). I was using a -20 for the Row value to move the Font Dialog (not properly a "control" I guess) above the control I was changing the font for (the FD partially covered it and needed to be dragged out of the way). When I tried pass the packed values, it wouldn't work (Worked great with positives, though).

So with the new technique just learned (thanks to MCM) I did this instead:

   'try this myself
  cf.nSizeMin = Font_Col&
  cf.nSizeMax  = Font_Row&

And it works peachy cream. Probably cause problems down the line somewhere by locating dialogs with negative numbers but that's for another day's debugging fun {grin}.

================================
"It is a miracle that curiosity
survives formal education."
Albert Einstein (1879-1955)
================================