#ifndef _GDIPLUSFONT_H
#define _GDIPLUSFONT_H

#require <GdiPlus.ab>
#require <Classes/System/Drawing/misc.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*/ 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 *GpFont
		lastResult = 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 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

	Sub Font(/*IN const*/ familyName As String, /*IN*/ emSize As Single,
		/*IN*/ style As Long, /*IN*/ unit As GraphicsUnit,
		/*IN const*/ fontCollection As FontCollection)
#ifdef __STRING_IS_NOT_UNICODE
		Dim oldAlloc = _System_AllocForConvertedString
		_System_AllocForConvertedString = AddressOf (_System_malloc)
		Dim name = ToWCStr(familyName)
		Font(name, emSize, style, unit, fontCollection)
		_System_free(name)
		_System_AllocForConvertedString = oldAlloc
#else
		Font(familyName.Chars, emSize, style, unit, fontCollection)
#endif
	End Sub

	Const Function GetLogFontA(/*IN const*/ 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*/ 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 GetLogFont(/*IN const*/ g As Graphics, /*OUT*/ ByRef lf As LOGFONT) As Status
		Dim nativeGraphics As *GpGraphics
		If VarPtr(g) <> 0 Then
			nativeGraphics = g.nativeGraphics
		End If
#ifdef UNICODE
		Return SetStatus(GdipGetLogFontW(nativeFont, nativeGraphics, lf))
#else
		Return SetStatus(GdipGetLogFontA(nativeFont, nativeGraphics, lf))
#endif
	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 Boolean
		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 SizeInPoints() As Single

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

	Const Function LastStatus() As Status
		Return lastResult
	End Function

	Const Function Height() As Long
		Return 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 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 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 *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 *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

Private
'	Sub Font(ByRef f As Font)

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
