msmouse.pp 8.6 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360
  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,%ebx
  121. andl $0xffff,%ecx
  122. andl $0xffff,%edx
  123. movl x,%eax
  124. movl %ecx,(%eax)
  125. movl y,%eax
  126. movl %edx,(%eax)
  127. movl buttons,%eax
  128. movl %ebx,(%eax)
  129. end;
  130. end;
  131. Function LPressed:Boolean;
  132. Begin
  133. If (Not MouseFound) Then Exit;
  134. asm
  135. movl $3,%eax
  136. pushl %ebp
  137. int $0x33
  138. popl %ebp
  139. movl %ebx,%eax
  140. andl $1,%eax
  141. movb %al,__RESULT
  142. end;
  143. end;
  144. Function RPressed:Boolean;
  145. Begin
  146. If (Not MouseFound) Then Exit;
  147. asm
  148. movl $3,%eax
  149. pushl %ebp
  150. int $0x33
  151. popl %ebp
  152. movl %ebx,%eax
  153. shrl $1,%eax
  154. andl $1,%eax
  155. movb %al,__RESULT
  156. end;
  157. end;
  158. Function MPressed:Boolean;
  159. Begin
  160. If (Not MouseFound) Then Exit;
  161. asm
  162. movl $3,%eax
  163. pushl %ebp
  164. int $0x33
  165. popl %ebp
  166. movl %ebx,%eax
  167. shrl $2,%eax
  168. andl $1,%eax
  169. movb %al,__RESULT
  170. end;
  171. end;
  172. Procedure SetMousePos(x,y:Longint);
  173. Begin
  174. If (Not MouseFound) Then Exit;
  175. asm
  176. movl $4,%eax
  177. movl x,%ecx
  178. movl y,%edx
  179. pushl %ebp
  180. int $0x33
  181. popl %ebp
  182. End;
  183. End;
  184. Function GetLastButtonPress(Button: Longint;var x,y:Longint):Longint;
  185. Begin
  186. If (Not MouseFound) Then Exit;
  187. asm
  188. movl $5,%eax
  189. movl button,%ebx
  190. shrl $1, %ebx {0 = left, 1 = right, 2 = middle}
  191. pushl %ebp
  192. int $0x33
  193. popl %ebp
  194. andl $0xffff,%ebx
  195. andl $0xffff,%edx
  196. andl $0xffff,%ecx
  197. movl %ebx, __RESULT
  198. movl x,%eax
  199. movl %ecx,(%eax)
  200. movl y,%eax
  201. movl %edx,(%eax)
  202. end;
  203. end;
  204. Function GetLastButtonRelease (button : Longint; var x,y:Longint): Longint;
  205. begin
  206. If (Not MouseFound) Then Exit;
  207. asm
  208. movl $6,%eax
  209. movl button,%ebx
  210. shrl $1, %ebx {0 = left, 1 = right, 2 = middle}
  211. pushl %ebp
  212. int $0x33
  213. popl %ebp
  214. andl $0xffff,%ebx
  215. andl $0xffff,%ecx
  216. andl $0xffff,%edx
  217. movl %ebx,__RESULT
  218. movl x,%eax
  219. movl %ecx,(%eax)
  220. movl y,%eax
  221. movl %edx,(%eax)
  222. end;
  223. end;
  224. Procedure SetMouseXRange (Min,Max:Longint);
  225. begin
  226. If (Not MouseFound) Then Exit;
  227. asm
  228. movl $7,%eax
  229. movl min,%ecx
  230. movl max,%edx
  231. pushl %ebp
  232. int $0x33
  233. popl %ebp
  234. end;
  235. end;
  236. Procedure SetMouseYRange (min,max:Longint);
  237. begin
  238. If (Not MouseFound) Then Exit;
  239. asm
  240. movl $8,%eax
  241. movl min,%ecx
  242. movl max,%edx
  243. pushl %ebp
  244. int $0x33
  245. popl %ebp
  246. end;
  247. end;
  248. Procedure SetMouseWindow(x1,y1,x2,y2:Longint);
  249. Begin
  250. If (Not MouseFound) Then Exit;
  251. SetMouseXRange(x1,x2);
  252. SetMouseYRange(y1,y2);
  253. End;
  254. Procedure SetMouseShape(ForeColor,BackColor,Ascii:Byte);
  255. Begin
  256. If (Not MouseFound) Then Exit;
  257. asm
  258. xorl %ebx,%ebx
  259. movl $0xa,%eax
  260. movl $0xffff,%ecx
  261. xorl %edx,%edx
  262. movb BackColor,%dh
  263. shlb $4,%dh
  264. addb ForeColor,%dh
  265. movb Ascii,%dl
  266. pushl %ebp
  267. int $0x33
  268. popl %ebp
  269. End;
  270. End;
  271. Procedure SetMouseAscii(Ascii:byte);
  272. Begin
  273. If (Not MouseFound) Then Exit;
  274. asm
  275. xorl %ebx,%ebx
  276. movl $0xa,%eax
  277. movl $0xff00,%ecx
  278. xorl %edx,%edx
  279. movb Ascii,%dl
  280. pushl %ebp
  281. int $0x33
  282. popl %ebp
  283. End;
  284. End;
  285. Procedure SetMouseHideWindow(x1,y1,x2,y2:Longint);
  286. Begin
  287. If (Not MouseFound) Then Exit;
  288. asm
  289. movl $0x0010,%eax
  290. movl x1,%ecx
  291. movl y1,%edx
  292. movl x2,%esi
  293. movl y2,%edi
  294. pushl %ebp
  295. int $0x33
  296. popl %ebp
  297. end;
  298. End;
  299. Procedure SetMouseSpeed(Horizontal,Vertical:Longint);
  300. Begin
  301. If (Not MouseFound) Then Exit;
  302. asm
  303. movl $0x0f,%eax
  304. movl Horizontal,%ecx
  305. movl Vertical,%edx
  306. pushl %ebp
  307. int $0x33
  308. popl %ebp
  309. end;
  310. End;
  311. Begin
  312. MouseFound := InitMouse;
  313. End.