diff --git a/lcl/interfaces/win32/win32callback.inc b/lcl/interfaces/win32/win32callback.inc index d9d378d3bd..6db8980a87 100644 --- a/lcl/interfaces/win32/win32callback.inc +++ b/lcl/interfaces/win32/win32callback.inc @@ -144,9 +144,9 @@ Begin Begin OwnerObject := TObject(GetProp(LParam, 'Lazarus')); Case Hi(WParam) Of - 0: + 0,1: {mouse click or a menuitem command or a shortcut pressed} Begin - if LParam=0 then OwnerObject := GetMenuItemObject; + if LParam=0 then OwnerObject := GetMenuItemObject; {menuitem or shortcut} If ((OwnerObject Is TControl) And (Not (OwnerObject Is TButton))) Then CallEvent(OwnerObject, TControl(OwnerObject).OnClick, Nil, etNotify) Else If OwnerObject Is TMenuItem Then @@ -510,7 +510,7 @@ end; {------------------------------------------------------------------------------ Function: ToolBtnWindowProc - Params: Window_hwnd - The window that receives a message for the timer window + Params: Window_hwnd - The window that receives a message for the window Msg - The message received WParam - Word parameter LParam - Long-integer parameter @@ -530,6 +530,9 @@ end; { $Log$ + Revision 1.24 2003/01/27 11:25:40 mattias + menu accelerator patch from Martin Smat + Revision 1.23 2003/01/19 10:57:46 mattias fix WindowProc now react on menu item click from Martin diff --git a/lcl/interfaces/win32/win32object.inc b/lcl/interfaces/win32/win32object.inc index eca9f51a43..74238801b2 100644 --- a/lcl/interfaces/win32/win32object.inc +++ b/lcl/interfaces/win32/win32object.inc @@ -26,15 +26,13 @@ Constructor for the class. ------------------------------------------------------------------------------} Constructor TWin32Object.Create; -Var - AcTbl: Array[1..50] Of ACCEL; Begin Inherited Create; FKeyStateList := TList.Create; FDeviceContexts := TDynHashArray.Create(-1); FGDIObjects := TDynHashArray.Create(-1); FMessageQueue := TList.Create; - FAccelGroup := CreateAcceleratorTable(LPACCEL(@AcTbl), High(AcTbl)); + FAccelGroup := 0; FTimerData := TList.Create; FTimerWindow := 0; End; @@ -220,17 +218,18 @@ Procedure TWin32Object.SetLabel(Sender: TObject; Data: Pointer); Procedure SetMenuItemCaption; var MenuInfo: MENUITEMINFO; - MenuHandle: HMenu; + Style: integer; Begin - MenuHandle := (Sender as TMenuItem).Handle; + if (Sender as TMenuItem).Caption = '-' then Style := MFT_SEPARATOR + else Style := MFT_STRING; with MenuInfo do begin cbsize:=sizeof(MENUITEMINFO); fMask:=MIIM_TYPE; - fType:=MFT_STRING; + fType:=Style; dwTypeData:=Data; end; - SetMenuItemInfo(FMenu, integer(MenuHandle), false, @MenuInfo); + SetMenuItemInfo((Sender as TMenuItem).Parent.Handle, integer((Sender as TMenuItem).Handle), false, @MenuInfo); DrawMenuBar(((Sender as TMenuItem).Owner as TWinControl).Handle); End; @@ -348,7 +347,7 @@ Var PStr, PStr2: PChar; R, R2: TRECT; SelectionMode: DWORD; // currently only used for listboxes - TBB: TBBUTTON; // Limited to 2 buttons at present + TBB: TBBUTTON; WindowStyle: Integer; //used by LM_SETTABPOSITION OldPageIndex: Integer; //used by LM_SETITEMINDEX of a csNotebook Begin @@ -912,6 +911,14 @@ activate_time : the time at which the activation event occurred. End End; End; + LM_SETSHORTCUT: + Begin + If Sender is TMenuItem Then + Begin + SetLabel(Sender, LPSTR((Sender as TMenuItem).Caption+#9+ShortCutToText(ShortCut(TLMShortCut(Data^).NewKey, TLMShortCut(Data^).NewModifier)))); + SetAccelKey(TLMShortCut(Data^).Handle, TLMShortCut(Data^).NewKey, TLMShortCut(Data^).NewModifier, FAccelGroup); + End; + End; Else Assert(True, Format ('WARNING: Unhandled message %d in IntSendMessage3 send by %s --> message:Redraw', [LM_Message, Sender.ClassName])); // unhandled message @@ -1860,10 +1867,10 @@ Begin csMenuItem: Begin Window := CreateMenu; - SetProp(Window, 'MenuCaption', StrTemp); + {SetProp(Window, 'MenuCaption', StrTemp); AccelIndex := Pos('&', Caption); If AccelIndex <> 0 Then - SetAccelKey(Window, Nil); + SetAccelKey(Window, Nil);} {SetProp(Window, 'Lazarus', Sender); SetName(Window, StrTemp);} End; @@ -2542,11 +2549,10 @@ var MenuInfo: MENUITEMINFO; ParentMenuHandle: HMenu; Style: integer; Mask: integer; + Msg: TLMShortCut; Begin - Mask := MIIM_TYPE or MIIM_ID or MIIM_DATA; + Mask := MIIM_ID or MIIM_DATA; if ((Sender as TMenuItem).Count > 0) then Mask := Mask or MIIM_SUBMENU; - if (Sender as TMenuItem).Caption = '-' then Style := MFT_SEPARATOR - else Style := MFT_STRING; MenuHandle := (Sender as TMenuItem).Handle; with MenuInfo do begin cbsize:=sizeof(MENUITEMINFO); @@ -2558,12 +2564,18 @@ Begin {hbmpChecked:=0; hbmpUnchecked:=0;} {not needed} dwItemData:=integer(Sender); - dwTypeData:=LPSTR((Sender as TmenuItem).Caption); + {dwTypeData:=LPSTR((Sender as TmenuItem).Caption);} {cch:=length((Sender as TMenuItem).Caption);} {not needed} end; ParentMenuHandle := (Sender as TMenuItem).Parent.Handle; InsertMenuItem(ParentMenuHandle, 0, false, @MenuInfo); - DrawMenuBar(((Sender as TMenuItem).Owner as TWinControl).Handle); + if (Sender as TMenuItem).ShortCut <> 0 then + begin + Msg.Handle:=MenuHandle; + ShortCutToKey((Sender as TMenuItem).ShortCut, Msg.NewKey, Msg.NewModifier); + IntSendMessage3(LM_SETSHORTCUT, Sender, @Msg); + end + else SetLabel(Sender, LPSTR((Sender as TMenuItem).Caption)); End; {------------------------------------------------------------------------------ @@ -2600,6 +2612,9 @@ End; { $Log$ + Revision 1.44 2003/01/27 11:25:40 mattias + menu accelerator patch from Martin Smat + Revision 1.43 2003/01/19 10:57:46 mattias fix WindowProc now react on menu item click from Martin diff --git a/lcl/interfaces/win32/win32proc.inc b/lcl/interfaces/win32/win32proc.inc index d95fc9f4c1..15e9c6b307 100644 --- a/lcl/interfaces/win32/win32proc.inc +++ b/lcl/interfaces/win32/win32proc.inc @@ -765,11 +765,59 @@ Begin Result := HACCEL(GetProp(Control, 'AccelGroup')); End; -Procedure SetAccelKey(Const Control: HWND; Const AKey: LPACCEL); +Procedure SetAccelKey(Const Control: HWND; Const AKey: word; Const AModifier: TShiftState; var AnAccelTable: HACCEL); +var AccelCount: integer; {number of accelerators in table} + NewCount: integer; {total sum of accelerators in the table} + ControlIndex: integer; {index of new (modified) accelerator in table} + OldAccel: HACCEL; {old accelerator table} + NewAccel: LPACCEL; {new accelerator table} + NullAccel: LPACCEL; {an accelerator table with nil value} + + function ControlInTable: integer; + var i: integer; + begin + Result:=AccelCount; + i:=0; + while i < AccelCount do + begin + if NewAccel[i].cmd = word(Control) then + begin + Result:=i; + exit; + end; + inc(i); + end; + end; + + function GetVirtFromState(const AState: TShiftState): word; + begin + Result := FVIRTKEY; + if ssAlt in AState then Result := Result or FALT; + if ssCtrl in AState then Result := Result or FCONTROL; + if ssShift in AState then Result := Result or FSHIFT; + end; + Begin - Assert(False, 'Trace:TODO: Code SetAccelKey'); - If (Control <> HWND(Nil)) Then - SetProp(Control, 'AccelKey', AKey); + OldAccel := AnAccelTable; + NullAccel := nil; + AccelCount := CopyAcceleratorTable(OldAccel, NullAccel, 0); + Assert(False,Format('Trace: AccelCount=%d',[AccelCount])); + NewAccel := LPACCEL(LocalAlloc(LPTR, AccelCount * sizeof(ACCEL))); + CopyAcceleratorTable(OldAccel, NewAccel, AccelCount); + ControlIndex := ControlInTable; + if ControlIndex = AccelCount then {realocating the accelerator array, adding new accelerator} + begin + LocalFree(HLOCAL(NewAccel)); + NewAccel := LPACCEL(LocalAlloc(LPTR, (AccelCount+1) * sizeof(ACCEL))); + CopyAcceleratorTable(OldAccel, NewAccel, AccelCount); + NewCount := AccelCount+1; + end + else NewCount := AccelCount; + NewAccel[ControlIndex].cmd := word(Control); + NewAccel[ControlIndex].fVirt := GetVirtFromState(AModifier); + NewAccel[ControlIndex].key := AKey; + DestroyAcceleratorTable(OldAccel); + AnAccelTable := CreateAcceleratorTable(NewAccel, NewCount); End; Function GetAccelKey(Const Control: HWND): LPACCEL; @@ -786,6 +834,9 @@ End; { ============================================================================= $Log$ + Revision 1.13 2003/01/27 11:25:40 mattias + menu accelerator patch from Martin Smat + Revision 1.12 2003/01/01 10:46:59 mattias fixes for win32 listbox/combobox from Karl Brandt