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 As *GpFontFamily

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

		Try
			SetStatus(GdipCreateFont(nativeFamily, emSize, style, unit As Long, 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