source: branch/egtra-gdiplus/Classes/System/Drawing/Font.ab@ 353

#ifndef _GDIPLUSFONT_H
#define _GDIPLUSFONT_H

#require <GdiPlusTypes.ab>
#require <GdiPlusGpStubs.ab>
#require <GdiPlusFlat.ab>
#require <Classes/System/Drawing/misc.ab>
#require <Classes/System/Drawing/Graphics.ab>

Namespace System
Namespace Drawing

Class FontFamily : End Class

Namespace Text
Class FontCollection : End Class
End Namespace

'Todo: コンストラクタ内での別コンストラクタ呼出を修正せよ

Class Font
Public
'    friend class Graphics

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

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

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

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

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

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

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

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

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

    Sub Font(/*IN const*/ familyName As PCWSTR, /*IN*/ emSize As Single)
        Font(familyName, emSize, FontStyleRegular, Unit.Point, ByVal 0)
    End Sub

    Sub Font(/*IN const*/ familyName As String, /*IN*/ emSize As Single)
        Font(familyName, emSize, FontStyleRegular, Unit.Point, ByVal 0)
    End Sub

    Sub Font(/*IN const*/ familyName As PCWSTR, /*IN*/ emSize As Single,
         /*IN*/ style As Long)
        Font(familyName, emSize, style, Unit.Point, ByVal 0)
    End Sub

    Sub Font(/*IN const*/ familyName As String, /*IN*/ emSize As Single,
         /*IN*/ style As Long)
        Font(familyName, emSize, style, Unit.Point, ByVal 0)
    End Sub

    Sub Font(/*IN const*/ familyName As PCWSTR, /*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 String, /*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 PCWSTR, /*IN*/ emSize As Single,
        /*IN*/ style As Long, /*IN*/ unit As GraphicsUnit,
        /*IN const*/ ByRef fontCollection As Text.FontCollection)

        nativeFont = 0

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

        lastResult = family.GetLastStatus()

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

        lastResult = Gdiplus.DllExports.GdipCreateFont(
            nativeFamily, emSize, style, unit, nativeFont)

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

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

    Sub Font(/*IN const*/ familyName As String, /*IN*/ emSize As Single,
        /*IN*/ style As Long, /*IN*/ unit As GraphicsUnit,
        /*IN const*/ fontCollection As Text.FontCollection)
        Font(ToWCStr(familyName), emSize, style, unit, fontCollection)
    End Sub

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

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

    Const Function GetLogFont(/*IN const*/ g As Graphics, /*OUT*/ ByRef lf As LOGFONT) As Gdiplus.Status
        Dim nativeGraphics As *GpGraphics
        If VarPtr(g) <> 0 Then
            nativeGraphics = g.nativeGraphics
        End If
#ifdef UNICODE
        Return SetStatus(Gdiplus.DllExports.GdipGetLogFontW(nativeFont, nativeGraphics, lf))
#else
        Return SetStatus(Gdiplus.DllExports.GdipGetLogFontA(nativeFont, nativeGraphics, lf))
#endif
    End Function

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

    Sub Dispose()
        Gdiplus.DllExports.GdipDeleteFont(nativeFont)
        nativeFont = 0
    End Sub

    Sub ~Font()
        If nativeFont <> 0 Then
            Dispose()
        End If
    End Sub

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

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

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

'   Const Function SizeInPoints() As Single

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

    Const Function LastStatus() As Gdiplus.Status
        Return lastResult
    End Function

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

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

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

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

'    Const Function FontFamily(/*OUT*/ ByRef family As FontFamily)
'       family = New FontFamily
'       Dim status = GdipGetFamily(nativeFont, family.nativeFamily)
'       family.SetStatus(status)
'       Return SetStatus(status)
'   End Function

    Const Function Bold() As Boolean
        Dim lf As LOGFONT
        GetLogFont(0, lf)
        Return lf.lfWeight > FW_BOLD
    End Function

    Const Function GdiCharSet() As Byte
        Dim lf As LOGFONT
        GetLogFont(0, lf)
        Return lf.lfCharSet
    End Function

    'Const Function GdiVerticalFont() As Boolean

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

    'Const Function IsSystemFont() As Boolean

    Const Function Italic() As Boolean
        Dim lf As LOGFONT
        GetLogFont(0, lf)
        Return lf.lfItalic <> FALSE
    End Function

    Const Function Name() As String
#ifdef __STRING_IS_NOT_UNICODE
        Dim lf As LOGFONTA
        GetLogFontA(0, lf)
#else
        Dim lf As LOGFONTW
        GetLogFontW(0, lf)
#endif
        Return lf.lfFaceName
    End Function

    'Const Function SizeInPoint() As Boolean

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

    Const Function StrikeOut() As Boolean
        Dim lf As LOGFONT
        GetLogFont(0, lf)
        Return lf.fdwStrikeOut <> FALSE
    End Function

    Const Function Style() As FontStyle
        Dim lf As LOGFONT
        GetLogFont(0, lf)
        Return (((lf.lfWeight > FW_BOLD) And FontStyle.Bold) Or _
            ((lf.lfItatlic <> FALSE) And FontStyle.Italic) Or _
            ((lf.fdwStrikeOut <> FALSE) And FontStyle.Strickeout) Or _
            ((lf.fdwUnderline <> FALSE) And FontStyle.Underline)) As FontStyle
    End Function

    'Const Function SystemFontName() As String

    Const Function Underline() As Boolean
        Dim lf As LOGFONT
        GetLogFont(0, lf)
        Return lf.fdwUnderline <> FALSE
    End Function

    Override Function ToString() As String
        Return Name
    End Function

    Const Function ToHfont() As HFONT
        Dim lf As LOGFONT
        GetLogFont(ByVal 0, lf)
        Return CreateFontIndirect(lf)
    End Function

    Const Sub ToLogFont(ByRef lf As LOGFONT)
        GetLogFont(ByVal 0, lf)
    End Sub

    Const Sub ToLogFont(ByRef lf As LOGFONT, g As Graphics)
        GetLogFont(g, lf)
    End Sub

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

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

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

End Namespace 'Drawing
End Namespace 'System

#endif