#include once "window9.bi"

Dim Shared As ChooseFont g_CF
Dim Shared As LOGFONT    g_LF
Function FontRequester(byval hwnd As HWND = 0, byval nColor As Integer = 0) As integer Export
    dim as HWND hwFocus = GetFocus()
    Dim As HFONT hfont
    ZeroMemory(@g_CF, sizeof(g_CF))
    g_CF.lStructSize = sizeof (g_CF)
    g_CF.hwndOwner = hwnd
    g_CF.lpLogFont = @g_LF
    g_CF.rgbColors = nColor
    g_CF.Flags = 1 or 256
    if (ChooseFont(Cast(LPCHOOSEFONT,@g_CF))<>FALSE) Then
        hfont = CreateFontIndirect(cast(LOGFONT ptr,g_CF.lpLogFont))
    EndIf
    SetFocus(hwFocus)
    Return CInt(hfont)
End Function

Function SelectedFontColor() As Integer Export
    Return g_CF.rgbColors
End Function

Function SelectedFontName() As USTRING Export
    dim as USTRING sRet = g_LF.lfFaceName
    Return sRet
End Function

Function SelectedFontSize() As Integer Export
    Dim As HDC hdc=GetDC( 0 )
    Function =  -MulDiv(g_LF.lfHeight,72 , GetDeviceCaps(hdc,LOGPIXELSY) )
    ReleaseDC(0,hdc)
End Function

Function SelectedFontStyle(ByVal style As Byte) As Byte Export
    Select Case style
        Case 1
            If g_LF.lfWeight<>700 Then
                Return 0
            Else
                Return 1
            EndIf
        Case 2
            Return -g_LF.lfItalic
        Case 3
            Return g_LF.lfUnderline
        Case 4
            Return g_LF.lfStrikeOut
    End Select
End Function

Function GetSystemDefaultFont() As Integer
    
    Return Cint(GetStockObject(SYSTEM_FONT))
    
    'static as Integer font
    'dim as NONCLIENTMETRICS ncm
    'ncm.cbSize = sizeof(ncm)
    'if LOBYTE(LOWORD(GetVersion())) >=6 then
    'if font = 0 then
    'SystemParametersInfo(SPI_GETNONCLIENTMETRICS, ncm.cbSize, @ncm, 0)
    'font = cint(CreateFontIndirect(@(ncm.lfMessageFont))) 
    'endif
    'return font
    'else
    'if font = 0 then
    'font = loadfont("Tahoma" , 8)
    'EndIf
    'Return font
    'endif
    
End Function

Function GetCurentDefaultFont() As Integer
    
    Dim As Integer font = win9GetGadgetFont()
    If font Then
        Return font
    Else
        Return Cint(GetStockObject(SYSTEM_FONT))
    Endif
    
End Function

Function GetNameFromFont(font As Integer) As UString
    
    Dim As LOGFONT lf
    GetObject(Cast(Any Ptr,font), Sizeof(LOGFONT), @lf)
    Return lf.lfFaceName
    
End Function

Function GetSizeFromFont(font As Integer) As Long
    
    Dim As LOGFONT lf
    GetObject(Cast(Any Ptr,font), Sizeof(LOGFONT), @lf)
    Dim As HDC hdc = GetDc(0)
    Dim As Long pointsize  = Abs(MulDiv(lf.lfHeight, 72, GetDeviceCaps(hdc, LOGPIXELSY)))
    ReleaseDc(0 , hdc)
    Return pointsize
    
End Function

Function GetStyleFromFont(font As Integer, iStyle As Long) As Long
    
    Dim As LOGFONT lf
    GetObject(Cast(Any Ptr,font), Sizeof(LOGFONT), @lf)
    If iStyle = 1 Then
        If lf.lfWeight=700 Then
            Return 1
        Endif
    Elseif iStyle = 2 Then
        If lf.lfItalic Then
            Return 1
        Endif
    Elseif iStyle = 3 Then
        If lf.lfUnderline Then
            Return 1
        Endif
    Elseif iStyle = 4 Then
        If lf.lfStrikeOut Then
            Return 1
        Endif
    Endif
    
End Function

Sub GetSizeStringFromFont(sText As UString , font As Integer , Byref iW As Long , Byref iH As Long)
    
    Dim As SIZE t
    Dim As HDC hdc = GetDC(0)
    Dim As HDC hOldFont
    hOldFont = SelectObject(hdc, Cast(Any Ptr,font))
    #ifdef UNICODE
        GetTextExtentPoint32(hdc , *sText , Len(sText), @t)
    #else
        GetTextExtentPoint32(hdc , sText , Len(sText), @t)
    #EndIf
    SelectObject(hdc, hOldFont)
    ReleaseDc(0,hdc)
    iW = t.cx
    iH = t.cy
    
End Sub