Implement much simpler GDI font creation wrappers

I've implemented these inside the Font_Management module, and will
eventually look at cleaning up pdFont to simply wrap these improved
creation functions.

As for pdTextRenderer, it will now create a fallback GDI font object if
GDI+ fails for whatever reason.  (The potential list of failure reasons
is longer than I can write in a single commit message... ha ha)

My next commit may take awhile, as my next task is new
fontGlyphCollection and fontGlyph classes, which manage raw path data
for individual character glyphs.  A ton of code has to be written before
I can test these functions, so I don't know that intermediate commits
will be very helpful.

Classes/pdTextRenderer.cls

@@ -38,6 +38,9 @@ Attribute VB_Exposed = False
 '
 'This unpleasant hybrid approach is part of the shit we deal with as Windows developers, I guess.
 '
+'Dependencies:
+'  - Font_Management module
+'
 'All source code in this file is licensed under a modified BSD license.  This means you may use the code in your own
 ' projects IF you provide attribution.  For more information, please visit http://photodemon.org/about/license/
 '
@@ -203,31 +206,35 @@ End Enum
     Private Const StringAlignmentNear = 0, StringAlignmentCenter = 1, StringAlignmentFar = 2
 #End If
 
-'Font family functions
+'GDI+ font family functions
 Private Declare Function GdipCreateFontFamilyFromName Lib "gdiplus" (ByVal ptrToSrcFontName As Long, ByVal srcFontCollection As Long, ByRef dstFontFamily As Long) As Long
 Private Declare Function GdipDeleteFontFamily Lib "gdiplus" (ByVal srcFontFamily As Long) As Long
 Private Declare Function GdipIsStyleAvailable Lib "gdiplus" (ByVal srcFontFamily As Long, ByVal srcStyleToTest As FontStyle, ByRef dstIsStyleAvailable As Long) As Long
 
-'Font functions
+'GDI+ font functions
 Private Declare Function GdipCreateFont Lib "gdiplus" (ByVal srcFontFamily As Long, ByVal srcFontSize As Single, ByVal srcFontStyle As FontStyle, ByVal srcMeasurementUnit As GdiPlusMeasurementUnit, ByRef dstCreatedFont As Long) As Long
 Private Declare Function GdipDeleteFont Lib "gdiplus" (ByVal srcFont As Long) As Long
 
-'String format functions
+'GDI+ string format functions
 Private Declare Function GdipStringFormatGetGenericTypographic Lib "gdiplus" (ByRef dstStringFormat As Long) As Long
 Private Declare Function GdipDeleteStringFormat Lib "gdiplus" (ByVal srcStringFormat As Long) As Long
 Private Declare Function GdipSetStringFormatAlign Lib "gdiplus" (ByVal dstStringFormat As Long, ByVal newAlignment As GdiPlusStringAlignment) As Long
 Private Declare Function GdipSetStringFormatLineAlign Lib "gdiplus" (ByVal dstStringFormat As Long, ByVal newLineAlignment As GdiPlusStringAlignment) As Long
 
-'Graphics container font functions
+'GDI+ graphics container font functions
 Private Declare Function GdipSetTextRenderingHint Lib "gdiplus" (ByVal dstGraphics As Long, ByVal newRenderHintMode As GdiPlusTextRenderingHint) As Long
 Private Declare Function GdipSetTextContrast Lib "gdiplus" (ByVal dstGraphics As Long, ByVal textContrast As Long) As Long
 Private Declare Function GdipSetCompositingQuality Lib "gdiplus" (ByVal dstGraphics As Long, ByVal newCompositingQuality As GdiPlusCompositingQuality) As Long
 Private Declare Function GdipSetSmoothingMode Lib "gdiplus" (ByVal dstGraphics As Long, ByVal newSmoothingMode As GdiPlusSmoothingMode) As Long
 Private Declare Function GdipSetPixelOffsetMode Lib "gdiplus" (ByVal dstGraphics As Long, ByVal newPixelOffsetMode As GdiPlusPixelOffsetMode) As Long
 
