1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
|
(*
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;
|
