mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-10-30 13:32:00 +01:00
+ common CtrlBreakHandler for unit Keyboard
git-svn-id: trunk@8696 -
This commit is contained in:
parent
0625040eba
commit
85b8eeac17
@ -293,3 +293,34 @@ begin
|
|||||||
end;
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
const
|
||||||
|
PrevCtrlBreakHandler: TCtrlBreakHandler = nil;
|
||||||
|
|
||||||
|
function KbdCtrlBreakHandler (CtrlBreak: boolean): boolean;
|
||||||
|
begin
|
||||||
|
(* Earlier registered handlers (user specific) have priority. *)
|
||||||
|
if Assigned (PrevCtrlBreakHandler) then
|
||||||
|
if PrevCtrlBreakHandler (CtrlBreak) then
|
||||||
|
begin
|
||||||
|
KbdCtrlBreakHandler := true;
|
||||||
|
Exit;
|
||||||
|
end;
|
||||||
|
(* If Ctrl-Break was pressed, either ignore it or allow default processing. *)
|
||||||
|
if CtrlBreak then
|
||||||
|
KbdCtrlBreakHandler := false
|
||||||
|
else (* Ctrl-C pressed or not possible to distinguish *)
|
||||||
|
begin
|
||||||
|
PutKeyEvent ((kbCtrl shl 16) or 3);
|
||||||
|
KbdCtrlBreakHandler := true;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
procedure SetKbdCtrlBreakHandler;
|
||||||
|
begin
|
||||||
|
PrevCtrlBreakHandler := SysSetCtrlBreakHandler (@KbdCtrlBreakHandler);
|
||||||
|
if PrevCtrlBreakHandler = TCtrlBreakHandler (pointer (-1)) then
|
||||||
|
PrevCtrlBreakHandler := nil;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user