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 Painting : 20 sig 21 type HWND and HDC and COLORREF and HRGN 22 23 type RECT = { top: int, left: int, bottom: int, right: int } 24 25 type BinaryRasterOperation 26 val R2_BLACK : BinaryRasterOperation 27 val R2_COPYPEN : BinaryRasterOperation 28 val R2_MASKNOTPEN : BinaryRasterOperation 29 val R2_MASKPEN : BinaryRasterOperation 30 val R2_MASKPENNOT : BinaryRasterOperation 31 val R2_MERGENOTPEN : BinaryRasterOperation 32 val R2_MERGEPEN : BinaryRasterOperation 33 val R2_MERGEPENNOT : BinaryRasterOperation 34 val R2_NOP : BinaryRasterOperation 35 val R2_NOT : BinaryRasterOperation 36 val R2_NOTCOPYPEN : BinaryRasterOperation 37 val R2_NOTMASKPEN : BinaryRasterOperation 38 val R2_NOTMERGEPEN : BinaryRasterOperation 39 val R2_NOTXORPEN : BinaryRasterOperation 40 val R2_WHITE : BinaryRasterOperation 41 val R2_XORPEN : BinaryRasterOperation 42 43 type PAINTSTRUCT = 44 { hdc: HDC, erase: bool, paint: RECT, private: Word8Vector.vector } 45 46 val BeginPaint : HWND -> HDC * PAINTSTRUCT 47 val EndPaint : HWND * PAINTSTRUCT -> unit 48 val GdiFlush : unit -> unit 49 val GdiGetBatchLimit : unit -> int 50 val GdiSetBatchLimit : int -> int 51 val GetBkColor : HDC -> COLORREF 52 val GetROP2 : HDC -> BinaryRasterOperation 53 val GetUpdateRect : HWND * bool -> RECT option 54 val GetUpdateRgn : HWND * HRGN * bool -> Region.ResultRegion 55 val GetWindowDC : HWND -> HDC 56 val InvalidateRgn : HWND * HRGN * bool -> unit 57 val SetBkColor : HDC * COLORREF -> COLORREF 58 val SetROP2 : HDC * BinaryRasterOperation -> BinaryRasterOperation 59 val WindowFromDC : HDC -> HWND 60 val InvalidateRect: HWND * RECT * bool -> unit 61 end = 62struct 63 local 64 open Foreign Base GdiBase 65 66 fun checkDC c = (checkResult(not(isHdcNull c)); c) 67 val zeroRect:RECT = {top=0, bottom=0, left=0, right=0} 68 in 69 type ResultRegion = Region.ResultRegion 70 type HDC = HDC and HRGN = HRGN and HWND = HWND 71 type RECT = RECT and COLORREF = COLORREF 72 73 (* GetROP2 and SetROP2. *) 74 local 75 datatype BinaryRasterOperation = 76 W of int 77 in 78 type BinaryRasterOperation = BinaryRasterOperation 79 val BINARYRASTEROPERATION = absConversion {abs = W, rep = fn W n => n} cInt 80 81 val R2_BLACK = W (1 (* 0 *)) 82 val R2_NOTMERGEPEN = W (2 (* DPon *)) 83 val R2_MASKNOTPEN = W (3 (* DPna *)) 84 val R2_NOTCOPYPEN = W (4 (* PN *)) 85 val R2_MASKPENNOT = W (5 (* PDna *)) 86 val R2_NOT = W (6 (* Dn *)) 87 val R2_XORPEN = W (7 (* DPx *)) 88 val R2_NOTMASKPEN = W (8 (* DPan *)) 89 val R2_MASKPEN = W (9 (* DPa *)) 90 val R2_NOTXORPEN = W (10 (* DPxn *)) 91 val R2_NOP = W (11 (* D *)) 92 val R2_MERGENOTPEN = W (12 (* DPno *)) 93 val R2_COPYPEN = W (13 (* P *)) 94 val R2_MERGEPENNOT = W (14 (* PDno *)) 95 val R2_MERGEPEN = W (15 (* DPo *)) 96 val R2_WHITE = W (16 (* 1 *)) 97 end 98 99 val GdiFlush = winCall0 (gdi "GdiFlush") () (successState "GdiFlush") 100 val GdiGetBatchLimit = winCall0 (gdi "GdiGetBatchLimit") () cDWORD 101 val GdiSetBatchLimit = winCall1 (gdi "GdiSetBatchLimit") (cDWORD) cDWORD 102 val GetBkColor = winCall1 (gdi "GetBkColor") (cHDC) cCOLORREF 103 val GetROP2 = winCall1(user "GetROP2") (cHDC) BINARYRASTEROPERATION 104 val GetUpdateRgn = winCall3(user "GetUpdateRgn") (cHWND,cHRGN,cBool) RESULTREGION 105 val GetWindowDC = winCall1(user "GetWindowDC") (cHWND) cHDC 106 val InvalidateRgn = winCall3(user "InvalidateRgn") (cHWND,cHRGN,cBool) (successState "InvalidateRgn") 107 val InvalidateRect = 108 winCall3 (user "InvalidateRect") (cHWND, cConstStar cRect, cBool) (successState "InvalidateRect") 109 val SetBkColor = winCall2 (gdi "SetBkColor") (cHDC, cCOLORREF) cCOLORREF 110 val WindowFromDC = winCall1(user "WindowFromDC") (cHDC) cHWND 111 val SetROP2 = winCall2(user "SetROP2") (cHDC, BINARYRASTEROPERATION) BINARYRASTEROPERATION 112 113 local 114 val getUpdateRect = winCall3 (user "GetUpdateRect") (cHWND, cStar cRect, cBool) cBool 115 in 116 fun GetUpdateRect (hw: HWND, erase: bool): RECT option = 117 let 118 val va = ref zeroRect 119 (* If the update area is empty the result is zero. *) 120 val res = getUpdateRect(hw, va, erase) 121 in 122 if res then SOME(!va) else NONE 123 end 124 end 125 126 type PAINTSTRUCT = 127 { hdc: HDC, erase: bool, paint: RECT, private: Word8Vector.vector } 128 129 local 130 fun toPt({hdc, erase, paint, private}: PAINTSTRUCT) = 131 (hdc, erase, paint, Byte.bytesToString private) 132 and fromPt(hdc, erase, paint, private) = 133 {hdc = hdc, erase = erase, paint = paint, private = Byte.stringToBytes private} 134 val PAINTSTRUCT = 135 absConversion {abs=fromPt, rep=toPt} (cStruct4(cHDC, cBool, cRect, cCHARARRAY 40)) 136 137 val beginPaint = winCall2 (user "BeginPaint") (cHWND, cStar PAINTSTRUCT) cHDC 138 in 139 fun BeginPaint(hwnd: HWND): HDC * PAINTSTRUCT = 140 let 141 val b = ref {hdc=hNull, erase=false, paint=zeroRect, private=Word8Vector.fromList []} 142 val hdc = checkDC (beginPaint (hwnd, b)) 143 in 144 (hdc, !b) 145 end 146 147 val EndPaint = winCall2 (user "EndPaint") (cHWND, cConstStar PAINTSTRUCT) cVoid 148 end 149 (* 150 Other painting and drawing functions: 151 DrawAnimatedRects 152 DrawCaption 153 DrawEdge 154 DrawFocusRect 155 DrawFrameControl 156 DrawState 157 DrawStateProc 158 ExcludeUpdateRgn 159 GetBkMode 160 GetBoundsRect 161 GetWindowRgn 162 GrayString 163 LockWindowUpdate 164 OutputProc 165 PaintDesktop 166 RedrawWindow 167 SetBkMode 168 SetBoundsRect 169 SetWindowRgn 170 UpdateWindow 171 ValidateRect 172 ValidateRgn 173 *) 174 175 end 176end; 177