ivf 2017 seems to hose fonts

[Brooks_Van_Horn]

 have been working on a statistical program for the last 18 months using IVF integration with Visual Studio Community. I've compiled with 2015 then 2016 and now 2017. But with 2017 I get all my fonts reduced. Fontsize = 24 displays as 8 and others reduced proportionally. Everything was AOK until I installed 2017 and wow!

A small piece of my code is:

         hDC = GetDC(NULL)
         if (hDC == NULL) Then
            mas = 16
            hDC = GetDC(NULL)
         End If
         sxWidth  = GetDeviceCaps(hDC, HORZRES)
         syHeight = GetDeviceCaps(hDC, VERTRES)
         sColorDepth = GetDeviceCaps(hdc, BITSPIXEL) *  &
                       GetDeviceCaps(hdc, PLANES)
         iret = ReleaseDC(NULL,hDC)
         if (sxWidth < 1024) Then
            mas = 12
            DOT1 = 1
            DOT2 = 1
            DOT3 = 2
         elseif (sxWidth < 1600) Then
            mas = 14
            DOT1 = 1
            DOT2 = 2
            DOT3 = 2
         else
            mas = 16
            DOT1 = 1
            DOT2 = 2
            DOT3 = 3
         end if
         bret = GetClientRect(ghDlg, rectd)
         bret = GetClientRect(ghWndMain, rectp)
         rectd%bottom = rectp%bottom
         rectp%left = DIALOGWIDTH + 1
         rectd%right = DIALOGWIDTH
         gMaxx = rectp%right - rectp%left
         gMaxy = rectp%bottom - 1
         bret = SetWindowPos(ghDlg, int(NULL,HANDLE), 0, 0, DIALOGWIDTH, DIALOGHEIGHT, 0)
         bret = DlgSetInt(gDlg, IDC_MYSPIN, 0, DLG_POSITION)
         ghBrushWhite = CreateSolidBrush (RGB(248,248,255))
         ghBrushBlack = GetStockObject(BLACK_BRUSH)
         ghPen = GetStockObject(BLACK_PEN)
         hBlackPen = ghPen
         ghBrush = ghBrushWhite
         lp%fErase = 0
         lp%rcPaint = rectp
!  Fill-in the log paint structure
         lf%lfWidth = 0
         lf%lfEscapement = 0
         lf%lfOrientation = 0
         lf%lfWeight = FW_BOLD
         lf%lfItalic = FALSE
         lf%lfUnderline = FALSE
         lf%lfStrikeOut = FALSE
         lf%lfCharSet = ANSI_CHARSET
         lf%lfOutPrecision = OUT_DEFAULT_PRECIS
         lf%lfClipPrecision = CLIP_DEFAULT_PRECIS
         lf%lfQuality = DEFAULT_QUALITY
         lf%lfPitchandFamily = ior(DEFAULT_PITCH, FF_DONTCARE)
         lf%lfFaceName = "Courier New"C
         If (hMyFont12 == NULL) Then
            lf%lfHeight = mas
            hMyFont12 = CreateFontIndirect ( lf )
            lf%lfHeight = mas + 2
            hMyFont16 = CreateFontIndirect ( lf )
            lf%lfHeight = mas + 4
            hMyFont20 = CreateFontIndirect ( lf )
            lf%lfHeight = mas + 8
            hMyFont24 = CreateFontIndirect ( lf )
            lf%lfHeight = mas + 16
            hMyFont36 = CreateFontIndirect ( lf )
         end if

Any suggestions would be greatly appreciated/

Brooks

[Yuan_C_Intel]

Hi， Brooks

The GetDC, GetDeviceCaps are all Windows APIs. Besides upgrade intel Fortran to 2017, have you also upgraded Visual Studio Community or your Windows operating system?

Thanks.

[Yuan_C_Intel]

Hi, Brooks

In addition, did you try debug build? Will you see the same issue with optimization disabled?

Thanks.

[JVanB]

Have you tried messing around with SetProcessDpiAwareness to see whether that might be the problem?

[andrew_4619]

Firstly it seems strange that changing compiler level would cause this problem. Do you still have the older compilers in VS? Options > intel compilers > fortran - or something like that - can be used to select an older compiler for back to back testing.

The font selections is a windows best guess to match the attributes you have selected, changes in windows/windows environment  could effect that. 

