paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-09-02 17:50:16 +02:00
Code Issues Packages Projects Releases Wiki Activity

* slightly optimized event handling (merged)

Browse Source
This commit is contained in:
peter 2001-01-14 22:20:00 +00:00
parent 73a75d5d5c
commit db8c675d94
3 changed files with 96 additions and 109 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

68
rtl/win32/keyboard.pp
View File

@ -110,18 +110,12 @@ end;
{ The event-Handler thread from the unit event will call us if a key-event
is available }
procedure HandleKeyboard;
procedure HandleKeyboard(var ir:INPUT_RECORD);
var
ir : INPUT_RECORD;
dwRead : DWord;
i : longint;
c : word;
addThis: boolean;
begin
dwRead:=1;
ReadConsoleInput(TextRec(Input).Handle,ir,1,dwRead);
if (dwRead=1) and (ir.EventType=KEY_EVENT) then
begin
with ir.KeyEvent do
begin
{ key up events are ignored (except alt) }
@ -156,36 +150,37 @@ begin
lastShiftState := transShiftState (dwControlKeyState); {save it for PollShiftStateEvent}
SetEvent (newKeyEvent); {event that a new key is available}
LeaveCriticalSection (lockVar);
end else
end
else
begin
lastShiftState := transShiftState (dwControlKeyState); {save it for PollShiftStateEvent}
{for alt-number we have to look for alt-key release}
if altNumActive then
if (wVirtualKeyCode = $12) then {alt-released}
begin
if altNumBuffer <> '' then {numbers with alt pressed?}
begin
if (wVirtualKeyCode = $12) then {alt-released}
begin
Val (altNumBuffer, c, i);
if (i = 0) and (c <= 255) then {valid number?}
begin {add to queue}
fillchar (ir, sizeof (ir), 0);
bKeyDown := true;
AsciiChar := char (c);
if altNumBuffer <> '' then {numbers with alt pressed?}
begin
Val (altNumBuffer, c, i);
if (i = 0) and (c <= 255) then {valid number?}
begin {add to queue}
fillchar (ir, sizeof (ir), 0);
bKeyDown := true;
AsciiChar := char (c);
{and add to queue}
EnterCriticalSection (lockVar);
keyboardeventqueue[nextfreekeyevent]:=
ir.KeyEvent;
incqueueindex(nextfreekeyevent);
SetEvent (newKeyEvent); {event that a new key is available}
LeaveCriticalSection (lockVar);
end;
EnterCriticalSection (lockVar);
keyboardeventqueue[nextfreekeyevent]:=ir.KeyEvent;
incqueueindex(nextfreekeyevent);
SetEvent (newKeyEvent); {event that a new key is available}
LeaveCriticalSection (lockVar);
end;
end;
altNumActive := false; {clear alt-buffer}
altNumBuffer := '';
end;
altNumActive := false; {clear alt-buffer}
altNumBuffer := '';
end;
end;
end;
end;
end;
end;
procedure InitKeyboard;
@ -194,16 +189,16 @@ begin
exit;
KeyBoardLayout:=GetKeyboardLayout(0);
lastShiftState := 0;
FlushConsoleInputBuffer(TextRec(Input).Handle);
FlushConsoleInputBuffer(StdInputHandle);
newKeyEvent := CreateEvent (nil, // address of security attributes
true, // flag for manual-reset event
false, // flag for initial state
nil); // address of event-object name
if newKeyEvent = INVALID_HANDLE_VALUE then
begin
// what to do here ????
RunError (217);
end;
begin
// what to do here ????
RunError (217);
end;
InitializeCriticalSection (lockVar);
altNumActive := false;
altNumBuffer := '';
@ -220,7 +215,7 @@ begin
exit;
SetKeyboardEventHandler(nil); {hangs???}
DeleteCriticalSection (lockVar);
FlushConsoleInputBuffer(TextRec(Input).Handle);
FlushConsoleInputBuffer(StdInputHandle);
closeHandle (newKeyEvent);
KeyboardActive:=false;
end;
@ -791,7 +786,10 @@ end;
end.
{
$Log$
Revision 1.1 2001-01-13 11:03:59 peter
Revision 1.2 2001-01-14 22:20:00 peter
* slightly optimized event handling (merged)
Revision 1.1 2001/01/13 11:03:59 peter
* API 2 RTL commit
}

