ChooseFont

[Ugo]

Hi Fw's.

ChooseFont function can not set correctly the dimension of character passed in Array parameter and if I change the dimension is not the set value correctly.

For Ex. I set in the array -12, ChooseFont 9, select 12 and return -16!!!

Another problem is if I press "Cancel" button after any setting, the function return the data setting and not the previous value.

Many thanks for the help

For more info test this:

#define LF_HEIGHT 1
#define LF_WIDTH 2
#define LF_ESCAPEMENT 3
#define LF_ORIENTATION 4
#define LF_WEIGHT 5
#define LF_ITALIC 6
#define LF_UNDERLINE 7
#define LF_STRIKEOUT 8
#define LF_CHARSET 9
#define LF_OUTPRECISION 10
#define LF_CLIPPRECISION 11
#define LF_QUALITY 12
#define LF_PITCHANDFAMILY 13
#define LF_FACENAME 14

#define FW_NORMAL 400
#define FW_BOLD 700

//------------------------------------------------------------------------------

FUNCTION Main( )

LOCAL aFont[14], oIni, aOldFont, cFont

INI oIni FILE "prova.ini"
GET cFont SECTION "Stampanti" ENTRY "FontInStampa" OF oIni DEFAULT "Arial| 0| -12| 0| 0| 0| 0| 0"
ENDINI

MsgInfo( cFont )

aFont[LF_FACENAME] := ALLTRIM(StrToken(cFont,1,"|" ))
aFont[LF_WIDTH] := VAL( StrToken( cFont, 2, "|" ))
aFont[LF_HEIGHT] := VAL( StrToken( cFont, 3, "|" ))
aFont[LF_WEIGHT] := IF( VAL( StrToken( cFont, 4, "|" )) > 0, FW_BOLD, FW_NORMAL )
aFont[LF_ESCAPEMENT] := VAL( StrToken( cFont, 5, "|" ))
aFont[LF_ITALIC] := VAL( StrToken( cFont, 6, "|" )) > 1
aFont[LF_UNDERLINE] := VAL( StrToken( cFont, 7, "|" )) > 1

aOldFont := AClone( aFont )

aFont := ChooseFont( aFont )

cFont := aFont[LF_FACENAME] + "|" +;
cValToChar( aFont[LF_WIDTH] ) + "|" +;
cValToChar( aFont[LF_HEIGHT] ) + "|" +;
cValToChar( aFont[LF_WEIGHT] ) + "|" +;
cValToChar( aFont[LF_ESCAPEMENT] ) + "|" +;
cValToChar( aFont[LF_ITALIC] ) + "|" +;
cValToChar( aFont[LF_UNDERLINE] )

// Test in uscita
MsgInfo( cFont )

return If( ! Empty( aFont[ LF_FACENAME ] ), aFont, aOldFont )

//------------------------------------------------------------------------------

[Antonio Linares]

Ugo,

Please read this important information:

>>
The one bit of trickery in this code is the value used for the size of the font, the lfHeight parameter to CreateFont(). Usually people are used to working with Point sizes, Size 10, Size 12, etc... when dealing with fonts. CreateFont() however doesn't accept point sizes, it wants Logical Units which are different on your screen than they are on your Printer, and even between Printers and screens.

The reason this situation exists is because the resolution of different devices is so vastly different... Printers can easily display 600 to 1200 pixels per inch, while a screen is lucky to get 200... if you used the same sized font on a printer as on a screen, you likely wouldn't even be able to see individual letters.

All we have to do is convert from the point size we want, into the appropriate logical size for the device. In this case the device is the screen, so we get the HDC to the screen, and get the number of logical pixels per inch using GetDeviceCaps() and slap this into the formula so generously provided in MSDN which uses MulDiv() to convert from our pointsize of 12 to the correct logical size that CreateFont() expects. We store this in lfHeight and pass it as the first parameter to CreateFont().
>>

[Antonio Linares]

Ugo,

This is the right code for your sample:

