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*) 18structure DragDrop: 19 sig 20 type HDROP 21 type HWND (* = Window.HWND *) 22 type POINT = { x: int, y: int } 23 val DragAcceptFiles : HWND * bool -> unit 24 val DragFinish : HDROP -> unit 25 val DragQueryFile : HDROP -> string list 26 val DragQueryPoint : HDROP -> POINT * bool 27 end = 28struct 29 local 30 open Foreign Base 31 in 32 type HDROP = HDROP and HWND = HWND 33 type POINT = POINT 34 35 (* Call DragAcceptFiles to accept files. *) 36 val DragAcceptFiles = winCall2 (shell "DragAcceptFiles") (cHWND,cBool) cVoid 37 38 (* Call DragFinish when finished processing a WM_DROP message. *) 39 and DragFinish = winCall1 (shell "DragFinish") (cHDROP) cVoid 40 41 (* Call DragQueryFile to get the file(s). *) 42 local 43 val dragQueryFile = winCall4 (shell "DragQueryFileA") (cHDROP,cUint,cPointer,cUint) cUint 44 in 45 fun DragQueryFile (hd: HDROP): string list = 46 let 47 val nfiles = dragQueryFile(hd, ~1, Memory.null, 0) 48 fun getFile n = 49 let 50 val buffsize = 51 dragQueryFile(hd, n, Memory.null, 0) + 1 (* Must add one for NULL *) 52 open Memory 53 val buff = malloc(Word.fromInt buffsize) 54 val _ = 55 dragQueryFile(hd, n, buff, buffsize) 56 handle ex => (free buff; raise ex) 57 in 58 fromCstring buff before free buff 59 end 60 in 61 List.tabulate(nfiles, getFile) 62 end 63 end 64 65 (* Call DragQueryPoint to find out where to drop the file(s). *) 66 local 67 val dragQueryPoint = winCall2 (shell "DragQueryPoint") (cHDROP, cStar cPoint) cBool 68 in 69 fun DragQueryPoint (hd: HDROP): POINT * bool = 70 let 71 val r = ref {x=0, y=0} 72 val res = dragQueryPoint(hd, r) 73 in 74 (!r, res) 75 end 76 end 77 end 78end; 79