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