1(* 2 Copyright (c) 2001 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 as published by the Free Software Foundation; either 8 version 2.1 of the License, or (at your option) any later version. 9 10 This library is distributed in the hope that it will be useful, 11 but WITHOUT ANY WARRANTY; without even the implied warranty of 12 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 13 Lesser General Public License for more details. 14 15 You should have received a copy of the GNU Lesser General Public 16 License along with this library; if not, write to the Free Software 17 Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA 18*) 19 20(* Buttons. *) 21structure Button: 22sig 23 structure Style: 24 sig 25 include BIT_FLAGS where type flags = Window.Style.flags 26 val WS_OVERLAPPED: flags and WS_POPUP: flags and WS_CHILD: flags and WS_MINIMIZE: flags 27 and WS_VISIBLE: flags and WS_DISABLED:flags and WS_CLIPSIBLINGS:flags 28 and WS_CLIPCHILDREN:flags and WS_MAXIMIZE:flags and WS_CAPTION:flags 29 and WS_BORDER:flags and WS_DLGFRAME:flags and WS_VSCROLL:flags and WS_HSCROLL:flags 30 and WS_SYSMENU:flags and WS_THICKFRAME:flags and WS_GROUP:flags and WS_TABSTOP:flags 31 and WS_MINIMIZEBOX:flags and WS_MAXIMIZEBOX:flags and WS_TILED:flags and WS_ICONIC:flags 32 and WS_SIZEBOX:flags and WS_OVERLAPPEDWINDOW:flags and WS_TILEDWINDOW:flags 33 and WS_POPUPWINDOW:flags and WS_CHILDWINDOW:flags 34 and BS_3STATE: flags and BS_AUTO3STATE: flags and BS_AUTOCHECKBOX: flags 35 and BS_AUTORADIOBUTTON: flags and BS_BITMAP: flags and BS_BOTTOM: flags 36 and BS_CENTER: flags and BS_CHECKBOX: flags and BS_DEFPUSHBUTTON: flags 37 and BS_FLAT: flags and BS_GROUPBOX: flags and BS_ICON: flags and BS_LEFT: flags 38 and BS_LEFTTEXT: flags and BS_MULTILINE: flags and BS_NOTIFY: flags 39 and BS_OWNERDRAW: flags and BS_PUSHBUTTON: flags and BS_PUSHLIKE: flags 40 and BS_RADIOBUTTON: flags and BS_RIGHT: flags and BS_RIGHTBUTTON: flags 41 and BS_TEXT: flags and BS_TOP: flags and BS_USERBUTTON: flags and BS_VCENTER: flags 42 end 43 44 structure Notifications: 45 sig 46 val BN_CLICKED: int 47 val BN_PAINT: int 48 val BN_HILITE: int 49 val BN_UNHILITE: int 50 val BN_DISABLE: int 51 val BN_DOUBLECLICKED: int 52 val BN_PUSHED: int 53 val BN_UNPUSHED: int 54 val BN_DBLCLK: int 55 val BN_SETFOCUS: int 56 val BN_KILLFOCUS: int 57 end 58 59 structure State: 60 sig 61 val BST_UNCHECKED: int 62 val BST_CHECKED: int 63 val BST_INDETERMINATE: int 64 val BST_PUSHED: int 65 val BST_FOCUS: int 66 end 67 68end 69= 70struct 71 structure Style = 72 struct 73 open Window.Style (* Include all the windows styles. *) 74 type flags = Window.Style.flags (* Causes the type to print as Dialog.Style.flags. *) 75 76 val BS_PUSHBUTTON: flags = fromWord 0wx00000000 77 val BS_DEFPUSHBUTTON: flags = fromWord 0wx00000001 78 val BS_CHECKBOX: flags = fromWord 0wx00000002 79 val BS_AUTOCHECKBOX: flags = fromWord 0wx00000003 80 val BS_RADIOBUTTON: flags = fromWord 0wx00000004 81 val BS_3STATE: flags = fromWord 0wx00000005 82 val BS_AUTO3STATE: flags = fromWord 0wx00000006 83 val BS_GROUPBOX: flags = fromWord 0wx00000007 84 val BS_USERBUTTON: flags = fromWord 0wx00000008 85 val BS_AUTORADIOBUTTON: flags = fromWord 0wx00000009 86 val BS_OWNERDRAW: flags = fromWord 0wx0000000B 87 val BS_LEFTTEXT: flags = fromWord 0wx00000020 88 val BS_TEXT: flags = fromWord 0wx00000000 89 val BS_ICON: flags = fromWord 0wx00000040 90 val BS_BITMAP: flags = fromWord 0wx00000080 91 val BS_LEFT: flags = fromWord 0wx00000100 92 val BS_RIGHT: flags = fromWord 0wx00000200 93 val BS_CENTER: flags = fromWord 0wx00000300 94 val BS_TOP: flags = fromWord 0wx00000400 95 val BS_BOTTOM: flags = fromWord 0wx00000800 96 val BS_VCENTER: flags = fromWord 0wx00000C00 97 val BS_PUSHLIKE: flags = fromWord 0wx00001000 98 val BS_MULTILINE: flags = fromWord 0wx00002000 99 val BS_NOTIFY: flags = fromWord 0wx00004000 100 val BS_FLAT: flags = fromWord 0wx00008000 101 val BS_RIGHTBUTTON: flags = BS_LEFTTEXT 102 103 val all = flags[Window.Style.all, BS_PUSHBUTTON, BS_DEFPUSHBUTTON, BS_CHECKBOX, 104 BS_AUTOCHECKBOX, BS_RADIOBUTTON, BS_3STATE, BS_AUTO3STATE, BS_GROUPBOX, 105 BS_USERBUTTON, BS_AUTORADIOBUTTON, BS_OWNERDRAW, BS_LEFTTEXT, BS_TEXT, 106 BS_ICON, BS_BITMAP, BS_LEFT, BS_RIGHT, BS_CENTER, BS_TOP, BS_BOTTOM, 107 BS_VCENTER, BS_PUSHLIKE, BS_MULTILINE, BS_NOTIFY, BS_FLAT] 108 109 val intersect = 110 List.foldl (fn (a, b) => fromWord(SysWord.andb(toWord a, toWord b))) all 111 end 112 113 structure Notifications = 114 struct 115 val BN_CLICKED = 0 116 val BN_PAINT = 1 117 val BN_HILITE = 2 118 val BN_UNHILITE = 3 119 val BN_DISABLE = 4 120 val BN_DOUBLECLICKED = 5 121 val BN_PUSHED = BN_HILITE 122 val BN_UNPUSHED = BN_UNHILITE 123 val BN_DBLCLK = BN_DOUBLECLICKED 124 val BN_SETFOCUS = 6 125 val BN_KILLFOCUS = 7 126 end 127 128 (* These are returned by SendMessage(button, BM_GETCHECK) so need to be integers. *) 129 structure State = 130 struct 131 val BST_UNCHECKED = 0x0000 132 val BST_CHECKED = 0x0001 133 val BST_INDETERMINATE = 0x0002 134 val BST_PUSHED = 0x0004 135 val BST_FOCUS = 0x0008 136 end 137 138end; 139 140(* 141let 142 open Button.Style 143 144 fun getType w = 145 let 146 val typeField = fromWord(SysWord.andb(toWord w, 0wx0f)) 147 in 148 if typeField = BS_PUSHBUTTON then "BS_PUSHBUTTON" 149 else if typeField = BS_DEFPUSHBUTTON then "BS_DEFPUSHBUTTON" 150 else if typeField = BS_CHECKBOX then "BS_CHECKBOX" 151 else if typeField = BS_AUTOCHECKBOX then "BS_AUTOCHECKBOX" 152 else if typeField = BS_RADIOBUTTON then "BS_RADIOBUTTON" 153 else if typeField = BS_3STATE then "BS_3STATE" 154 else if typeField = BS_AUTO3STATE then "BS_AUTO3STATE" 155 else if typeField = BS_GROUPBOX then "BS_GROUPBOX" 156 else if typeField = BS_USERBUTTON then "BS_USERBUTTON" 157 else if typeField = BS_AUTORADIOBUTTON then "BS_AUTORADIOBUTTON" 158 else if typeField = BS_OWNERDRAW then "BS_OWNERDRAW" 159 else "??" 160 end 161 162 val flagTable = 163 [(BS_LEFTTEXT, "BS_LEFTTEXT"), 164 (BS_ICON, "BS_ICON"), 165 (BS_BITMAP, "BS_BITMAP"), 166 (BS_CENTER, "BS_CENTER"), (* Must come before the next two. *) 167 (BS_LEFT, "BS_LEFT"), 168 (BS_RIGHT, "BS_RIGHT"), 169 (BS_VCENTER, "BS_VCENTER"), (* Must come before the next two. *) 170 (BS_TOP, "BS_TOP"), 171 (BS_BOTTOM, "BS_BOTTOM"), 172 (BS_PUSHLIKE, "BS_PUSHLIKE"), 173 (BS_MULTILINE, "BS_MULTILINE"), 174 (BS_NOTIFY, "BS_NOTIFY"), 175 (BS_FLAT, "BS_FLAT"), 176 (WS_POPUP, "WS_POPUP"), 177 (WS_CHILD, "WS_CHILD"), 178 (WS_MINIMIZE, "WS_MINIMIZE"), 179 (WS_VISIBLE, "WS_VISIBLE"), 180 (WS_DISABLED, "WS_DISABLED"), 181 (WS_CLIPSIBLINGS, "WS_CLIPSIBLINGS"), 182 (WS_CLIPCHILDREN, "WS_CLIPCHILDREN"), 183 (WS_MAXIMIZE, "WS_MAXIMIZE"), 184 (WS_CAPTION, "WS_CAPTION"), 185 (WS_BORDER, "WS_BORDER"), 186 (WS_DLGFRAME, "WS_DLGFRAME"), 187 (WS_VSCROLL, "WS_VSCROLL"), 188 (WS_HSCROLL, "WS_HSCROLL"), 189 (WS_SYSMENU, "WS_SYSMENU"), 190 (WS_THICKFRAME, "WS_THICKFRAME"), 191 (WS_GROUP, "WS_GROUP"), 192 (WS_TABSTOP, "WS_TABSTOP"), 193 (WS_MINIMIZEBOX, "WS_MINIMIZEBOX"), 194 (WS_MAXIMIZEBOX, "WS_MAXIMIZEBOX")] 195 196 fun accumulateFlags f [] = [] 197 | accumulateFlags f ((w, s)::t) = 198 if allSet(w, f) then s :: accumulateFlags(clear(w, f)) t 199 else accumulateFlags f t 200 201 fun printFlags(put, beg, brk, nd) depth _ x = 202 (* This is just the code to print a list. *) 203 let 204 205 val stringFlags = getType x :: accumulateFlags x flagTable 206 fun plist [] depth = () 207 | plist _ 0 = put "..." 208 | plist [h] depth = put h 209 | plist (h::t) depth = 210 ( put (h^","); 211 brk (1, 0); 212 plist t (depth - 1) 213 ) 214 in 215 beg (3, false); 216 put "["; 217 if depth <= 0 then put "..." else plist stringFlags depth; 218 put "]"; 219 nd () 220 end 221in 222 PolyML.install_pp printFlags 223end; 224*)