msmouse.pp 8.6 KB

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