mouse.pas 5.2 KB

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