48
rtl/win32/mouse.pp
View File

@ -32,18 +32,14 @@ var
Const
MouseEventActive : Boolean = false;
procedure MouseEventHandler;
procedure MouseEventHandler(var ir:INPUT_RECORD);
var
ir : INPUT_RECORD;
dwRead : DWord;
i: longint;
e : TMouseEvent;
begin
ReadConsoleInput(TextRec(Input).Handle,ir,1,dwRead);
if (dwRead=1) and (ir.EventType=_MOUSE_EVENT) then
begin
EnterCriticalSection(ChangeMouseEvents);
e.x:=ir.MouseEvent.dwMousePosition.x;
e.y:=ir.MouseEvent.dwMousePosition.y;
@ -71,7 +67,6 @@ procedure MouseEventHandler;
// inc(PendingMouseEvents);
end;
LeaveCriticalSection(ChangeMouseEvents);
end;
end;
procedure InitMouse;
@ -83,9 +78,9 @@ begin
if MouseEventActive then
exit;
// enable mouse events
GetConsoleMode(TextRec(Input).Handle,@mode);
GetConsoleMode(StdInputHandle,@mode);
mode:=mode or ENABLE_MOUSE_INPUT;
SetConsoleMode(TextRec(Input).Handle,mode);
SetConsoleMode(StdInputHandle,mode);
PendingMouseHead:=@PendingMouseEvent;
PendingMouseTail:=@PendingMouseEvent;
@ -106,9 +101,9 @@ begin
exit;
HideMouse;
// disable mouse events
GetConsoleMode(TextRec(Input).Handle,@mode);
GetConsoleMode(StdInputHandle,@mode);
mode:=mode and (not ENABLE_MOUSE_INPUT);
SetConsoleMode(TextRec(Input).Handle,mode);
SetConsoleMode(StdInputHandle,mode);
SetMouseEventHandler(nil);
DeleteCriticalSection(ChangeMouseEvents);
@ -193,6 +188,20 @@ begin
end;
function PollMouseEvent(var MouseEvent: TMouseEvent):boolean;
begin
EnterCriticalSection(ChangeMouseEvents);
if PendingMouseEvents>0 then
begin
MouseEvent:=PendingMouseHead^;
PollMouseEvent:=true;
end
else
PollMouseEvent:=false;
LeaveCriticalSection(ChangeMouseEvents);
end;
procedure PutMouseEvent(const MouseEvent: TMouseEvent);
begin
if PendingMouseEvents<MouseEventBufSize then
@ -207,24 +216,13 @@ begin
end;
end;
function PollMouseEvent(var MouseEvent: TMouseEvent):boolean;
begin
EnterCriticalSection(ChangeMouseEvents);
if PendingMouseEvents>0 then
begin
MouseEvent:=PendingMouseHead^;
PollMouseEvent:=true;
end
else
PollMouseEvent:=false;
LeaveCriticalSection(ChangeMouseEvents);
end;
end.
{
$Log$
Revision 1.1 2001-01-13 11:03:59 peter
Revision 1.2 2001-01-14 22:20:00 peter
* slightly optimized event handling (merged)
Revision 1.1 2001/01/13 11:03:59 peter
* API 2 RTL commit
}

89
rtl/win32/winevent.pp
View File

