Font Metrics Listing

It took me really some time to firure out, how to get a list of the installed fonts and especially their metricses. Other users might find it helpful. Therefor here the source code. (Perhaps it is a good idea to include it in the Fortran help.)

Program ListFonts   ! List name and metrics of all installed fonts
IMPLICIT   NONE
INCLUDE    <windows.ins>
INTEGER    MA, iWH, i, iVal(20)
CHARACTER  cFace*32

MA = WINIO@ ('%bg[grey]%sp%pv%`bg[white]%110.10cw[vscroll]%gr[]%lw%ww%es',50,50,0,1,1,iWH)
DO I= 1, 3000
   CALL GET_FONT_NAME@ (cFace,I)
   IF (cFace .EQ. ' ') EXIT
   CALL SELECT_FONT@  (cFace)
   CALL FONT_METRICS@ (iVal)
   WRITE (*, '(i4,1x,a24,20i4)') I, cFace, iVal
ENDDO
END

FONT_METRICS@ privides 20 nice values: Height, Ascent, Descent, InternalLeading, ExternalLeading, AveCharWidth, MaxCharWidth, Weight, Overhang, DigitizedAspectX, DigitizedAspectY, FirstChar, LastChar, DefaultChar, BreakChar, Italic, Underlined, StruckOut, PitchAndFamily, CharSet

To create a font using reateFont I need: i2Height, i2Width, i2Escapement, i2Orientation, i2Weight, iItalic, iUnderline, iStrikeOut, iCharSet, iOutputPrecision, iClipPrecision, iQuality, iPitchAndFamilym, lpszFace

How can I bring these values together?

      Integer hdc,ignor,font

      logical ok

      STDCALL CREATEFONTA 'CreateFontA' (VAL,VAL,VAL,VAL,VAL,VAL,VAL,VAL &
     &,VAL,VAL,VAL,VAL,VAL,STRING):INTEGER*4

      DATA DIALOG_FONT /'Arial          ','Comic Sans MS  ',
     *                  'Courier        ','Courier New    ',
     *                  'Helvetica      ','Times Roman    ',
     *                  'Times New Roman'/

C     Windows Font ID Storage For 223 Characters

      ibase = glGenLists(223)

C  Height Of Font           , Width Of Font    , Angle Of Escapement , Orientation Angle , 
C  Font Weight              , Italic           , Underline           , Strikeout         ,
C  Character Set Identifier , Output Precision , Clipping Precision  , Output Quality    ,
C  Family And Pitch         , Font Name

          font = CreateFontA(-20,8,0,0,
     *    FW_NORMAL,.FALSE.,.FALSE.,.FALSE.,
     *    ANSI_CHARSET,OUT_TT_PRECIS,CLIP_DEFAULT_PRECIS,
     *    DEFAULT_QUALITY,ior(FF_DONTCARE,DEFAULT_PITCH),
     *    DIALOG_FONT(1))

C     Selects The Font We Want

      ignor = SelectObject(hDC, font)

C     Builds 223 Characters Starting At Character 32

      ok = wglUseFontBitmaps(hDC, 32, 223, ibase)

Thanks, John.

I am not a specialist for Windows API function application. I cannot see how your code works. A complete example program would be great.

What I really wont to do here is to create a font which is very similar to

Consolas 14 11 3 2 0 8 11 400 0 96 96 30 255 31 32 0 0 0 54 0

These values are from FONT_METRICS@ I would like to have such a font to work around the font size problems in WINIO.

Erwin