Code: Select all  Expand view  RUN

   aFont := Array( 14 )
   aFont[LF_FACENAME]   := ALLTRIM(StrToken(cFont,1,"|" ))
   aFont[LF_WIDTH]      := VAL( StrToken( cFont, 2, "|" ))
   aFont[LF_HEIGHT]     := Int( -VAL( StrToken( cFont, 3, "|" ) ) * GetDeviceCaps( hDC := GetDC( GetDesktopWindow() ), LOGPIXELSY ) / 72 )
   ReleaseDC( GetDesktopWindow(), hDC )


You may use the hDC of the printer, if it is a font for to be printed.

[Ugo]

Great Antonio,
Now I set -12 in my array after apply your conversion and the Value is 16
This value is passed to Choose font and correctly I see preset 12 !!!

GOOD !!

After choosefont the dimension is 16!!!

Is necessary reconvert the value for obtain -12.

Is possible to insert this features directly in Choosefont?
With 2 parameter ChooseFont( aFont, hDC ) ?

Have You found also the Solution for Cancel and X Button?

Pier Luigi write this solution:
if ( !bOk )
_reta(0);
else {
_reta( 14 );
_storni( ( bOk || bInitLF ) ? lf.lfHeight: 0, -1, LF_HEIGHT );
_storni( ( bOk || bInitLF ) ? lf.lfWidth: 0, -1, LF_WIDTH );

I think that the problem is in bOk || bInitLF!

Good work.

[Antonio Linares]

Ugo,

> Is necessary reconvert the value for obtain -12.

You may do the same calculations again.

> Is possible to insert this features directly in Choosefont?

I have thought about it, but I am afraid we may break existing code.

> Have You found also the Solution for Cancel and X Button?

Yes, already fixed, though we return an array of 14 elements, all nil.

[Ugo]

Antonio,
> You may do the same calculations again.
Yes.

> > Have You found also the Solution for Cancel and X Button?
> Yes, already fixed, though we return an array of 14 elements, all nil.

Can you send to me?
Thanks.

[Antonio Linares]

Ugo,

Just change this:

Code: Select all  Expand view  RUN

if ( !bOk )
   _reta( 14 );
...


[Ugo]

Antonio,
i modified the fonts.c and i added to my project but I receive this message:

Code: Select all  Expand view  RUN

Bcc32.Exe -M -c -O2  -tW -v- -X -DHB_FM_STATISTICS_OFF -DHB_NO_DEFAULT_API_MACROS -DHB_NO_DEFAULT_STACK_MACROS -DHB_OS_WIN_32 -Ic:\work\fwh\include -Ic:\work\BCC55\Include;c:\work\xHarbour\Include  -nObj Source\fonts.c
Borland C++ 5.5.1 for Win32 Copyright (c) 1993, 2000 Borland
Source\fonts.c:
Warning W8017 Source\fonts.c 28: Redefinition of 'CHOOSEFONT' is not identical
Warning W8019 Source\fonts.c 371: Code has no effect in function GETFONTNAM
iLink32.Exe -Gn -aa -Tpe -s @InfoFiat.bcl
Turbo Incremental Link 5.00 Copyright (c) 1997, 2000 Borland


and not run correctly!

Thanks for suggestion.

[Antonio Linares]

Whats your code at line 371 ?

[Ugo]

line 371:

Code: Select all  Expand view  RUN

     FreeProcInstance( ( FARPROC ) EnumFontsCallBack );


[Antonio Linares]

Ugo,

Fom Win32 docs:

>>
The FreeProcInstance function is obsolete.

This function is provided only for compatibility with 16-bit versions of Windows. Win32-based applications should not use this function; it has no meaning in the 32-bit environment.
>>

Those both are just warnings, that you can safely ignore.

[Ugo]

Antonio,
thank you for the info, I rem this line,
but for this warning:

Code: Select all  Expand view  RUN

Warning W8017 Source\fonts.c 28: Redefinition of 'CHOOSEFONT' is not identical

the line 28 is:

Code: Select all  Expand view  RUN

#define CHOOSEFONT CHOOSEFONT

[Antonio Linares]

Ugo,

It is a warning you can safely ignore.