paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-06-03 02:38:16 +02:00
Code Issues Packages Projects Releases Wiki Activity

implement shortcut handling, tcustomlabel accelerator focuscontrol functionality

Browse Source 
git-svn-id: trunk@6725 -
This commit is contained in:
micha 2005-02-03 15:10:23 +00:00
parent b89a0ffc98
commit 6fa632827f
12 changed files with 222 additions and 16 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
lcl/actnlist.pas
View File

@ -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);

11
lcl/controls.pp
View File

@ -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

8
lcl/forms.pp
View File

@ -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;

18
lcl/include/application.inc
View File

@ -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

13
lcl/include/control.inc
View File

@ -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

9
lcl/include/customactionlist.inc
View File

@ -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

27
lcl/include/customform.inc
View File

@ -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

23
lcl/include/customlabel.inc
View File

@ -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

20
lcl/include/menu.inc
View File

@ -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

90
lcl/include/wincontrol.inc
View File

@ -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

7
lcl/menus.pp
View File

@ -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

4
lcl/stdctrls.pp
View File

@ -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