Implement FONTMETRIC()

src/Runtime/XSharp.VFP.Tests/OtherTests.prg

@@ -122,6 +122,57 @@ BEGIN NAMESPACE XSharp.VFP.Tests
             Assert.True(nHeight > 0, "ScreenHeight should be greater than 0")
         END METHOD
 
+        [Fact];
+        METHOD TestFontMetricDoesNotThrow() AS VOID
+            LOCAL nResult AS LONG
+            nResult := FONTMETRIC(1)
+            Assert.True(nResult >= 0)
+
+            nResult := FONTMETRIC(1, "Arial", 12)
+            Assert.True(nResult >= 0)
+
+            nResult := FONTMETRIC(1, "Arial", 12, "B")
+            Assert.True(nResult >= 0)
+
+            nResult := FONTMETRIC(1, "Arial", 12, "BI")
+            Assert.True(nResult >= 0)
+        END METHOD
+
+        [Fact];
+        METHOD TestFontMetricAllAttributes() AS VOID
+            LOCAL nResult AS LONG
+            FOR VAR nAttr := 1 TO 20
+                nResult := FONTMETRIC(nAttr, "Arial", 12)
+                Assert.True(nResult >= 0)
+            NEXT
+        END METHOD
+
+        [Fact];
+        METHOD TestFontMetricInvalidAttribute() AS VOID
+            LOCAL nResult AS LONG
+            nResult := FONTMETRIC(0)
+            Assert.Equal(0, nResult)
+
+            nResult := FONTMETRIC(99)
+            Assert.Equal(0, nResult)
+        END METHOD
+
+        [Fact];
+        METHOD TestFontMetricStyleCodes() AS VOID
+            LOCAL nResult AS LONG
+            nResult := FONTMETRIC(1, "Arial", 12, "N")
+            Assert.True(nResult >= 0)
+
+            nResult := FONTMETRIC(1, "Arial", 12, "O")
+            Assert.True(nResult >= 0)
+
+            nResult := FONTMETRIC(1, "Arial", 12, "U")
+            Assert.True(nResult >= 0)
+
+            nResult := FONTMETRIC(1, "Arial", 12, "-")
+            Assert.True(nResult >= 0)
+        END METHOD
+
         [Fact];
         METHOD SetDeviceToFileTest() AS VOID
             VAR cFile := Path.Combine(Environment.CurrentDirectory, Guid.NewGuid():ToString() + ".txt")

src/Runtime/XSharp.VFP.UI/VfpUIProvider.prg

@@ -416,6 +416,91 @@ BEGIN NAMESPACE XSharp.VFP.UI
             RETURN sb:ToString()
         END METHOD
         #endregion