I have no magic insight into this problem, I would be tempted after selecting the font object from the handle to call 

GetTextMetrics for the working and non-working version just to verify exactly what is happening. 

[Paul_Curtis]

This is a Windows issue, only accidentally related to IVF.  I don't think you should rely on all the elements of your logfont structure remaining constant over multiple calls/returns to CreateFontIndirect().  I have put similar code in a subroutine which can be called multiple times for multiple fonts...

! Creates a font with simple characteristics. The face name and size
! are provided, along with bold and italic flags. Returns a handle
! to the new font, or 0 on failiure.
!
INTEGER(HANDLE) FUNCTION CreateSimpleFont (faceName, size, bold, italic)
    IMPLICIT NONE
    CHARACTER(LEN=*), INTENT(IN)   :: faceName
    INTEGER, INTENT(IN)            :: size
    LOGICAL, INTENT(IN)            :: bold
    LOGICAL, INTENT(IN)            :: italic

    TYPE(T_LOGFONT)                :: logfont
    INTEGER(HANDLE)                :: hfont

    logfont%lfHeight		= size
    logfont%lfWidth			= 0
    logfont%lfEscapement	= 0
    logfont%lfOrientation	= 0
    IF (bold) THEN
        logfont%lfWeight = FW_BOLD
    ELSE
        logfont%lfWeight = FW_NORMAL
    END IF
    logfont%lfItalic			= italic
    logfont%lfUnderline			= .FALSE.
    logfont%lfStrikeout			= .FALSE.
    logfont%lfCharSet			= ANSI_CHARSET
    logfont%lfOutPrecision		= OUT_DEFAULT_PRECIS
    logfont%lfClipPrecision		= CLIP_DEFAULT_PRECIS
    logfont%lfQuality			= DEFAULT_QUALITY
    logfont%lfPitchAndFamily	= IOR(DEFAULT_PITCH, FF_DONTCARE)
	logfont%lfFaceName			= faceName

    hfont = CreateFontIndirect (logfont)

    CreateSimpleFont = hfont

END FUNCTION CreateSimpleFont

[Brooks_Van_Horn]

Hi  Paul,

I'll try it but what 'use' statements do I need?

Thanks,

Brooks

[Robert_van_Amerongen]

You can use the module IFWIN

Robert

[Paul_Curtis]

The F90 interface to CreateFontIndirect() is in GDI32.f90, which is included in IFWIN.f90.  You will also need IFWINTY.f90 for Windows defines such as HANDLE, T_LOGFONT, FW_* and so forth.  Siince your existing code already references those items, no changes may be required, just put the subroutine in the same module as your calling code.

[Brooks_Van_Horn]

OK, got it to work but the textout function is now printing my font with a white background. I added SetBkColor and it compiles OK but I get a error LNK2019: unresolved external symbol _setbkcolor referenced in function MMYHEADEROUT_mp_MYHEADEROUT in the link process. What must I do to the project options to resolve this error. I am running a pure x64 compile/link setup.

Here is my revised code modified from above

FUNCTION CreateSimpleFont (faceName, size, bold, italic)
!DEC$ ATTRIBUTES STDCALL, ALIAS : 'CreateSimpleFont' :: CreateSimpleFont

! Creates a font with simple characteristics. The face name and size
! are provided, along with bold and italic flags. Returns a handle
! to the new font, or 0 on failiure.

    use IFWIN

    Integer(Handle):: CreateSimpleFont
    CHARACTER(LEN=*), INTENT(IN)   :: faceName
    INTEGER(4), INTENT(IN)         :: size
    LOGICAL(4), INTENT(IN)         :: bold
    LOGICAL(4), INTENT(IN)         :: italic

    TYPE(T_LOGFONT)                :: logfont
    INTEGER(HANDLE)                :: hfont

    logfont%lfHeight		= size
    logfont%lfWidth			= 0
    logfont%lfEscapement	= 0
    logfont%lfOrientation	= 0
    IF (bold) THEN
        logfont%lfWeight = FW_BOLD
    ELSE
        logfont%lfWeight = FW_NORMAL
    END IF
    logfont%lfItalic			   = italic
    logfont%lfUnderline			= .FALSE.
    logfont%lfStrikeout			= .FALSE.
    logfont%lfCharSet			= ANSI_CHARSET
    logfont%lfOutPrecision		= OUT_DEFAULT_PRECIS
    logfont%lfClipPrecision		= CLIP_DEFAULT_PRECIS
    logfont%lfQuality			= DEFAULT_QUALITY
    logfont%lfPitchAndFamily	= IOR(DEFAULT_PITCH, FF_DONTCARE)
    logfont%lfFaceName			= faceName  

    hfont = CreateFontIndirect (logfont)

    CreateSimpleFont = hfont
    return
    
