source: trunk/ab5.0/ablib/src/Classes/System/Drawing/Font.ab@ 698

Namespace System
Namespace Drawing

/**
@file Classes/System/Drawing/Font.ab
@brief Fontクラスなどの実装。
*/

Class FontCollection
Public
    nativeCollection As *GpFontCollection
End Class

Class Font
    Implements System.IDisposable
Public
    Static Function FromHDC(/*IN*/ hdc As HDC) As Font
        Dim font = 0 As *GpFont
        SetStatus(GdipCreateFontFromDC(hdc, font))
        FromHDC = New Font(font)
    End Function

    Static Function FromLogFont(/*IN*/ hdc As HDC, /*IN const*/ ByRef logfont As LOGFONTA) As Font
        Dim font = 0 As *GpFont
        SetStatus(GdipCreateFontFromLogfontA(hdc, logfont, font))
        FromLogFont = New Font(font)
    End Function

    Static Function FromLogFont(/*IN*/ hdc As HDC, /*IN const*/ ByRef logfont As LOGFONTW) As Font
        Dim font = 0 As *GpFont
        SetStatus(GdipCreateFontFromLogfontW(hdc, logfont, font))
        FromLogFont = New Font(font)
    End Function

    Static Function FromHFont(/*IN*/ hdc As HDC, /*IN const*/ hfont As HFONT) As Font
        Dim font = 0 As *GpFont
        If hfont <> 0 Then
            Dim lf As LOGFONTA
            If GetObjectA(hfont, Len(lf), lf) <> 0 Then
                SetStatus(GdipCreateFontFromLogfontA(hdc, lf, font))
            Else
                SetStatus(GdipCreateFontFromDC(hdc, font))
            End If
        Else
            SetStatus(GdipCreateFontFromDC(hdc, font))
        End If
        FromHFont = New Font(font)
    End Function

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

    Sub Font(/*IN const*/ family As FontFamily, /*IN*/ emSize As Single)
        initFont(family, emSize, FontStyle.Regular, GraphicsUnit.Point)
    End Sub

    Sub Font(/*IN const*/ family As FontFamily, /*IN*/ emSize As Single, /*IN*/ style As FontStyle)
        initFont(family, emSize, style, GraphicsUnit.Point)
    End Sub

    Sub Font(/*IN const*/ family As FontFamily, /*IN*/ emSize As Single, /*IN*/ unit As GraphicsUnit)
        initFont(family, emSize, FontStyle.Regular, unit)
    End Sub

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

        initFont(family, emSize, style, unit)
    End Sub

    Sub Font(/*IN const*/ familyName As PCWSTR, /*IN*/ emSize As Single)
        initFromName(familyName, emSize, FontStyle.Regular, GraphicsUnit.Point, Nothing)
    End Sub

    Sub Font(/*IN const*/ familyName As String, /*IN*/ emSize As Single)
        initFromName(ToWCStr(familyName), emSize, FontStyle.Regular, GraphicsUnit.Point, Nothing)
    End Sub

    Sub Font(/*IN const*/ familyName As PCWSTR, /*IN*/ emSize As Single, /*IN*/ style As FontStyle)
        initFromName(familyName, emSize, style, GraphicsUnit.Point, Nothing)
    End Sub

    Sub Font(/*IN const*/ familyName As String, /*IN*/ emSize As Single, /*IN*/ style As FontStyle)
        initFromName(ToWCStr(familyName), emSize, style, GraphicsUnit.Point, Nothing)
    End Sub

    Sub Font(/*IN const*/ familyName As PCWSTR, /*IN*/ emSize As Single, /*IN*/ unit As GraphicsUnit)
        initFromName(familyName, emSize, FontStyle.Regular, unit, Nothing)
    End Sub

    Sub Font(/*IN const*/ familyName As String, /*IN*/ emSize As Single, /*IN*/ unit As GraphicsUnit)
        initFromName(ToWCStr(familyName), emSize, FontStyle.Regular, unit, Nothing)
    End Sub

    Sub Font(/*IN const*/ familyName As PCWSTR, /*IN*/ emSize As Single,
         /*IN*/ style As FontStyle, /*IN*/ unit As GraphicsUnit)

        initFromName(familyName, emSize, style, unit, Nothing)
    End Sub

    Sub Font(/*IN const*/ familyName As String, /*IN*/ emSize As Single,
         /*IN*/ style As FontStyle, /*IN*/ unit As GraphicsUnit)

        initFromName(ToWCStr(familyName), emSize, style, unit, Nothing)
    End Sub

    Sub Font(/*IN const*/ familyName As PCWSTR, /*IN*/ emSize As Single,
        /*IN*/ style As FontStyle, /*IN*/ unit As GraphicsUnit,
        /*IN const*/ fontCollection As FontCollection)

        initFromName(familyName, emSize, style, unit, fontCollection)
    End Sub

    Sub Font(/*IN const*/ familyName As String, /*IN*/ emSize As Single,
        /*IN*/ style As FontStyle, /*IN*/ unit As GraphicsUnit,
        /*IN const*/ fontCollection As FontCollection)

        initFromName(ToWCStr(familyName), emSize, style, unit, fontCollection)
    End Sub

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

    Sub Dispose()
        If nativeFont <> 0 Then
            GdipDeleteFont(nativeFont)
        End If
        nativeFont = 0
    End Sub

    Sub ~Font()
        Dispose()
    End Sub

