diff --git a/src/Runtime/XSharp.VFP.Tests/OtherTests.prg b/src/Runtime/XSharp.VFP.Tests/OtherTests.prg
index f71002c952..9bd2285a43 100644
--- a/src/Runtime/XSharp.VFP.Tests/OtherTests.prg
+++ b/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")
diff --git a/src/Runtime/XSharp.VFP.UI/VfpUIProvider.prg b/src/Runtime/XSharp.VFP.UI/VfpUIProvider.prg
index 0bad6ffd57..2d7f8906d9 100644
--- a/src/Runtime/XSharp.VFP.UI/VfpUIProvider.prg
+++ b/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
diff --git a/src/Runtime/XSharp.VFP.UI/Win32UI.prg b/src/Runtime/XSharp.VFP.UI/Win32UI.prg
index 5470660aa4..951784e7eb 100644
--- a/src/Runtime/XSharp.VFP.UI/Win32UI.prg
+++ b/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
diff --git a/src/Runtime/XSharp.VFP/ToDo-EF.prg b/src/Runtime/XSharp.VFP/ToDo-EF.prg
index 2b06a9a874..92b1d55d67 100644
--- a/src/Runtime/XSharp.VFP/ToDo-EF.prg
+++ b/src/Runtime/XSharp.VFP/ToDo-EF.prg
@@ -14,13 +14,6 @@ FUNCTION FldList( ) AS USUAL
THROW NotImplementedException{}
// RETURN NIL
-/// -- todo --
-///
-[FoxProFunction("FONTMETRIC", FoxFunctionCategory.UIAndWindow, FoxEngine.UI, FoxFunctionStatus.Stub, FoxCriticality.Medium)];
-FUNCTION FontMetric( nAttribute , cFontName, nFontSize , cFontStyle) AS LONG CLIPPER
- THROW NotImplementedException{}
- // RETURN 0
-
diff --git a/src/Runtime/XSharp.VFP/UI/VfpUIService.prg b/src/Runtime/XSharp.VFP/UI/VfpUIService.prg
index 97df812143..6543ccd7ab 100644
--- a/src/Runtime/XSharp.VFP/UI/VfpUIService.prg
+++ b/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
diff --git a/src/Runtime/XSharp.VFP/UIFunctions.prg b/src/Runtime/XSharp.VFP/UIFunctions.prg
index f724e59abe..2548dcec4e 100644
--- a/src/Runtime/XSharp.VFP/UIFunctions.prg
+++ b/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
+
+///
+[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)