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

menu accelerator patch from Martin Smat

Browse Source 
git-svn-id: trunk@3826 -
This commit is contained in:
mattias 2003-01-27 11:25:40 +00:00
parent 77b396bdc6
commit dbbb6c102e
3 changed files with 91 additions and 22 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
lcl/interfaces/win32/win32callback.inc
View File

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

45
lcl/interfaces/win32/win32object.inc
View File

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

59
lcl/interfaces/win32/win32proc.inc
View File

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