← Back to branch summary

~ubuntu-branches/debian/lenny/fpc/lenny

« back to all changes in this revision

Viewing changes to rtl/win32/winevent.pp

  • Committer: Bazaar Package Importer
  • Author(s): Mazen Neifer, Torsten Werner, Mazen Neifer
  • Date: 2008-05-17 17:12:11 UTC
  • mfrom: (3.1.9 intrepid)
  • Revision ID: james.westby@ubuntu.com-20080517171211-9qi33xhd9evfa0kg
Tags: 2.2.0-dfsg1-9
http://bugs.debian.org/477743
[ Torsten Werner ]
* Add Mazen Neifer to Uploaders field.

[ Mazen Neifer ]
* Moved FPC sources into a version dependent directory from /usr/share/fpcsrc
  to /usr/share/fpcsrc/${FPCVERSION}. This allow installing more than on FPC
  release.
* Fixed far call issue in compiler preventing building huge binearies.
  (closes: #477743)
* Updated building dependencies, recomennded and suggested packages.
* Moved fppkg to fp-utils as it is just a helper tool and is not required by
  compiler.

Show diffs side-by-side

added added

removed removed

Lines of Context:
rtl/win32/winevent.pp
1
 
{
2
 
    $Id: winevent.pp,v 1.3 2002/09/07 16:01:29 peter Exp $
3
 
    This file is part of the Free Pascal run time library.
4
 
    Copyright (c) 1999-2000 by Florian Klaempfl
5
 
    member of the Free Pascal development team
6
 
 
7
 
    Event Handling unit for setting Keyboard and Mouse Handlers
8
 
 
9
 
    See the file COPYING.FPC, included in this distribution,
10
 
    for details about the copyright.
11
 
 
12
 
    This program is distributed in the hope that it will be useful,
13
 
    but WITHOUT ANY WARRANTY; without even the implied warranty of
14
 
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
15
 
 
16
 
 **********************************************************************}
17
 
unit WinEvent;
18
 
interface
19
 
 
20
 
{
21
 
   We need this unit to implement keyboard and mouse,
22
 
   because win32 uses only one message queue for mouse and key events
23
 
}
24
 
 
25
 
    uses
26
 
       Windows;
27
 
 
28
 
    type
29
 
       TEventProcedure = Procedure(var ir:INPUT_RECORD);
30
 
 
31
 
    { these procedures must be used to set the event handlers }
32
 
    { these doesn't do something, they signal only the        }
33
 
    { the upper layer that an event occured, this event       }
34
 
    { must be handled with Win32-API function by the upper    }
35
 
    { layer                                                   }
36
 
    Procedure SetMouseEventHandler(p : TEventProcedure);
37
 
    Procedure SetKeyboardEventHandler(p : TEventProcedure);
38
 
    Procedure SetFocusEventHandler(p : TEventProcedure);
39
 
    Procedure SetMenuEventHandler(p : TEventProcedure);
40
 
    Procedure SetResizeEventHandler(p : TEventProcedure);
41
 
    Procedure SetUnknownEventHandler(p : TEventProcedure);
42
 
 
43
 
    { these procedures must be used to get the event handlers }
44
 
    Function GetMouseEventHandler : TEventProcedure;
45
 
    Function GetKeyboardEventHandler : TEventProcedure;
46
 
    Function GetFocusEventHandler : TEventProcedure;
47
 
    Function GetMenuEventHandler : TEventProcedure;
48
 
    Function GetResizeEventHandler : TEventProcedure;
49
 
    Function GetUnknownEventHandler : TEventProcedure;
50
 
 
51
 
  implementation
52
 
 
53
 
    const
54
 
       { these procedures are called if an event occurs }
55
 
       MouseEventHandler : TEventProcedure = nil;
56
 
       KeyboardEventHandler : TEventProcedure = nil;
57
 
       FocusEventHandler : TEventProcedure = nil;
58
 
       MenuEventHandler : TEventProcedure = nil;
59
 
       ResizeEventHandler : TEventProcedure = nil;
60
 
       UnknownEventHandler  : TEventProcedure = nil;
61
 
 
62
 
       { if this counter is zero, the event handler thread is killed }
63
 
       InstalledHandlers : Byte = 0;
64
 
 
65
 
    var
66
 
       HandlerChanging : TCriticalSection;
67
 
       EventThreadHandle : Handle;
68
 
       EventThreadID : DWord;
69
 
 
70
 
       { true, if the event handler should be stoped }
71
 
       ExitEventHandleThread : boolean;
72
 
 
73
 
    Function GetMouseEventHandler : TEventProcedure;
74
 
      begin
75
 
         GetMouseEventHandler:=MouseEventHandler;
76
 
      end;
77
 
 
78
 
 
79
 
    Function GetKeyboardEventHandler : TEventProcedure;
80
 
      begin
81
 
         GetKeyboardEventHandler:=KeyboardEventHandler;
82
 
      end;
83
 
 
84
 
 
85
 
    Function GetFocusEventHandler : TEventProcedure;
86
 
      begin
87
 
         GetFocusEventHandler:=FocusEventHandler;
88
 
      end;
89
 
 
90
 
 
91
 
    Function GetMenuEventHandler : TEventProcedure;
92
 
      begin
93
 
         GetMenuEventHandler:=MenuEventHandler;
94
 
      end;
95
 
 
96
 
 
97
 
    Function GetResizeEventHandler : TEventProcedure;
98
 
      begin
99
 
         GetResizeEventHandler:=ResizeEventHandler;
100
 
      end;
101
 
 
102
 
 
103
 
    Function GetUnknownEventHandler : TEventProcedure;
104
 
      begin
105
 
         GetUnknownEventHandler:=UnknownEventHandler;
106
 
      end;
107
 
 
108
 
 
109
 
    Function EventHandleThread(p : pointer) : DWord;StdCall;
110
 
      const
111
 
        irsize = 10;
112
 
      var
113
 
         ir : array[0..irsize-1] of TInputRecord;
114
 
         i,dwRead : DWord;
115
 
      begin
116
 
         while not(ExitEventHandleThread) do
117
 
           begin
118
 
              { wait for an event }
119
 
              WaitForSingleObject(StdInputHandle,INFINITE);
120
 
              { guard this code, else it is doomed to crash, if the
121
 
                thread is switched between the assigned test and
122
 
                the call and the handler is removed
123
 
              }
124
 
              if not(ExitEventHandleThread) then
125
 
                begin
126
 
                   EnterCriticalSection(HandlerChanging);
127
 
                   { read, but don't remove the event }
128
 
                   if ReadConsoleInput(StdInputHandle,ir[0],irsize,dwRead) then
129
 
                    begin
130
 
                      i:=0;
131
 
                      while (i<dwRead) do
132
 
                       begin
133
 
                       { call the handler }
134
 
                       case ir[i].EventType of
135
 
                        KEY_EVENT:
136
 
                          begin
137
 
                             if assigned(KeyboardEventHandler) then
138
 
                               KeyboardEventHandler(ir[i]);
139
 
                          end;
140
 
 
141
 
                        _MOUSE_EVENT:
142
 
                          begin
143
 
                             if assigned(MouseEventHandler) then
144
 
                               MouseEventHandler(ir[i]);
145
 
                          end;
146
 
 
147
 
                        WINDOW_BUFFER_SIZE_EVENT:
148
 
                          begin
149
 
                             if assigned(ResizeEventHandler) then
150
 
                               ResizeEventHandler(ir[i]);
151
 
                          end;
152
 
 
153
 
                        MENU_EVENT:
154
 
                          begin
155
 
                             if assigned(MenuEventHandler) then
156
 
                               MenuEventHandler(ir[i]);
157
 
                          end;
158
 
 
159
 
                        FOCUS_EVENT:
160
 
                          begin
161
 
                             if assigned(FocusEventHandler) then
162
 
                               FocusEventHandler(ir[i]);
163
 
                          end;
164
 
 
165
 
                        else
166
 
                          begin
167
 
                             if assigned(UnknownEventHandler) then
168
 
                               UnknownEventHandler(ir[i]);
169
 
                          end;
170
 
                       end;
171
 
                       inc(i);
172
 
                      end;
173
 
                    end;
174
 
                   LeaveCriticalSection(HandlerChanging);
175
 
                end;
176
 
           end;
177
 
        EventHandleThread:=0;
178
 
      end;
179
 
 
180
 
    Procedure NewEventHandlerInstalled(p,oldp : TEventProcedure);
181
 
      var
182
 
         oldcount : Byte;
183
 
         ir : TInputRecord;
184
 
         written : DWord;
185
 
      begin
186
 
         oldcount:=InstalledHandlers;
187
 
         if Pointer(oldp)<>nil then
188
 
           dec(InstalledHandlers);
189
 
         if Pointer(p)<>nil then
190
 
           inc(InstalledHandlers);
191
 
         { start event handler thread }
192
 
         if (oldcount=0) and (InstalledHandlers=1) then
193
 
           begin
194
 
              ExitEventHandleThread:=false;
195
 
              EventThreadHandle:=CreateThread(nil,0,@EventHandleThread,
196
 
                nil,0,EventThreadID);
197
 
           end
198
 
         { stop and destroy event handler thread }
199
 
         else if (oldcount=1) and (InstalledHandlers=0) then
200
 
           begin
201
 
              ExitEventHandleThread:=true;
202
 
              { create a dummy event and sent it to the thread, so
203
 
                we can leave WaitForSingleObject }
204
 
              ir.EventType:=KEY_EVENT;
205
 
              { mouse event can be disabled by mouse.inc code
206
 
                in DoneMouse
207
 
                so use a key event instead PM }
208
 
              WriteConsoleInput(StdInputHandle,ir,1,written);
209
 
              { wait, til the thread is ready }
210
 
              WaitForSingleObject(EventThreadHandle,INFINITE);
211
 
              CloseHandle(EventThreadHandle);
212
 
           end;
213
 
      end;
214
 
 
215
 
 
216
 
    Procedure SetMouseEventHandler(p : TEventProcedure);
217
 
      var
218
 
         oldp : TEventProcedure;
219
 
      begin
220
 
         EnterCriticalSection(HandlerChanging);
221
 
         oldp:=MouseEventHandler;
222
 
         MouseEventHandler:=p;
223
 
         NewEventHandlerInstalled(MouseEventHandler,oldp);
224
 
         LeaveCriticalSection(HandlerChanging);
225
 
      end;
226
 
 
227
 
 
228
 
    Procedure SetKeyboardEventHandler(p : TEventProcedure);
229
 
      var
230
 
         oldp : TEventProcedure;
231
 
      begin
232
 
         EnterCriticalSection(HandlerChanging);
233
 
         oldp:=KeyboardEventHandler;
234
 
         KeyboardEventHandler:=p;
235
 
         NewEventHandlerInstalled(KeyboardEventHandler,oldp);
236
 
         LeaveCriticalSection(HandlerChanging);
237
 
      end;
238
 
 
239
 
 
240
 
    Procedure SetFocusEventHandler(p : TEventProcedure);
241
 
      var
242
 
         oldp : TEventProcedure;
243
 
      begin
244
 
         EnterCriticalSection(HandlerChanging);
245
 
         oldp:=FocusEventHandler;
246
 
         FocusEventHandler:=p;
247
 
         NewEventHandlerInstalled(FocusEventHandler,oldp);
248
 
         LeaveCriticalSection(HandlerChanging);
249
 
      end;
250
 
 
251
 
 
252
 
    Procedure SetMenuEventHandler(p : TEventProcedure);
253
 
      var
254
 
         oldp : TEventProcedure;
255
 
      begin
256
 
         EnterCriticalSection(HandlerChanging);
257
 
         oldp:=MenuEventHandler;
258
 
         MenuEventHandler:=p;
259
 
         NewEventHandlerInstalled(MenuEventHandler,oldp);
260
 
         LeaveCriticalSection(HandlerChanging);
261
 
      end;
262
 
 
263
 
 
264
 
    Procedure SetResizeEventHandler(p : TEventProcedure);
265
 
      var
266
 
         oldp : TEventProcedure;
267
 
      begin
268
 
         EnterCriticalSection(HandlerChanging);
269
 
         oldp:=ResizeEventHandler;
270
 
         ResizeEventHandler:=p;
271
 
         NewEventHandlerInstalled(ResizeEventHandler,oldp);
272
 
         LeaveCriticalSection(HandlerChanging);
273
 
      end;
274
 
 
275
 
 
276
 
    Procedure SetUnknownEventHandler(p : TEventProcedure);
277
 
      var
278
 
         oldp : TEventProcedure;
279
 
      begin
280
 
         EnterCriticalSection(HandlerChanging);
281
 
         oldp:=UnknownEventHandler;
282
 
         UnknownEventHandler:=p;
283
 
         NewEventHandlerInstalled(UnknownEventHandler,oldp);
284
 
         LeaveCriticalSection(HandlerChanging);
285
 
      end;
286
 
 
287
 
 
288
 
initialization
289
 
   InitializeCriticalSection(HandlerChanging);
290
 
 
291
 
finalization
292
 
  { Uninstall all handlers                   }
293
 
  { this stops also the event handler thread }
294
 
  SetMouseEventHandler(nil);
295
 
  SetKeyboardEventHandler(nil);
296
 
  SetFocusEventHandler(nil);
297
 
  SetMenuEventHandler(nil);
298
 
  SetResizeEventHandler(nil);
299
 
  SetUnknownEventHandler(nil);
300
 
  { delete the critical section object }
301
 
  DeleteCriticalSection(HandlerChanging);
302
 
 
303
 
end.
304
 
 
305
 
{
306
 
  $Log: winevent.pp,v $
307
 
  Revision 1.3  2002/09/07 16:01:29  peter
308
 
    * old logs removed and tabs fixed
309
 
 
310
 
}