mouse.pas 5.4 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198
  1. {
  2. $Id$
  3. Mouse unit, part of the portable API for Pascal
  4. Copyright (c) 1997 Balazs Scheidler ([email protected])
  5. This library is free software; you can redistribute it and/or
  6. modify it under the terms of the GNU Library General Public
  7. License as published by the Free Software Foundation; either
  8. version 2 of the License, or (at your option) any later version.
  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. Library General Public License for more details.
  13. You should have received a copy of the GNU Library General Public
  14. License along with this library; if not, write to the Free
  15. Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  16. ****************************************************************************}
  17. unit Mouse;
  18. interface
  19. {$ifdef TP}
  20. {$G+}
  21. {$endif}
  22. {$i platform.inc}
  23. uses
  24. ApiComm;
  25. const
  26. { We have an errorcode base of 1010 }
  27. errMouseInitError = errMouseBase + 0;
  28. errMouseNotImplemented = errMouseBase + 1;
  29. type
  30. PMouseEvent=^TMouseEvent;
  31. TMouseEvent=packed record { 8 bytes }
  32. buttons : word;
  33. x,y : word;
  34. Action : word;
  35. end;
  36. const
  37. MouseActionDown = $0001; { Mouse down event }
  38. MouseActionUp = $0002; { Mouse up event }
  39. MouseActionMove = $0004; { Mouse move event }
  40. MouseLeftButton = $01; { Left mouse button }
  41. MouseRightButton = $02; { Right mouse button }
  42. MouseMiddleButton = $04; { Middle mouse button }
  43. {$ifdef OS_WINDOWS}
  44. MouseEventBufSize = 255;
  45. {$else OS_WINDOWS}
  46. MouseEventBufSize = 16;
  47. {$endif OS_WINDOWS}
  48. var
  49. PendingMouseEvent : array[0..MouseEventBufSize-1] of TMouseEvent;
  50. PendingMouseHead,
  51. PendingMouseTail : PMouseEvent;
  52. PendingMouseEvents : byte;
  53. LastMouseEvent : TMouseEvent;
  54. MouseIntFlag : Byte; { Mouse in int flag }
  55. MouseButtons : Byte; { Mouse button state }
  56. MouseWhereX,
  57. MouseWhereY : Word; { Mouse position }
  58. procedure InitMouse;
  59. { Initialize the mouse interface }
  60. procedure DoneMouse;
  61. { Deinitialize the mouse interface }
  62. function DetectMouse:byte;
  63. { Detect if a mouse is present, returns the amount of buttons or 0
  64. if no mouse is found }
  65. procedure ShowMouse;
  66. { Show the mouse cursor }
  67. procedure HideMouse;
  68. { Hide the mouse cursor }
  69. function GetMouseX:word;
  70. { Return the current X position of the mouse }
  71. function GetMouseY:word;
  72. { Return the current Y position of the mouse }
  73. function GetMouseButtons:word;
  74. { Return the current button state of the mouse }
  75. procedure SetMouseXY(x,y:word);
  76. { Place the mouse cursor on x,y }
  77. procedure GetMouseEvent(var MouseEvent:TMouseEvent);
  78. { Returns the last Mouseevent, and waits for one if not available }
  79. procedure PutMouseEvent(const MouseEvent: TMouseEvent);
  80. { Adds the given MouseEvent to the input queue. Please note that depending on
  81. the implementation this can hold only one value (NO FIFOs etc) }
  82. function PollMouseEvent(var MouseEvent: TMouseEvent):boolean;
  83. { Checks if a Mouseevent is available, and returns it if one is found. If no
  84. event is pending, it returns 0 }
  85. {$ifdef go32v2}
  86. { tells the mouse unit to draw the mouse cursor itself }
  87. procedure DoCustomMouse(b : boolean);
  88. {$endif go32v2}
  89. implementation
  90. { Include platform dependent routines }
  91. {$i mouse.inc}
  92. { Platform independent routines }
  93. {$IFNDEF OS2}
  94. procedure PutMouseEvent(const MouseEvent: TMouseEvent);
  95. begin
  96. if PendingMouseEvents<MouseEventBufSize then
  97. begin
  98. PendingMouseTail^:=MouseEvent;
  99. inc(PendingMouseTail);
  100. if longint(PendingMouseTail)=longint(@PendingMouseEvent)+sizeof(PendingMouseEvent) then
  101. PendingMouseTail:=@PendingMouseEvent;
  102. { why isn't this done here ?
  103. so the win32 version do this by hand:
  104. inc(PendingMouseEvents); }
  105. end
  106. else
  107. end;
  108. {$ENDIF}
  109. end.
  110. {
  111. $Log$
  112. Revision 1.1 2000-07-13 06:29:38 michael
  113. + Initial import
  114. Revision 1.5 2000/03/12 15:05:14 peter
  115. * $G+ is only needed for tp
  116. Revision 1.4 2000/02/29 11:43:16 pierre
  117. Common renamed APIComm to avoid problems with free vision
  118. Revision 1.3 2000/02/07 22:54:44 florian
  119. * custommouse define removed, i.e. code is always active
  120. * the xor value for the mouse cursor must be $7f instead of $ff
  121. Revision 1.2 2000/02/06 14:28:19 florian
  122. * mouse support for vesa resolutions under go32v2, needs currently the define
  123. custommouse
  124. Revision 1.1 2000/01/06 01:20:31 peter
  125. * moved out of packages/ back to topdir
  126. Revision 1.2 1999/12/31 17:25:24 marco
  127. Added $G+, TP version required it.
  128. Revision 1.1 1999/12/23 19:36:47 peter
  129. * place unitfiles in target dirs
  130. Revision 1.1 1999/11/24 23:36:37 peter
  131. * moved to packages dir
  132. Revision 1.5 1999/07/29 11:38:56 peter
  133. * fixed comment for tp7
  134. Revision 1.4 1999/07/17 22:37:07 florian
  135. * implemented mouse handling
  136. Revision 1.3 1999/04/23 17:54:58 hajny
  137. PutMouseEvent modified for support of two queues in OS/2
  138. Revision 1.2 1998/12/11 00:13:17 peter
  139. + SetMouseXY
  140. * use far for exitproc procedure
  141. Revision 1.1 1998/12/04 12:48:24 peter
  142. * moved some dirs
  143. Revision 1.1 1998/10/28 00:02:07 peter
  144. + mouse
  145. + video.clearscreen, video.videobufsize
  146. }