diff --git a/rtl/win32/keyboard.pp b/rtl/win32/keyboard.pp index 95fb038059..907258b022 100644 --- a/rtl/win32/keyboard.pp +++ b/rtl/win32/keyboard.pp @@ -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 } diff --git a/rtl/win32/mouse.pp b/rtl/win32/mouse.pp index 7107761eba..f40667f31d 100644 --- a/rtl/win32/mouse.pp +++ b/rtl/win32/mouse.pp @@ -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 PendingMouseEvents0 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 } diff --git a/rtl/win32/winevent.pp b/rtl/win32/winevent.pp index d583fc64a3..ac7b850230 100644 --- a/rtl/win32/winevent.pp +++ b/rtl/win32/winevent.pp @@ -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