fix accelerators: now registered per window

git-svn-id: trunk@4899 -
This commit is contained in:
micha 2003-12-18 08:51:01 +00:00
parent 3cd2333df2
commit 6ff2c7cbb9
3 changed files with 25 additions and 12 deletions

View File

@ -54,7 +54,6 @@ Type
{ Win32 interface-object class }
TWin32Object = Class(TInterfaceBase)
Private
FAccelGroup: HACCEL;
FAppHandle: HWND; // The parent of all windows, represents the button of the taskbar
// Assoc. windowproc also acts as handler for popup menus
FMetrics: TNonClientMetrics;
@ -192,6 +191,9 @@ End.
{ =============================================================================
$Log$
Revision 1.61 2003/12/18 08:51:01 micha
fix accelerators: now registered per window
Revision 1.60 2003/12/15 21:57:16 micha
checklistbox, implement object+checked; from vincent

View File

@ -31,7 +31,6 @@
Constructor TWin32Object.Create;
Begin
Inherited Create;
FAccelGroup := 0;
FTimerData := TList.Create;
FMetrics.cbSize := SizeOf(FMetrics);
FMetricsFailed := not Windows.SystemParametersInfo(SPI_GETNONCLIENTMETRICS,
@ -88,8 +87,6 @@ Begin
FTimerData.Free;
if FAccelGroup <> 0 then
DestroyAcceleratorTable(FAccelGroup);
if FAppHandle <> 0 then
DestroyWindow(FAppHandle);
@ -585,6 +582,7 @@ Begin
If Handle <> 0 Then
begin
RemoveProp(Handle, 'Lazarus');
DestroyAcceleratorTable(Windows.GetProp(Handle, 'Accel'));
DestroyWindow(Handle);
end;
End
@ -995,7 +993,12 @@ activate_time : the time at which the activation event occurred.
If Sender is TMenuItem Then
Begin
SetLabel(Sender, LPSTR(TMenuItem(Sender).Caption+#9+ShortCutToText(ShortCut(TLMShortCut(Data^).NewKey, TLMShortCut(Data^).NewModifier))));
SetAccelKey(TLMShortCut(Data^).Handle, TLMShortCut(Data^).NewKey, TLMShortCut(Data^).NewModifier, FAccelGroup);
if (TMenuItem(Sender).Owner is TWinControl) and TMenuItem(Sender).HandleAllocated then
begin
SetAccelKey(TWinControl(TMenuItem(Sender).Owner).Handle, TMenuItem(Sender).Command, TLMShortCut(Data^).NewKey, TLMShortCut(Data^).NewModifier);
end else begin
WriteLn('LM_SETSHORTCUT: unable to set shortcut, menu has no window handle');
end;
End;
End;
Else
@ -1091,10 +1094,12 @@ end;
Procedure TWin32Object.HandleEvents;
var
AMessage: TMsg;
AccelTable: HACCEL;
Begin
While PeekMessage(AMessage, HWnd(Nil), 0, 0,PM_REMOVE) Do
Begin
If TranslateAccelerator(AMessage.HWnd, FAccelGroup, @AMessage) = 0 Then
AccelTable := HACCEL(Windows.GetProp(AMessage.HWnd, 'Accel'));
If (AccelTable = HACCEL(nil)) or (TranslateAccelerator(AMessage.HWnd, AccelTable, @AMessage) = 0) Then
Begin
TranslateMessage(@AMessage);
DispatchMessage(@AMessage);
@ -2888,6 +2893,9 @@ End;
{
$Log$
Revision 1.143 2003/12/18 08:51:01 micha
fix accelerators: now registered per window
Revision 1.142 2003/12/16 21:04:02 micha
fix menuitem icon patch, hdcScreen released too soon

View File

@ -567,13 +567,13 @@ Begin
Result := HACCEL(GetProp(Control, 'AccelGroup'));
End;
Procedure SetAccelKey(Const Control: HWND; Const AKey: word; Const AModifier: TShiftState; var AnAccelTable: HACCEL);
Procedure SetAccelKey(Window: HWND; Const CommandId: Word; Const AKey: word; Const AModifier: TShiftState);
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}
NullAccel: LPACCEL; {nil pointer}
function ControlInTable: integer;
var i: integer;
@ -582,7 +582,7 @@ var AccelCount: integer; {number of accelerators in table}
i:=0;
while i < AccelCount do
begin
if NewAccel[i].cmd = word(Control) then
if NewAccel[i].cmd = CommandId then
begin
Result:=i;
exit;
@ -600,7 +600,7 @@ var AccelCount: integer; {number of accelerators in table}
end;
Begin
OldAccel := AnAccelTable;
OldAccel := Windows.GetProp(Window, 'Accel');
NullAccel := nil;
AccelCount := CopyAcceleratorTable(OldAccel, NullAccel, 0);
Assert(False,Format('Trace: AccelCount=%d',[AccelCount]));
@ -615,11 +615,11 @@ Begin
NewCount := AccelCount+1;
end
else NewCount := AccelCount;
NewAccel[ControlIndex].cmd := word(Control);
NewAccel[ControlIndex].cmd := CommandId;
NewAccel[ControlIndex].fVirt := GetVirtFromState(AModifier);
NewAccel[ControlIndex].key := AKey;
DestroyAcceleratorTable(OldAccel);
AnAccelTable := CreateAcceleratorTable(NewAccel, NewCount);
Windows.SetProp(Window, 'Accel', CreateAcceleratorTable(NewAccel, NewCount));
End;
Function GetAccelKey(Const Control: HWND): LPACCEL;
@ -716,6 +716,9 @@ End;
{ =============================================================================
$Log$
Revision 1.31 2003/12/18 08:51:01 micha
fix accelerators: now registered per window
Revision 1.30 2003/11/22 23:56:33 mattias
fixed win32 intf menu height from Wojciech