'   Const Function Style() As FontStyle
'       SetStatus(GdipGetFontStyle(nativeFont, Style))
'   End Function

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

'   Const Function SizeInPoints() As Single
'   End Function

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

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

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

    Const Function GetHeight(/*IN const*/ g As Graphics) As Single
        Dim nativeGraphics = getNativeGraphics(g)
        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() As FontFamily
'       Dim nativeFamily As *GpFamily
'       SetStatus(GdipGetFamily(nativeFont, nativeFamily))
'       FontFamily = New FontFamily(nativeFamily)
'   End Function

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

    Const Function GdiCharSet() As Byte
        Dim lf As LOGFONT
        ToLogFont(lf)
        Return lf.lfCharSet
    End Function

    'Const Function GdiVerticalFont() As Boolean

    'Const Function IsSystemFont() As Boolean

    Const Function Italic() As Boolean
        Dim lf As LOGFONT
        ToLogFont(lf)
        Italic = lf.lfItalic <> FALSE
    End Function

    Const Function Name() As String
        Dim lf As LOGFONT
        ToLogFont(lf)
        Dim p = lf.lfFaceName As PCTSTR
        Name = New String(p)
    End Function

    Const Function StrikeOut() As Boolean
        Dim lf As LOGFONT
        ToLogFont(lf)
        StrikeOut = lf.lfStrikeOut <> FALSE
    End Function

    Const Function Style() As FontStyle
        Dim lf As LOGFONT
        ToLogFont(lf)
        Style = FontStyle.Regular
        If lf.lfWeight > FW_BOLD Then
            Style Or= FontStyle.Bold
        End If
        If lf.lfItalic <> FALSE Then
            Style Or= FontStyle.Italic
        End If
        If lf.lfStrikeOut <> FALSE Then
            Style Or= FontStyle.Strikeout
        End If
        If lf.lfUnderline <> FALSE Then
            Style Or= FontStyle.Underline
        End If
    End Function

    'Const Function SystemFontName() As String

    Const Function Underline() As Boolean
        Dim lf As LOGFONT
        ToLogFont(lf)
        Underline = lf.lfUnderline <> FALSE
    End Function

    Override Function ToString() As String
        ToString = Name
    End Function

    Const Function ToHfont() As HFONT
        Dim lf As LOGFONT
        ToLogFont(lf)
        ToHfont = CreateFontIndirect(lf)
    End Function

    Const Sub ToLogFont(/*OUT*/ ByRef lf As LOGFONTA, /*IN const*/ g As Graphics)
        Dim nativeGraphics = getNativeGraphics(g)
        SetStatus(GdipGetLogFontA(nativeFont, nativeGraphics, lf))
    End Sub

    Const Sub ToLogFont(/*OUT*/ ByRef lf As LOGFONTW, /*IN const*/ g As Graphics)
        Dim nativeGraphics = getNativeGraphics(g)
        SetStatus(GdipGetLogFontW(nativeFont, nativeGraphics, lf))
    End Sub

    Const Sub ToLogFont(ByRef lf As LOGFONTA)
        ToLogFont(lf, Nothing)
    End Sub

    Const Sub ToLogFont(ByRef lf As LOGFONTW)
        ToLogFont(lf, Nothing)
    End Sub

    Function NativeFont() As *GpFont
        NativeFont = nativeFont
    End Function

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

        If ActiveBasic.IsNothing(family) Then
            Throw New ArgumentNullException("family")
        End If
        SetStatus(GdipCreateFont(family.NativeFamily, emSize, style, unit, nativeFont))
    End Sub

    Sub initFromName(/*IN const*/ familyName As PCWSTR, /*IN*/ emSize As Single,
        /*IN*/ style As Long, /*IN*/ unit As GraphicsUnit, fontCollection As FontCollection)

        nativeFont = 0
        Dim family = Nothing As FontFamily
        Dim nativeFamily = family.NativeFamily

        Try
            family = New FontFamily(familyName, fontCollection)
        Catch e As Exception
            nativeFamily = FontFamily.GenericSansSerif().NativeFamily
        End Try

        Try
            SetStatus(GdipCreateFont(nativeFamily, emSize, style, unit, nativeFont))
        Catch e As Exception
            nativeFamily = FontFamily.GenericSansSerif().NativeFamily
            SetStatus(GdipCreateFont(nativeFamily, emSize, style, unit, nativeFont))
        End Try
    End Sub

    Static Function getNativeGraphics(g As Graphics) As *GpGraphics
        If ActiveBasic.IsNothing(g) Then
            getNativeGraphics = 0
        Else
            getNativeGraphics = g.NativeGraphics
        End If
    End Function

    nativeFont As *GpFont
End Class

End Namespace
End Namespace