(* Copyright (c) 2001-7, 2015 David C.J. Matthews This library is free software; you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License version 2.1 as published by the Free Software Foundation. This library is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for more details. You should have received a copy of the GNU Lesser General Public License along with this library; if not, write to the Free Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA *) (* This contains the types used in the Win structure. *) structure WinBase = struct local open Foreign Base in structure Style :> sig include BIT_FLAGS val WS_BORDER : flags val WS_CAPTION : flags val WS_CHILD : flags val WS_CHILDWINDOW : flags val WS_CLIPCHILDREN : flags val WS_CLIPSIBLINGS : flags val WS_DISABLED : flags val WS_DLGFRAME : flags val WS_GROUP : flags val WS_HSCROLL : flags val WS_ICONIC : flags val WS_MAXIMIZE : flags val WS_MAXIMIZEBOX : flags val WS_MINIMIZE : flags val WS_MINIMIZEBOX : flags val WS_OVERLAPPED : flags val WS_OVERLAPPEDWINDOW : flags val WS_POPUP : flags val WS_POPUPWINDOW : flags val WS_SIZEBOX : flags val WS_SYSMENU : flags val WS_TABSTOP : flags val WS_THICKFRAME : flags val WS_TILED : flags val WS_TILEDWINDOW : flags val WS_VISIBLE : flags val WS_VSCROLL : flags end = struct type flags = SysWord.word fun toWord f = f fun fromWord f = f val flags = List.foldl (fn (a, b) => SysWord.orb(a,b)) 0w0 fun allSet (fl1, fl2) = SysWord.andb(fl1, fl2) = fl1 fun anySet (fl1, fl2) = SysWord.andb(fl1, fl2) <> 0w0 fun clear (fl1, fl2) = SysWord.andb(SysWord.notb fl1, fl2) (* Window styles. *) val WS_OVERLAPPED: flags = 0wx00000000 val WS_POPUP: flags = 0wx80000000 val WS_CHILD: flags = 0wx40000000 val WS_MINIMIZE: flags = 0wx20000000 val WS_VISIBLE: flags = 0wx10000000 val WS_DISABLED: flags = 0wx08000000 val WS_CLIPSIBLINGS: flags = 0wx04000000 val WS_CLIPCHILDREN: flags = 0wx02000000 val WS_MAXIMIZE: flags = 0wx01000000 val WS_CAPTION: flags = 0wx00C00000 (* WS_BORDER | WS_DLGFRAME *) val WS_BORDER: flags = 0wx00800000 val WS_DLGFRAME: flags = 0wx00400000 val WS_VSCROLL: flags = 0wx00200000 val WS_HSCROLL: flags = 0wx00100000 val WS_SYSMENU: flags = 0wx00080000 val WS_THICKFRAME: flags = 0wx00040000 val WS_GROUP: flags = 0wx00020000 val WS_TABSTOP: flags = 0wx00010000 val WS_MINIMIZEBOX: flags = 0wx00020000 val WS_MAXIMIZEBOX: flags = 0wx00010000 val WS_TILED: flags = WS_OVERLAPPED val WS_ICONIC: flags = WS_MINIMIZE val WS_SIZEBOX: flags = WS_THICKFRAME val WS_OVERLAPPEDWINDOW = flags[WS_OVERLAPPED, WS_CAPTION, WS_SYSMENU, WS_THICKFRAME, WS_MINIMIZEBOX, WS_MAXIMIZEBOX] val WS_TILEDWINDOW = WS_OVERLAPPEDWINDOW val WS_POPUPWINDOW = flags[WS_POPUP, WS_BORDER, WS_SYSMENU] val WS_CHILDWINDOW = WS_CHILD val all = flags[WS_OVERLAPPED, WS_POPUP, WS_CHILD, WS_MINIMIZE, WS_VISIBLE, WS_DISABLED, WS_CLIPSIBLINGS, WS_CLIPCHILDREN, WS_MAXIMIZE, WS_CAPTION, WS_BORDER, WS_DLGFRAME, WS_VSCROLL, WS_HSCROLL, WS_SYSMENU, WS_THICKFRAME, WS_GROUP, WS_TABSTOP, WS_MINIMIZEBOX, WS_MAXIMIZEBOX] val intersect = List.foldl (fn (a, b) => SysWord.andb(a,b)) all end structure ExStyle:> sig include BIT_FLAGS val WS_EX_DLGMODALFRAME: flags and WS_EX_NOPARENTNOTIFY: flags and WS_EX_TOPMOST: flags and WS_EX_ACCEPTFILES : flags and WS_EX_TRANSPARENT: flags and WS_EX_MDICHILD: flags and WS_EX_TOOLWINDOW: flags and WS_EX_WINDOWEDGE: flags and WS_EX_CLIENTEDGE: flags and WS_EX_CONTEXTHELP: flags and WS_EX_RIGHT: flags and WS_EX_LEFT: flags and WS_EX_RTLREADING: flags and WS_EX_LTRREADING: flags and WS_EX_LEFTSCROLLBAR: flags and WS_EX_RIGHTSCROLLBAR: flags and WS_EX_CONTROLPARENT: flags and WS_EX_STATICEDGE: flags and WS_EX_APPWINDOW: flags and WS_EX_OVERLAPPEDWINDOW: flags and WS_EX_PALETTEWINDOW: flags end = struct type flags = SysWord.word fun toWord f = f fun fromWord f = f val flags = List.foldl (fn (a, b) => SysWord.orb(a,b)) 0w0 fun allSet (fl1, fl2) = SysWord.andb(fl1, fl2) = fl1 fun anySet (fl1, fl2) = SysWord.andb(fl1, fl2) <> 0w0 fun clear (fl1, fl2) = SysWord.andb(SysWord.notb fl1, fl2) val WS_EX_DLGMODALFRAME = 0wx00000001 val WS_EX_NOPARENTNOTIFY = 0wx00000004 val WS_EX_TOPMOST = 0wx00000008 val WS_EX_ACCEPTFILES = 0wx00000010 val WS_EX_TRANSPARENT = 0wx00000020 val WS_EX_MDICHILD = 0wx00000040 val WS_EX_TOOLWINDOW = 0wx00000080 val WS_EX_WINDOWEDGE = 0wx00000100 val WS_EX_CLIENTEDGE = 0wx00000200 val WS_EX_CONTEXTHELP = 0wx00000400 val WS_EX_RIGHT = 0wx00001000 val WS_EX_LEFT = 0wx00000000 val WS_EX_RTLREADING = 0wx00002000 val WS_EX_LTRREADING = 0wx00000000 val WS_EX_LEFTSCROLLBAR = 0wx00004000 val WS_EX_RIGHTSCROLLBAR = 0wx00000000 val WS_EX_CONTROLPARENT = 0wx00010000 val WS_EX_STATICEDGE = 0wx00020000 val WS_EX_APPWINDOW = 0wx00040000 val WS_EX_OVERLAPPEDWINDOW = flags[WS_EX_WINDOWEDGE, WS_EX_CLIENTEDGE] val WS_EX_PALETTEWINDOW = flags[WS_EX_WINDOWEDGE, WS_EX_TOOLWINDOW, WS_EX_TOPMOST] val all = flags[WS_EX_DLGMODALFRAME, WS_EX_NOPARENTNOTIFY, WS_EX_TOPMOST, WS_EX_ACCEPTFILES, WS_EX_TRANSPARENT, WS_EX_MDICHILD, WS_EX_TOOLWINDOW, WS_EX_WINDOWEDGE, WS_EX_CLIENTEDGE, WS_EX_CONTEXTHELP, WS_EX_RIGHT, WS_EX_LEFT, WS_EX_RTLREADING, WS_EX_LTRREADING, WS_EX_LEFTSCROLLBAR, WS_EX_RIGHTSCROLLBAR, WS_EX_CONTROLPARENT, WS_EX_STATICEDGE, WS_EX_APPWINDOW] val intersect = List.foldl (fn (a, b) => SysWord.andb(a,b)) all end datatype WindowPositionStyle = SWP_ASYNCWINDOWPOS | SWP_DEFERERASE | SWP_FRAMECHANGED | SWP_HIDEWINDOW | SWP_NOACTIVATE | SWP_NOCOPYBITS | SWP_NOMOVE | SWP_NOOWNERZORDER | SWP_NOREDRAW | SWP_NOSENDCHANGING | SWP_NOSIZE | SWP_NOZORDER | SWP_SHOWWINDOW | SWP_OTHER of Word32.word local val tab = [ (SWP_NOSIZE, 0wx0001), (SWP_NOMOVE, 0wx0002), (SWP_NOZORDER, 0wx0004), (SWP_NOREDRAW, 0wx0008), (SWP_NOACTIVATE, 0wx0010), (SWP_FRAMECHANGED, 0wx0020), (* The frame changed: send WM_NCCALCSIZE *) (SWP_SHOWWINDOW, 0wx0040), (SWP_HIDEWINDOW, 0wx0080), (SWP_NOCOPYBITS, 0wx0100), (SWP_NOOWNERZORDER, 0wx0200), (* Don't do owner Z ordering *) (SWP_NOSENDCHANGING, 0wx0400), (* Don't send WM_WINDOWPOSCHANGING *) (SWP_DEFERERASE, 0wx2000), (SWP_ASYNCWINDOWPOS, 0wx4000)] (* It seems that some other bits are set although they're not defined. *) fun toWord (SWP_OTHER i) = i | toWord _ = raise Match in val cWINDOWPOSITIONSTYLE = tableSetConversion(tab, SOME(SWP_OTHER, toWord)) end (* In C the parent and menu arguments are combined in a rather odd way. *) datatype ParentType = PopupWithClassMenu (* Popup or overlapped window using class menu. *) | PopupWindow of HMENU (* Popup or overlapped window with supplied menu. *) | ChildWindow of { parent: HWND, id: int } (* Child window. *) (* This function is used whenever windows are created. *) local open Style in (* In the case of a child window the "menu" is actually an integer which identifies the child in notification messages to the parent. We silently set or clear the WS_CHILD bit depending on the argument. *) fun unpackWindowRelation(relation: ParentType, style) = case relation of PopupWithClassMenu => (hwndNull, Memory.null, toWord(clear(WS_CHILD, style))) | PopupWindow hm => (hwndNull, voidStarOfHandle hm, toWord(clear(WS_CHILD, style))) | ChildWindow{parent, id} => (parent, Memory.sysWord2VoidStar(SysWord.fromInt id), toWord(flags[WS_CHILD, style])) end end end;