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