From 6fa632827f38fa814aee7e64043edd3f3963b614 Mon Sep 17 00:00:00 2001 From: micha Date: Thu, 3 Feb 2005 15:10:23 +0000 Subject: [PATCH] implement shortcut handling, tcustomlabel accelerator focuscontrol functionality git-svn-id: trunk@6725 - --- lcl/actnlist.pas | 8 +-- lcl/controls.pp | 11 +++- lcl/forms.pp | 8 +++ lcl/include/application.inc | 18 +++++++ lcl/include/control.inc | 13 +++++ lcl/include/customactionlist.inc | 9 ++-- lcl/include/customform.inc | 27 ++++++++++ lcl/include/customlabel.inc | 23 ++++++++ lcl/include/menu.inc | 20 +++++++ lcl/include/wincontrol.inc | 90 ++++++++++++++++++++++++++++++-- lcl/menus.pp | 7 ++- lcl/stdctrls.pp | 4 ++ 12 files changed, 222 insertions(+), 16 deletions(-) diff --git a/lcl/actnlist.pas b/lcl/actnlist.pas index 7812afff7b..b3bf61fbbf 100644 --- a/lcl/actnlist.pas +++ b/lcl/actnlist.pas @@ -26,7 +26,7 @@ unit ActnList; interface uses - Classes, SysUtils, LCLStrConsts, LCLProc, ImgList, LCLClasses; + Classes, SysUtils, LCLStrConsts, LCLProc, ImgList, LCLClasses, LMessages; type @@ -98,7 +98,7 @@ type constructor Create(AOwner: TComponent); override; destructor Destroy; override; function ExecuteAction(Action: TBasicAction): Boolean; override; - //function IsShortCut(var Message: TWMKey): Boolean; + function IsShortCut(var Message: TLMKey): Boolean; function UpdateAction(Action: TBasicAction): Boolean; override; function IndexOfName(const ActionName: string): integer; function ActionByName(const ActionName: string): TContainedAction; @@ -297,7 +297,9 @@ procedure Register; implementation -uses Controls; +uses Controls, + Menus, {func Shortcut} + Forms; {func KeyDataToShiftState} procedure RegisterActions(const CategoryName: string; const AClasses: array of TBasicActionClass; Resource: TComponentClass); diff --git a/lcl/controls.pp b/lcl/controls.pp index c59b438865..ea9a48141d 100644 --- a/lcl/controls.pp +++ b/lcl/controls.pp @@ -1018,7 +1018,7 @@ type procedure SetDragMode(Value: TDragMode); virtual; //procedure SendDockNotification; virtual; MG: probably not needed protected - // mouse + // key and mouse procedure Click; dynamic; procedure DblClick; dynamic; procedure TripleClick; dynamic; @@ -1028,6 +1028,7 @@ type procedure MouseUp(Button: TMouseButton; Shift:TShiftState; X,Y:Integer); dynamic; procedure MouseEnter; virtual; procedure MouseLeave; virtual; + function DialogChar(var Message: TLMKey): boolean; virtual; protected procedure Changed; function GetPalette: HPalette; virtual; @@ -1552,10 +1553,13 @@ type function DoMouseWheelDown(Shift: TShiftState; MousePos: TPoint): Boolean; dynamic; function DoMouseWheelUp(Shift: TShiftState; MousePos: TPoint): Boolean; dynamic; function DoKeyDown(var Message: TLMKey): Boolean; - function DoRemainginKeyDown(var Message: TLMKeyDown): Boolean; + function DoRemainingKeyDown(var Message: TLMKeyDown): Boolean; function DoKeyPress(var Message: TLMKey): Boolean; + function DoRemainingKeyPress(var Message: TLMKey): Boolean; function DoUTF8KeyPress(var UTF8Key: TUTF8Char): boolean; dynamic; function DoKeyUp(var Message: TLMKey): Boolean; + function ChildKey(var Message: TLMKey): boolean; dynamic; + function DialogChar(var Message: TLMKey): boolean; override; procedure ControlKeyDown(var Key: Word; Shift: TShiftState); dynamic; procedure KeyDown(var Key: Word; Shift: TShiftState); dynamic; procedure KeyDownBeforeInterface(var Key: Word; Shift: TShiftState); dynamic; @@ -2895,6 +2899,9 @@ end. { ============================================================================= $Log$ + Revision 1.279 2005/02/03 15:10:22 micha + implement shortcut handling, tcustomlabel accelerator focuscontrol functionality + Revision 1.278 2005/01/26 23:23:11 mattias added error when setting FormStyle to MDI diff --git a/lcl/forms.pp b/lcl/forms.pp index c23c87505f..51168efb5d 100644 --- a/lcl/forms.pp +++ b/lcl/forms.pp @@ -332,6 +332,8 @@ type THelpEvent = function(Command: Word; Data: Longint; var CallHelp: Boolean): Boolean of object; + TShortCutEvent = procedure (var Msg: TLMKey; var Handled: Boolean) of object; + TFormStateType = ( fsCreating, // initializing (form streaming) fsVisible, // form should be shown @@ -380,6 +382,7 @@ type FOnDestroy: TNotifyEvent; FOnHelp: THelpEvent; FOnHide: TNotifyEvent; + FOnShortcut: TShortCutEvent; FOnShow: TNotifyEvent; FOnWindowStateChanged: TNotifyEvent; FPixelsPerInch: Longint; @@ -492,6 +495,7 @@ type procedure RemoveHandlerFirstShow(OnFirstShowHandler: TNotifyEvent); procedure AddHandlerClose(OnCloseHandler: TCloseEvent; AsLast: Boolean); procedure RemoveHandlerClose(OnCloseHandler: TCloseEvent); + function IsShortcut(var Message: TLMKey): boolean; public // drag and dock procedure Dock(NewDockSite: TWinControl; ARect: TRect); override; @@ -527,6 +531,7 @@ type property OnHelp: THelpEvent read FOnHelp write FOnHelp; property OnHide: TNotifyEvent read FOnHide write FOnHide; property OnResize stored IsForm; + property OnShortcut: TShortcutEvent read FOnShortcut write FOnShortcut; property OnShow: TNotifyEvent read FOnShow write FOnShow; property OnWindowStateChanged: TNotifyEvent read fOnWindowStateChanged write fOnWindowStateChanged; @@ -876,6 +881,7 @@ type FOnHint: TNotifyEvent; FOnIdle: TIdleEvent; FOnIdleEnd: TNotifyEvent; + FOnShortcut: TShortcutEvent; FOnShowHint: TShowHintEvent; FOnUserInput: TOnUserInputEvent; FReleaseComponents: TList; @@ -972,6 +978,7 @@ type procedure RemoveOnKeyDownHandler(Handler: TKeyEvent); procedure RemoveAllHandlersOfObject(AnObject: TObject); virtual; procedure DoBeforeMouseMessage(CurMouseControl: TControl); + function IsShortcut(var Message: TLMKey): boolean; public property CaptureExceptions: boolean read FCaptureExceptions write SetCaptureExceptions; @@ -991,6 +998,7 @@ type property OnIdleEnd: TNotifyEvent read FOnIdleEnd write FOnIdleEnd; property OnHelp: THelpEvent read FOnHelp write FOnHelp; property OnHint: TNotifyEvent read FOnHint write FOnHint; + property OnShortcut: TShortcutEvent read FOnShortcut write FOnShortcut; property OnShowHint: TShowHintEvent read FOnShowHint write FOnShowHint; property OnUserInput: TOnUserInputEvent read FOnUserInput write FOnUserInput; property ShowHint: Boolean read FShowHint write SetShowHint; diff --git a/lcl/include/application.inc b/lcl/include/application.inc index e64d0a570b..b5769f82c6 100644 --- a/lcl/include/application.inc +++ b/lcl/include/application.inc @@ -1244,6 +1244,21 @@ begin UpdateMouseControl(GetControlAtMouse); end; +function TApplication.IsShortcut(var Message: TLMKey): boolean; +begin + Result := false; + if Assigned(FOnShortcut) then + begin + FOnShortcut(Message, Result); + if Result then + exit; + end; + // TODO: only send shortcuts to main form if no form is showing modal + // or otherwise disabling the main form + if Assigned(FMainForm) {and IsWindowEnabled(FMainForm.Handle)} then + Result := FMainForm.IsShortcut(Message); +end; + {------------------------------------------------------------------------------ TApplication CreateForm @@ -1341,6 +1356,9 @@ end; { ============================================================================= $Log$ + Revision 1.95 2005/02/03 15:10:23 micha + implement shortcut handling, tcustomlabel accelerator focuscontrol functionality + Revision 1.94 2005/01/14 00:27:05 mattias fixed several dialogs to react on esacpe diff --git a/lcl/include/control.inc b/lcl/include/control.inc index 18690fae41..9024ae8264 100644 --- a/lcl/include/control.inc +++ b/lcl/include/control.inc @@ -1768,6 +1768,16 @@ Begin FOnClick(Self); end; +{------------------------------------------------------------------------------ + TControl DialogChar + + Do something useful with accelerators etc. +------------------------------------------------------------------------------} +function TControl.DialogChar(var Message: TLMKey): boolean; +begin + Result := false; +end; + {------------------------------------------------------------------------------ TControl AddControl @@ -3449,6 +3459,9 @@ end; { ============================================================================= $Log$ + Revision 1.243 2005/02/03 15:10:23 micha + implement shortcut handling, tcustomlabel accelerator focuscontrol functionality + Revision 1.242 2005/01/26 15:45:08 mattias implemented adding files from directory in project inspector, fixed extrac proc checking overlapping blocks diff --git a/lcl/include/customactionlist.inc b/lcl/include/customactionlist.inc index 4bea044419..82d7a9cc6e 100644 --- a/lcl/include/customactionlist.inc +++ b/lcl/include/customactionlist.inc @@ -117,20 +117,19 @@ begin OwnerFormDesignerModified(Self); end; -{ ToDo: -function TCustomActionList.IsShortCut(var Message: TWMKey): Boolean; +function TCustomActionList.IsShortCut(var Message: TLMKey): Boolean; var I: Integer; ShortCut: TShortCut; ShiftState: TShiftState; Action: TCustomAction; begin - ShiftState := KeyDataToShiftState(Message.KeyData); + ShiftState := Forms.KeyDataToShiftState(Message.KeyData); ShortCut := Menus.ShortCut(Message.CharCode, ShiftState); if ShortCut <> scNone then for I := 0 to FActions.Count - 1 do begin - Action := FActions.List[I]; + Action := TCustomAction(FActions.Items[I]); if (TObject(Action) is TCustomAction) then if (Action.ShortCut = ShortCut) or (Assigned(Action.FSecondaryShortCuts) and (Action.SecondaryShortCuts.IndexOfShortCut(ShortCut) <> -1)) then @@ -140,7 +139,7 @@ begin end; end; Result := False; -end; } +end; function TCustomActionList.ExecuteAction(Action: TBasicAction): Boolean; begin diff --git a/lcl/include/customform.inc b/lcl/include/customform.inc index 76aef93920..895ca74da6 100644 --- a/lcl/include/customform.inc +++ b/lcl/include/customform.inc @@ -1511,6 +1511,30 @@ begin Result := False; end; +function TCustomForm.IsShortCut(var Message: TLMKey): boolean; +var + I: integer; +begin + Result := false; + if Assigned(FOnShortcut) then + FOnShortcut(Message, Result); + if Result then + exit; + if Assigned(FMenu) then + begin + Result := FMenu.IsShortCut(Message); + if Result then exit; + end; + if Assigned(FActionLists) then + begin + for I := 0 to FActionLists.Count - 1 do + begin + Result := TCustomActionList(FActionLists.Items[I]).IsShortCut(Message); + if Result then exit; + end; + end; +end; + {------------------------------------------------------------------------------ Method: TCustomForm.CreateWnd Params: None @@ -1866,6 +1890,9 @@ end; { ============================================================================= $Log$ + Revision 1.176 2005/02/03 15:10:23 micha + implement shortcut handling, tcustomlabel accelerator focuscontrol functionality + Revision 1.175 2005/01/27 10:10:25 mattias added TTreeNode.GetParentNodeOfAbsoluteLevel from Sergio diff --git a/lcl/include/customlabel.inc b/lcl/include/customlabel.inc index 279be00d4e..3ac31d4549 100644 --- a/lcl/include/customlabel.inc +++ b/lcl/include/customlabel.inc @@ -178,6 +178,26 @@ begin end; end; +function TCustomLabel.DialogChar(var Message: TLMKey): boolean; +var + PrefixIndex: integer; + PrefixChar: char; +begin + Result := false; + if not FShowAccelChar then exit; + if FFocusControl = nil then exit; + + PrefixIndex := Pos('&', Caption); + if PrefixIndex < Length(Caption) then + PrefixChar := Caption[PrefixIndex+1]; + if ssAlt in KeyDataToShiftState(Message.KeyData) then + if char(Message.CharCode and $ff) = PrefixChar then + begin + Result := true; + FFocusControl.SetFocus; + end; +end; + procedure TCustomLabel.Loaded; begin inherited Loaded; @@ -251,6 +271,9 @@ end; { $Log$ + Revision 1.28 2005/02/03 15:10:23 micha + implement shortcut handling, tcustomlabel accelerator focuscontrol functionality + Revision 1.27 2005/01/26 17:51:34 mattias calling autosizing on changing TLabel.Caption diff --git a/lcl/include/menu.inc b/lcl/include/menu.inc index 02f8c19cf0..b6272dc1d4 100644 --- a/lcl/include/menu.inc +++ b/lcl/include/menu.inc @@ -140,6 +140,23 @@ begin Result:=Find(Items); end; +function TMenu.IsShortcut(var Message: TLMKey): boolean; +var + Item: TMenuItem; + Shortcut: TShortcut; + ShiftState: TShiftState; +begin + ShiftState := KeyDataToShiftState(Message.KeyData); + Shortcut := Menus.Shortcut(Message.CharCode, ShiftState); + Item := FindItem(Shortcut, fkShortcut); + Result := Item <> nil; + if Result then + begin + Item.InitiateActions; + Item.Click; + end; +end; + {------------------------------------------------------------------------------ Function: TMenu.GetHandle Params: none @@ -245,6 +262,9 @@ end; { ============================================================================= $Log$ + Revision 1.30 2005/02/03 15:10:23 micha + implement shortcut handling, tcustomlabel accelerator focuscontrol functionality + Revision 1.29 2005/01/07 13:04:08 vincents don't create handle for unvisible menu item diff --git a/lcl/include/wincontrol.inc b/lcl/include/wincontrol.inc index d5b618db63..1f122b9efe 100644 --- a/lcl/include/wincontrol.inc +++ b/lcl/include/wincontrol.inc @@ -2461,6 +2461,44 @@ begin if CharCode = VK_UNKNOWN then Exit; end; + // check popup menu + if Assigned(FPopupMenu) then + begin + if FPopupMenu.IsShortCut(Message) then + begin + CharCode := VK_UNKNOWN; + exit; + end; + end; + + // let each parent form handle shortcuts + AParent:=Parent; + while (AParent<>nil) do begin + if (AParent is TCustomForm) then begin + if TCustomForm(AParent).IsShortcut(Message) then + begin + CharCode := VK_UNKNOWN; + exit; + end; + end; + AParent:=AParent.Parent; + end; + + // let application handle shortcut + if Assigned(Application) and Application.IsShortcut(Message) then + begin + CharCode := VK_UNKNOWN; + exit; + end; + + // let parent(s) handle key from child key + if Assigned(Parent) then + if Parent.ChildKey(Message) then + begin + CharCode := VK_UNKNOWN; + exit; + end; + // let user handle the key if not (csNoStdEvents in ControlStyle) then begin @@ -2473,12 +2511,33 @@ begin Result := False; end; +function TWinControl.ChildKey(var Message: TLMKey): boolean; +begin + if Assigned(Parent) then + Result := Parent.ChildKey(Message) + else + Result := false; +end; + +function TWinControl.DialogChar(var Message: TLMKey): boolean; +var + I: integer; +begin + // broadcast to children + Result := false; + for I := 0 to ControlCount - 1 do + begin + Result := Controls[I].DialogChar(Message); + if Result then exit; + end; +end; + {------------------------------------------------------------------------------ - TWinControl DoRemainginKeyDown + TWinControl DoRemainingKeyDown Returns True if key handled ------------------------------------------------------------------------------} -function TWinControl.DoRemainginKeyDown(var Message: TLMKeyDown): Boolean; +function TWinControl.DoRemainingKeyDown(var Message: TLMKeyDown): Boolean; var ShiftState: TShiftState; begin @@ -2542,6 +2601,23 @@ begin Result := False; End; +{------------------------------------------------------------------------------ + TWinControl DoRemainingKeyPress + + Returns True if key handled +------------------------------------------------------------------------------} +function TWinControl.DoRemainingKeyPress(var Message : TLMKey): Boolean; +var + ParentForm: TCustomForm; +begin + ParentForm := GetParentForm(Self); + if ParentForm <> nil then + begin + Result := ParentForm.DialogChar(Message); + if Result then exit; + end; +end; + {------------------------------------------------------------------------------ TWinControl DoUTF8KeyPress @@ -3548,12 +3624,13 @@ end; ------------------------------------------------------------------------------} procedure TWinControl.WMChar(var Message: TLMChar); begin + DoRemainingKeyPress(Message); Assert(False, Format('Trace:[TWinControl.WMChar] %s', [ClassName])); end; procedure TWinControl.WMSysChar(var Message: TLMChar); begin - + DoRemainingKeyPress(Message); end; {------------------------------------------------------------------------------ @@ -3565,12 +3642,12 @@ end; ------------------------------------------------------------------------------} Procedure TWinControl.WMKeyDown(Var Message: TLMKeyDown); begin - DoRemainginKeyDown(Message); + DoRemainingKeyDown(Message); end; procedure TWinControl.WMSysKeyDown(var Message: TLMKeyDown); begin - DoRemainginKeyDown(Message); + DoRemainingKeyDown(Message); end; {------------------------------------------------------------------------------ @@ -4387,6 +4464,9 @@ end; { ============================================================================= $Log$ + Revision 1.309 2005/02/03 15:10:23 micha + implement shortcut handling, tcustomlabel accelerator focuscontrol functionality + Revision 1.308 2005/01/26 15:45:08 mattias implemented adding files from directory in project inspector, fixed extrac proc checking overlapping blocks diff --git a/lcl/menus.pp b/lcl/menus.pp index 16eebfbdc0..7297c3eda6 100644 --- a/lcl/menus.pp +++ b/lcl/menus.pp @@ -273,6 +273,7 @@ type destructor Destroy; override; procedure DestroyHandle; virtual; function FindItem(AValue: Integer; Kind: TFindItemKind) : TMenuItem; + function IsShortcut(var Message: TLMKey): boolean; function HandleAllocated: Boolean; Function IsRightToLeft: Boolean; procedure HandleNeeded; @@ -339,7 +340,8 @@ procedure Register; implementation uses - WSMenus; + WSMenus, + Forms {KeyDataToShiftState}; { Menu command managment } @@ -403,6 +405,9 @@ end. { $Log$ + Revision 1.77 2005/02/03 15:10:23 micha + implement shortcut handling, tcustomlabel accelerator focuscontrol functionality + Revision 1.76 2004/12/12 03:54:09 mattias implemented open project after open standard windows diff --git a/lcl/stdctrls.pp b/lcl/stdctrls.pp index c9b1ed6e50..d6b778231b 100644 --- a/lcl/stdctrls.pp +++ b/lcl/stdctrls.pp @@ -1087,6 +1087,7 @@ type function CanTab: boolean; override; procedure CalcSize(var AWidth, AHeight: integer); procedure DoAutoSize; override; + function DialogChar(var Message: TLMKey): boolean; override; procedure CMTextChanged(var Message: TLMSetText); message CM_TEXTCHANGED; procedure WMActivate(var Message: TLMActivate); message LM_ACTIVATE; @@ -1216,6 +1217,9 @@ end. { ============================================================================= $Log$ + Revision 1.189 2005/02/03 15:10:23 micha + implement shortcut handling, tcustomlabel accelerator focuscontrol functionality + Revision 1.188 2005/01/26 17:36:02 mattias added error message for TStaticText.BorderStyle not implemented during designing