source: Include/Classes/System/Drawing/Font.ab@ 104

#ifndef _GDIPLUSFONT_H
#define _GDIPLUSFONT_H

#require <GdiPlus.ab>
#require <Classes/System/Drawing/Graphics.ab>

Class FontFamily : End Class
Class FontCollection : End Class

Class Font
Public
'    friend class Graphics

    Sub Font(/*IN*/ hdc As HDC)
        Dim font = 0 As *GpFont
        lastResult = GdipCreateFontFromDC(hdc, font)
        SetNativeFont(font)
    End Sub

    Sub Font(/*IN*/ hdc As HDC, /*IN const*/ ByRef logfont As LOGFONTA)
        Dim font = 0 As *GpFont
        lastResult =GdipCreateFontFromLogfontA(hdc, logfont, font)
        SetNativeFont(font)
    End Sub

    Sub Font(/*IN*/ hdc As HDC, /*IN const*/ ByRef logfont As LOGFONTW)
        Dim font = 0 As *GpFont
        lastResult =GdipCreateFontFromLogfontW(hdc, logfont, font)
        SetNativeFont(font)
    End Sub

    Sub Font(/*IN*/ hdc As HDC, /*IN const*/ hfont As HFONT)
        Dim font = 0 As *GpFont
        If hfont <> 0 Then
            Dim lf As LOGFONTA
            If GetObjectA(hfont, sizeof (LOGFONTA), lf) <> 0 Then
                lastResult = GdipCreateFontFromLogfontA(hdc, lf, font)
            Else
                lastResult = GdipCreateFontFromDC(hdc, font)
            End If
        Else
            lastResult = GdipCreateFontFromDC(hdc, font)
        End If
        SetNativeFont(font)
    End Sub

    Sub Font(/*IN const*/ ByRef family As FontFamily, /*IN*/ emSize As Single)
        Font(family, emSize, FontStyleRegular, UnitPoint)
    End Sub

    Sub Font(/*IN const*/ ByRef family As FontFamily,
        /*IN*/ emSize As Single, /*IN*/ style As Long)

        Font(family, emSize, style, UnitPoint)
    End Sub

    Sub Font(/*IN const*/ ByRef family As FontFamily, /*IN*/ emSize As Single,
        /*IN*/ style As Long, /*IN*/ unit As GraphicsUnit)

        Dim font = 0 As *GpFont
        lastResult = GdipCreateFont(
            family.NativeFamily, emSize, style, unit, font)
        SetNativeFont(font)
    End Sub

    Sub Font(/*IN const*/ familyName As *WCHAR, /*IN*/ emSize As Single)
        Font(familyName, emSize, FontStyleRegular, UnitPoint, ByVal 0)
    End Sub

    Sub Font(/*IN const*/ familyName As *WCHAR, /*IN*/ emSize As Single,
         /*IN*/ style As Long)
        Font(familyName, emSize, style, UnitPoint, ByVal 0)
    End Sub

    Sub Font(/*IN const*/ familyName As *WCHAR, /*IN*/ emSize As Single,
         /*IN*/ style As Long, /*IN*/ unit As GraphicsUnit)
        Font(familyName, emSize, style, unit, ByVal 0)
    End Sub

    Sub Font(/*IN const*/ familyName As *WCHAR, /*IN*/ emSize As Single,
        /*IN*/ style As Long, /*IN*/ unit As GraphicsUnit,
        /*IN const*/ ByRef fontCollection As FontCollection)

        nativeFont = 0

        Dim family As FontFamily(familyName, fontCollection)
        Dim nativeFamily = family.NativeFamily As *GpFontFamily

        lastResult = family.GetLastStatus()

        If lastResult <> Ok Then
            nativeFamily = FontFamily.GenericSansSerif()->NativeFamily
            lastResult = FontFamily.GenericSansSerif()->lastResult
            If lastResult <> Ok Then
                Exit Sub
            End If
        End If

        lastResult = GdipCreateFont(
            nativeFamily, emSize, style, unit, nativeFont)

        If lastResult <> Ok Then
            nativeFamily = FontFamily.GenericSansSerif()->NativeFamily
            lastResult = FontFamily.GenericSansSerif()->lastResult
            If lastResult <> Ok Then
                Exit Sub
            End If

            lastResult = GdipCreateFont(
                nativeFamily, emSize, style, unit, nativeFont)
        End If
    End Sub

    Const Function GetLogFontA(/*IN const*/ ByRef g As Graphics, /*OUT*/ ByRef lf As LOGFONTA) As Status
        Dim nativeGraphics As *GpGraphics
        If VarPtr(g) <> 0 Then
            nativeGraphics = g.nativeGraphics
        End If
        Return SetStatus(GdipGetLogFontA(nativeFont, nativeGraphics, lf))
    End Function

    Const Function GetLogFontW(/*IN const*/ ByRef g As Graphics, /*OUT*/ ByRef lf As LOGFONTW) As Status
        Dim nativeGraphics As *GpGraphics
        If VarPtr(g) <> 0 Then
            nativeGraphics = g.nativeGraphics
        End If
        Return SetStatus(GdipGetLogFontW(nativeFont, nativeGraphics, lf))
    End Function

    Const Function Clone() As *Font
        Dim cloneFont = 0 As *GpFont
        SetStatus(GdipCloneFont(nativeFont, cloneFont))
        Return New Font(cloneFont, lastResult)
    End Function

    Sub ~Font()
        GdipDeleteFont(nativeFont)
    End Sub

    Const Function IsAvailable() As BOOL
        Return nativeFont <> 0
    End Function

    Const Function Style() As Long
        SetStatus(GdipGetFontStyle(nativeFont, Style))
    End Function

    Const Function Size() As Single
        SetStatus(GdipGetFontSize(nativeFont, Size))
    End Function

    Const Function Unit() As GraphicsUnit
        SetStatus(GdipGetFontUnit(nativeFont, Unit))
    End Function

    Const Function LastStatus() As Status
        Return lastResult
    End Function

    Const Function Height() As Single
        Return GetHeight()
    End Function

    Const Function GetHeight() As Single
        SetStatus(GdipGetFontHeight(nativeFont, 0, GetHeight))
    End Function

    Const Function GetHeight(/*IN const*/ ByRef g As Graphics) As Single
        Dim nativeGraphics As *GpGraphics
        If VarPtr(g) <> 0 Then
            nativeGraphics = g.NativeGraphics
        End If
        SetStatus(GdipGetFontHeight(nativeFont, nativeGraphics, GetHeight))
    End Function

    Const Function GetHeight(/*IN*/ dpi As Single) As Single
        SetStatus(GdipGetFontHeightGivenDPI(nativeFont, dpi, GetHeight))
    End Function

'    Const Function FontFamily(/*OUT*/ ByRef family As FontFamily)
'       If VarPtr(family) = 0 Then
'           Return SetStatus(Status.InvalidParameter)
'       End If
'       Dim status = GdipGetFamily(nativeFont, family->nativeFamily)
'       family->SetStatus(status)
'       Return SetStatus(status)
'   End Function

    Const Function NativeFont() As *GpFont
        Return nativeFont
    End Function

Private
'   Sub Font(ByRef f As Font)
    Sub Operator =(ByRef f As Font)
        Debug
    End Sub

Protected
    Sub Font(f As *GpFont, status As Status)
        lastResult = status
        SetNativeFont(f)
    End Sub

    Sub SetNativeFont(f As *GpFont)
        nativeFont = f
    End Sub

    Const Function SetStatus(s As Status) As Status
        If s <> Status.Ok Then
            lastResult = s
            Return s
        Else
            Return s
        End If
    End Function

Protected
    nativeFont As *GpFont
    /*mutable*/ lastResult As Status
End Class

#endif