- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
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
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
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.
Link Copied
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
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.
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
Hi, Brooks
In addition, did you try debug build? Will you see the same issue with optimization disabled?
Thanks.
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
Have you tried messing around with SetProcessDpiAwareness to see whether that might be the problem?
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
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.
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
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
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
Hi Paul,
I'll try it but what 'use' statements do I need?
Thanks,
Brooks
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
You can use the module IFWIN
Robert
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
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.
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
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
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
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.
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
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.
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
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.
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
Thanks Andrew and Paul.
Brooks
- Subscribe to RSS Feed
- Mark Topic as New
- Mark Topic as Read
- Float this Topic for Current User
- Bookmark
- Subscribe
- Printer Friendly Page