← Back to branch summary

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

« back to all changes in this revision

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