sysmsg.pas 3.0 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140
  1. {
  2. Unit to handle system events
  3. Copyright 2000 by Pierre Muller <[email protected]>
  4. See the file COPYING.FPC, included in this distribution,
  5. for details about the copyright.
  6. This library is distributed in the hope that it will be useful,
  7. but WITHOUT ANY WARRANTY; without even the implied warranty of
  8. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
  9. Library General Public License for more details.
  10. You should have received a copy of the GNU Library General Public
  11. License along with this library; if not, write to the Free
  12. Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston,
  13. MA 02110-1301, USA.
  14. ****************************************************************************}
  15. Unit sysmsg;
  16. interface
  17. {$i platform.inc}
  18. type
  19. TSystemMessage = (
  20. SysNothing,
  21. SysSetFocus,
  22. SysReleaseFocus,
  23. SysClose,
  24. SysResize );
  25. TSystemEvent = Record
  26. case typ : TSystemMessage of
  27. SysClose : ( CloseTyp : Longint);
  28. SysResize : (X,Y : Longint);
  29. end;
  30. PSystemEvent = ^TSystemEvent;
  31. const
  32. SystemEventBufSize = 16;
  33. var
  34. PendingSystemEvent : array[0..SystemEventBufSize-1] of TSystemEvent;
  35. PendingSystemHead,
  36. PendingSystemTail : PSystemEvent;
  37. PendingSystemEvents : byte;
  38. LastSystemEvent : TSystemEvent;
  39. procedure InitSystemMsg;
  40. procedure DoneSystemMsg;
  41. procedure GetSystemEvent(var SystemEvent:TSystemEvent);
  42. { Returns the last SystemEvent, and waits for one if not available }
  43. procedure PutSystemEvent(const SystemEvent: TSystemEvent);
  44. { Adds the given SystemEvent to the input queue. }
  45. function PollSystemEvent(var SystemEvent: TSystemEvent):boolean;
  46. { Checks if a SystemEvent is available, and returns it if one is found. If no
  47. event is pending, it returns 0 }
  48. implementation
  49. {$undef HAS_SYSMSG}
  50. {$ifdef go32v2}
  51. {$i go32smsg.inc}
  52. {$define HAS_SYSMSG}
  53. {$endif go32v2}
  54. {$ifdef OS_WINDOWS}
  55. {$i w32smsg.inc}
  56. {$define HAS_SYSMSG}
  57. {$endif OS_WINDOWS}
  58. {$ifdef unix}
  59. {$i unixsmsg.inc}
  60. {$define HAS_SYSMSG}
  61. {$endif unix}
  62. {$ifdef amiga}
  63. {$i amismsg.inc}
  64. {$define HAS_SYSMSG}
  65. {$endif amiga}
  66. {$ifdef morphos}
  67. {$i amismsg.inc}
  68. {$define HAS_SYSMSG}
  69. {$endif morphos}
  70. {$ifdef aros}
  71. {$i amismsg.inc}
  72. {$define HAS_SYSMSG}
  73. {$endif aros}
  74. {$ifdef HAS_SYSMSG}
  75. procedure PutSystemEvent(const SystemEvent: TSystemEvent);
  76. begin
  77. if PendingSystemEvents<SystemEventBufSize then
  78. begin
  79. PendingSystemTail^:=SystemEvent;
  80. inc(PendingSystemTail);
  81. if longint(PendingSystemTail)=longint(@PendingSystemEvent)+sizeof(PendingSystemEvent) then
  82. PendingSystemTail:=@PendingSystemEvent;
  83. inc(PendingSystemEvents);
  84. end;
  85. end;
  86. {$else HAS_SYSMSG}
  87. procedure InitSystemMsg;
  88. begin
  89. end;
  90. procedure DoneSystemMsg;
  91. begin
  92. end;
  93. procedure GetSystemEvent(var SystemEvent:TSystemEvent);
  94. begin
  95. FillChar(SystemEvent,SizeOf(SystemEvent),#0);
  96. end;
  97. function PollSystemEvent(var SystemEvent: TSystemEvent):boolean;
  98. begin
  99. FillChar(SystemEvent,SizeOf(SystemEvent),#0);
  100. PollSystemEvent:=false;
  101. end;
  102. procedure PutSystemEvent(const SystemEvent: TSystemEvent);
  103. begin
  104. end;
  105. {$endif not HAS_SYSMSG}
  106. end.