#ifndef _GDIPLUSFONT_H #define _GDIPLUSFONT_H #require #require #require 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 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*/ ByRef 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*/ 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 GetLogFont(/*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 #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*/ 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 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, ByRef g As Graphics) GetLogFont(g, lf) End Sub 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