1(* 2 Copyright (c) 2001-7, 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 19(* This contains the types used in the Win structure. *) 20structure WinBase = 21struct 22 local 23 open Foreign Base 24 in 25 26 structure Style :> 27 sig 28 include BIT_FLAGS 29 val WS_BORDER : flags 30 val WS_CAPTION : flags 31 val WS_CHILD : flags 32 val WS_CHILDWINDOW : flags 33 val WS_CLIPCHILDREN : flags 34 val WS_CLIPSIBLINGS : flags 35 val WS_DISABLED : flags 36 val WS_DLGFRAME : flags 37 val WS_GROUP : flags 38 val WS_HSCROLL : flags 39 val WS_ICONIC : flags 40 val WS_MAXIMIZE : flags 41 val WS_MAXIMIZEBOX : flags 42 val WS_MINIMIZE : flags 43 val WS_MINIMIZEBOX : flags 44 val WS_OVERLAPPED : flags 45 val WS_OVERLAPPEDWINDOW : flags 46 val WS_POPUP : flags 47 val WS_POPUPWINDOW : flags 48 val WS_SIZEBOX : flags 49 val WS_SYSMENU : flags 50 val WS_TABSTOP : flags 51 val WS_THICKFRAME : flags 52 val WS_TILED : flags 53 val WS_TILEDWINDOW : flags 54 val WS_VISIBLE : flags 55 val WS_VSCROLL : flags 56 end = 57 struct 58 type flags = SysWord.word 59 fun toWord f = f 60 fun fromWord f = f 61 val flags = List.foldl (fn (a, b) => SysWord.orb(a,b)) 0w0 62 fun allSet (fl1, fl2) = SysWord.andb(fl1, fl2) = fl1 63 fun anySet (fl1, fl2) = SysWord.andb(fl1, fl2) <> 0w0 64 fun clear (fl1, fl2) = SysWord.andb(SysWord.notb fl1, fl2) 65 66 (* Window styles. *) 67 val WS_OVERLAPPED: flags = 0wx00000000 68 val WS_POPUP: flags = 0wx80000000 69 val WS_CHILD: flags = 0wx40000000 70 val WS_MINIMIZE: flags = 0wx20000000 71 val WS_VISIBLE: flags = 0wx10000000 72 val WS_DISABLED: flags = 0wx08000000 73 val WS_CLIPSIBLINGS: flags = 0wx04000000 74 val WS_CLIPCHILDREN: flags = 0wx02000000 75 val WS_MAXIMIZE: flags = 0wx01000000 76 val WS_CAPTION: flags = 0wx00C00000 (* WS_BORDER | WS_DLGFRAME *) 77 val WS_BORDER: flags = 0wx00800000 78 val WS_DLGFRAME: flags = 0wx00400000 79 val WS_VSCROLL: flags = 0wx00200000 80 val WS_HSCROLL: flags = 0wx00100000 81 val WS_SYSMENU: flags = 0wx00080000 82 val WS_THICKFRAME: flags = 0wx00040000 83 val WS_GROUP: flags = 0wx00020000 84 val WS_TABSTOP: flags = 0wx00010000 85 val WS_MINIMIZEBOX: flags = 0wx00020000 86 val WS_MAXIMIZEBOX: flags = 0wx00010000 87 val WS_TILED: flags = WS_OVERLAPPED 88 val WS_ICONIC: flags = WS_MINIMIZE 89 val WS_SIZEBOX: flags = WS_THICKFRAME 90 val WS_OVERLAPPEDWINDOW = 91 flags[WS_OVERLAPPED, WS_CAPTION, WS_SYSMENU, 92 WS_THICKFRAME, WS_MINIMIZEBOX, WS_MAXIMIZEBOX] 93 val WS_TILEDWINDOW = WS_OVERLAPPEDWINDOW 94 val WS_POPUPWINDOW = 95 flags[WS_POPUP, WS_BORDER, WS_SYSMENU] 96 val WS_CHILDWINDOW = WS_CHILD 97 98 val all = flags[WS_OVERLAPPED, WS_POPUP, WS_CHILD, WS_MINIMIZE, WS_VISIBLE, 99 WS_DISABLED, WS_CLIPSIBLINGS, WS_CLIPCHILDREN, WS_MAXIMIZE, 100 WS_CAPTION, WS_BORDER, WS_DLGFRAME, WS_VSCROLL, WS_HSCROLL, 101 WS_SYSMENU, WS_THICKFRAME, WS_GROUP, WS_TABSTOP, WS_MINIMIZEBOX, 102 WS_MAXIMIZEBOX] 103 104 val intersect = List.foldl (fn (a, b) => SysWord.andb(a,b)) all 105 end 106 107 structure ExStyle:> 108 sig 109 include BIT_FLAGS 110 val WS_EX_DLGMODALFRAME: flags and WS_EX_NOPARENTNOTIFY: flags and WS_EX_TOPMOST: flags 111 and WS_EX_ACCEPTFILES : flags and WS_EX_TRANSPARENT: flags and WS_EX_MDICHILD: flags 112 and WS_EX_TOOLWINDOW: flags and WS_EX_WINDOWEDGE: flags and WS_EX_CLIENTEDGE: flags 113 and WS_EX_CONTEXTHELP: flags and WS_EX_RIGHT: flags and WS_EX_LEFT: flags 114 and WS_EX_RTLREADING: flags and WS_EX_LTRREADING: flags and WS_EX_LEFTSCROLLBAR: flags 115 and WS_EX_RIGHTSCROLLBAR: flags and WS_EX_CONTROLPARENT: flags and WS_EX_STATICEDGE: flags 116 and WS_EX_APPWINDOW: flags and WS_EX_OVERLAPPEDWINDOW: flags and WS_EX_PALETTEWINDOW: flags 117 end = 118 struct 119 type flags = SysWord.word 120 fun toWord f = f 121 fun fromWord f = f 122 val flags = List.foldl (fn (a, b) => SysWord.orb(a,b)) 0w0 123 fun allSet (fl1, fl2) = SysWord.andb(fl1, fl2) = fl1 124 fun anySet (fl1, fl2) = SysWord.andb(fl1, fl2) <> 0w0 125 fun clear (fl1, fl2) = SysWord.andb(SysWord.notb fl1, fl2) 126 val WS_EX_DLGMODALFRAME = 0wx00000001 127 val WS_EX_NOPARENTNOTIFY = 0wx00000004 128 val WS_EX_TOPMOST = 0wx00000008 129 val WS_EX_ACCEPTFILES = 0wx00000010 130 val WS_EX_TRANSPARENT = 0wx00000020 131 val WS_EX_MDICHILD = 0wx00000040 132 val WS_EX_TOOLWINDOW = 0wx00000080 133 val WS_EX_WINDOWEDGE = 0wx00000100 134 val WS_EX_CLIENTEDGE = 0wx00000200 135 val WS_EX_CONTEXTHELP = 0wx00000400 136 137 val WS_EX_RIGHT = 0wx00001000 138 val WS_EX_LEFT = 0wx00000000 139 val WS_EX_RTLREADING = 0wx00002000 140 val WS_EX_LTRREADING = 0wx00000000 141 val WS_EX_LEFTSCROLLBAR = 0wx00004000 142 val WS_EX_RIGHTSCROLLBAR = 0wx00000000 143 144 val WS_EX_CONTROLPARENT = 0wx00010000 145 val WS_EX_STATICEDGE = 0wx00020000 146 val WS_EX_APPWINDOW = 0wx00040000 147 148 149 val WS_EX_OVERLAPPEDWINDOW = flags[WS_EX_WINDOWEDGE, WS_EX_CLIENTEDGE] 150 val WS_EX_PALETTEWINDOW = flags[WS_EX_WINDOWEDGE, WS_EX_TOOLWINDOW, WS_EX_TOPMOST] 151 152 val all = flags[WS_EX_DLGMODALFRAME, WS_EX_NOPARENTNOTIFY, WS_EX_TOPMOST, WS_EX_ACCEPTFILES, 153 WS_EX_TRANSPARENT, WS_EX_MDICHILD, WS_EX_TOOLWINDOW, WS_EX_WINDOWEDGE, 154 WS_EX_CLIENTEDGE, WS_EX_CONTEXTHELP, WS_EX_RIGHT, WS_EX_LEFT, WS_EX_RTLREADING, 155 WS_EX_LTRREADING, WS_EX_LEFTSCROLLBAR, WS_EX_RIGHTSCROLLBAR, WS_EX_CONTROLPARENT, 156 WS_EX_STATICEDGE, WS_EX_APPWINDOW] 157 158 val intersect = List.foldl (fn (a, b) => SysWord.andb(a,b)) all 159 end 160 161 datatype WindowPositionStyle = 162 SWP_ASYNCWINDOWPOS 163 | SWP_DEFERERASE 164 | SWP_FRAMECHANGED 165 | SWP_HIDEWINDOW 166 | SWP_NOACTIVATE 167 | SWP_NOCOPYBITS 168 | SWP_NOMOVE 169 | SWP_NOOWNERZORDER 170 | SWP_NOREDRAW 171 | SWP_NOSENDCHANGING 172 | SWP_NOSIZE 173 | SWP_NOZORDER 174 | SWP_SHOWWINDOW 175 | SWP_OTHER of Word32.word 176 177 local 178 val tab = [ 179 (SWP_NOSIZE, 0wx0001), 180 (SWP_NOMOVE, 0wx0002), 181 (SWP_NOZORDER, 0wx0004), 182 (SWP_NOREDRAW, 0wx0008), 183 (SWP_NOACTIVATE, 0wx0010), 184 (SWP_FRAMECHANGED, 0wx0020), (* The frame changed: send WM_NCCALCSIZE *) 185 (SWP_SHOWWINDOW, 0wx0040), 186 (SWP_HIDEWINDOW, 0wx0080), 187 (SWP_NOCOPYBITS, 0wx0100), 188 (SWP_NOOWNERZORDER, 0wx0200), (* Don't do owner Z ordering *) 189 (SWP_NOSENDCHANGING, 0wx0400), (* Don't send WM_WINDOWPOSCHANGING *) 190 (SWP_DEFERERASE, 0wx2000), 191 (SWP_ASYNCWINDOWPOS, 0wx4000)] 192 193 (* It seems that some other bits are set although they're not defined. *) 194 fun toWord (SWP_OTHER i) = i | toWord _ = raise Match 195 in 196 val cWINDOWPOSITIONSTYLE = tableSetConversion(tab, SOME(SWP_OTHER, toWord)) 197 end 198 199 (* In C the parent and menu arguments are combined in a rather odd way. *) 200 datatype ParentType = 201 PopupWithClassMenu (* Popup or overlapped window using class menu. *) 202 | PopupWindow of HMENU (* Popup or overlapped window with supplied menu. *) 203 | ChildWindow of { parent: HWND, id: int } (* Child window. *) 204 205 (* This function is used whenever windows are created. *) 206 local 207 open Style 208 in 209 (* In the case of a child window the "menu" is actually an integer 210 which identifies the child in notification messages to the parent. 211 We silently set or clear the WS_CHILD bit depending on the argument. *) 212 fun unpackWindowRelation(relation: ParentType, style) = 213 case relation of 214 PopupWithClassMenu => 215 (hwndNull, Memory.null, toWord(clear(WS_CHILD, style))) 216 | PopupWindow hm => 217 (hwndNull, voidStarOfHandle hm, toWord(clear(WS_CHILD, style))) 218 | ChildWindow{parent, id} => 219 (parent, Memory.sysWord2VoidStar(SysWord.fromInt id), toWord(flags[WS_CHILD, style])) 220 end 221 222 end 223end; 224