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 Brush: 20 sig 21 type HBITMAP and HBRUSH and HDC 22 23 datatype 24 HatchStyle = 25 HS_BDIAGONAL 26 | HS_CROSS 27 | HS_DIAGCROSS 28 | HS_FDIAGONAL 29 | HS_HORIZONTAL 30 | HS_VERTICAL 31 32 datatype 33 BrushStyle = 34 BS_HATCHED of HatchStyle 35 | BS_HOLLOW 36 | BS_PATTERN of HBITMAP 37 | BS_SOLID 38 39 type COLORREF = Color.COLORREF 40 41 type LOGBRUSH = BrushStyle * COLORREF 42 type POINT = {x: int, y: int} 43 type RasterOpCode = Bitmap.RasterOpCode 44 45 datatype ColorType = 46 COLOR_SCROLLBAR 47 | COLOR_BACKGROUND 48 | COLOR_ACTIVECAPTION 49 | COLOR_INACTIVECAPTION 50 | COLOR_MENU 51 | COLOR_WINDOW 52 | COLOR_WINDOWFRAME 53 | COLOR_MENUTEXT 54 | COLOR_WINDOWTEXT 55 | COLOR_CAPTIONTEXT 56 | COLOR_ACTIVEBORDER 57 | COLOR_INACTIVEBORDER 58 | COLOR_APPWORKSPACE 59 | COLOR_HIGHLIGHT 60 | COLOR_HIGHLIGHTTEXT 61 | COLOR_BTNFACE 62 | COLOR_BTNSHADOW 63 | COLOR_GRAYTEXT 64 | COLOR_BTNTEXT 65 | COLOR_INACTIVECAPTIONTEXT 66 | COLOR_BTNHIGHLIGHT 67 | COLOR_3DDKSHADOW 68 | COLOR_3DLIGHT 69 | COLOR_INFOTEXT 70 | COLOR_INFOBK 71 72 val CreateBrushIndirect : LOGBRUSH -> HBRUSH 73 val CreateHatchBrush : HatchStyle * COLORREF -> HBRUSH 74 val CreatePatternBrush : HBITMAP -> HBRUSH 75 val CreateSolidBrush : COLORREF -> HBRUSH 76 val GetSysColorBrush : ColorType -> HBRUSH 77 val GetBrushOrgEx : HDC -> POINT 78 val PatBlt : HDC * int * int * int * int * RasterOpCode -> unit 79 val SetBrushOrgEx : HDC * POINT -> POINT 80 81 end = 82struct 83 local 84 open Foreign Base 85(* 86 fun gdicall_IW name CR (C1,C2) (a1) = 87 let val (from1,to1,ctype1) = breakConversion C1 88 val (from2,to2,ctype2) = breakConversion C2 89 val (fromR,toR,ctypeR) = breakConversion CR 90 val va1 = to1 a1 91 val va2 = address (alloc 1 ctype2) 92 val res = callgdi name [(ctype1,va1),(Cpointer ctype2,va2)] ctypeR 93 val _: unit = fromR res 94 in (from2 (deref va2)) 95 end 96 fun gdicall_IM name CR (C1,C2) (a1,a2) = 97 let val (from1,to1,ctype1) = breakConversion C1 98 val (from2,to2,ctype2) = breakConversion C2 99 val (fromR,toR,ctypeR) = breakConversion CR 100 val va1 = to1 a1 101 val va2 = address (to2 a2) 102 val res = callgdi name [(ctype1,va1),(Cpointer ctype2,va2)] ctypeR 103 val _ : unit = fromR res 104 in from2 (deref va2) 105 end 106 107 val XCOORD = INT : int Conversion 108 val YCOORD = INT: int Conversion 109 val WIDTH = INT: int Conversion 110 val HEIGHT = INT: int Conversion*) 111 112 in 113 type HBRUSH = HBRUSH and COLORREF = Color.COLORREF and HBITMAP = HBITMAP 114 and HDC = HDC and POINT = POINT 115 116 open GdiBase 117 118 119 (* BRUSHES *) 120 val CreateBrushIndirect = winCall1 (user "CreateBrushIndirect") (cConstStar cLOGBRUSH) cHBRUSH 121 and CreateHatchBrush = winCall2 (gdi "CreateHatchBrush") (cHATCHSTYLE, cCOLORREF) cHBRUSH 122 and CreateSolidBrush = winCall1 (gdi "CreateSolidBrush") (cCOLORREF) cHBRUSH 123 124 local 125 val getBrushOrgEx = 126 winCall2 (gdi "GetBrushOrgEx") (cHDC, cStar cPoint) (successState "GetBrushOrgEx") 127 and setBrushOrgEx = 128 winCall4 (gdi "SetBrushOrgEx")(cHDC, cInt, cInt, cStar cPoint) (successState "SetBrushOrgEx") 129 in 130 fun GetBrushOrgEx hdc = let val v = ref{x=0, y=0} in getBrushOrgEx(hdc, v); !v end 131 and SetBrushOrgEx(hdc, {x, y}) = let val v = ref{x=0, y=0} in setBrushOrgEx(hdc, x, y, v); !v end 132 end 133 val CreatePatternBrush = winCall1 (gdi "CreatePatternBrush") (cHBITMAP) cHBRUSH 134 val PatBlt = winCall6(gdi "PatBlt") (cHDC,cInt,cInt,cInt,cInt,cRASTEROPCODE) 135 (successState "PatBlt") 136 datatype ColorType = 137 COLOR_SCROLLBAR 138 | COLOR_BACKGROUND 139 | COLOR_ACTIVECAPTION 140 | COLOR_INACTIVECAPTION 141 | COLOR_MENU 142 | COLOR_WINDOW 143 | COLOR_WINDOWFRAME 144 | COLOR_MENUTEXT 145 | COLOR_WINDOWTEXT 146 | COLOR_CAPTIONTEXT 147 | COLOR_ACTIVEBORDER 148 | COLOR_INACTIVEBORDER 149 | COLOR_APPWORKSPACE 150 | COLOR_HIGHLIGHT 151 | COLOR_HIGHLIGHTTEXT 152 | COLOR_BTNFACE 153 | COLOR_BTNSHADOW 154 | COLOR_GRAYTEXT 155 | COLOR_BTNTEXT 156 | COLOR_INACTIVECAPTIONTEXT 157 | COLOR_BTNHIGHLIGHT 158 | COLOR_3DDKSHADOW 159 | COLOR_3DLIGHT 160 | COLOR_INFOTEXT 161 | COLOR_INFOBK 162 163 fun colourTypeToInt COLOR_SCROLLBAR = 0 164 | colourTypeToInt COLOR_BACKGROUND = 1 165 | colourTypeToInt COLOR_ACTIVECAPTION = 2 166 | colourTypeToInt COLOR_INACTIVECAPTION = 3 167 | colourTypeToInt COLOR_MENU = 4 168 | colourTypeToInt COLOR_WINDOW = 5 169 | colourTypeToInt COLOR_WINDOWFRAME = 6 170 | colourTypeToInt COLOR_MENUTEXT = 7 171 | colourTypeToInt COLOR_WINDOWTEXT = 8 172 | colourTypeToInt COLOR_CAPTIONTEXT = 9 173 | colourTypeToInt COLOR_ACTIVEBORDER = 10 174 | colourTypeToInt COLOR_INACTIVEBORDER = 11 175 | colourTypeToInt COLOR_APPWORKSPACE = 12 176 | colourTypeToInt COLOR_HIGHLIGHT = 13 177 | colourTypeToInt COLOR_HIGHLIGHTTEXT = 14 178 | colourTypeToInt COLOR_BTNFACE = 15 179 | colourTypeToInt COLOR_BTNSHADOW = 16 180 | colourTypeToInt COLOR_GRAYTEXT = 17 181 | colourTypeToInt COLOR_BTNTEXT = 18 182 | colourTypeToInt COLOR_INACTIVECAPTIONTEXT = 19 183 | colourTypeToInt COLOR_BTNHIGHLIGHT = 20 184 | colourTypeToInt COLOR_3DDKSHADOW = 21 185 | colourTypeToInt COLOR_3DLIGHT = 22 186 | colourTypeToInt COLOR_INFOTEXT = 23 187 | colourTypeToInt COLOR_INFOBK = 24 188 189 (* Create a brush from a system colour. *) 190 val GetSysColorBrush = winCall1 (user "GetSysColorBrush") (cInt) cHBRUSH o colourTypeToInt 191 192 (* 193 Other Brush functions: 194 CreateDIBPatternBrushPt 195 *) 196 end 197end; 198