Changeset 698 for trunk/ab5.0/ablib/src/Classes/System/Drawing/Font.ab
- Timestamp:
- Mar 31, 2009, 2:09:07 PM (15 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/ab5.0/ablib/src/Classes/System/Drawing/Font.ab
r635 r698 1 1 Namespace System 2 2 Namespace Drawing 3 4 3 5 4 /** … … 8 7 */ 9 8 10 Class FontFamily : End Class 11 Class FontCollection : End Class 9 Class FontCollection 10 Public 11 nativeCollection As *GpFontCollection 12 End Class 12 13 13 14 Class Font 14 15 Implements System.IDisposable 15 16 Public 16 ' friend class Graphics 17 18 Sub Font(/*IN*/ hdc As HDC) 17 Static Function FromHDC(/*IN*/ hdc As HDC) As Font 19 18 Dim font = 0 As *GpFont 20 lastResult = GdipCreateFontFromDC(hdc, font)21 SetNativeFont(font)22 End Sub23 24 S ub Font(/*IN*/ hdc As HDC, /*IN const*/ ByRef logfont As LOGFONTA)19 SetStatus(GdipCreateFontFromDC(hdc, font)) 20 FromHDC = New Font(font) 21 End Function 22 23 Static Function FromLogFont(/*IN*/ hdc As HDC, /*IN const*/ ByRef logfont As LOGFONTA) As Font 25 24 Dim font = 0 As *GpFont 26 lastResult =GdipCreateFontFromLogfontA(hdc, logfont, font)27 SetNativeFont(font)28 End Sub29 30 S ub Font(/*IN*/ hdc As HDC, /*IN const*/ ByRef logfont As LOGFONTW)25 SetStatus(GdipCreateFontFromLogfontA(hdc, logfont, font)) 26 FromLogFont = New Font(font) 27 End Function 28 29 Static Function FromLogFont(/*IN*/ hdc As HDC, /*IN const*/ ByRef logfont As LOGFONTW) As Font 31 30 Dim font = 0 As *GpFont 32 lastResult =GdipCreateFontFromLogfontW(hdc, logfont, font)33 SetNativeFont(font)34 End Sub35 36 S ub Font(/*IN*/ hdc As HDC, /*IN const*/ hfont As HFONT)31 SetStatus(GdipCreateFontFromLogfontW(hdc, logfont, font)) 32 FromLogFont = New Font(font) 33 End Function 34 35 Static Function FromHFont(/*IN*/ hdc As HDC, /*IN const*/ hfont As HFONT) As Font 37 36 Dim font = 0 As *GpFont 38 37 If hfont <> 0 Then 39 38 Dim lf As LOGFONTA 40 If GetObjectA(hfont, sizeof (LOGFONTA), lf) <> 0 Then41 lastResult = GdipCreateFontFromLogfontA(hdc, lf, font)39 If GetObjectA(hfont, Len(lf), lf) <> 0 Then 40 SetStatus(GdipCreateFontFromLogfontA(hdc, lf, font)) 42 41 Else 43 lastResult = GdipCreateFontFromDC(hdc, font)42 SetStatus(GdipCreateFontFromDC(hdc, font)) 44 43 End If 45 44 Else 46 lastResult = GdipCreateFontFromDC(hdc, font) 47 End If 48 SetNativeFont(font) 45 SetStatus(GdipCreateFontFromDC(hdc, font)) 46 End If 47 FromHFont = New Font(font) 48 End Function 49 50 Sub Font(f As *GpFont) 51 nativeFont = f 49 52 End Sub 50 53 51 54 Sub Font(/*IN const*/ family As FontFamily, /*IN*/ emSize As Single) 52 Font(family, emSize, FontStyleRegular, UnitPoint) 53 End Sub 54 55 Sub Font(/*IN const*/ family As FontFamily, 56 /*IN*/ emSize As Single, /*IN*/ style As Long) 57 58 Font(family, emSize, style, UnitPoint) 55 initFont(family, emSize, FontStyle.Regular, GraphicsUnit.Point) 56 End Sub 57 58 Sub Font(/*IN const*/ family As FontFamily, /*IN*/ emSize As Single, /*IN*/ style As FontStyle) 59 initFont(family, emSize, style, GraphicsUnit.Point) 60 End Sub 61 62 Sub Font(/*IN const*/ family As FontFamily, /*IN*/ emSize As Single, /*IN*/ unit As GraphicsUnit) 63 initFont(family, emSize, FontStyle.Regular, unit) 59 64 End Sub 60 65 61 66 Sub Font(/*IN const*/ family As FontFamily, /*IN*/ emSize As Single, 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) 67 /*IN*/ style As FontStyle, /*IN*/ unit As GraphicsUnit) 68 69 initFont(family, emSize, style, unit) 68 70 End Sub 69 71 70 72 Sub Font(/*IN const*/ familyName As PCWSTR, /*IN*/ emSize As Single) 71 Font(familyName, emSize, FontStyleRegular, Unit.Point, ByVal 0)73 initFromName(familyName, emSize, FontStyle.Regular, GraphicsUnit.Point, Nothing) 72 74 End Sub 73 75 74 76 Sub Font(/*IN const*/ familyName As String, /*IN*/ emSize As Single) 75 Font(familyName, emSize, FontStyleRegular, Unit.Point, ByVal 0) 77 initFromName(ToWCStr(familyName), emSize, FontStyle.Regular, GraphicsUnit.Point, Nothing) 78 End Sub 79 80 Sub Font(/*IN const*/ familyName As PCWSTR, /*IN*/ emSize As Single, /*IN*/ style As FontStyle) 81 initFromName(familyName, emSize, style, GraphicsUnit.Point, Nothing) 82 End Sub 83 84 Sub Font(/*IN const*/ familyName As String, /*IN*/ emSize As Single, /*IN*/ style As FontStyle) 85 initFromName(ToWCStr(familyName), emSize, style, GraphicsUnit.Point, Nothing) 86 End Sub 87 88 Sub Font(/*IN const*/ familyName As PCWSTR, /*IN*/ emSize As Single, /*IN*/ unit As GraphicsUnit) 89 initFromName(familyName, emSize, FontStyle.Regular, unit, Nothing) 90 End Sub 91 92 Sub Font(/*IN const*/ familyName As String, /*IN*/ emSize As Single, /*IN*/ unit As GraphicsUnit) 93 initFromName(ToWCStr(familyName), emSize, FontStyle.Regular, unit, Nothing) 76 94 End Sub 77 95 78 96 Sub Font(/*IN const*/ familyName As PCWSTR, /*IN*/ emSize As Single, 79 /*IN*/ style As Long) 80 Font(familyName, emSize, style, Unit.Point, ByVal 0) 97 /*IN*/ style As FontStyle, /*IN*/ unit As GraphicsUnit) 98 99 initFromName(familyName, emSize, style, unit, Nothing) 81 100 End Sub 82 101 83 102 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) 103 /*IN*/ style As FontStyle, /*IN*/ unit As GraphicsUnit) 104 105 initFromName(ToWCStr(familyName), emSize, style, unit, Nothing) 86 106 End Sub 87 107 88 108 Sub Font(/*IN const*/ familyName As PCWSTR, /*IN*/ emSize As Single, 89 /*IN*/ style As Long, /*IN*/ unit As GraphicsUnit) 90 Font(familyName, emSize, style, unit, ByVal 0) 109 /*IN*/ style As FontStyle, /*IN*/ unit As GraphicsUnit, 110 /*IN const*/ fontCollection As FontCollection) 111 112 initFromName(familyName, emSize, style, unit, fontCollection) 91 113 End Sub 92 114 93 115 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, 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 132 Sub Font(/*IN const*/ familyName As String, /*IN*/ emSize As Single, 133 /*IN*/ style As Long, /*IN*/ unit As GraphicsUnit, 116 /*IN*/ style As FontStyle, /*IN*/ unit As GraphicsUnit, 134 117 /*IN const*/ fontCollection As FontCollection) 135 Font(ToWCStr(familyName), emSize, style, unit, fontCollection) 136 End Sub 137 138 Const Function GetLogFontA(/*IN const*/ g As Graphics, /*OUT*/ ByRef lf As LOGFONTA) As Status 139 Dim nativeGraphics As *GpGraphics 140 If Not ActiveBasic.IsNothing(g) Then 141 nativeGraphics = g.nativeGraphics 142 End If 143 Return SetStatus(GdipGetLogFontA(nativeFont, nativeGraphics, lf)) 144 End Function 145 146 Const Function GetLogFontW(/*IN const*/ g As Graphics, /*OUT*/ ByRef lf As LOGFONTW) As Status 147 Dim nativeGraphics As *GpGraphics 148 If Not ActiveBasic.IsNothing(g) Then 149 nativeGraphics = g.nativeGraphics 150 End If 151 Return SetStatus(GdipGetLogFontW(nativeFont, nativeGraphics, lf)) 152 End Function 153 154 Const Function GetLogFont(/*IN const*/ g As Graphics, /*OUT*/ ByRef lf As LOGFONT) As Status 155 Dim nativeGraphics As *GpGraphics 156 If Not ActiveBasic.IsNothing(g) Then 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 118 119 initFromName(ToWCStr(familyName), emSize, style, unit, fontCollection) 120 End Sub 165 121 166 122 Const Function Clone() As Font 167 123 Dim cloneFont = 0 As *GpFont 168 124 SetStatus(GdipCloneFont(nativeFont, cloneFont)) 169 Return New Font(cloneFont, lastResult) 170 End Function 125 Clone = New Font(cloneFont) 126 End Function 127 128 Sub Dispose() 129 If nativeFont <> 0 Then 130 GdipDeleteFont(nativeFont) 131 End If 132 nativeFont = 0 133 End Sub 171 134 172 135 Sub ~Font() 173 GdipDeleteFont(nativeFont) 174 End Sub 175 176 Const Function IsAvailable() As Boolean 177 Return nativeFont <> 0 178 End Function 179 180 Const Function Style() As Long 181 SetStatus(GdipGetFontStyle(nativeFont, Style)) 182 End Function 136 Dispose() 137 End Sub 138 139 ' Const Function Style() As FontStyle 140 ' SetStatus(GdipGetFontStyle(nativeFont, Style)) 141 ' End Function 183 142 184 143 Const Function Size() As Single … … 186 145 End Function 187 146 188 Const Function SizeInPoints() As Single 189 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 147 ' Const Function SizeInPoints() As Single 148 ' End Function 149 150 ' Const Function Unit() As GraphicsUnit 151 ' SetStatus(GdipGetFontUnit(nativeFont, Unit)) 152 ' End Function 197 153 198 154 Const Function Height() As Long 199 ReturnGetHeight() As Long155 Height = GetHeight() As Long 200 156 End Function 201 157 … … 205 161 206 162 Const Function GetHeight(/*IN const*/ g As Graphics) As Single 207 Dim nativeGraphics As *GpGraphics 208 If Not ActiveBasic.IsNothing(g) Then 209 nativeGraphics = g.NativeGraphics 210 End If 163 Dim nativeGraphics = getNativeGraphics(g) 211 164 SetStatus(GdipGetFontHeight(nativeFont, nativeGraphics, GetHeight)) 212 165 End Function … … 216 169 End Function 217 170 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) 171 ' Const Function FontFamily() As FontFamily 172 ' Dim nativeFamily As *GpFamily 173 ' SetStatus(GdipGetFamily(nativeFont, nativeFamily)) 174 ' FontFamily = New FontFamily(nativeFamily) 225 175 ' End Function 226 176 227 177 Const Function Bold() As Boolean 228 178 Dim lf As LOGFONT 229 GetLogFont(0,lf)179 ToLogFont(lf) 230 180 Return lf.lfWeight > FW_BOLD 231 181 End Function … … 233 183 Const Function GdiCharSet() As Byte 234 184 Dim lf As LOGFONT 235 GetLogFont(0,lf)185 ToLogFont(lf) 236 186 Return lf.lfCharSet 237 187 End Function … … 239 189 'Const Function GdiVerticalFont() As Boolean 240 190 241 Const Function NativeFont() As *GpFont242 Return nativeFont243 End Function244 245 191 'Const Function IsSystemFont() As Boolean 246 192 247 193 Const Function Italic() As Boolean 248 194 Dim lf As LOGFONT 249 GetLogFont(0,lf)250 Returnlf.lfItalic <> FALSE195 ToLogFont(lf) 196 Italic = lf.lfItalic <> FALSE 251 197 End Function 252 198 253 199 Const Function Name() As String 254 #ifdef UNICODE 255 Dim lf As LOGFONTW 256 GetLogFontW(0, lf) 257 #else 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 200 Dim lf As LOGFONT 201 ToLogFont(lf) 202 Dim p = lf.lfFaceName As PCTSTR 203 Name = New String(p) 204 End Function 265 205 266 206 Const Function StrikeOut() As Boolean 267 207 Dim lf As LOGFONT 268 GetLogFont(0,lf)269 Return lf.fdwStrikeOut <> FALSE208 ToLogFont(lf) 209 StrikeOut = lf.lfStrikeOut <> FALSE 270 210 End Function 271 211 272 212 Const Function Style() As FontStyle 273 213 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 214 ToLogFont(lf) 215 Style = FontStyle.Regular 216 If lf.lfWeight > FW_BOLD Then 217 Style Or= FontStyle.Bold 218 End If 219 If lf.lfItalic <> FALSE Then 220 Style Or= FontStyle.Italic 221 End If 222 If lf.lfStrikeOut <> FALSE Then 223 Style Or= FontStyle.Strikeout 224 End If 225 If lf.lfUnderline <> FALSE Then 226 Style Or= FontStyle.Underline 227 End If 279 228 End Function 280 229 … … 283 232 Const Function Underline() As Boolean 284 233 Dim lf As LOGFONT 285 GetLogFont(0,lf)286 Return lf.fdwUnderline <> FALSE234 ToLogFont(lf) 235 Underline = lf.lfUnderline <> FALSE 287 236 End Function 288 237 289 238 Override Function ToString() As String 290 ReturnName239 ToString = Name 291 240 End Function 292 241 293 242 Const Function ToHfont() As HFONT 294 243 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 303 Const Sub ToLogFont(ByRef lf As LOGFONT, g As Graphics) 304 GetLogFont(g, lf) 305 End Sub 244 ToLogFont(lf) 245 ToHfont = CreateFontIndirect(lf) 246 End Function 247 248 Const Sub ToLogFont(/*OUT*/ ByRef lf As LOGFONTA, /*IN const*/ g As Graphics) 249 Dim nativeGraphics = getNativeGraphics(g) 250 SetStatus(GdipGetLogFontA(nativeFont, nativeGraphics, lf)) 251 End Sub 252 253 Const Sub ToLogFont(/*OUT*/ ByRef lf As LOGFONTW, /*IN const*/ g As Graphics) 254 Dim nativeGraphics = getNativeGraphics(g) 255 SetStatus(GdipGetLogFontW(nativeFont, nativeGraphics, lf)) 256 End Sub 257 258 Const Sub ToLogFont(ByRef lf As LOGFONTA) 259 ToLogFont(lf, Nothing) 260 End Sub 261 262 Const Sub ToLogFont(ByRef lf As LOGFONTW) 263 ToLogFont(lf, Nothing) 264 End Sub 265 266 Function NativeFont() As *GpFont 267 NativeFont = nativeFont 268 End Function 306 269 307 270 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 271 Sub initFont(/*IN const*/ family As FontFamily, /*IN*/ emSize As Single, 272 /*IN*/ style As Long, /*IN*/ unit As GraphicsUnit) 273 274 If ActiveBasic.IsNothing(family) Then 275 Throw New ArgumentNullException("family") 276 End If 277 SetStatus(GdipCreateFont(family.NativeFamily, emSize, style, unit, nativeFont)) 278 End Sub 279 280 Sub initFromName(/*IN const*/ familyName As PCWSTR, /*IN*/ emSize As Single, 281 /*IN*/ style As Long, /*IN*/ unit As GraphicsUnit, fontCollection As FontCollection) 282 283 nativeFont = 0 284 Dim family = Nothing As FontFamily 285 Dim nativeFamily = family.NativeFamily 286 287 Try 288 family = New FontFamily(familyName, fontCollection) 289 Catch e As Exception 290 nativeFamily = FontFamily.GenericSansSerif().NativeFamily 291 End Try 292 293 Try 294 SetStatus(GdipCreateFont(nativeFamily, emSize, style, unit, nativeFont)) 295 Catch e As Exception 296 nativeFamily = FontFamily.GenericSansSerif().NativeFamily 297 SetStatus(GdipCreateFont(nativeFamily, emSize, style, unit, nativeFont)) 298 End Try 299 End Sub 300 301 Static Function getNativeGraphics(g As Graphics) As *GpGraphics 302 If ActiveBasic.IsNothing(g) Then 303 getNativeGraphics = 0 324 304 Else 325 Return s 326 End If 327 End Function 328 329 Protected 305 getNativeGraphics = g.NativeGraphics 306 End If 307 End Function 308 330 309 nativeFont As *GpFont 331 /*mutable*/ lastResult As Status332 310 End Class 333 311
Note:
See TracChangeset
for help on using the changeset viewer.