@ -22,8 +22,11 @@ interface
because win32 uses only one message queue for mouse and key events
}
uses
Windows;
type
TEventProcedure = Procedure;
TEventProcedure = Procedure(var ir:INPUT_RECORD);
{ these procedures must be used to set the event handlers }
{ these doesn't do something, they signal only the }
@ -47,24 +50,20 @@ interface
implementation
uses
windows, dos;
const
{ these procedures are called if an event occurs }
MouseEventHandler : procedure = nil;
KeyboardEventHandler : procedure = nil;
FocusEventHandler : procedure = nil;
MenuEventHandler : procedure = nil;
ResizeEventHandler : procedure = nil;
UnknownEventHandler : procedure = nil;
MouseEventHandler : TEventProcedure = nil;
KeyboardEventHandler : TEventProcedure = nil;
FocusEventHandler : TEventProcedure = nil;
MenuEventHandler : TEventProcedure = nil;
ResizeEventHandler : TEventProcedure = nil;
UnknownEventHandler : TEventProcedure = nil;
{ if this counter is zero, the event handler thread is killed }
InstalledHandlers : Byte = 0;
var
HandlerChanging : TCriticalSection;
OldExitProc : Pointer;
EventThreadHandle : Handle;
EventThreadID : DWord;
@ -106,25 +105,18 @@ interface
GetUnknownEventHandler:=UnknownEventHandler;
end;
{ removes an event from the event queue }
{ necessary, if no handler is installed }
Procedure DestroyOneEvent;
var
ir : TInputRecord;
dwRead : DWord;
begin
ReadConsoleInput(TextRec(Input).Handle,ir,1,dwRead);
end;
Function EventHandleThread(p : pointer) : DWord;StdCall;
const
irsize = 10;
var
ir : TInputRecord;
dwRead : DWord;
ir : array[0..irsize-1] of TInputRecord;
i,dwRead : DWord;
begin
while not(ExitEventHandleThread) do
begin
{ wait for an event }
WaitForSingleObject(TextRec(Input).Handle,INFINITE);
WaitForSingleObject(StdInputHandle,INFINITE);
{ guard this code, else it is doomed to crash, if the
thread is switched between the assigned test and
the call and the handler is removed
@ -133,61 +125,56 @@ interface
begin
EnterCriticalSection(HandlerChanging);
{ read, but don't remove the event }
if (PeekConsoleInput(TextRec(Input).Handle,ir,1,dwRead)) and
(dwRead>0) then
{ call the handler }
case ir.EventType of
if ReadConsoleInput(StdInputHandle,ir[0],irsize,dwRead) then
begin
i:=0;
while (i<dwRead) do
begin
{ call the handler }
case ir[i].EventType of
KEY_EVENT:
begin
if assigned(KeyboardEventHandler) then
KeyboardEventHandler
else
DestroyOneEvent;
KeyboardEventHandler(ir[i]);
end;
_MOUSE_EVENT:
begin
if assigned(MouseEventHandler) then
MouseEventHandler
else
DestroyOneEvent;
MouseEventHandler(ir[i]);
end;
WINDOW_BUFFER_SIZE_EVENT:
begin
if assigned(ResizeEventHandler) then
ResizeEventHandler
else
DestroyOneEvent;
ResizeEventHandler(ir[i]);
end;
MENU_EVENT:
begin
if assigned(MenuEventHandler) then
MenuEventHandler
else
DestroyOneEvent;
MenuEventHandler(ir[i]);
end;
FOCUS_EVENT:
begin
if assigned(FocusEventHandler) then
FocusEventHandler
else
DestroyOneEvent;
FocusEventHandler(ir[i]);
end;
else
begin
if assigned(UnknownEventHandler) then
UnknownEventHandler
else
DestroyOneEvent;
UnknownEventHandler(ir[i]);
end;
end;
end;
inc(i);
end;
end;
LeaveCriticalSection(HandlerChanging);
end;
end;
EventHandleThread:=0;
end;
Procedure NewEventHandlerInstalled(p,oldp : TEventProcedure);
@ -213,12 +200,12 @@ interface
begin
ExitEventHandleThread:=true;
{ create a dummy event and sent it to the thread, so
we can leave WatiForSingleObject }
we can leave WaitForSingleObject }
ir.EventType:=KEY_EVENT;
{ mouse event can be disabled by mouse.inc code
in DoneMouse
so use a key event instead PM }
WriteConsoleInput(TextRec(Input).Handle,ir,1,written);
WriteConsoleInput(StdInputHandle,ir,1,written);
{ wait, til the thread is ready }
WaitForSingleObject(EventThreadHandle,INFINITE);
CloseHandle(EventThreadHandle);
@ -312,11 +299,15 @@ finalization
SetUnknownEventHandler(nil);
{ delete the critical section object }
DeleteCriticalSection(HandlerChanging);
end.
{
$Log$
Revision 1.1 2001-01-13 11:03:59 peter
Revision 1.2 2001-01-14 22:20:00 peter
* slightly optimized event handling (merged)
Revision 1.1 2001/01/13 11:03:59 peter
* API 2 RTL commit
}