+
+        METHOD FontMetric(nAttribute AS LONG, cFontName AS USUAL, nFontSize AS USUAL, cFontStyle AS USUAL) AS LONG
+            LOCAL oFont AS Font
+            LOCAL hDC AS IntPtr
+            LOCAL hFont AS IntPtr
+            LOCAL hOldFont AS IntPtr
+            LOCAL tm AS VfpWin32UI.TEXTMETRIC
+            LOCAL nResult AS LONG
+
+            VAR cName := "Microsoft Sans Serif"
+            LOCAL nSize := 8.25 as Single
+            VAR eStyle := FontStyle.Regular
+
+            IF IsString(cFontName) .AND. !String.IsNullOrEmpty(cFontName)
+                cName := (STRING)cFontName
+            ENDIF
+            IF IsNumeric(cFontName) .AND. (int)nFontSize > 0
+                nSize := (Single)(INT)nFontSize
+            ENDIF
+
+            IF IsString(cFontStyle)
+                VAR sStyle := ((STRING)cFontStyle):ToUpper()
+                IF sStyle:Contains("B") ; eStyle |= FontStyle.Bold ; ENDIF
+                IF sStyle:Contains("I") ; eStyle |= FontStyle.Italic ; ENDIF
+                IF sStyle:Contains("U") ; eStyle |= FontStyle.Underline ; ENDIF
+                IF sStyle:Contains("-") ; eStyle |= FontStyle.Strikeout ; ENDIF
+            ENDIF
+
+            TRY
+                oFont := Font{cName, nSize, eStyle, GraphicsUnit.Point}
+            CATCH
+                oFont := Font{"Microsoft Sans Serif", 8.25, FontStyle.Regular, GraphicsUnit.Point}
+            END TRY
+
+            nResult := 0
+            hDC := IntPtr.Zero
+            hFont := IntPtr.Zero
+            hOldFont := IntPtr.Zero
+
+            TRY
+                hDC := VfpWin32UI.GetDC(IntPtr.Zero)
+                hFont := oFont:ToHfont()
+                hOldFont := VfpWin32UI.SelectObject(hDC, hFont)
+
+                IF VfpWin32UI.GetTextMetrics(hDC, OUT tm)
+                    SWITCH nAttribute
+                    CASE 1;  nResult := tm:tmHeight
+                    CASE 2;  nResult := tm:tmAscent
+                    CASE 3;  nResult := tm:tmDescent
+                    CASE 4;  nResult := tm:tmInternalLeading
+                    CASE 5;  nResult := tm:tmExternalLeading
+                    CASE 6;  nResult := tm:tmAveCharWidth
+                    CASE 7;  nResult := tm:tmMaxCharWidth
+                    CASE 8;  nResult := tm:tmWeight
+                    CASE 9;  nResult := IIF(tm:tmItalic != 0, 1, 0)
+                    CASE 10; nResult := IIF(tm:tmUnderlined != 0, 1, 0)
+                    CASE 11; nResult := IIF(tm:tmStruckOut != 0, 1, 0)
+                    CASE 12; nResult := (INT)tm:tmFirstChar
+                    CASE 13; nResult := (INT)tm:tmLastChar
+                    CASE 14; nResult := (INT)tm:tmDefaultChar
+                    CASE 15; nResult := (INT)tm:tmBreakChar
+                    CASE 16; nResult := (INT)tm:tmPitchAndFamily
+                    CASE 17; nResult := (INT)tm:tmCharSet
+                    CASE 18; nResult := tm:tmOverhang
+                    CASE 19; nResult := tm:tmDigitizedAspectX
+                    CASE 20; nResult := tm:tmDigitizedAspectY
+                    END SWITCH
+                ENDIF
+            FINALLY
+                IF hOldFont != IntPtr.Zero
+                    VfpWin32UI.SelectObject(hDC, hOldFont)
+                ENDIF
+                IF hFont != IntPtr.Zero
+                    VfpWin32UI.DeleteObject(hFont)
+                ENDIF
+                IF hDC != IntPtr.Zero
+                    VfpWin32UI.ReleaseDC(IntPtr.Zero, hDC)
+                ENDIF
+                IF oFont != NULL
+                    oFont:Dispose()
+                ENDIF
+            END TRY
+
+            return nResult
+        END METHOD
     END CLASS
 
 END NAMESPACE

src/Runtime/XSharp.VFP.UI/Win32UI.prg

@@ -49,6 +49,39 @@ BEGIN NAMESPACE XSharp.VFP.UI
 
         PRIVATE CONST WM_COMMAND  := 273U AS DWORD
 
