[635] | 1 | Namespace System
|
---|
| 2 | Namespace Drawing
|
---|
| 3 |
|
---|
| 4 |
|
---|
[473] | 5 | /**
|
---|
| 6 | @file Classes/System/Drawing/Font.ab
|
---|
| 7 | @brief Fontクラスなどの実装。
|
---|
| 8 | */
|
---|
[104] | 9 |
|
---|
| 10 | Class FontFamily : End Class
|
---|
| 11 | Class FontCollection : End Class
|
---|
| 12 |
|
---|
| 13 | Class Font
|
---|
[473] | 14 | Implements System.IDisposable
|
---|
[104] | 15 | Public
|
---|
| 16 | ' friend class Graphics
|
---|
| 17 |
|
---|
| 18 | Sub Font(/*IN*/ hdc As HDC)
|
---|
| 19 | Dim font = 0 As *GpFont
|
---|
| 20 | lastResult = GdipCreateFontFromDC(hdc, font)
|
---|
| 21 | SetNativeFont(font)
|
---|
| 22 | End Sub
|
---|
| 23 |
|
---|
| 24 | Sub Font(/*IN*/ hdc As HDC, /*IN const*/ ByRef logfont As LOGFONTA)
|
---|
| 25 | Dim font = 0 As *GpFont
|
---|
| 26 | lastResult =GdipCreateFontFromLogfontA(hdc, logfont, font)
|
---|
| 27 | SetNativeFont(font)
|
---|
| 28 | End Sub
|
---|
| 29 |
|
---|
| 30 | Sub Font(/*IN*/ hdc As HDC, /*IN const*/ ByRef logfont As LOGFONTW)
|
---|
| 31 | Dim font = 0 As *GpFont
|
---|
| 32 | lastResult =GdipCreateFontFromLogfontW(hdc, logfont, font)
|
---|
| 33 | SetNativeFont(font)
|
---|
| 34 | End Sub
|
---|
| 35 |
|
---|
| 36 | Sub Font(/*IN*/ hdc As HDC, /*IN const*/ hfont As HFONT)
|
---|
| 37 | Dim font = 0 As *GpFont
|
---|
| 38 | If hfont <> 0 Then
|
---|
| 39 | Dim lf As LOGFONTA
|
---|
| 40 | If GetObjectA(hfont, sizeof (LOGFONTA), lf) <> 0 Then
|
---|
| 41 | lastResult = GdipCreateFontFromLogfontA(hdc, lf, font)
|
---|
| 42 | Else
|
---|
| 43 | lastResult = GdipCreateFontFromDC(hdc, font)
|
---|
| 44 | End If
|
---|
| 45 | Else
|
---|
| 46 | lastResult = GdipCreateFontFromDC(hdc, font)
|
---|
| 47 | End If
|
---|
| 48 | SetNativeFont(font)
|
---|
| 49 | End Sub
|
---|
| 50 |
|
---|
[212] | 51 | Sub Font(/*IN const*/ family As FontFamily, /*IN*/ emSize As Single)
|
---|
[104] | 52 | Font(family, emSize, FontStyleRegular, UnitPoint)
|
---|
| 53 | End Sub
|
---|
| 54 |
|
---|
[212] | 55 | Sub Font(/*IN const*/ family As FontFamily,
|
---|
[104] | 56 | /*IN*/ emSize As Single, /*IN*/ style As Long)
|
---|
| 57 |
|
---|
| 58 | Font(family, emSize, style, UnitPoint)
|
---|
| 59 | End Sub
|
---|
| 60 |
|
---|
[212] | 61 | Sub Font(/*IN const*/ family As FontFamily, /*IN*/ emSize As Single,
|
---|
[104] | 62 | /*IN*/ style As Long, /*IN*/ unit As GraphicsUnit)
|
---|
| 63 |
|
---|
| 64 | Dim font = 0 As *GpFont
|
---|
| 65 | lastResult = GdipCreateFont(
|
---|
| 66 | family.NativeFamily, emSize, style, unit, font)
|
---|
| 67 | SetNativeFont(font)
|
---|
| 68 | End Sub
|
---|
| 69 |
|
---|
[137] | 70 | Sub Font(/*IN const*/ familyName As PCWSTR, /*IN*/ emSize As Single)
|
---|
| 71 | Font(familyName, emSize, FontStyleRegular, Unit.Point, ByVal 0)
|
---|
[104] | 72 | End Sub
|
---|
| 73 |
|
---|
[137] | 74 | Sub Font(/*IN const*/ familyName As String, /*IN*/ emSize As Single)
|
---|
| 75 | Font(familyName, emSize, FontStyleRegular, Unit.Point, ByVal 0)
|
---|
| 76 | End Sub
|
---|
| 77 |
|
---|
| 78 | Sub Font(/*IN const*/ familyName As PCWSTR, /*IN*/ emSize As Single,
|
---|
[104] | 79 | /*IN*/ style As Long)
|
---|
[137] | 80 | Font(familyName, emSize, style, Unit.Point, ByVal 0)
|
---|
[104] | 81 | End Sub
|
---|
| 82 |
|
---|
[137] | 83 | Sub Font(/*IN const*/ familyName As String, /*IN*/ emSize As Single,
|
---|
| 84 | /*IN*/ style As Long)
|
---|
| 85 | Font(familyName, emSize, style, Unit.Point, ByVal 0)
|
---|
| 86 | End Sub
|
---|
| 87 |
|
---|
| 88 | Sub Font(/*IN const*/ familyName As PCWSTR, /*IN*/ emSize As Single,
|
---|
[104] | 89 | /*IN*/ style As Long, /*IN*/ unit As GraphicsUnit)
|
---|
| 90 | Font(familyName, emSize, style, unit, ByVal 0)
|
---|
| 91 | End Sub
|
---|
| 92 |
|
---|
[137] | 93 | Sub Font(/*IN const*/ familyName As String, /*IN*/ emSize As Single,
|
---|
| 94 | /*IN*/ style As Long, /*IN*/ unit As GraphicsUnit)
|
---|
| 95 | Font(familyName, emSize, style, unit, ByVal 0)
|
---|
| 96 | End Sub
|
---|
| 97 |
|
---|
| 98 | Sub Font(/*IN const*/ familyName As PCWSTR, /*IN*/ emSize As Single,
|
---|
[104] | 99 | /*IN*/ style As Long, /*IN*/ unit As GraphicsUnit,
|
---|
| 100 | /*IN const*/ ByRef fontCollection As FontCollection)
|
---|
| 101 |
|
---|
| 102 | nativeFont = 0
|
---|
| 103 |
|
---|
| 104 | Dim family As FontFamily(familyName, fontCollection)
|
---|
| 105 | Dim nativeFamily = family.NativeFamily As *GpFontFamily
|
---|
| 106 |
|
---|
| 107 | lastResult = family.GetLastStatus()
|
---|
| 108 |
|
---|
| 109 | If lastResult <> Ok Then
|
---|
| 110 | nativeFamily = FontFamily.GenericSansSerif()->NativeFamily
|
---|
| 111 | lastResult = FontFamily.GenericSansSerif()->lastResult
|
---|
| 112 | If lastResult <> Ok Then
|
---|
| 113 | Exit Sub
|
---|
| 114 | End If
|
---|
| 115 | End If
|
---|
| 116 |
|
---|
| 117 | lastResult = GdipCreateFont(
|
---|
| 118 | nativeFamily, emSize, style, unit, nativeFont)
|
---|
| 119 |
|
---|
| 120 | If lastResult <> Ok Then
|
---|
| 121 | nativeFamily = FontFamily.GenericSansSerif()->NativeFamily
|
---|
| 122 | lastResult = FontFamily.GenericSansSerif()->lastResult
|
---|
| 123 | If lastResult <> Ok Then
|
---|
| 124 | Exit Sub
|
---|
| 125 | End If
|
---|
| 126 |
|
---|
| 127 | lastResult = GdipCreateFont(
|
---|
| 128 | nativeFamily, emSize, style, unit, nativeFont)
|
---|
| 129 | End If
|
---|
| 130 | End Sub
|
---|
| 131 |
|
---|
[137] | 132 | Sub Font(/*IN const*/ familyName As String, /*IN*/ emSize As Single,
|
---|
| 133 | /*IN*/ style As Long, /*IN*/ unit As GraphicsUnit,
|
---|
[212] | 134 | /*IN const*/ fontCollection As FontCollection)
|
---|
[473] | 135 | Font(ToWCStr(familyName), emSize, style, unit, fontCollection)
|
---|
[137] | 136 | End Sub
|
---|
| 137 |
|
---|
[212] | 138 | Const Function GetLogFontA(/*IN const*/ g As Graphics, /*OUT*/ ByRef lf As LOGFONTA) As Status
|
---|
[104] | 139 | Dim nativeGraphics As *GpGraphics
|
---|
[473] | 140 | If Not ActiveBasic.IsNothing(g) Then
|
---|
[104] | 141 | nativeGraphics = g.nativeGraphics
|
---|
| 142 | End If
|
---|
| 143 | Return SetStatus(GdipGetLogFontA(nativeFont, nativeGraphics, lf))
|
---|
| 144 | End Function
|
---|
| 145 |
|
---|
[212] | 146 | Const Function GetLogFontW(/*IN const*/ g As Graphics, /*OUT*/ ByRef lf As LOGFONTW) As Status
|
---|
[104] | 147 | Dim nativeGraphics As *GpGraphics
|
---|
[473] | 148 | If Not ActiveBasic.IsNothing(g) Then
|
---|
[104] | 149 | nativeGraphics = g.nativeGraphics
|
---|
| 150 | End If
|
---|
| 151 | Return SetStatus(GdipGetLogFontW(nativeFont, nativeGraphics, lf))
|
---|
| 152 | End Function
|
---|
| 153 |
|
---|
[212] | 154 | Const Function GetLogFont(/*IN const*/ g As Graphics, /*OUT*/ ByRef lf As LOGFONT) As Status
|
---|
[137] | 155 | Dim nativeGraphics As *GpGraphics
|
---|
[473] | 156 | If Not ActiveBasic.IsNothing(g) Then
|
---|
[137] | 157 | nativeGraphics = g.nativeGraphics
|
---|
| 158 | End If
|
---|
| 159 | #ifdef UNICODE
|
---|
| 160 | Return SetStatus(GdipGetLogFontW(nativeFont, nativeGraphics, lf))
|
---|
| 161 | #else
|
---|
| 162 | Return SetStatus(GdipGetLogFontA(nativeFont, nativeGraphics, lf))
|
---|
| 163 | #endif
|
---|
| 164 | End Function
|
---|
| 165 |
|
---|
[212] | 166 | Const Function Clone() As Font
|
---|
[104] | 167 | Dim cloneFont = 0 As *GpFont
|
---|
| 168 | SetStatus(GdipCloneFont(nativeFont, cloneFont))
|
---|
| 169 | Return New Font(cloneFont, lastResult)
|
---|
| 170 | End Function
|
---|
| 171 |
|
---|
| 172 | Sub ~Font()
|
---|
| 173 | GdipDeleteFont(nativeFont)
|
---|
| 174 | End Sub
|
---|
| 175 |
|
---|
[137] | 176 | Const Function IsAvailable() As Boolean
|
---|
[104] | 177 | Return nativeFont <> 0
|
---|
| 178 | End Function
|
---|
| 179 |
|
---|
| 180 | Const Function Style() As Long
|
---|
| 181 | SetStatus(GdipGetFontStyle(nativeFont, Style))
|
---|
| 182 | End Function
|
---|
| 183 |
|
---|
| 184 | Const Function Size() As Single
|
---|
| 185 | SetStatus(GdipGetFontSize(nativeFont, Size))
|
---|
| 186 | End Function
|
---|
| 187 |
|
---|
[137] | 188 | Const Function SizeInPoints() As Single
|
---|
| 189 |
|
---|
[104] | 190 | Const Function Unit() As GraphicsUnit
|
---|
| 191 | SetStatus(GdipGetFontUnit(nativeFont, Unit))
|
---|
| 192 | End Function
|
---|
| 193 |
|
---|
| 194 | Const Function LastStatus() As Status
|
---|
| 195 | Return lastResult
|
---|
| 196 | End Function
|
---|
| 197 |
|
---|
[137] | 198 | Const Function Height() As Long
|
---|
| 199 | Return GetHeight() As Long
|
---|
[104] | 200 | End Function
|
---|
| 201 |
|
---|
| 202 | Const Function GetHeight() As Single
|
---|
| 203 | SetStatus(GdipGetFontHeight(nativeFont, 0, GetHeight))
|
---|
| 204 | End Function
|
---|
| 205 |
|
---|
[212] | 206 | Const Function GetHeight(/*IN const*/ g As Graphics) As Single
|
---|
[104] | 207 | Dim nativeGraphics As *GpGraphics
|
---|
[473] | 208 | If Not ActiveBasic.IsNothing(g) Then
|
---|
[104] | 209 | nativeGraphics = g.NativeGraphics
|
---|
| 210 | End If
|
---|
| 211 | SetStatus(GdipGetFontHeight(nativeFont, nativeGraphics, GetHeight))
|
---|
| 212 | End Function
|
---|
| 213 |
|
---|
| 214 | Const Function GetHeight(/*IN*/ dpi As Single) As Single
|
---|
| 215 | SetStatus(GdipGetFontHeightGivenDPI(nativeFont, dpi, GetHeight))
|
---|
| 216 | End Function
|
---|
| 217 |
|
---|
| 218 | ' Const Function FontFamily(/*OUT*/ ByRef family As FontFamily)
|
---|
| 219 | ' If VarPtr(family) = 0 Then
|
---|
| 220 | ' Return SetStatus(Status.InvalidParameter)
|
---|
| 221 | ' End If
|
---|
| 222 | ' Dim status = GdipGetFamily(nativeFont, family->nativeFamily)
|
---|
| 223 | ' family->SetStatus(status)
|
---|
| 224 | ' Return SetStatus(status)
|
---|
| 225 | ' End Function
|
---|
| 226 |
|
---|
[137] | 227 | Const Function Bold() As Boolean
|
---|
| 228 | Dim lf As LOGFONT
|
---|
| 229 | GetLogFont(0, lf)
|
---|
| 230 | Return lf.lfWeight > FW_BOLD
|
---|
| 231 | End Function
|
---|
| 232 |
|
---|
| 233 | Const Function GdiCharSet() As Byte
|
---|
| 234 | Dim lf As LOGFONT
|
---|
| 235 | GetLogFont(0, lf)
|
---|
| 236 | Return lf.lfCharSet
|
---|
| 237 | End Function
|
---|
| 238 |
|
---|
| 239 | 'Const Function GdiVerticalFont() As Boolean
|
---|
| 240 |
|
---|
[104] | 241 | Const Function NativeFont() As *GpFont
|
---|
| 242 | Return nativeFont
|
---|
| 243 | End Function
|
---|
| 244 |
|
---|
[137] | 245 | 'Const Function IsSystemFont() As Boolean
|
---|
| 246 |
|
---|
| 247 | Const Function Italic() As Boolean
|
---|
| 248 | Dim lf As LOGFONT
|
---|
| 249 | GetLogFont(0, lf)
|
---|
| 250 | Return lf.lfItalic <> FALSE
|
---|
| 251 | End Function
|
---|
| 252 |
|
---|
| 253 | Const Function Name() As String
|
---|
[497] | 254 | #ifdef UNICODE
|
---|
| 255 | Dim lf As LOGFONTW
|
---|
| 256 | GetLogFontW(0, lf)
|
---|
| 257 | #else
|
---|
[137] | 258 | Dim lf As LOGFONTA
|
---|
| 259 | GetLogFontA(0, lf)
|
---|
| 260 | #endif
|
---|
| 261 | Return lf.lfFaceName
|
---|
| 262 | End Function
|
---|
| 263 |
|
---|
| 264 | 'Const Function SizeInPoint() As Boolean
|
---|
| 265 |
|
---|
| 266 | Const Function StrikeOut() As Boolean
|
---|
| 267 | Dim lf As LOGFONT
|
---|
| 268 | GetLogFont(0, lf)
|
---|
| 269 | Return lf.fdwStrikeOut <> FALSE
|
---|
| 270 | End Function
|
---|
| 271 |
|
---|
| 272 | Const Function Style() As FontStyle
|
---|
| 273 | Dim lf As LOGFONT
|
---|
| 274 | GetLogFont(0, lf)
|
---|
| 275 | Return (((lf.lfWeight > FW_BOLD) And FontStyle.Bold) Or _
|
---|
| 276 | ((lf.lfItatlic <> FALSE) And FontStyle.Italic) Or _
|
---|
| 277 | ((lf.fdwStrikeOut <> FALSE) And FontStyle.Strickeout) Or _
|
---|
| 278 | ((lf.fdwUnderline <> FALSE) And FontStyle.Underline)) As FontStyle
|
---|
| 279 | End Function
|
---|
[142] | 280 |
|
---|
[137] | 281 | 'Const Function SystemFontName() As String
|
---|
| 282 |
|
---|
| 283 | Const Function Underline() As Boolean
|
---|
| 284 | Dim lf As LOGFONT
|
---|
| 285 | GetLogFont(0, lf)
|
---|
| 286 | Return lf.fdwUnderline <> FALSE
|
---|
| 287 | End Function
|
---|
| 288 |
|
---|
| 289 | Override Function ToString() As String
|
---|
| 290 | Return Name
|
---|
| 291 | End Function
|
---|
| 292 |
|
---|
| 293 | Const Function ToHfont() As HFONT
|
---|
| 294 | Dim lf As LOGFONT
|
---|
| 295 | GetLogFont(ByVal 0, lf)
|
---|
| 296 | Return CreateFontIndirect(lf)
|
---|
| 297 | End Function
|
---|
| 298 |
|
---|
| 299 | Const Sub ToLogFont(ByRef lf As LOGFONT)
|
---|
| 300 | GetLogFont(ByVal 0, lf)
|
---|
| 301 | End Sub
|
---|
| 302 |
|
---|
[212] | 303 | Const Sub ToLogFont(ByRef lf As LOGFONT, g As Graphics)
|
---|
[137] | 304 | GetLogFont(g, lf)
|
---|
| 305 | End Sub
|
---|
| 306 |
|
---|
[104] | 307 | Private
|
---|
| 308 | ' Sub Font(ByRef f As Font)
|
---|
| 309 |
|
---|
| 310 | Protected
|
---|
| 311 | Sub Font(f As *GpFont, status As Status)
|
---|
| 312 | lastResult = status
|
---|
| 313 | SetNativeFont(f)
|
---|
| 314 | End Sub
|
---|
| 315 |
|
---|
| 316 | Sub SetNativeFont(f As *GpFont)
|
---|
| 317 | nativeFont = f
|
---|
| 318 | End Sub
|
---|
| 319 |
|
---|
| 320 | Const Function SetStatus(s As Status) As Status
|
---|
| 321 | If s <> Status.Ok Then
|
---|
| 322 | lastResult = s
|
---|
| 323 | Return s
|
---|
| 324 | Else
|
---|
| 325 | Return s
|
---|
| 326 | End If
|
---|
| 327 | End Function
|
---|
| 328 |
|
---|
| 329 | Protected
|
---|
| 330 | nativeFont As *GpFont
|
---|
| 331 | /*mutable*/ lastResult As Status
|
---|
| 332 | End Class
|
---|
[635] | 333 |
|
---|
| 334 | End Namespace
|
---|
| 335 | End Namespace
|
---|