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 Cursor: 20 sig 21 type HCURSOR and HINSTANCE 22 type POINT = { x : int, y: int } 23 type RECT = { left: int, top: int, right: int, bottom: int } 24 val hcursorNull : HCURSOR 25 val isHcursorNull : HCURSOR -> bool 26 27 datatype 28 CursorId = 29 OCR_APPSTARTING 30 | OCR_CROSS 31 | OCR_IBEAM 32 | OCR_NO 33 | OCR_NORMAL 34 | OCR_SIZEALL 35 | OCR_SIZENESW 36 | OCR_SIZENS 37 | OCR_SIZENWSE 38 | OCR_SIZEWE 39 | OCR_UP 40 | OCR_WAIT 41 42 val ClipCursor : RECT -> unit 43 val CopyCursor : HCURSOR -> HCURSOR 44 val DestroyCursor : HCURSOR -> unit 45 val GetClipCursor : unit -> RECT 46 val GetCursor : unit -> HCURSOR 47 val GetCursorPos : unit -> POINT 48 val LoadCursor : HINSTANCE * Resource.RESID -> HCURSOR 49 val LoadCursorFromFile : string -> HCURSOR 50 val LoadSystemCursor : CursorId -> HCURSOR 51 val LoadSystemCursorFromFile : CursorId -> HCURSOR 52 val SetCursor : HCURSOR -> HCURSOR 53 val SetCursorPos : int * int -> unit 54 val SetSystemCursor : HCURSOR * CursorId -> unit 55 val ShowCursor : bool -> int 56 end 57 = 58struct 59 local 60 open Foreign 61 open Base 62 open Resource 63 in 64 type HCURSOR = HCURSOR and HINSTANCE = HINSTANCE 65 type RECT = RECT and POINT = POINT 66 val hcursorNull = hgdiObjNull 67 and isHcursorNull = isHgdiObjNull 68 69 datatype CursorId = 70 OCR_APPSTARTING (* Standard arrow and small hourglass *) 71 | OCR_NORMAL (* Standard arrow *) 72 | OCR_CROSS (* Crosshair *) 73 | OCR_IBEAM (* I-beam *) 74 | OCR_NO (* Slashed circle *) 75 | OCR_SIZEALL (* Four-pointed arrow pointing north, south, east, and west *) 76 | OCR_SIZENESW (* Double-pointed arrow pointing northeast and southwest *) 77 | OCR_SIZENS (* Double-pointed arrow pointing north and south *) 78 | OCR_SIZENWSE (* Double-pointed arrow pointing northwest and southeast *) 79 | OCR_SIZEWE (* Double-pointed arrow pointing west and east *) 80 | OCR_UP (* Vertical arrow *) 81 | OCR_WAIT (* Hourglass *) 82 83 local 84 fun idToInt OCR_APPSTARTING = 32650 85 | idToInt OCR_NORMAL = 32512 86 | idToInt OCR_CROSS = 32515 87 | idToInt OCR_IBEAM = 32513 88 | idToInt OCR_NO = 32648 89 | idToInt OCR_SIZEALL = 32646 90 | idToInt OCR_SIZENESW = 32643 91 | idToInt OCR_SIZENS = 32645 92 | idToInt OCR_SIZENWSE = 32642 93 | idToInt OCR_SIZEWE = 32644 94 | idToInt OCR_UP = 32516 95 | idToInt OCR_WAIT = 32514 96 97 fun intToId _ = raise Fail "intToId" 98 in 99 val CURSORID = absConversion {abs=intToId, rep=idToInt} cDWORD 100 end 101 102 val SetSystemCursor = 103 winCall2 (user "SetSystemCursor") (cHCURSOR, CURSORID) (successState "SetSystemCursor") 104 105 fun checkCursor c = (checkResult(not(isHcursorNull c)); c) 106 107 val LoadCursorFromFile = 108 checkCursor o 109 winCall1 (user "LoadCursorFromFileA") (cString) cHCURSOR 110 111 (* ML extension - simpler than having a separate function. *) 112 (* I found a note suggesting that it was better to use the Unicode version 113 because not all implementations handle this properly. *) 114 val LoadSystemCursorFromFile = 115 checkCursor o 116 winCall1 (user "LoadCursorFromFileW") (CURSORID) cHCURSOR 117 118 val ClipCursor = 119 winCall1 (user "ClipCursor") (cConstStar cRect) (successState "ClipCursor") 120 121 val CopyCursor = 122 checkCursor o 123 winCall1 (user "CopyCursor") (cHCURSOR) cHCURSOR 124 125 val DestroyCursor = 126 winCall1 (user "DestroyCursor") (cHCURSOR) (successState "DestroyCursor") 127 128 local 129 val getClipCursor = 130 winCall1 (user "GetClipCursor") (cStar cRect) (successState "GetClipCursor") 131 in 132 fun GetClipCursor (): RECT = 133 let 134 val r = ref { top = 0, bottom = 0, left = 0, right = 0 } 135 in 136 getClipCursor r; 137 !r 138 end 139 end 140 141 val GetCursor = winCall0 (user "GetCursor") () cHCURSOR 142 143 local 144 val getCursorPos = 145 winCall1 (user "GetCursorPos") (cStar cPoint) (successState "GetCursorPos") 146 in 147 fun GetCursorPos (): POINT = 148 let 149 val r = ref { x = 0, y = 0 } 150 in 151 getCursorPos r; 152 !r 153 end 154 end 155 156 val SetCursor = winCall1 (user "SetCursor") cHCURSOR cHCURSOR 157 158 val SetCursorPos = 159 winCall2 (user "SetCursorPos") (cInt, cInt) (successState "SetCursorPos") 160 161 val ShowCursor = winCall1 (user "ShowCursor") cBool cInt 162 163 (* Superseded by LoadImage *) 164 val LoadCursor = 165 checkCursor o 166 winCall2 (user "LoadCursorA") (cHINSTANCE, cRESID) cHCURSOR 167 168 local 169 val loadCursor = 170 checkCursor o winCall2 (user "LoadCursorA") (cHINSTANCE, CURSORID) cHCURSOR 171 in 172 fun LoadSystemCursor(id: CursorId) = loadCursor(hinstanceNull, id) 173 end 174(* 175TODO: 176CreateCursor 177 a little complicated because it includes bit maps. 178*) 179 end 180end; 181