1(* 2 Copyright (c) 2001, 2015 3 David C.J. Matthews 4 5 This library is free software; you can redistribute it and/or 6 modify it under the terms of the GNU Lesser General Public 7 License version 2.1 as published by the Free Software Foundation. 8 9 This library is distributed in the hope that it will be useful, 10 but WITHOUT ANY WARRANTY; without even the implied warranty of 11 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 12 Lesser General Public License for more details. 13 14 You should have received a copy of the GNU Lesser General Public 15 License along with this library; if not, write to the Free Software 16 Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA 17*) 18 19structure DeviceContext: 20 sig 21 type BITMAP and HDC and HGDIOBJ and HWND and HRGN 22 type LOGBRUSH = Brush.LOGBRUSH 23 type LOGFONT = Font.LOGFONT 24 type LOGPEN = Pen.LOGPEN 25 type POINT = {x: int, y: int} 26 27 type StockObjectType 28 val ANSI_FIXED_FONT : StockObjectType 29 val ANSI_VAR_FONT : StockObjectType 30 val BLACK_BRUSH : StockObjectType 31 val BLACK_PEN : StockObjectType 32 val CLR_INVALID : StockObjectType 33 val DEFAULT_PALETTE : StockObjectType 34 val DEVICE_DEFAULT_FONT : StockObjectType 35 val DKGRAY_BRUSH : StockObjectType 36 val GRAY_BRUSH : StockObjectType 37 val HOLLOW_BRUSH : StockObjectType 38 val LTGRAY_BRUSH : StockObjectType 39 val NULL_BRUSH : StockObjectType 40 val NULL_PEN : StockObjectType 41 val OEM_FIXED_FONT : StockObjectType 42 val SYSTEM_FIXED_FONT : StockObjectType 43 val SYSTEM_FONT : StockObjectType 44 val WHITE_BRUSH : StockObjectType 45 val WHITE_PEN : StockObjectType 46 47 val GetStockObject : StockObjectType -> HGDIOBJ 48 49 eqtype DeviceItem 50 val ASPECTX : DeviceItem 51 val ASPECTXY : DeviceItem 52 val ASPECTY : DeviceItem 53 val BITSPIXEL : DeviceItem 54 val CLIPCAPS : DeviceItem 55 val COLORRES : DeviceItem 56 val CURVECAPS : DeviceItem 57 val DRIVERVERSION : DeviceItem 58 val HORZRES : DeviceItem 59 val HORZSIZE : DeviceItem 60 val LINECAPS : DeviceItem 61 val LOGPIXELSX : DeviceItem 62 val LOGPIXELSY : DeviceItem 63 val NUMBRUSHES : DeviceItem 64 val NUMCOLORS : DeviceItem 65 val NUMFONTS : DeviceItem 66 val NUMMARKERS : DeviceItem 67 val NUMPENS : DeviceItem 68 val NUMRESERVED : DeviceItem 69 val PDEVICESIZE : DeviceItem 70 val PHYSICALHEIGHT : DeviceItem 71 val PHYSICALOFFSETX : DeviceItem 72 val PHYSICALOFFSETY : DeviceItem 73 val PHYSICALWIDTH : DeviceItem 74 val PLANES : DeviceItem 75 val POLYGONALCAPS : DeviceItem 76 val RASTERCAPS : DeviceItem 77 val SCALINGFACTORX : DeviceItem 78 val SCALINGFACTORY : DeviceItem 79 val SIZEPALETTE : DeviceItem 80 val TECHNOLOGY : DeviceItem 81 val TEXTCAPS : DeviceItem 82 val VERTRES : DeviceItem 83 val VERTSIZE : DeviceItem 84 85 val GetDeviceCaps : HDC * DeviceItem -> int 86 87 (* Results of various calls to GetDeviceCaps. Perhaps its result type should 88 be a union. *) 89 val CC_CHORD : int 90 val CC_CIRCLES : int 91 val CC_ELLIPSES : int 92 val CC_INTERIORS : int 93 val CC_NONE : int 94 val CC_PIE : int 95 val CC_ROUNDRECT : int 96 val CC_STYLED : int 97 val CC_WIDE : int 98 val CC_WIDESTYLED : int 99 100 val CP_NONE : int 101 val CP_RECTANGLE : int 102 val CP_REGION : int 103 104 val DT_CHARSTREAM : int 105 val DT_DISPFILE : int 106 val DT_METAFILE : int 107 val DT_PLOTTER : int 108 val DT_RASCAMERA : int 109 val DT_RASDISPLAY : int 110 val DT_RASPRINTER : int 111 112 val LC_INTERIORS : int 113 val LC_MARKER : int 114 val LC_NONE : int 115 val LC_POLYLINE : int 116 val LC_POLYMARKER : int 117 val LC_STYLED : int 118 val LC_WIDE : int 119 val LC_WIDESTYLED : int 120 121 val PC_INTERIORS : int 122 val PC_NONE : int 123 val PC_PATHS : int 124 val PC_POLYGON : int 125 val PC_POLYPOLYGON : int 126 val PC_RECTANGLE : int 127 val PC_SCANLINE : int 128 val PC_STYLED : int 129 val PC_TRAPEZOID : int 130 val PC_WIDE : int 131 val PC_WIDESTYLED : int 132 val PC_WINDPOLYGON : int 133 134 val RC_BANDING : int 135 val RC_BIGFONT : int 136 val RC_BITBLT : int 137 val RC_BITMAP64 : int 138 val RC_DEVBITS : int 139 val RC_DIBTODEV : int 140 val RC_DI_BITMAP : int 141 val RC_FLOODFILL : int 142 val RC_GDI20_OUTPUT : int 143 val RC_GDI20_STATE : int 144 val RC_OP_DX_OUTPUT : int 145 val RC_PALETTE : int 146 val RC_SAVEBITMAP : int 147 val RC_SCALING : int 148 val RC_STRETCHBLT : int 149 val RC_STRETCHDIB : int 150 151 val TC_CP_STROKE : int 152 val TC_CR_90 : int 153 val TC_CR_ANY : int 154 val TC_EA_DOUBLE : int 155 val TC_IA_ABLE : int 156 val TC_OP_CHARACTER : int 157 val TC_OP_STROKE : int 158 val TC_RA_ABLE : int 159 val TC_RESERVED : int 160 val TC_SA_CONTIN : int 161 val TC_SA_DOUBLE : int 162 val TC_SA_INTEGER : int 163 val TC_SCROLLBLT : int 164 val TC_SF_X_YINDEP : int 165 val TC_SO_ABLE : int 166 val TC_UA_ABLE : int 167 val TC_VA_ABLE : int 168 169 datatype DMColor = DMCOLOR_COLOR | DMCOLOR_MONOCHROME 170 and DMDither = 171 DMDITHER_COARSE 172 | DMDITHER_FINE 173 | DMDITHER_GRAYSCALE 174 | DMDITHER_LINEART 175 | DMDITHER_NONE 176 | DMDITHER_OTHER of int 177 and DMDuplex = DMDUP_HORIZONTAL | DMDUP_SIMPLEX | DMDUP_VERTICAL 178 and DMICMIntent = 179 DMICMINTENT_OTHER of int 180 | DMICM_COLORMETRIC 181 | DMICM_CONTRAST 182 | DMICM_SATURATE 183 and DMICMMethod = 184 DMICMMETHOD_DEVICE 185 | DMICMMETHOD_DRIVER 186 | DMICMMETHOD_NONE 187 | DMICMMETHOD_OTHER of int 188 | DMICMMETHOD_SYSTEM 189 and DMMedia = 190 DMICMMEDIA_OTHER of int 191 | DMMEDIA_GLOSSY 192 | DMMEDIA_STANDARD 193 | DMMEDIA_TRANSPARENCY 194 and DMOrientation = DMORIENT_LANDSCAPE | DMORIENT_PORTRAIT 195 and DMPaperSize = 196 DMPAPER_10X11 197 | DMPAPER_10X14 198 | DMPAPER_11X17 199 | DMPAPER_15X11 200 | DMPAPER_9X11 201 | DMPAPER_A2 202 | DMPAPER_A3 203 | DMPAPER_A3_EXTRA 204 | DMPAPER_A3_EXTRA_TRANSVERSE 205 | DMPAPER_A3_TRANSVERSE 206 | DMPAPER_A4 207 | DMPAPER_A4SMALL 208 | DMPAPER_A4_EXTRA 209 | DMPAPER_A4_PLUS 210 | DMPAPER_A4_TRANSVERSE 211 | DMPAPER_A5 212 | DMPAPER_A5_EXTRA 213 | DMPAPER_A5_TRANSVERSE 214 | DMPAPER_A_PLUS 215 | DMPAPER_B4 216 | DMPAPER_B5 217 | DMPAPER_B5_EXTRA 218 | DMPAPER_B5_TRANSVERSE 219 | DMPAPER_B_PLUS 220 | DMPAPER_CSHEET 221 | DMPAPER_DSHEET 222 | DMPAPER_ENV_10 223 | DMPAPER_ENV_11 224 | DMPAPER_ENV_12 225 | DMPAPER_ENV_14 226 | DMPAPER_ENV_9 227 | DMPAPER_ENV_B4 228 | DMPAPER_ENV_B5 229 | DMPAPER_ENV_B6 230 | DMPAPER_ENV_C3 231 | DMPAPER_ENV_C4 232 | DMPAPER_ENV_C5 233 | DMPAPER_ENV_C6 234 | DMPAPER_ENV_C65 235 | DMPAPER_ENV_DL 236 | DMPAPER_ENV_INVITE 237 | DMPAPER_ENV_ITALY 238 | DMPAPER_ENV_MONARCH 239 | DMPAPER_ENV_PERSONAL 240 | DMPAPER_ESHEET 241 | DMPAPER_EXECUTIVE 242 | DMPAPER_FANFOLD_LGL_GERMAN 243 | DMPAPER_FANFOLD_STD_GERMAN 244 | DMPAPER_FANFOLD_US 245 | DMPAPER_FOLIO 246 | DMPAPER_ISO_B4 247 | DMPAPER_JAPANESE_POSTCARD 248 | DMPAPER_LEDGER 249 | DMPAPER_LEGAL 250 | DMPAPER_LEGAL_EXTRA 251 | DMPAPER_LETTER 252 | DMPAPER_LETTERSMALL 253 | DMPAPER_LETTER_EXTRA 254 | DMPAPER_LETTER_EXTRA_TRANSVERSE 255 | DMPAPER_LETTER_PLUS 256 | DMPAPER_LETTER_TRANSVERSE 257 | DMPAPER_NOTE 258 | DMPAPER_OTHER of int 259 | DMPAPER_QUARTO 260 | DMPAPER_RESERVED_48 261 | DMPAPER_RESERVED_49 262 | DMPAPER_STATEMENT 263 | DMPAPER_TABLOID 264 | DMPAPER_TABLOID_EXTRA 265 and DMResolution = 266 DMRES_DPI of int 267 | DMRES_DRAFT 268 | DMRES_HIGH 269 | DMRES_LOW 270 | DMRES_MEDIUM 271 and DMSource = 272 DMBIN_AUTO 273 | DMBIN_CASSETTE 274 | DMBIN_ENVELOPE 275 | DMBIN_ENVMANUAL 276 | DMBIN_FORMSOURCE 277 | DMBIN_LARGECAPACITY 278 | DMBIN_LARGEFMT 279 | DMBIN_LOWER 280 | DMBIN_MANUAL 281 | DMBIN_MIDDLE 282 | DMBIN_ONLYONE 283 | DMBIN_SMALLFMT 284 | DMBIN_TRACTOR 285 | DMBIN_UPPER 286 | DMSOURCE_OTHER of int 287 and DMTrueType = 288 DMTT_BITMAP 289 | DMTT_DOWNLOAD 290 | DMTT_DOWNLOAD_OUTLINE 291 | DMTT_SUBDEV 292 293 type DEVMODE = { 294 deviceName: string, 295 driverVersion: int, 296 orientation: DMOrientation option, 297 paperSize: DMPaperSize option, 298 paperLength: int option, 299 paperWidth: int option, 300 scale: int option, 301 copies: int option, 302 defaultSource: DMSource option, 303 printQuality: DMResolution option, 304 color: DMColor option, 305 duplex: DMDuplex option, 306 yResolution: int option, 307 ttOption: DMTrueType option, 308 collate: bool option, 309 formName: string option, 310 logPixels: int option, 311 bitsPerPixel: int option, 312 pelsWidth: int option, 313 pelsHeight: int option, 314 displayFlags: int option, (* Apparently no longer used. *) 315 displayFrequency: int option, 316 icmMethod: DMICMMethod option, 317 icmIntent: DMICMIntent option, 318 mediaType: DMMedia option, 319 ditherType: DMDither option, 320 panningWidth: int option, 321 panningHeight: int option, 322 driverPrivate: Word8Vector.vector 323 } 324 325 val CancelDC : HDC -> unit 326 val CreateCompatibleDC : HDC -> HDC 327 val CreateDC : string option * string option * string option * DEVMODE option -> HDC 328 329 val DeleteDC : HDC -> unit 330 val DeleteObject : HGDIOBJ -> unit 331 332 datatype 333 EnumObject = 334 OBJ_BITMAP 335 | OBJ_BRUSH 336 | OBJ_DC 337 | OBJ_ENHMETADC 338 | OBJ_ENHMETAFILE 339 | OBJ_EXTPEN 340 | OBJ_FONT 341 | OBJ_MEMDC 342 | OBJ_METADC 343 | OBJ_METAFILE 344 | OBJ_PAL 345 | OBJ_PEN 346 | OBJ_REGION 347 val GetCurrentObject : HDC * EnumObject -> HGDIOBJ 348 val GetDC : HWND -> HDC 349 350 datatype 351 DeviceContextFlag = 352 DCX_CACHE 353 | DCX_CLIPCHILDREN 354 | DCX_CLIPSIBLINGS 355 | DCX_EXCLUDERGN 356 | DCX_EXCLUDEUPDATE 357 | DCX_INTERSECTRGN 358 | DCX_INTERSECTUPDATE 359 | DCX_LOCKWINDOWUPDATE 360 | DCX_NORECOMPUTE 361 | DCX_NORESETATTRS 362 | DCX_PARENTCLIP 363 | DCX_VALIDATE 364 | DCX_WINDOW 365 366 val GetDCEx : HWND * HRGN * DeviceContextFlag list -> HDC 367 val GetDCOrgEx : HDC -> POINT 368 369 datatype 370 GetObject = 371 GO_Bitmap of BITMAP 372 | GO_Brush of LOGBRUSH 373 | GO_Font of LOGFONT 374 | GO_Palette of int 375 | GO_Pen of LOGPEN 376 377 val GetObject : HGDIOBJ -> GetObject 378 379 val GetObjectType : HGDIOBJ -> EnumObject 380 381 382 val ReleaseDC : HWND * HDC -> bool 383 val ResetDC : HDC * DEVMODE -> HDC 384 val RestoreDC : HDC * int -> unit 385 val SaveDC : HDC -> int 386 val SelectObject : HDC * HGDIOBJ -> HGDIOBJ 387 388 type DEVNAMES = {driver: string, device: string, output: string, default: bool} 389 end 390 = 391struct 392 local 393 open Foreign Base 394 fun checkDC c = (checkResult(not(isHdcNull c)); c) 395 in 396 type HDC = HDC and HGDIOBJ = HGDIOBJ and HWND = HWND and HRGN = HRGN 397 type LOGFONT = Font.LOGFONT 398 399 open GdiBase DeviceBase 400 401 type POINT = POINT 402 403 datatype DeviceContextFlag = 404 DCX_WINDOW | DCX_CACHE | DCX_NORESETATTRS | DCX_CLIPCHILDREN | DCX_CLIPSIBLINGS | 405 DCX_PARENTCLIP | DCX_EXCLUDERGN | DCX_INTERSECTRGN | DCX_EXCLUDEUPDATE | DCX_INTERSECTUPDATE | 406 DCX_LOCKWINDOWUPDATE | DCX_NORECOMPUTE | DCX_VALIDATE 407 local 408 val tab = [ 409 (DCX_WINDOW, 0wx00000001), 410 (DCX_CACHE, 0wx00000002), 411 (DCX_NORESETATTRS, 0wx00000004), 412 (DCX_CLIPCHILDREN, 0wx00000008), 413 (DCX_CLIPSIBLINGS, 0wx00000010), 414 (DCX_PARENTCLIP, 0wx00000020), 415 (DCX_EXCLUDERGN, 0wx00000040), 416 (DCX_INTERSECTRGN, 0wx00000080), 417 (DCX_EXCLUDEUPDATE, 0wx00000100), 418 (DCX_INTERSECTUPDATE, 0wx00000200), 419 (DCX_LOCKWINDOWUPDATE, 0wx00000400), 420 (DCX_NORECOMPUTE, 0wx00100000), 421 (DCX_VALIDATE, 0wx00200000)] 422 in 423 val DEVICECONTEXTFLAG = tableSetConversion(tab, NONE) 424 end 425 426 427 (* DEVNAMES is not actually used in this structure. *) 428 type DEVNAMES = {driver: string, device: string, output: string, default: bool} 429 430 datatype EnumObject = OBJ_PEN | OBJ_BRUSH | OBJ_DC | OBJ_METADC | OBJ_PAL | OBJ_FONT | 431 OBJ_BITMAP | OBJ_REGION | OBJ_METAFILE | OBJ_MEMDC | OBJ_EXTPEN | OBJ_ENHMETADC | 432 OBJ_ENHMETAFILE 433 434 local 435 val tab = [ 436 (OBJ_PEN, 1), 437 (OBJ_BRUSH, 2), 438 (OBJ_DC, 3), 439 (OBJ_METADC, 4), 440 (OBJ_PAL, 5), 441 (OBJ_FONT, 6), 442 (OBJ_BITMAP, 7), 443 (OBJ_REGION, 8), 444 (OBJ_METAFILE, 9), 445 (OBJ_MEMDC, 10), 446 (OBJ_EXTPEN, 11), 447 (OBJ_ENHMETADC, 12), 448 (OBJ_ENHMETAFILE, 13) 449 ] 450 datatype EnumObject = 451 W of int 452 (* GetObjectType returns 0 in the event of an error. *) 453 fun toInt _ = raise Match 454 fun fromInt i = (checkResult(i <> 0); raise Match); 455 in 456 val ENUMOBJECT = tableConversion(tab, SOME(fromInt, toInt)) cUint 457 end 458 459 local 460 datatype DeviceItem = 461 W of int 462 in 463 type DeviceItem = DeviceItem 464 val DEVICEITEM = absConversion {abs = W, rep = fn W n => n} cInt 465 466 val DRIVERVERSION = W (0 (* Device driver version *)) 467 val TECHNOLOGY = W (2 (* Device classification *)) 468 val HORZSIZE = W (4 (* Horizontal size in millimeters *)) 469 val VERTSIZE = W (6 (* Vertical size in millimeters *)) 470 val HORZRES = W (8 (* Horizontal width in pixels *)) 471 val VERTRES = W (10 (* Vertical width in pixels *)) 472 val BITSPIXEL = W (12 (* Number of bits per pixel *)) 473 val PLANES = W (14 (* Number of planes *)) 474 val NUMBRUSHES = W (16 (* Number of brushes the device has *)) 475 val NUMPENS = W (18 (* Number of pens the device has *)) 476 val NUMMARKERS = W (20 (* Number of markers the device has *)) 477 val NUMFONTS = W (22 (* Number of fonts the device has *)) 478 val NUMCOLORS = W (24 (* Number of colors the device supports *)) 479 val PDEVICESIZE = W (26 (* Size required for device descriptor *)) 480 val CURVECAPS = W (28 (* Curve capabilities *)) 481 val LINECAPS = W (30 (* Line capabilities *)) 482 val POLYGONALCAPS = W (32 (* Polygonal capabilities *)) 483 val TEXTCAPS = W (34 (* Text capabilities *)) 484 val CLIPCAPS = W (36 (* Clipping capabilities *)) 485 val RASTERCAPS = W (38 (* Bitblt capabilities *)) 486 val ASPECTX = W (40 (* Length of the X leg *)) 487 val ASPECTY = W (42 (* Length of the Y leg *)) 488 val ASPECTXY = W (44 (* Length of the hypotenuse *)) 489 val LOGPIXELSX = W (88 (* Logical pixels/inch in X *)) 490 val LOGPIXELSY = W (90 (* Logical pixels/inch in Y *)) 491 val SIZEPALETTE = W (104 (* Number of entries in physical palette *)) 492 val NUMRESERVED = W (106 (* Number of reserved entries in palette *)) 493 val COLORRES = W (108 (* Actual color resolution *)) 494 val PHYSICALWIDTH = W (110 (* Physical Width in device units *)) 495 val PHYSICALHEIGHT = W (111 (* Physical Height in device units *)) 496 val PHYSICALOFFSETX = W (112 (* Physical Printable Area x margin *)) 497 val PHYSICALOFFSETY = W (113 (* Physical Printable Area y margin *)) 498 val SCALINGFACTORX = W (114 (* Scaling factor x *)) 499 val SCALINGFACTORY = W (115 (* Scaling factor y *)) 500 end 501 502 (* Results of GetDeviceCaps. Since it returns an int all these are simply ints. *) 503 504 val DT_PLOTTER = 0 (* Vector plotter *) 505 val DT_RASDISPLAY = 1 (* Raster display *) 506 val DT_RASPRINTER = 2 (* Raster printer *) 507 val DT_RASCAMERA = 3 (* Raster camera *) 508 val DT_CHARSTREAM = 4 (* Character-stream, PLP *) 509 val DT_METAFILE = 5 (* Metafile, VDM *) 510 val DT_DISPFILE = 6 (* Display-file *) 511 512 (* Curve Capabilities *) 513 val CC_NONE = 0 (* Curves not supported *) 514 val CC_CIRCLES = 1 (* Can do circles *) 515 val CC_PIE = 2 (* Can do pie wedges *) 516 val CC_CHORD = 4 (* Can do chord arcs *) 517 val CC_ELLIPSES = 8 (* Can do ellipese *) 518 val CC_WIDE = 16 (* Can do wide lines *) 519 val CC_STYLED = 32 (* Can do styled lines *) 520 val CC_WIDESTYLED = 64 (* Can do wide styled lines *) 521 val CC_INTERIORS = 128 (* Can do interiors *) 522 val CC_ROUNDRECT = 256 (* *) 523 524 (* Line Capabilities *) 525 val LC_NONE = 0 (* Lines not supported *) 526 val LC_POLYLINE = 2 (* Can do polylines *) 527 val LC_MARKER = 4 (* Can do markers *) 528 val LC_POLYMARKER = 8 (* Can do polymarkers *) 529 val LC_WIDE = 16 (* Can do wide lines *) 530 val LC_STYLED = 32 (* Can do styled lines *) 531 val LC_WIDESTYLED = 64 (* Can do wide styled lines *) 532 val LC_INTERIORS = 128 (* Can do interiors *) 533 534 (* Polygonal Capabilities *) 535 val PC_NONE = 0 (* Polygonals not supported *) 536 val PC_POLYGON = 1 (* Can do polygons *) 537 val PC_RECTANGLE = 2 (* Can do rectangles *) 538 val PC_WINDPOLYGON = 4 (* Can do winding polygons *) 539 val PC_TRAPEZOID = 4 (* Can do trapezoids *) 540 val PC_SCANLINE = 8 (* Can do scanlines *) 541 val PC_WIDE = 16 (* Can do wide borders *) 542 val PC_STYLED = 32 (* Can do styled borders *) 543 val PC_WIDESTYLED = 64 (* Can do wide styled borders *) 544 val PC_INTERIORS = 128 (* Can do interiors *) 545 val PC_POLYPOLYGON = 256 (* Can do polypolygons *) 546 val PC_PATHS = 512 (* Can do paths *) 547 548 (* Clipping Capabilities *) 549 val CP_NONE = 0 (* No clipping of output *) 550 val CP_RECTANGLE = 1 (* Output clipped to rects *) 551 val CP_REGION = 2 (* obsolete *) 552 553 (* Text Capabilities *) 554 val TC_OP_CHARACTER = 0x00000001 (* Can do OutputPrecision CHARACTER *) 555 val TC_OP_STROKE = 0x00000002 (* Can do OutputPrecision STROKE *) 556 val TC_CP_STROKE = 0x00000004 (* Can do ClipPrecision STROKE *) 557 val TC_CR_90 = 0x00000008 (* Can do CharRotAbility 90 *) 558 val TC_CR_ANY = 0x00000010 (* Can do CharRotAbility ANY *) 559 val TC_SF_X_YINDEP = 0x00000020 (* Can do ScaleFreedom X_YINDEPENDENT *) 560 val TC_SA_DOUBLE = 0x00000040 (* Can do ScaleAbility DOUBLE *) 561 val TC_SA_INTEGER = 0x00000080 (* Can do ScaleAbility INTEGER *) 562 val TC_SA_CONTIN = 0x00000100 (* Can do ScaleAbility CONTINUOUS *) 563 val TC_EA_DOUBLE = 0x00000200 (* Can do EmboldenAbility DOUBLE *) 564 val TC_IA_ABLE = 0x00000400 (* Can do ItalisizeAbility ABLE *) 565 val TC_UA_ABLE = 0x00000800 (* Can do UnderlineAbility ABLE *) 566 val TC_SO_ABLE = 0x00001000 (* Can do StrikeOutAbility ABLE *) 567 val TC_RA_ABLE = 0x00002000 (* Can do RasterFontAble ABLE *) 568 val TC_VA_ABLE = 0x00004000 (* Can do VectorFontAble ABLE *) 569 val TC_RESERVED = 0x00008000 570 val TC_SCROLLBLT = 0x00010000 (* Don't do text scroll with blt *) 571 572 (* Raster Capabilities *) 573 val RC_BITBLT = 1 (* Can do standard BLT. *) 574 val RC_BANDING = 2 (* Device requires banding support *) 575 val RC_SCALING = 4 (* Device requires scaling support *) 576 val RC_BITMAP64 = 8 (* Device can support >64K bitmap *) 577 val RC_GDI20_OUTPUT = 0x0010 (* has 2.0 output calls *) 578 val RC_GDI20_STATE = 0x0020 579 val RC_SAVEBITMAP = 0x0040 580 val RC_DI_BITMAP = 0x0080 (* supports DIB to memory *) 581 val RC_PALETTE = 0x0100 (* supports a palette *) 582 val RC_DIBTODEV = 0x0200 (* supports DIBitsToDevice *) 583 val RC_BIGFONT = 0x0400 (* supports >64K fonts *) 584 val RC_STRETCHBLT = 0x0800 (* supports StretchBlt *) 585 val RC_FLOODFILL = 0x1000 (* supports FloodFill *) 586 val RC_STRETCHDIB = 0x2000 (* supports StretchDIBits *) 587 val RC_OP_DX_OUTPUT = 0x4000 588 val RC_DEVBITS = 0x8000 589 590 local 591 datatype StockObjectType = 592 W of int 593 in 594 type StockObjectType = StockObjectType 595 val STOCKOBJECTTYPE = absConversion {abs = W, rep = fn W n => n} cInt 596 597 val WHITE_BRUSH = W (0) 598 val LTGRAY_BRUSH = W (1) 599 val GRAY_BRUSH = W (2) 600 val DKGRAY_BRUSH = W (3) 601 val BLACK_BRUSH = W (4) 602 val NULL_BRUSH = W (5) 603 val HOLLOW_BRUSH = NULL_BRUSH 604 val WHITE_PEN = W (6) 605 val BLACK_PEN = W (7) 606 val NULL_PEN = W (8) 607 val OEM_FIXED_FONT = W (10) 608 val ANSI_FIXED_FONT = W (11) 609 val ANSI_VAR_FONT = W (12) 610 val SYSTEM_FONT = W (13) 611 val DEVICE_DEFAULT_FONT = W (14) 612 val DEFAULT_PALETTE = W (15) 613 val SYSTEM_FIXED_FONT = W (16) 614 (*val STOCK_LAST = W (16)*) 615 val CLR_INVALID = W (0xFFFFFFFF) 616 end 617 618 val CancelDC = winCall1(gdi "CancelDC") (cHDC) (successState "CancelDC") 619 val CreateCompatibleDC = winCall1(gdi "CreateCompatibleDC") (cHDC) cHDC 620 val DeleteDC = winCall1(gdi "DeleteDC") (cHDC) (successState "DeleteDC") 621 val DeleteObject = winCall1(gdi "DeleteObject") (cHGDIOBJ) (successState "DeleteObject") 622 val GetCurrentObject = winCall2(gdi "GetCurrentObject") (cHDC,ENUMOBJECT) cHGDIOBJ 623 val GetDC = checkDC o winCall1(user "GetDC") (cHWND) cHDC 624 val GetDCEx = checkDC o winCall3(user "GetDCEx") (cHWND,cHRGN,DEVICECONTEXTFLAG) cHDC 625 626 local 627 val getDCOrgEx = winCall2(gdi "GetDCOrgEx") (cHDC, cStar cPoint) (successState "GetDCOrgEx") 628 in 629 fun GetDCOrgEx hdc = let val v = ref {x=0, y=0} in getDCOrgEx(hdc, v); !v end 630 end 631 632 val GetDeviceCaps = winCall2(gdi "GetDeviceCaps") (cHDC,DEVICEITEM) cInt 633 val GetObjectType = winCall1(gdi "GetObjectType") (cHGDIOBJ) ENUMOBJECT 634 val GetStockObject = winCall1 (gdi "GetStockObject") (STOCKOBJECTTYPE) cHGDIOBJ 635 val ReleaseDC = winCall2(user "ReleaseDC") (cHWND,cHDC) cBool 636 val RestoreDC = winCall2(gdi "RestoreDC") (cHDC,cInt) (successState "RestoreDC") 637 val SaveDC = winCall1(gdi "SaveDC") (cHDC) cInt 638 val ResetDC = winCall2 (gdi "ResetDC") (cHDC, LPDEVMODE) cHDC 639 (* The result of SelectObject is a bit of a mess. It is the original object being 640 replaced except if the argument is a region when it returns a RESULTREGION. 641 Perhaps we need a different function for that. *) 642 val SelectObject = winCall2(gdi "SelectObject") (cHDC,cHGDIOBJ) cHGDIOBJ 643 644 val CreateDC = winCall4 (gdi "CreateDCA") (STRINGOPT, STRINGOPT, STRINGOPT, cOptionPtr LPDEVMODE) cHDC 645 646 (* GetObject returns information about different kinds of GDI object. 647 It takes a pointer to a structure whose size and format differ according 648 to the type of object. To implement this properly in ML we have to 649 find out the type before we start. *) 650 datatype GetObject = 651 GO_Bitmap of BITMAP 652 (*| GO_DIBSection of DIBSECTION*) (* This is a subset of BITMAP *) 653 (*| GO_ExPen of EXTLOGPEN*) 654 | GO_Brush of LOGBRUSH 655 | GO_Font of LOGFONT 656 | GO_Pen of LOGPEN 657 | GO_Palette of int 658 local 659 val getObj = winCall3 (gdi "GetObjectA") (cHGDIOBJ, cInt, cPointer) cInt 660 val {load=fromCBM, ...} = breakConversion cBITMAP 661 val {load=fromCLF, ...} = breakConversion FontBase.cLOGFONT 662 val {load=fromCLB, ...} = breakConversion cLOGBRUSH 663 val {load=fromCLP, ...} = breakConversion cLOGPEN 664 val {load=fromCshort, ...} = breakConversion cShort 665 in 666 fun GetObject(hgdi: HGDIOBJ): GetObject = 667 let 668 (* Call with a NULL buffer to find out the memory required. Also 669 checks the GDI object. *) 670 open Memory 671 val space = getObj(hgdi, 0, Memory.null) 672 val _ = checkResult(space > 0); 673 val mem = malloc (Word.fromInt space) 674 val _ = 675 getObj(hgdi, space, mem) handle ex => (free mem; raise ex) 676 in 677 (case GetObjectType hgdi of 678 OBJ_PEN => GO_Pen(fromCLP mem) 679 | OBJ_BRUSH => GO_Brush(fromCLB mem) 680 | OBJ_BITMAP => GO_Bitmap(fromCBM mem) 681 | OBJ_FONT => GO_Font(fromCLF mem) 682 (*| OBJ_EXPEN => *) (* TODO!!*) 683 | OBJ_PAL => GO_Palette(fromCshort mem) (* Number of entries. *) 684 | _ => raise Fail "Different type") 685 before free mem 686 end 687 end 688 689 (* 690 Other Device context functions: 691 ChangeDisplaySettings 692 ChangeDisplaySettingsEx 693 CreateIC 694 DeviceCapabilities 695 DrawEscape 696 EnumDisplayDevices 697 EnumDisplaySettings 698 EnumObjects 699 EnumObjectsProc 700 GetDCBrushColor - NT 5.0 and Win 98 only 701 GetDCPenColor - NT 5.0 and Win 98 only 702 SetDCBrushColor - NT 5.0 and Win 98 only 703 SetDCPenColor - NT 5.0 and Win 98 only 704 *) 705 end 706end; 707