-'Render functions
+'GDI+ Render functions
 Private Declare Function GdipDrawString Lib "gdiplus" (ByVal dstGraphics As Long, ByVal ptrToString As Long, ByVal strLength As Long, ByVal gdipFontHandle As Long, ByRef layoutRect As RECTF, ByVal gdipStringFormat As Long, ByVal gdipBrush As Long) As Long
 
+'GDI generic object management
+Private Declare Function SelectObject Lib "gdi32" (ByVal hDC As Long, ByVal hObject As Long) As Long
+Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
+
 'This class internally maintains various font properties.  These properties must be converted into specific GDI+ parameters via
 ' various means, but they are stored in human-friendly format to simplify serializing a class instance to an XML string.
 Private m_FontFace As String
@@ -263,11 +270,12 @@ Private m_VerticalAlignment As GdiPlusStringAlignment
 Private m_TextRenderingHint As GdiPlusTextRenderingHint
 Private m_TextContrast As Long
 
-'For performance reasons, this class caches various GDI+ font objects and handles.  This spares us from having to recreate
-' expensive font data during rendering steps.
+'For performance reasons, this class caches various font objects and handles from both GDI and GDI+.  This spares us from
+' having to recreate expensive font data during rendering steps.
 Private m_GDIPlusFont As Long
 Private m_GDIPlusFontFamily As Long
 Private m_GDIPlusStringFormat As Long
+Private m_GDIFont As Long
 
 'If a font object has been created, and a setting has been changed (e.g. font name, size, etc), we must recreate the font.
 ' All relevant property changes will set this value to FALSE to signify a re-cache is required.
@@ -586,7 +594,7 @@ Public Function createFontObject() As Boolean
 
 End Function
 
-'Attempt to create a GDI+ font family matching the current class settings
+'Attempt to create a GDI+ font matching the current class settings.  Note that GDI+ creates two relevant objects: font family, and font itself
 Private Function createGDIPlusFont() As Boolean
 
     Debug.Print "Attempting to create GDI+ font object matching the current pdTextRenderer settings..."
@@ -700,6 +708,45 @@ Private Sub reportGDIPlusFailure(ByVal failCode As Long)
 
 End Sub
 