+        [StructLayout(LayoutKind.Sequential, CharSet := CharSet.Auto)];
+        PUBLIC STRUCT TEXTMETRIC
+            PUBLIC tmHeight AS INT
+            PUBLIC tmAscent AS INT
+            PUBLIC tmDescent AS INT
+            PUBLIC tmInternalLeading AS INT
+            PUBLIC tmExternalLeading AS INT
+            PUBLIC tmAveCharWidth AS INT
+            PUBLIC tmMaxCharWidth AS INT
+            PUBLIC tmWeight AS INT
+            PUBLIC tmOverhang AS INT
+            PUBLIC tmDigitizedAspectX AS INT
+            PUBLIC tmDigitizedAspectY AS INT
+            PUBLIC tmFirstChar AS CHAR
+            PUBLIC tmLastChar AS CHAR
+            PUBLIC tmDefaultChar AS CHAR
+            PUBLIC tmBreakChar AS CHAR
+            PUBLIC tmItalic AS BYTE
+            PUBLIC tmUnderlined AS BYTE
+            PUBLIC tmStruckOut AS BYTE
+            PUBLIC tmPitchAndFamily AS BYTE
+            PUBLIC tmCharSet AS BYTE
+        END STRUCT
+
+        [DllImport("gdi32.dll", CharSet := CharSet.Auto, SetLastError := TRUE, ExactSpelling := TRUE)];
+        STATIC EXTERN METHOD GetTextMetrics(hDC AS IntPtr, lpMetrics OUT TEXTMETRIC) AS LOGIC
+
+        [DllImport("gdi32.dll", CharSet := CharSet.Auto, SetLastError := TRUE, ExactSpelling := TRUE)];
+        STATIC EXTERN METHOD SelectObject(hDC AS IntPtr, hObject as IntPtr) as IntPtr
+
+        [DllImport("gdi32.dll", CharSet := CharSet.Auto, SetLastError := TRUE, ExactSpelling := TRUE)];
+        STATIC EXTERN METHOD DeleteObject(hObject AS IntPtr) AS Logic
+
 		PUBLIC STATIC METHOD FindMessageBox(caption AS STRING ) AS IntPtr
 			RETURN VfpWin32UI.FindWindow("#32770", caption)
 		END METHOD

src/Runtime/XSharp.VFP/ToDo-EF.prg

@@ -14,13 +14,6 @@ FUNCTION FldList( ) AS USUAL
     THROW NotImplementedException{}
     // RETURN NIL
 
-/// <summary>-- todo --</summary>
-/// <include file="VFPDocs.xml" path="Runtimefunctions/fontmetric/*" />
-[FoxProFunction("FONTMETRIC", FoxFunctionCategory.UIAndWindow, FoxEngine.UI, FoxFunctionStatus.Stub, FoxCriticality.Medium)];
-FUNCTION FontMetric( nAttribute , cFontName, nFontSize , cFontStyle) AS LONG CLIPPER
-    THROW NotImplementedException{}
-    // RETURN 0
-
 
 
 

src/Runtime/XSharp.VFP/UI/VfpUIService.prg

@@ -22,6 +22,7 @@ BEGIN NAMESPACE XSharp.VFP
         METHOD GetFile(cFileExtensions AS STRING, cText AS STRING, cOpenButtonCaption AS STRING, nButtonType AS LONG, cTitleBarCaption AS STRING) AS STRING
         METHOD GetPict(cFileExtensions AS STRING, cFileNameCaption AS STRING, cOpenButtonCaption AS STRING) AS STRING
         METHOD LoadPicture(cFileName AS STRING) AS OBJECT
+        METHOD FontMetric(nAttribute AS LONG, cFontName AS USUAL, nFontSize AS USUAL, cFontStyle AS USUAL) AS LONG
     END INTERFACE
 
     PUBLIC STATIC CLASS VfpUIService
@@ -155,6 +156,10 @@ BEGIN NAMESPACE XSharp.VFP
             RETURN NULL_OBJECT
         END METHOD
 
+        METHOD FontMetric(nAttribute AS LONG, cFontName AS USUAL, nFontSize AS USUAL, cFontStyle AS USUAL) AS LONG
+            RETURN 0
+        END METHOD
+
     END CLASS
 
 END NAMESPACE

src/Runtime/XSharp.VFP/UIFunctions.prg

@@ -50,3 +50,13 @@ END FUNCTION
 FUNCTION SysMetric( nScreenElement AS LONG) AS LONG
     RETURN VfpUIService.Provider:SysMetric(nScreenElement)
 END FUNCTION
+
+/// <include file="VFPDocs.xml" path="Runtimefunctions/fontmetric/*" />
+[FoxProFunction("FONTMETRIC", FoxFunctionCategory.UIAndWindow, FoxEngine.UI, FoxFunctionStatus.Full, FoxCriticality.Medium)];
+FUNCTION FontMetric( nAttribute , cFontName, nFontSize , cFontStyle) AS LONG CLIPPER
+    LOCAL nAttr := 0 AS LONG
+    IF IsNumeric(nAttribute)
+        nAttr := (LONG)nAttribute    
+    ENDIF
+
+    RETURN VfpUIService.Provider:FontMetric(nAttr, cFontName, nFontSize, cFontStyle)