msmouse.pp 8.5 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365
  1. {
  2. This file is part of the Free Pascal run time library.
  3. Copyright (c) 1999-2000 by the Free Pascal development team
  4. Mouse unit for microsoft mouse compatible drivers
  5. See the file COPYING.FPC, included in this distribution,
  6. for details about the copyright.
  7. This program is distributed in the hope that it will be useful,
  8. but WITHOUT ANY WARRANTY; without even the implied warranty of
  9. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
  10. **********************************************************************
  11. }
  12. Unit MSMouse;
  13. Interface
  14. {
  15. Mouse support functions and procedures, with error checking: if mouse
  16. isn't present then the routine ends. If you want to remove error checking,
  17. remove the next define.
  18. }
  19. {initializes the mouse with the default values for the current screen mode}
  20. Function InitMouse:Boolean;
  21. {shows mouse pointer,text+graphics screen support}
  22. Procedure ShowMouse;
  23. {hides mouse pointer}
  24. Procedure HideMouse;
  25. {reads mouse position in pixels (divide by 8 to get text position in standard
  26. text mode) and reads the buttons state:
  27. bit 1 set -> left button pressed
  28. bit 2 set -> right button pressed
  29. bit 3 set -> middle button pressed
  30. Have a look at the example program in the manual to see how you can use this}
  31. Procedure GetMouseState(var x,y, buttons :LongInt);
  32. {returns true if the left button is pressed}
  33. Function LPressed:Boolean;
  34. {returns true if the right button is pressed}
  35. Function RPressed:Boolean;
  36. {returns true if the middle button is pressed}
  37. Function MPressed:Boolean;
  38. {positions the mouse pointer}
  39. Procedure SetMousePos(x,y:LongInt);
  40. {returns at which position "button" was last pressed in x,y and returns the
  41. number of times this button has been pressed since the last time this
  42. function was called with "button" as parameter. For button you can use the
  43. LButton, RButton and MButton constants for resp. the left, right and middle
  44. button}
  45. Function GetLastButtonPress(button:LongInt;var x,y:LongInt): LongInt;
  46. {returns at which position "button" was last released in x,y and returns the
  47. number of times this button has been re since the last time. For button
  48. you can use the LButton, RButton and MButton constants for resp. the left,
  49. right and middle button}
  50. Function GetLastButtonRelease (button : LongInt; var x,y:LongInt): LongInt;
  51. {sets mouse's x range, with Min and Max resp. the higest and the lowest
  52. column (in pixels) in between which the mouse cursor can move}
  53. Procedure SetMouseXRange (Min,Max:LongInt);
  54. {sets mouse's y range, with Min and Max resp. the higest and the lowest
  55. row (in pixels) in between which the mouse cursor can move}
  56. Procedure SetMouseYRange (Min,Max:LongInt);
  57. {set the window coordinates in which the mouse cursor can move}
  58. Procedure SetMouseWindow(x1,y1,x2,y2:LongInt);
  59. {sets the mouse shape in text mode: background and foreground color and the
  60. Ascii value with which the character on screen is XOR'ed when the cursor
  61. moves over it. Set to 0 for a "transparent" cursor}
  62. Procedure SetMouseShape(ForeColor,BackColor,Ascii:Byte);
  63. {sets the mouse ascii in text mode. The difference between this one and
  64. SetMouseShape, is that the foreground and background colors stay the same
  65. and that the Ascii code you enter is the character that you will get on
  66. screen; there's no XOR'ing}
  67. Procedure SetMouseAscii(Ascii:Byte);
  68. {set mouse speed in mickey's/pixel; default: horizontal: 8; vertical: 16}
  69. Procedure SetMouseSpeed(Horizontal ,Vertical:LongInt);
  70. {set a rectangle on screen that mouse will disappear if it is moved into}
  71. Procedure SetMouseHideWindow(x1,y1,x2,y2:LongInt);
  72. Const LButton = 1; {left button}
  73. RButton = 2; {right button}
  74. MButton = 4; {middle button}
  75. Var
  76. MouseFound: Boolean;
  77. Implementation
  78. {$asmmode INTEL}
  79. Function InitMouse: Boolean;
  80. begin
  81. if MemL[0:$33*4] = 0 then
  82. exit(False);
  83. asm
  84. xor ax,ax
  85. push bp
  86. int $33
  87. pop bp
  88. cmp ax, $FFFF
  89. mov al, 0
  90. jne @@1
  91. inc al
  92. @@1:
  93. mov @Result, al
  94. end;
  95. end;
  96. Procedure ShowMouse;
  97. begin
  98. If (Not MouseFound) Then Exit;
  99. asm
  100. mov ax, 1
  101. push bp
  102. int $33
  103. pop bp
  104. end;
  105. end;
  106. Procedure HideMouse;
  107. begin
  108. If (Not MouseFound) Then Exit;
  109. asm
  110. mov ax, 2
  111. push bp
  112. int $33
  113. pop bp
  114. end;
  115. end;
  116. Procedure GetMouseState(var x,y,buttons:LongInt);
  117. begin
  118. If (Not MouseFound) Then Exit;
  119. asm
  120. mov ax, 3
  121. push bp
  122. int $33
  123. pop bp
  124. mov di, x
  125. mov [di], cx
  126. mov word [di + 2], 0
  127. mov di, y
  128. mov [di], dx
  129. mov word [di + 2], 0
  130. mov di, buttons
  131. mov [di], bx
  132. mov word [di + 2], 0
  133. end;
  134. end;
  135. Function LPressed:Boolean;
  136. Begin
  137. If (Not MouseFound) Then Exit;
  138. asm
  139. mov ax, 3
  140. push bp
  141. int $33
  142. pop bp
  143. mov ax,bx
  144. and ax, 1
  145. mov @Result, al
  146. end;
  147. end;
  148. Function RPressed:Boolean;
  149. Begin
  150. If (Not MouseFound) Then Exit;
  151. asm
  152. mov ax, 3
  153. push bp
  154. int $33
  155. pop bp
  156. mov ax,bx
  157. shr ax,1
  158. and ax,1
  159. mov @Result, al
  160. end;
  161. end;
  162. Function MPressed:Boolean;
  163. Begin
  164. If (Not MouseFound) Then Exit;
  165. asm
  166. mov ax, 3
  167. push bp
  168. int $33
  169. pop bp
  170. mov ax, bx
  171. shr ax, 1
  172. shr ax, 1
  173. and ax, 1
  174. mov @Result, al
  175. end;
  176. end;
  177. Procedure SetMousePos(x,y:LongInt);
  178. Begin
  179. If (Not MouseFound) Then Exit;
  180. asm
  181. mov ax, 4
  182. mov cx, x
  183. mov dx, y
  184. push bp
  185. int $33
  186. pop bp
  187. End;
  188. End;
  189. Function GetLastButtonPress(Button: LongInt;var x,y:LongInt):LongInt;
  190. Begin
  191. If (Not MouseFound) Then Exit;
  192. GetLastButtonPress := 0;
  193. asm
  194. mov ax, 5
  195. mov bx, button
  196. shr bx, 1 {0 = left, 1 = right, 2 = middle}
  197. push bp
  198. int $33
  199. pop bp
  200. mov @Result, bx
  201. mov di, x
  202. mov [di], cx
  203. mov word [di + 2], 0
  204. mov di, y
  205. mov [di], dx
  206. mov word [di + 2], 0
  207. end;
  208. end;
  209. Function GetLastButtonRelease (button : LongInt; var x,y:LongInt): LongInt;
  210. begin
  211. If (Not MouseFound) Then Exit;
  212. GetLastButtonRelease := 0;
  213. asm
  214. mov ax, 6
  215. mov bx, button
  216. shr bx, 1 {0 = left, 1 = right, 2 = middle}
  217. push bp
  218. int $33
  219. pop bp
  220. mov @Result, bx
  221. mov di, x
  222. mov [di], cx
  223. mov word [di + 2], 0
  224. mov di, y
  225. mov [di], dx
  226. mov word [di + 2], 0
  227. end;
  228. end;
  229. Procedure SetMouseXRange (Min,Max:LongInt);
  230. begin
  231. If (Not MouseFound) Then Exit;
  232. asm
  233. mov ax, 7
  234. mov cx, min
  235. mov dx, max
  236. push bp
  237. int $33
  238. pop bp
  239. end;
  240. end;
  241. Procedure SetMouseYRange (min,max:LongInt);
  242. begin
  243. If (Not MouseFound) Then Exit;
  244. asm
  245. mov ax, 8
  246. mov cx, min
  247. mov dx, max
  248. push bp
  249. int $33
  250. pop bp
  251. end;
  252. end;
  253. Procedure SetMouseWindow(x1,y1,x2,y2:LongInt);
  254. Begin
  255. If (Not MouseFound) Then Exit;
  256. SetMouseXRange(x1,x2);
  257. SetMouseYRange(y1,y2);
  258. End;
  259. Procedure SetMouseShape(ForeColor,BackColor,Ascii:Byte);
  260. Begin
  261. If (Not MouseFound) Then Exit;
  262. asm
  263. xor bx, bx
  264. mov ax, 10
  265. xor dx, dx
  266. mov dh, BackColor
  267. mov cl, 4
  268. shl dh, cl
  269. add dh, ForeColor
  270. mov dl, Ascii
  271. mov cx, $ffff
  272. push bp
  273. int $33
  274. pop bp
  275. End;
  276. End;
  277. Procedure SetMouseAscii(Ascii:byte);
  278. Begin
  279. If (Not MouseFound) Then Exit;
  280. asm
  281. xor bx, bx
  282. mov ax, 10
  283. mov cx, $ff00
  284. xor dx,dx
  285. mov dl, Ascii
  286. push bp
  287. int $33
  288. pop bp
  289. End;
  290. End;
  291. Procedure SetMouseHideWindow(x1,y1,x2,y2:LongInt);
  292. Begin
  293. If (Not MouseFound) Then Exit;
  294. asm
  295. mov ax, $0010
  296. mov cx, x1
  297. mov dx, y1
  298. mov si, x2
  299. mov di, y2
  300. push bp
  301. int $33
  302. pop bp
  303. end;
  304. End;
  305. Procedure SetMouseSpeed(Horizontal,Vertical:LongInt);
  306. Begin
  307. If (Not MouseFound) Then Exit;
  308. asm
  309. mov ax, $0f
  310. mov cx, Horizontal
  311. mov dx, Vertical
  312. push bp
  313. int $33
  314. pop bp
  315. end;
  316. End;
  317. Begin
  318. MouseFound := InitMouse;
  319. End.