Community
cancel
Showing results for 
Search instead for 
Did you mean: 
Highlighted
New Contributor I
3 Views

ivf 2017 seems to hose fonts

Jump to solution

 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

 

0 Kudos

Accepted Solutions
Highlighted
Valued Contributor I
3 Views

The background color setting

Jump to 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.

View solution in original post

0 Kudos
13 Replies
Highlighted
Employee
3 Views

Hi, Brooks

Jump to solution

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.

 

 

 

 

 

 

 

0 Kudos
Highlighted
Employee
3 Views

Hi, Brooks

Jump to solution

Hi, Brooks

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

Thanks.

0 Kudos
Highlighted
Valued Contributor II
3 Views

Have you tried messing around

Jump to solution

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

 

0 Kudos
Highlighted
Valued Contributor II
3 Views

Firstly it seems strange that

Jump to solution

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. 
0 Kudos
Highlighted
Valued Contributor I
3 Views

This is a Windows issue, only

Jump to solution

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


 

0 Kudos
Highlighted
New Contributor I
3 Views

Hi  Paul,

Jump to solution

Hi  Paul,

 

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

Thanks,

Brooks

0 Kudos
Highlighted
New Contributor II
3 Views

You can use the module IFWIN

Jump to solution

You can use the module IFWIN

 

Robert

0 Kudos
Highlighted
Valued Contributor I
3 Views

The F90 interface to

Jump to solution

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.

0 Kudos
Highlighted
New Contributor I
3 Views

OK, got it to work but the

Jump to solution

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

0 Kudos
Highlighted
Valued Contributor II
3 Views

There is a function

Jump to solution

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.

0 Kudos
Highlighted
Valued Contributor II
3 Views

At a glance I don't see any

Jump to solution

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.

0 Kudos
Highlighted
Valued Contributor I
4 Views

The background color setting

Jump to 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.

View solution in original post

0 Kudos
Highlighted
New Contributor I
3 Views

Thanks Andrew and Paul.

Jump to solution

Thanks Andrew and Paul.

Brooks

0 Kudos