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
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
|
(*
Copyright (c) 2001, 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
*)
(* Scrollbars. *)
structure Scrollbar:
sig
type HWND and HDC and HRGN
type RECT = { left: int, top: int, right: int, bottom: int }
structure Style:
sig
include BIT_FLAGS where type flags = Window.Style.flags
val WS_OVERLAPPED: flags and WS_POPUP: flags and WS_CHILD: flags and WS_MINIMIZE: flags
and WS_VISIBLE: flags and WS_DISABLED:flags and WS_CLIPSIBLINGS:flags
and WS_CLIPCHILDREN:flags and WS_MAXIMIZE:flags and WS_CAPTION:flags
and WS_BORDER:flags and WS_DLGFRAME:flags and WS_VSCROLL:flags and WS_HSCROLL:flags
and WS_SYSMENU:flags and WS_THICKFRAME:flags and WS_GROUP:flags and WS_TABSTOP:flags
and WS_MINIMIZEBOX:flags and WS_MAXIMIZEBOX:flags and WS_TILED:flags and WS_ICONIC:flags
and WS_SIZEBOX:flags and WS_OVERLAPPEDWINDOW:flags and WS_TILEDWINDOW:flags
and WS_POPUPWINDOW:flags and WS_CHILDWINDOW:flags
and SBS_HORZ:flags and SBS_VERT:flags and SBS_TOPALIGN:flags and SBS_LEFTALIGN:flags
and SBS_BOTTOMALIGN:flags and SBS_RIGHTALIGN:flags and SBS_SIZEBOXTOPLEFTALIGN:flags
and SBS_SIZEBOXBOTTOMRIGHTALIGN:flags and SBS_SIZEBOX:flags and SBS_SIZEGRIP:flags
end
type enableArrows = { enableLeftUp: bool, enableRightDown: bool }
val ESB_ENABLE_BOTH: enableArrows
val ESB_DISABLE_BOTH: enableArrows
val ESB_DISABLE_LEFT: enableArrows
val ESB_DISABLE_RIGHT: enableArrows
val ESB_DISABLE_UP: enableArrows
val ESB_DISABLE_DOWN: enableArrows
type SCROLLINFO =
{ minPos: int, maxPos: int, pageSize: int, pos: int, trackPos: int }
datatype ScrollInfoOption =
SIF_RANGE | SIF_PAGE | SIF_POS | SIF_DISABLENOSCROLL | SIF_TRACKPOS
val SIF_ALL : ScrollInfoOption list
datatype ScrollBarType = SB_BOTH | SB_CTL | SB_HORZ | SB_VERT
datatype ScrollWindowFlag = SW_ERASE | SW_INVALIDATE | SW_SCROLLCHILDREN
val EnableScrollBar : HWND * ScrollBarType * enableArrows -> unit
val GetScrollInfo : HWND * ScrollBarType * ScrollInfoOption list -> SCROLLINFO
val GetScrollPos : HWND * ScrollBarType -> int
val ScrollDC : HDC * int * int * RECT * RECT * HRGN -> RECT
val ScrollWindow : HWND * int * int * RECT * RECT -> unit
val ScrollWindowEx : HWND * int * int * RECT * RECT * HRGN * ScrollWindowFlag list -> RECT
val SetScrollInfo :
HWND * ScrollBarType * ScrollInfoOption list * SCROLLINFO * bool -> int
val SetScrollPos : HWND * ScrollBarType * int * bool -> int
val SetScrollRange : HWND * ScrollBarType * int * int * bool -> bool
val ShowScrollBar : HWND * ScrollBarType * bool -> unit
end
=
struct
local
open Foreign Base
in
open ScrollBase
type HDC = HDC and HWND = HWND and HRGN = HRGN and RECT = RECT
structure Style =
struct
open Window.Style (* Include all the windows styles. *)
val SBS_HORZ = fromWord 0wx0000
val SBS_VERT = fromWord 0wx0001
val SBS_TOPALIGN = fromWord 0wx0002
val SBS_LEFTALIGN = fromWord 0wx0002
val SBS_BOTTOMALIGN = fromWord 0wx0004
val SBS_RIGHTALIGN = fromWord 0wx0004
val SBS_SIZEBOXTOPLEFTALIGN = fromWord 0wx0002
val SBS_SIZEBOXBOTTOMRIGHTALIGN = fromWord 0wx0004
val SBS_SIZEBOX = fromWord 0wx0008
val SBS_SIZEGRIP = fromWord 0wx0010
val all = flags[Window.Style.all, SBS_HORZ, SBS_VERT, SBS_TOPALIGN, SBS_BOTTOMALIGN,
SBS_SIZEBOX, SBS_SIZEGRIP]
val intersect =
List.foldl (fn (a, b) => fromWord(SysWord.andb(toWord a, toWord b))) all
end
datatype ScrollBarType = SB_CTL | SB_HORZ | SB_VERT | SB_BOTH
local
val tab = [
(SB_HORZ, 0),
(SB_VERT, 1),
(SB_CTL, 2),
(SB_BOTH, 3)
]
in
val cSCROLLBARTYPE = tableConversion(tab, NONE) cUint
(* It's a UINT for EnableScrollBar and int for GetScrollInfo *)
end
datatype ScrollWindowFlag =
SW_SCROLLCHILDREN | SW_INVALIDATE | SW_ERASE
local
val tab = [
(SW_SCROLLCHILDREN, 0wx0001),
(SW_INVALIDATE, 0wx0002),
(SW_ERASE, 0wx0004) ]
in
val cSCROLLWINDOWFLAG = tableSetConversion(tab, NONE)
end
local
open Foreign
open Base
in
val EnableScrollBar = winCall3(user "EnableScrollBar") (cHWND, cSCROLLBARTYPE, cENABLESCROLLBARFLAG)
(successState "EnableScrollBar")
val GetScrollPos = winCall2 (user "GetScrollPos") (cHWND,cSCROLLBARTYPE) cInt
val SetScrollRange = winCall5(user "SetScrollRange") (cHWND,cSCROLLBARTYPE,cInt,cInt,cBool) cBool
val SetScrollPos = winCall4(user "SetScrollPos") (cHWND,cSCROLLBARTYPE,cInt,cBool) cInt
val ShowScrollBar = winCall3(user "ShowScrollBar") (cHWND,cSCROLLBARTYPE,cBool) (successState "ShowScrollBar")
val ScrollWindow = winCall5(user "ScrollWindow") (cHWND,cInt,cInt,cConstStar cRect,cConstStar cRect)
(successState "ScrollWindow")
local
val scrollDC =
winCall7 (user "ScrollDC") (cHDC,cInt,cInt,cConstStar cRect,cConstStar cRect,cHRGN,cStar cRect)
(successState "ScrollDC")
val scrollWindowEx = winCall8(user "ScrollWindowEx")
(cHWND,cInt,cInt,cConstStar cRect,cConstStar cRect,cHRGN,cStar cRect,cSCROLLWINDOWFLAG)
(successState "ScrollWindowEx")
in
fun ScrollDC(hDC, dx, dy, prcScroll, prcClip, hrgnUpdate): RECT =
let
val v = ref{top=0, bottom=0, left=0, right=0}
val () = scrollDC(hDC, dx, dy, prcScroll, prcClip, hrgnUpdate, v)
in
! v
end
and ScrollWindowEx(hWnd, dx, dy, prcScroll, prcClip, hrgnUpdate, flags) =
let
val v = ref{top=0, bottom=0, left=0, right=0}
val () =
scrollWindowEx(hWnd, dx, dy, prcScroll, prcClip, hrgnUpdate, v, flags)
in
! v
end
end
local
val {ctype = {size=sizeStruct, ...}, ...} = breakConversion cSCROLLINFOSTRUCT
val getScrollInfo =
winCall3 (user "GetScrollInfo") (cHWND, cSCROLLBARTYPE, cStar cSCROLLINFOSTRUCT)
(successState "GetScrollInfo")
and setScrollInfo =
winCall4 (user "SetScrollInfo") (cHWND, cSCROLLBARTYPE, cConstStar cSCROLLINFOSTRUCT, cBool) cInt
in
fun GetScrollInfo(hwnd, sbt, options): SCROLLINFO =
let
val v = ref(Word.toInt sizeStruct, options, 0, 0, 0, 0, 0)
val _: unit = getScrollInfo(hwnd, sbt, v)
val (_, _, minPos, maxPos, pageSize, pos, trackPos) = ! v
in
{minPos = minPos, maxPos = maxPos, pageSize = pageSize,
pos = pos, trackPos = trackPos}
end
and SetScrollInfo(hwnd, sbt, options,
{ minPos, maxPos, pageSize, pos, trackPos}, redraw): int =
setScrollInfo(hwnd, sbt,
(Word.toInt sizeStruct, options, minPos, maxPos, pageSize, pos, trackPos), redraw)
end
end
end
end;
(*
let
open Scrollbar.Style
(* The same values are used with different names for horizontal and vertical bars.
Maybe we should generate different names according to whether the SBS_VERT flag
is set. *)
val flagTable =
[(SBS_VERT, "SBS_VERT"),
(SBS_TOPALIGN, "SBS_TOPALIGN"),
(SBS_BOTTOMALIGN, "SBS_BOTTOMALIGN"),
(SBS_SIZEBOX, "SBS_SIZEBOX"),
(SBS_SIZEGRIP, "SBS_SIZEGRIP"),
(WS_POPUP, "WS_POPUP"),
(WS_CHILD, "WS_CHILD"),
(WS_MINIMIZE, "WS_MINIMIZE"),
(WS_VISIBLE, "WS_VISIBLE"),
(WS_DISABLED, "WS_DISABLED"),
(WS_CLIPSIBLINGS, "WS_CLIPSIBLINGS"),
(WS_CLIPCHILDREN, "WS_CLIPCHILDREN"),
(WS_MAXIMIZE, "WS_MAXIMIZE"),
(WS_CAPTION, "WS_CAPTION"),
(WS_BORDER, "WS_BORDER"),
(WS_DLGFRAME, "WS_DLGFRAME"),
(WS_VSCROLL, "WS_VSCROLL"),
(WS_HSCROLL, "WS_HSCROLL"),
(WS_SYSMENU, "WS_SYSMENU"),
(WS_THICKFRAME, "WS_THICKFRAME"),
(WS_GROUP, "WS_GROUP"),
(WS_TABSTOP, "WS_TABSTOP"),
(WS_MINIMIZEBOX, "WS_MINIMIZEBOX"),
(WS_MAXIMIZEBOX, "WS_MAXIMIZEBOX")]
fun accumulateFlags f [] = []
| accumulateFlags f ((w, s)::t) =
if allSet(w, f) then s :: accumulateFlags(clear(w, f)) t
else accumulateFlags f t
fun printFlags(put, beg, brk, nd) depth _ x =
(* This is just the code to print a list. *)
let
val stringFlags = accumulateFlags x flagTable
fun plist [] depth = ()
| plist _ 0 = put "..."
| plist [h] depth = put h
| plist (h::t) depth =
( put (h^",");
brk (1, 0);
plist t (depth - 1)
)
in
beg (3, false);
put "[";
if depth <= 0 then put "..." else plist stringFlags depth;
put "]";
nd ()
end
in
PolyML.install_pp printFlags
end;
*)
|
