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