1(* 2 Copyright (c) 2001, 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 19structure Menu: 20 sig 21 type HMENU and HBITMAP and HWND and HINSTANCE 22 type RECT = { left: int, top: int, right: int, bottom: int } 23 24 datatype MenuFlag = 25 MF_BYCOMMAND | MF_BYPOSITION | MF_SEPARATOR | MF_ENABLED | MF_GRAYED | 26 MF_DISABLED | MF_UNCHECKED | MF_CHECKED | MF_USECHECKBITMAPS | MF_STRING | 27 MF_BITMAP | MF_OWNERDRAW | MF_POPUP | MF_MENUBARBREAK | MF_MENUBREAK | 28 MF_UNHILITE | MF_HILITE | MF_DEFAULT | MF_SYSMENU | MF_HELP | 29 MF_RIGHTJUSTIFY | MF_MOUSESELECT 30 31 datatype MenuIdOrHandle = MenuHandle of HMENU | MenuId of int 32 33 datatype MenuItemOptions = 34 MFT_MENUBARBREAK 35 | MFT_MENUBREAK 36 | MFT_RADIOCHECK 37 | MFT_RIGHTJUSTIFY 38 | MFT_RIGHTORDER 39 40 datatype MenuItemType = 41 MFT_BITMAP of HBITMAP 42 | MFT_OWNERDRAW of SysWord.word 43 | MFT_SEPARATOR 44 | MFT_STRING of string 45 46 datatype MenuState = 47 MFS_CHECKED 48 | MFS_DEFAULT 49 | MFS_DISABLED 50 | MFS_ENABLED 51 | MFS_GRAYED 52 | MFS_HILITE 53 | MFS_UNCHECKED 54 | MFS_UNHILITE 55 56 type MenuItemInfo = 57 { 58 menuType: MenuItemType, 59 menuOptions: MenuItemOptions list, 60 state: MenuState list, 61 wID: int, 62 hSubMenu: HMENU option, 63 hbmpChecked: HBITMAP option, 64 hbmpUnchecked: HBITMAP option, 65 itemData: int 66 } 67 68 val AppendMenu : HMENU * MenuFlag list * MenuIdOrHandle * MenuItemType -> unit 69 val CheckMenuRadioItem : HMENU * int * int * int * MenuFlag -> unit 70 val CreateMenu : unit -> HMENU 71 val CreatePopupMenu : unit -> HMENU 72 val DeleteMenu : HMENU * int * MenuFlag -> unit 73 val DestroyMenu : HMENU -> unit 74 val DrawMenuBar : HWND -> unit 75 val EnableMenuItem : HMENU * int * MenuFlag -> MenuFlag list 76 val GetMenu : HWND -> HMENU 77 78 datatype GMDIFlags = GMDI_GOINTOPOPUPS | GMDI_USEDISABLED 79 val GetMenuDefaultItem : HMENU * bool * GMDIFlags list -> int 80 81 val GetMenuItemCount : HMENU -> int 82 val GetMenuItemID : HMENU -> int 83 val GetMenuItemInfo : HMENU * int * bool -> MenuItemInfo 84 val GetMenuItemRect : HWND * HMENU * int -> RECT 85 val GetMenuState : HMENU * int * MenuFlag -> MenuFlag list * int 86 val GetMenuString : HMENU * int * MenuFlag -> string 87 val GetSubMenu : HMENU * int -> HMENU 88 val GetSystemMenu : HWND * bool -> HMENU 89 val HiliteMenuItem : HWND * HMENU * int * MenuFlag list -> unit 90 val InsertMenu : HMENU * int * MenuFlag list * MenuIdOrHandle * MenuItemType -> unit 91 val IsMenu : HMENU -> bool 92 val LoadMenu : HINSTANCE * Resource.RESID -> HMENU 93 val ModifyMenu : HMENU * int * MenuFlag list * MenuIdOrHandle * MenuItemType -> unit 94 val RemoveMenu : HMENU * int * MenuFlag -> unit 95 val SetMenu : HWND * HMENU option -> unit 96 val SetMenuItemInfo : HMENU * int * bool * MenuItemInfo -> unit 97 val InsertMenuItem : HMENU * int * bool * MenuItemInfo -> unit 98 99 datatype TrackPopupMenuOptions = 100 TPM_LEFTBUTTON | TPM_RIGHTBUTTON | TPM_LEFTALIGN | TPM_CENTERALIGN | TPM_RIGHTALIGN | 101 TPM_TOPALIGN | TPM_VCENTERALIGN | TPM_BOTTOMALIGN | (*TPM_HORIZONTAL | TPM_VERTICAL |*) 102 TPM_NONOTIFY | TPM_RETURNCMD 103 val TrackPopupMenu : HMENU * TrackPopupMenuOptions list * int * int * HWND -> int 104 105 val SetMenuContextHelpId: HMENU * int -> unit 106 val GetMenuContextHelpId: HMENU -> int 107 end = 108struct 109 local 110 open Foreign 111 open Base 112 in 113 open MenuBase 114 115 type HMENU = HMENU and HBITMAP = HBITMAP and RECT = RECT and HWND = HWND 116 and HINSTANCE = HINSTANCE 117 118 val isHmenuNull = isHmenuNull 119 120 fun checkMenu c = (checkResult(not(isHmenuNull c)); c) 121 122 (* Check here means "make active", the opposite of uncheck *) 123 val CheckMenuRadioItem = 124 checkResult o 125 winCall5 (user "CheckMenuRadioItem") (cHMENU, cUint, cUint, cUint, cMENUFLAG) cBool 126 127 val CreateMenu = 128 checkMenu o winCall0 (user "CreateMenu") () cHMENU 129 130 val CreatePopupMenu = 131 checkMenu o winCall0 (user "CreatePopupMenu") () cHMENU 132 133 val DeleteMenu = 134 checkResult o 135 winCall3 (user "DeleteMenu") (cHMENU, cUint, cMENUFLAG) cBool 136 137 val DestroyMenu = 138 checkResult o winCall1 (user "DestroyMenu") (cHMENU) cBool 139 140 val DrawMenuBar = 141 checkResult o winCall1 (user "DrawMenuBar") (cHWND) cBool 142 143 local 144 val enableCall = winCall3(user "EnableMenuItem") (cHMENU, cUint, cMENUFLAG) cUintw 145 in 146 fun EnableMenuItem(hMenu: HMENU, id: int, flags: MenuFlag): MenuFlag list = 147 let 148 val res = enableCall(hMenu, id, flags) 149 in 150 checkResult(res <> ~ 0w1); 151 toMenuFlagSet res 152 end 153 end 154 155 val GetMenu = winCall1 (user "GetMenu") (cHWND) cHMENU 156 157 datatype GMDIFlags = GMDI_GOINTOPOPUPS | GMDI_USEDISABLED 158 local 159 val tab = [ 160 (GMDI_USEDISABLED, 0wx0001), 161 (GMDI_GOINTOPOPUPS, 0wx0002) ] 162 in 163 val GMDIFLAGS = tableSetConversion(tab, NONE) 164 end 165 166 local 167 val callGMDI = winCall3 (user "GetMenuDefaultItem") (cHMENU, cBool, GMDIFLAGS) cUint 168 in 169 fun GetMenuDefaultItem(hMenu: HMENU, m: bool, opts: GMDIFlags list): int = 170 let 171 172 val res = callGMDI(hMenu, m, opts) 173 in 174 checkResult(res <> ~1); 175 res 176 end 177 end 178 179 local 180 val getMenuItemCount = winCall1 (user "GetMenuItemCount") (cHMENU) cInt 181 in 182 fun GetMenuItemCount hMenu = 183 case getMenuItemCount hMenu of 184 ~1 => raiseSysErr() 185 | n => n 186 end 187 188 val GetMenuItemID = winCall1 (user "GetMenuItemID") (cHMENU) cUint 189 190 local 191 val getMenuString = winCall5 (user "GetMenuStringA") 192 (cHMENU,cUint,cPointer,cInt,cMENUFLAG) (cPOSINT "GetMenuString") 193 in 194 (* We can get the length by passing null first, then get the actual string. *) 195 fun GetMenuString(h,i,f): string = 196 getStringWithNullIsLength(fn (buff, n) => getMenuString(h,i,buff,n,f)) 197 end 198 199 200 datatype MenuItemType = 201 MFT_BITMAP of HBITMAP 202 | MFT_SEPARATOR 203 | MFT_STRING of string 204 | MFT_OWNERDRAW of SysWord.word 205 206 val mft_STRING = 0wx00000000 (* Replaced by MIIM_STRING *) 207 val mft_BITMAP = 0wx00000004 (* Replaced by MIIM_BITMAP and hbmpItem *) 208 val mft_OWNERDRAW = 0wx00000100 209 val mft_SEPARATOR = 0wx00000800 210 val mft_POPUP = 0wx00000010 211 val typeBits = 0wx914 212 213 datatype MenuItemOptions = 214 MFT_MENUBARBREAK 215 | MFT_MENUBREAK 216 | MFT_RADIOCHECK 217 | MFT_RIGHTJUSTIFY 218 | MFT_RIGHTORDER 219 220 local 221 val tab = [ 222 (MFT_MENUBARBREAK, 0wx00000020: Word32.word), 223 (MFT_MENUBREAK, 0wx00000040), 224 (MFT_RADIOCHECK, 0wx00000200), 225 (MFT_RIGHTORDER, 0wx00002000), 226 (MFT_RIGHTJUSTIFY, 0wx00004000)] 227 in 228 val (fromMFT, toMFT) = tableSetLookup(tab, NONE) 229 end 230 231 datatype MenuState = 232 MFS_GRAYED 233 | MFS_DISABLED 234 | MFS_CHECKED 235 | MFS_DEFAULT 236 | MFS_HILITE 237 | MFS_ENABLED 238 | MFS_UNCHECKED 239 | MFS_UNHILITE 240 241 local 242 val tab = [ 243 (MFS_DISABLED, 0wx00000002), 244 (MFS_ENABLED, 0wx00000000), 245 (MFS_GRAYED, 0wx00000003), 246 (MFS_CHECKED, 0wx00000008), 247 (MFS_UNCHECKED, 0wx00000000), 248 (MFS_HILITE, 0wx00000080), 249 (MFS_UNHILITE, 0wx00000000), 250 (MFS_DEFAULT, 0wx00001000)] 251 in 252 val cMENUSTATE = tableSetConversion(tab, NONE) 253 end 254 255 type MenuItemInfo = 256 { 257 (*mask: int,*) (* Datatype? *) 258 menuType: MenuItemType, 259 menuOptions: MenuItemOptions list, 260 state: MenuState list, 261 wID: int, 262 hSubMenu: HMENU option, 263 hbmpChecked: HBITMAP option, 264 hbmpUnchecked: HBITMAP option, 265 itemData: int 266 } 267 268 (* Although we can selectively return information it's probably simpler to 269 return the lot. It's only in SetMenuItemInfo where we might want to 270 update only some of the information. 271 To find out if we've got all the string we will have to loop until 272 the value of cch we get back is less than the buffer we passed. *) 273 local 274 (* Flags used in GetItemInfo and SetItemInfo. *) 275 (*val MIIM_STATE = 0x00000001 276 val MIIM_ID = 0x00000002 277 val MIIM_SUBMENU = 0x00000004 278 val MIIM_CHECKMARKS = 0x00000008 279 (*val MIIM_TYPE = 0x00000010 *) (* Replaced by new fields. *) 280 val MIIM_DATA = 0x00000020 281 val MIIM_STRING = 0x00000040 (* Added *) 282 val MIIM_BITMAP = 0x00000080 (* Added *) 283 val MIIM_FTYPE = 0x00000100*) 284 val allInfo = 0x1ef 285 286 val cMENUITEMINFO = 287 cStruct12(cUintw,cUint,cUintw,cMENUSTATE,cUint,cHMENUOPT,cHGDIOBJOPT, 288 cHGDIOBJOPT,cULONG_PTR,cPointer,cUint, cHGDIOBJ) 289 val {ctype={size=sizeMenuItemStruct, ...}, ...} = breakConversion cMENUITEMINFO 290 val sizeMenuItemStruct = Word32.fromLargeWord(Word.toLargeWord sizeMenuItemStruct) 291 (*val (fromCmenuiteminfo, toCmenuiteminfo, menuItemStruct) = breakConversion MENUITEMINFO*) 292 val getMenuItemInfo = 293 winCall4 (user "GetMenuItemInfoA") (cHMENU, cUint, cBool, cStar cMENUITEMINFO) 294 (successState "GetMenuItemInfo") 295 val setMenuItemInfo = 296 winCall4 (user "SetMenuItemInfoA") (cHMENU, cUint, cBool, cConstStar cMENUITEMINFO) 297 (successState "SetMenuItemInfo") 298 val insertMenuItem = 299 winCall4 (user "InsertMenuItemA") (cHMENU, cUint, cBool, cConstStar cMENUITEMINFO) 300 (successState "InsertMenuItem") 301 in 302 fun GetMenuItemInfo(hMenu: HMENU, uItem: int, fByPosition): MenuItemInfo = 303 let 304 (* First request allInfo. Look at the returned type and cch. If cch is 305 non-zero allocate memory of cch+1 and pass memory pointer and cch+1 to 306 get the string. *) 307 val r = ref (sizeMenuItemStruct, allInfo, 0w0, [], 0, NONE, NONE, NONE, 0, Memory.null, 0, hNull) 308 val () = getMenuItemInfo(hMenu, uItem, fByPosition, r) 309 val cch = #11(!r) 310 val str = 311 if cch = 0 then "" 312 else 313 let 314 open Memory 315 val v = malloc (Word.fromInt cch + 0w1) 316 val () = 317 r := (sizeMenuItemStruct, allInfo, 0w0, [], 0, NONE, NONE, NONE, 0, v, cch+1, hNull) 318 in 319 (* Get the string. Updates r *) 320 getMenuItemInfo(hMenu, uItem, fByPosition, r) 321 handle ex => (free v; raise ex); 322 fromCstring v before free v 323 end 324 val (_, _, mtype, state, wID, hSubMenu, hbmpChecked, hbmpUnchecked, 325 itemData, typeData, _, hbmp) = ! r 326 val menuType = 327 if Word32.andb(mtype, mft_BITMAP) <> 0w0 328 then MFT_BITMAP hbmp 329 else if Word32.andb(mtype, mft_OWNERDRAW) <> 0w0 330 then MFT_OWNERDRAW(Memory.voidStar2Sysword typeData) 331 else if Word32.andb(mtype, mft_SEPARATOR) <> 0w0 332 then MFT_SEPARATOR 333 else (* String *) MFT_STRING str 334 (* The options are the other bits in the type field. *) 335 val menuOptions = 336 toMFT(Word32.andb(Word32.notb typeBits, mtype)) 337 in 338 { menuType = menuType, menuOptions = menuOptions, wID = wID, 339 hSubMenu = hSubMenu, hbmpChecked = hbmpChecked, 340 hbmpUnchecked = hbmpUnchecked, itemData = itemData, 341 state = state } 342 end 343 344 (* It's simplest to set everything. *) 345 fun SetMenuItemInfo(hMenu: HMENU, uItem: int, fByPosition, 346 ({menuType, menuOptions, wID, hSubMenu, hbmpChecked, hbmpUnchecked, 347 itemData, state }: MenuItemInfo)) = 348 let 349 open Memory 350 val (bits, typeData, cch, bmp) = 351 case menuType of 352 MFT_BITMAP b => (mft_BITMAP, null, 0, b) 353 | MFT_OWNERDRAW i => (mft_OWNERDRAW, sysWord2VoidStar i, 0, hNull) 354 | MFT_SEPARATOR => (mft_SEPARATOR, null, 0, hNull) 355 | MFT_STRING s => (mft_STRING, toCstring s, size s + 1, hNull) 356 357 val mtype = Word32.orb(fromMFT menuOptions, bits) 358 val r = (sizeMenuItemStruct, allInfo, mtype, state, wID, 359 hSubMenu, hbmpChecked, hbmpUnchecked, itemData, typeData, cch, bmp) 360 in 361 setMenuItemInfo(hMenu, uItem, fByPosition, r) 362 handle ex => (free typeData; raise ex); 363 free typeData 364 end 365 366 fun InsertMenuItem(hMenu: HMENU, uItem: int, fByPosition, 367 ({menuType, menuOptions, wID, hSubMenu, hbmpChecked, hbmpUnchecked, 368 itemData, state }: MenuItemInfo)) = 369 let 370 open Memory 371 val (bits, typeData, cch, bmp) = 372 case menuType of 373 MFT_BITMAP b => (mft_BITMAP, null, 0, b) 374 | MFT_OWNERDRAW i => (mft_OWNERDRAW, sysWord2VoidStar i, 0, hNull) 375 | MFT_SEPARATOR => (mft_SEPARATOR, null, 0, hNull) 376 | MFT_STRING s => (mft_STRING, toCstring s, size s + 1, hNull) 377 378 val mtype = Word32.orb(fromMFT menuOptions, bits) 379 val r = (sizeMenuItemStruct, allInfo, mtype, state, wID, 380 hSubMenu, hbmpChecked, hbmpUnchecked, itemData, typeData, cch, bmp) 381 in 382 insertMenuItem(hMenu, uItem, fByPosition, r) 383 handle ex => (free typeData; raise ex); 384 free typeData 385 end 386 end 387 388 local 389 val getMenuState = winCall3 (user "GetMenuState") (cHMENU,cUint,cMENUFLAG) cUintw 390 in 391 (* If the menu opens a submenu the high order word is the number of 392 items. The low order word is the state. *) 393 fun GetMenuState (hm, i, mf): MenuFlag list * int = 394 let 395 val res = getMenuState(hm, i, mf) 396 in 397 checkResult(res <> ~ 0w1); 398 (toMenuFlagSet(Word32.fromLargeWord(Word.toLargeWord(LOWORD res))), Word.toInt(HIWORD res)) 399 end 400 end 401 402 val GetSubMenu = winCall2 (user "GetSubMenu") (cHMENU,cInt) cHMENU 403 404 val GetSystemMenu = winCall2 (user "GetSystemMenu") (cHWND,cBool) cHMENU 405 406 val HiliteMenuItem = 407 winCall4 (user "HiliteMenuItem") (cHWND,cHMENU,cUint,cMENUFLAGSET) (successState "HiliteMenuItem") 408 409 val IsMenu = winCall1 (user "IsMenu") (cHMENU) cBool 410 411 (* InsertMenu can insert a string item or a submenu. *) 412 datatype MenuIdOrHandle = 413 MenuId of int 414 | MenuHandle of HMENU 415 416 local 417 open Memory 418 (* Get the menu item. If this is a string we have to free the memory afterwards. *) 419 fun getDisplay (MFT_BITMAP hb) = (mft_BITMAP, voidStarOfHandle hb, null) 420 | getDisplay MFT_SEPARATOR = (mft_SEPARATOR, null, null) 421 | getDisplay (MFT_STRING (s: string)) = let val v = toCstring s in (mft_STRING, v, v) end 422 | getDisplay (MFT_OWNERDRAW i) = (mft_OWNERDRAW, sysWord2VoidStar i, null) 423 424 fun InsertOrModifyMenu (functionName: string) = 425 let 426 val docall = 427 winCall5 (user functionName) (cHMENU,cUint,cUintw,cPointer,cPointer) (successState functionName) 428 in 429 fn(hMenu: HMENU, pos: int, flags: MenuFlag list, 430 new: MenuIdOrHandle, disp: MenuItemType) => 431 let 432 (* Flags - mask out the ones we set by other means. *) 433 val f1 = Word32.andb(fromMenuFlagSet flags, Word32.notb typeBits) 434 (* The C call incorporates various options within the flags. It's better, 435 in ML, to pull these out and treat them as part of the datatype. *) 436 (* The "new" argument indicates whether the item is a sub-menu or 437 should send a message containing the id when the menu item is 438 selected. *) 439 val (f2, id) = 440 case new of 441 MenuId i => (0w0, sysWord2VoidStar (SysWord.fromInt i)) 442 | MenuHandle m => (mft_POPUP, voidStarOfHandle m) 443 (* The "disp" argument describes how the item is displayed. *) 444 val (f3, str, toFree) = getDisplay disp 445 val flags = List.foldl Word32.orb 0w0 [f1,f2,f3] 446 in 447 docall(hMenu, pos, flags, id, str) 448 handle ex => (free toFree; raise ex); 449 free toFree 450 end 451 end 452 453 val appendMenu = 454 winCall4 (user "AppendMenuA") (cHMENU,cUintw,cPointer,cPointer) (successState "AppendMenuA") 455 in 456 val InsertMenu = InsertOrModifyMenu "InsertMenuA" 457 and ModifyMenu = InsertOrModifyMenu "ModifyMenuA" 458 459 fun AppendMenu(hMenu: HMENU, flags: MenuFlag list, new: MenuIdOrHandle, disp: MenuItemType) = 460 let 461 val f1 = Word32.andb(fromMenuFlagSet flags, Word32.notb typeBits) 462 val (f2, id) = 463 case new of 464 MenuId i => (0w0, sysWord2VoidStar (SysWord.fromInt i)) 465 | MenuHandle m => (mft_POPUP, voidStarOfHandle m) 466 val (f3, str, toFree) = getDisplay disp 467 val flags = List.foldl Word32.orb 0w0 [f1,f2,f3] 468 in 469 appendMenu (hMenu, flags, id, str) 470 handle ex => (free toFree; raise ex); 471 free toFree 472 end 473 end 474 475 val RemoveMenu = winCall3(user "RemoveMenu") (cHMENU, cUint, cMENUFLAG) (successState "RemoveMenu") 476 477 datatype TrackPopupMenuOptions = 478 TPM_LEFTBUTTON | TPM_RIGHTBUTTON | TPM_LEFTALIGN | TPM_CENTERALIGN | TPM_RIGHTALIGN | 479 TPM_TOPALIGN | TPM_VCENTERALIGN | TPM_BOTTOMALIGN | (*TPM_HORIZONTAL | TPM_VERTICAL |*) 480 TPM_NONOTIFY | TPM_RETURNCMD 481 482 local 483 val tab = [ 484 (TPM_LEFTBUTTON, 0wx0000), 485 (TPM_RIGHTBUTTON, 0wx0002), 486 (TPM_LEFTALIGN, 0wx0000), 487 (TPM_CENTERALIGN, 0wx0004), 488 (TPM_RIGHTALIGN, 0wx0008), 489 (TPM_TOPALIGN, 0wx0000), 490 (TPM_VCENTERALIGN, 0wx0010), 491 (TPM_BOTTOMALIGN, 0wx0020), 492 (*(TPM_HORIZONTAL, 0wx0000), 493 (TPM_VERTICAL, 0wx0040),*) 494 (TPM_NONOTIFY, 0wx0080), 495 (TPM_RETURNCMD, 0wx0100) 496 ] 497 in 498 val TRACKPOPUPOPTIONS = tableSetConversion(tab, NONE) 499 end 500 501 local 502 val trackPopupMenu = 503 winCall7 (user "TrackPopupMenu") 504 (cHMENU, TRACKPOPUPOPTIONS, cInt, cInt, cInt, cHWND, cPointer) cInt 505 in 506 fun TrackPopupMenu(menu, flags, x, y, owner) = 507 trackPopupMenu(menu, flags, x, y, 0, owner, Memory.null) 508 end 509 510 local 511 val getMenuItemRect = 512 winCall4 (user "GetMenuItemRect") (cHWND, cHMENU, cUint, cStar cRect) (successState "GetMenuItemRect") 513 in 514 fun GetMenuItemRect(hWnd, hMenu, item): RECT = 515 let 516 val r = ref { top = 0, bottom=0, left=0, right=0} 517 val () = getMenuItemRect(hWnd, hMenu, item, r) 518 in 519 ! r 520 end 521 end 522 523 val LoadMenu = winCall2 (user "LoadMenuA") (cHINSTANCE, cRESID) cHMENU 524 val SetMenu = winCall2 (user "SetMenu") (cHWND, cHMENUOPT) (successState "SetMenu") 525 526 val SetMenuContextHelpId = 527 winCall2 (user "SetMenuContextHelpId") (cHMENU, cDWORD) 528 (successState "SetWindowContextHelpId") 529 530 val GetMenuContextHelpId = winCall1 (user "GetMenuContextHelpId") (cHMENU) cDWORD 531 532 (* *) 533 (*fun LoadMenuIndirect (mlist: (MenuFlag list * int * string) list list) = 534 let 535 val count = List.length mlist 536 val menu = *) 537(* 538TODO: 539GetMenuCheckMarkDimensions - use GetSystemMetrics 540LoadMenuIndirect 541MenuItemFromPoint 542SetMenuDefaultItem 543SetMenuItemBitmaps 544TrackPopupMenuEx 545 546Obsolete Functions 547CheckMenuItem 548GetMenuCheckMarkDimensions 549ModifyMenu 550*) 551 end 552end; 553(* 554struct 555 556 datatype MenuItemData = MID of {option: Style.flag, id:MenuItem, display:string} 557 558 (* I don't think this will work. The strings have to be Unicode. *) 559 fun LoadMenuIndirect (mlist) = 560 let val count = List.length mlist 561 562 val menu = alloc count (Cstruct [Cshort,Cshort,Cpointer Cchar]) 563 564 fun pl2a v n [] = () 565 | pl2a v n (MID {option=flag, 566 id= MenuID id, 567 display=s} :: rest) = 568 let 569 val item = make_struct [(Cshort,toCshort (repE MenuFlagE flag)), 570 (Cshort,toCshort id ), 571 (Cpointer Cchar,toCstring s) ] 572 in 573 ( assign (Cstruct [Cshort,Cshort,Cpointer Cchar]) 574 (offset n (Cstruct [Cshort,Cshort,Cpointer Cchar]) v) item ; 575 pl2a v (n+1) rest ) 576 end 577 578 val u = pl2a menu 0 mlist 579 580 in 581 winCall1 (getuser "LoadMenuIndirectA") 582 (POINTER) (cHMENU) 583 (address menu) 584 end 585end; 586*) 587