+'Attempt to create a GDI font matching the current class settings
+Private Function createGDIFont() As Boolean
+
+    'Reset the current font cache state, as we're about to wipe any existing font handles
+    m_FontCacheClean = False
+
+    Debug.Print "Attempting to create GDI font object matching the current pdTextRenderer settings..."
+
+    'If a GDI font handle already exists, free it.  Note that the font must have been unselected from a DC; this is typically handled
+    ' by the renderer function itself.
+    If m_GDIFont <> 0 Then DeleteObject m_GDIFont
+
+    'The font management module makes this task a lot easier.  Start by creating a LOGFONTW container.
+    Dim tmpLogFont As LOGFONTW
+
+    'Use the font management module to populate the struct
+    Font_Management.fillLogFontW_Basic tmpLogFont, m_FontFace, m_FontBold, m_FontItalic, m_FontUnderline, m_FontStrikeout
+    Font_Management.fillLogFontW_Size tmpLogFont, m_FontSize, m_FontSizeUnit
+    Font_Management.fillLogFontW_Quality tmpLogFont, m_TextRenderingHint
+
+    'Attempt to create a matching GDI font
+    If Font_Management.createGDIFont(tmpLogFont, m_GDIFont) Then
+
+        'Success!  Note that GDI is an acceptable engine for this font, and return success
+        m_curTextEngine = te_GDI
+        m_FontCacheClean = True
+        createGDIFont = True
+
+    Else
+
+        'Failure!  PD doesn't have a fallback beyond GDI, so this whole request is doomed
+        m_curTextEngine = te_UNKNOWN
+        m_FontCacheClean = False
+        createGDIFont = False
+
+    End If
+
+End Function
+
 'Use this function to render arbitrary text to an arbitrary DIB.  Performance should be decent, but if you're going to be making
 ' a ton of successive calls, it's probably worthwhile to cache a GDI+ graphics instance that points to the target.  (This class does
 ' not currently offer a function for that, FYI.)
@@ -719,6 +766,12 @@ Public Function renderTextToDIB(ByRef dstDIB As pdDIB, ByRef srcString As String
 
         'GDI is required
         Case te_GDI
+
+            'Because GDI doesn't support 32-bpp rendering targets, we must manually translate GDI glyphs into GDI+ paths, then render
+            ' the paths manually.  Because this is hugely energy intensive, our separate class attempts to cache glyphs as they are
+            ' created.  This saves us from having to translate glyphs more than once, which is a non-trivial boost on long chunks
+            ' of text.
+
 
         'GDI and GDI+ both failed; at present, we have no fallback for this case
         Case te_UNKNOWN
@@ -839,6 +892,9 @@ Private Sub Class_Terminate()
         If m_GDIPlusFontFamily <> 0 Then GdipDeleteFontFamily m_GDIPlusFontFamily
         If m_GDIPlusStringFormat <> 0 Then GdipDeleteStringFormat m_GDIPlusStringFormat
 
+        'Release any GDI objects we created
+        If m_GDIFont <> 0 Then DeleteObject m_GDIFont
+
     End If
 
 End Sub

Modules/VBP_FontManagement.bas

@@ -25,8 +25,7 @@ Attribute VB_Name = "Font_Management"
 Option Explicit
 
 '****************************************************************************************
-'Note: these types are used in the callback function for EnumFontFamiliesEx; as such, I have declared them as public,
-'       despite them not really being used anywhere but inside this module.
+'Note: these types are used in the callback function for EnumFontFamiliesEx; as such, I have to declare them as public.
 
 Public Const LF_FACESIZEW = 64
 
@@ -74,7 +73,7 @@ Public Type NEWTEXTMETRIC
     ntmAveWidth As Long
 End Type
 
-'END FONT-SPECIFIC DECLARATIONS
+'END PUBLIC ENUMS
 '****************************************************************************************
 
 'Font enumeration types
@@ -112,6 +111,43 @@ Private Declare Function GdipGetFamilyName Lib "gdiplus" (ByVal srcFontFamily As
 Private Const LF_FACESIZE As Long = 32          'Note: this represents 32 *chars*, not bytes!
 Private Const LANG_NEUTRAL As Integer = &H0
 
+'GDI font weight (boldness)
+Private Const FW_DONTCARE As Long = 0
+Private Const FW_THIN As Long = 100
+Private Const FW_EXTRALIGHT As Long = 200
+Private Const FW_ULTRALIGHT As Long = 200
+Private Const FW_LIGHT As Long = 300
+Private Const FW_NORMAL As Long = 400
+Private Const FW_REGULAR As Long = 400
+Private Const FW_MEDIUM As Long = 500
+Private Const FW_SEMIBOLD As Long = 600
+Private Const FW_DEMIBOLD As Long = 600
+Private Const FW_BOLD As Long = 700
+Private Const FW_EXTRABOLD As Long = 800
+Private Const FW_ULTRABOLD As Long = 800
+Private Const FW_HEAVY As Long = 900
+Private Const FW_BLACK As Long = 900
+
+'GDI font quality
+Private Const DEFAULT_QUALITY As Long = 0
+Private Const DRAFT_QUALITY As Long = 1
+Private Const PROOF_QUALITY As Long = 2
+Private Const NONANTIALIASED_QUALITY As Long = 3
+Private Const ANTIALIASED_QUALITY As Long = 4
+Private Const CLEARTYPE_QUALITY As Byte = 5
+
+'GDI font creation
+Private Declare Function CreateFontIndirect Lib "gdi32" Alias "CreateFontIndirectW" (ByRef lpLogFont As LOGFONTW) As Long
+
+'Various non-font-specific WAPI functions helpful for font assembly
+Private Const LOGPIXELSX = 88
+Private Const LOGPIXELSY = 90
+Private Declare Function GetDeviceCaps Lib "gdi32" (ByVal hDC As Long, ByVal nIndex As Long) As Long
+Private Declare Function MulDiv Lib "kernel32" (ByVal nNumber As Long, ByVal nNumerator As Long, ByVal nDenominator As Long) As Long
+
+'Some system-specific font settings are cached at initialization time, and unchanged for the life of the program
+Private curLogPixelsX As Long, curLogPixelsY As Long
+
 'Internal font cache.  PD uses this to populate things like font selection dropdowns.
 Private m_PDFontCache As pdStringStack
 Private Const INITIAL_PDFONTCACHE_SIZE As Long = 256
@@ -137,6 +173,10 @@ Public Function buildFontCache(Optional ByVal getTrueTypeOnly As Boolean = False
     Set m_TestDIB = New pdDIB
     m_TestDIB.createBlank 4, 4, 32, 0, 0
 
+    'Use the DIB to retrieve system-specific font conversion values
+    curLogPixelsX = GetDeviceCaps(m_TestDIB.getDIBDC, LOGPIXELSX)
+    curLogPixelsY = GetDeviceCaps(m_TestDIB.getDIBDC, LOGPIXELSY)
+
     'We now branch into two possible directions:
     ' 1) If getTrueTypeOnly is FALSE, we retrieve all fonts on the PC via GDI's EnumFontFamiliesEx
     ' 2) If getTrueTypeOnly is TRUE, we retrieve only TrueType fonts via GDI+'s getFontFamilyCollectionList function.
@@ -300,4 +340,116 @@ Private Function TrimNull(ByRef origString As String) As String
 
 End Function
 
+'Given some standard font characteristics (font face, style, etc), fill a corresponding LOGFONTW struct with matching values.
+' This is helpful as PD stores characteristics in VB-friendly formats (e.g. booleans for styles), while LOGFONTW uses custom
+' descriptors (e.g. font size, which is not calculated in an obvious way).
+Public Sub fillLogFontW_Basic(ByRef dstLogFontW As LOGFONTW, ByRef srcFontFace As String, ByVal srcFontBold As Boolean, ByVal srcFontItalic As Boolean, ByVal srcFontUnderline As Boolean, ByVal srcFontStrikeout As Boolean)
+
+    With dstLogFontW
+
+        'For Unicode compatibility, the font face must be copied directly, without internal VB translations
+        Dim copyLength As Long
+        copyLength = Len(srcFontFace) * 2
+        If copyLength > LF_FACESIZEW Then copyLength = LF_FACESIZEW
+        CopyMemory ByVal VarPtr(.lfFaceName(0)), ByVal StrPtr(srcFontFace), copyLength
+
+        'Bold is a unique style, because it must be translated to a corresponding weight measurement
+        If srcFontBold Then
+            .lfWeight = FW_BOLD
+        Else
+            .lfWeight = FW_NORMAL
+        End If
+
+        'Other styles all use the same pattern: multiply the bool by -1 to obtain a matching byte-type style
+        .lfItalic = -1 * srcFontItalic
+        .lfUnderline = -1 * srcFontUnderline
+        .lfStrikeOut = -1 & srcFontStrikeout
+
+        'While we're here, set charset to the default value; PD does not deviate from this (at present)
+        .lfCharSet = DEFAULT_CHARSET
+
+    End With
+
+End Sub
+
+'Fill a LOGFONTW struct with a matching PD font size (typically in pixels, but points are also supported)
+Public Sub fillLogFontW_Size(ByRef dstLogFontW As LOGFONTW, ByVal fontSize As Single, ByVal fontMeasurementUnit As pdFontUnit)
+
+    With dstLogFontW
+
+        Select Case fontMeasurementUnit
+
+            'Pixels use a modified version of the standard Windows formula; note that this assumes 96 DPI at present - high DPI
+            ' systems still need testing!  TODO!
+            Case pdfu_Pixel
+
+                'Convert font size to points
+                fontSize = fontSize * 0.75      '(72 / 96, technically, where 96 is the current screen DPI)
+
+                'Use the standard point-based formula
+                .lfHeight = -1 * internal_MulDiv(fontSize, curLogPixelsY, 72)
+
+            'Points are converted using a standard Windows formula; see https://msdn.microsoft.com/en-us/library/dd145037%28v=vs.85%29.aspx
+            Case pdfu_Point
+                .lfHeight = -1 * internal_MulDiv(fontSize, curLogPixelsY, 72)
+
+        End Select
+
+        'Per convention, font width is set to 0 so the font mapper can select an aspect-ratio preserved width for us
+        .lfWidth = 0
+
+    End With
+
+End Sub
+
+'It really isn't necessary to rely on the system MulDiv values for the sizes used for fonts.  By using CLng, we can mimic
+' MulDiv's rounding behavior as well.
+Private Function internal_MulDiv(ByVal srcNumber As Single, ByVal srcNumerator As Single, ByVal srcDenominator As Single) As Long
+    internal_MulDiv = CLng((srcNumber * srcNumerator) / srcDenominator)
+End Function
+
+'Once I have a better idea of what I can do with font quality, I'll be switching the fontQuality Enum to something internal to PD.
+' But right now, I'm still in the exploratory phase, and trying to figure out whether different font quality settings affect
+' the glyph outline returned.  (They should, technically, since hinting affects font shape.)
+Public Sub fillLogFontW_Quality(ByRef dstLogFontW As LOGFONTW, ByVal fontQuality As GdiPlusTextRenderingHint)
 
+    Dim gdiFontQuality As Long
+
+    'Per http://stackoverflow.com/questions/1203087/why-is-graphics-measurestring-returning-a-higher-than-expected-number?lq=1
+    ' this function mirrors the .NET conversion from GDI+ text rendering hints to GDI font quality settings.  Mapping deliberately
+    ' ignores some settings (no idea why, but if the .NET stack does it, there's probably a reason)
+    Select Case fontQuality
+
+        Case TextRenderingHintSystemDefault
+            gdiFontQuality = DEFAULT_QUALITY
+
+        Case TextRenderingHintSingleBitPerPixel
+            gdiFontQuality = DRAFT_QUALITY
+
+        Case TextRenderingHintSingleBitPerPixelGridFit
+            gdiFontQuality = PROOF_QUALITY
+
+        Case TextRenderingHintAntiAlias
+            gdiFontQuality = ANTIALIASED_QUALITY
+
+        Case TextRenderingHintAntiAliasGridFit
+            gdiFontQuality = ANTIALIASED_QUALITY
+
+        Case TextRenderingHintClearTypeGridFit
+            gdiFontQuality = CLEARTYPE_QUALITY
+
+        Case Else
+            Debug.Print "Unknown font quality passed; please double-check requests to fillLogFontW_Quality"
+
+    End Select
+
+    dstLogFontW.lfQuality = gdiFontQuality
+
+End Sub
+
+'Given a filled LOGFONTW struct (hopefully filled by the fillLogFontW_* functions above!), attempt to create an actual font object.
+' Returns TRUE if successful; FALSE otherwise.
+Public Function createGDIFont(ByRef srcLogFont As LOGFONTW, ByRef dstFontHandle As Long) As Boolean
+    dstFontHandle = CreateFontIndirect(srcLogFont)
+    createGDIFont = CBool(dstFontHandle <> 0)
+End Function

PhotoDemon.vbp

@@ -284,7 +284,7 @@ Description="PhotoDemon Photo Editor"
 CompatibleMode="0"
 MajorVer=6
 MinorVer=7
-RevisionVer=99
+RevisionVer=100
 AutoIncrementVer=1
 ServerSupportFiles=0
 VersionComments="Copyright 2000-2015 Tanner Helland -  photodemon.org"