END FUNCTION CreateSimpleFont

and I invoke it with

        If (hMyFont12 == NULL) Then
            hMyFont12 = CreateSimpleFont( "Courier New"C, mas, .TRUE., .FALSE.)
            mas = mas + 2
            hMyFont16 = CreateSimpleFont( "Courier New"C, mas, .TRUE., .FALSE.)
            mas = mas + 4
            hMyFont20 = CreateSimpleFont( "Courier New"C, mas, .TRUE., .FALSE.)
            mas = mas + 8
            hMyFont24 = CreateSimpleFont( "Courier New"C, mas, .TRUE., .FALSE.)
            mas = mas + 10
            hMyFont36 = CreateSimpleFont( "Courier New"C, mas, .TRUE., .FALSE.)
         end if

The code using the font is

    use ifwin
    use gdi32
    use user32
    use ifqwin
    use kernel32
    use PearsonGlobals
 
Integer(4)::     x, y, lnth, lenx
Integer(BOOL)::  bret
Integer(4):: oldBkColor
Integer(4):: BlueBkColor
Character(100):: myBuffer
Type (T_TEXTMETRIC)    ta

 if ((hmyFont36 == NULL) .or. ($Maxi == FALSE)) Then
         return
      End if
 
      if (ghwDC /= NULL) Then
         bret = EndPaint(NULL, lps)
      End If
 
      ghwDC = GetDC(NULL)
      if (ghwDC == NULL) Then
         return
      End If
 
      hOldPen = SelectObject(ghwDC, GetStockObject(BLACK_PEN))
      BlueBkColor = RGB(0,0,255)
   
      oldBkColor = SetBkColor(BlueBkColor)
      hOldFont = SelectObject(ghwDC, hMyFont24)
      myBuffer = 'Pearson Distribution Curves (PDC)'
      myBuffer = TRIM(AdjustL(myBuffer))
      bret = GetTextMetrics(ghwDC, ta)
      Call GetLength(myBuffer,lnth)
      lenx = ta%tmAveCharWidth * lnth / 2
      x = GetDeviceCaps(ghwDC, HORZRES) / 2 - lenx
      y = 0
      bret = textOut(ghwDC, x, y, myBuffer, lnth)
      rectg%top = 0
      rectg%bottom = 80
      rectg%left = 700
      rectg%right = 1200
      bret = ValidateRect(NULL, rectg)
      hOldFont = SelectObject(ghwDC, hOldFont)
      hOldPen = SelectObject(ghwDC, hOldPen)
      oldBkColor = SetBKColor (oldBkColor)
      x = ReleaseDC(NULL, ghwDC)
      ghwDC = NULL
 
      return

Using this code I am actually writing in the system area, which on my Win10 maxhine is a blue band.

Brooks

[andrew_4619]

There is a function setbkcolor in IFQWIN and and SDK function of the same name in GDI32 that has a different interface (it takes 2 parameters) I think that is the one you are after.

[andrew_4619]

At a glance I don't see any need for USE IFQWIN in that routine. Also you don't need GDI32, USER32 or KERNEL32 as they are all included in IFWIN.

[Paul_Curtis · Accepted solution]

The background color setting function has been renamed in IVF (carried over from MS Fortran) to avoid a conflict.

rval = MSFWIN$SetBkColor (hdc, yellow)

Also, the background/foreground color is simply an attribute of the DC for text output, it is not the same thing as selecting a brush which uses/creates an allocated resource and hence must be destroyed/deallocated/restored when that code section completes; so the color value is not a handle to anything and the extra calls to "restore" the "oldbkcolor" and so forth are not needed.

There are a number of WinAPIs which have been similarly renamed; do a search on MSFWIN$ over the IVF project include paths.

[Brooks_Van_Horn]

Thanks Andrew and Paul.

Brooks