mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-12-16 02:00:30 +01:00
MG: added VK_IRREGULAR and key grabbing
git-svn-id: trunk@296 -
This commit is contained in:
lazarus
parent
dadfbee9e4
commit
16d5355d7b
@ -1,4 +1,3 @@
|
||||
unit keymapping;
|
||||
{
|
||||
Author: Mattias Gaertner
|
||||
|
||||
@ -9,6 +8,7 @@ unit keymapping;
|
||||
|
||||
ToDo:
|
||||
}
|
||||
unit keymapping;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
@ -37,10 +37,10 @@ const
|
||||
ecCodeCompletion = ecUserFirst + 101;
|
||||
|
||||
ecSave = ecUserFirst + 200;
|
||||
ecOpen = ecSave + 1;
|
||||
ecClose = ecOpen + 1;
|
||||
ecBuild = ecClose + 1;
|
||||
ecRun = ecBuild + 1;
|
||||
ecOpen = ecSave + 1;
|
||||
ecClose = ecOpen + 1;
|
||||
ecBuild = ecClose + 1;
|
||||
ecRun = ecBuild + 1;
|
||||
|
||||
ecJumpToEditor = ecUserFirst + 300;
|
||||
ecToggleFormUnit = ecUserFirst + 301;
|
||||
@ -98,21 +98,31 @@ type
|
||||
//---------------------------------------------------------------------------
|
||||
// form for editing one command - key relationship
|
||||
TKeyMappingEditForm = class(TForm)
|
||||
OkButton:TButton;
|
||||
CancelButton:TButton;
|
||||
CommandLabel:TLabel;
|
||||
Key1GroupBox:TGroupBox;
|
||||
Key1CtrlCheckBox:TCheckBox;
|
||||
Key1AltCheckBox:TCheckBox;
|
||||
Key1ShiftCheckBox:TCheckBox;
|
||||
Key1KeyComboBox:TComboBox;
|
||||
Key2GroupBox:TGroupBox;
|
||||
Key2CtrlCheckBox:TCheckBox;
|
||||
Key2AltCheckBox:TCheckBox;
|
||||
Key2ShiftCheckBox:TCheckBox;
|
||||
Key2KeyComboBox:TComboBox;
|
||||
procedure OkButtonClick(Sender:TObject);
|
||||
procedure CancelButtonClick(Sender:TObject);
|
||||
OkButton: TButton;
|
||||
CancelButton: TButton;
|
||||
CommandLabel: TLabel;
|
||||
Key1GroupBox: TGroupBox;
|
||||
Key1CtrlCheckBox: TCheckBox;
|
||||
Key1AltCheckBox: TCheckBox;
|
||||
Key1ShiftCheckBox: TCheckBox;
|
||||
Key1KeyComboBox: TComboBox;
|
||||
Key1GrabButton: TButton;
|
||||
Key2GroupBox: TGroupBox;
|
||||
Key2CtrlCheckBox: TCheckBox;
|
||||
Key2AltCheckBox: TCheckBox;
|
||||
Key2ShiftCheckBox: TCheckBox;
|
||||
Key2KeyComboBox: TComboBox;
|
||||
Key2GrabButton: TButton;
|
||||
procedure OkButtonClick(Sender: TObject);
|
||||
procedure CancelButtonClick(Sender: TObject);
|
||||
procedure Key1GrabButtonClick(Sender: TObject);
|
||||
procedure Key2GrabButtonClick(Sender: TObject);
|
||||
procedure FormKeyUp(Sender: TObject; var Key: Word; Shift:TShiftState);
|
||||
private
|
||||
GrabbingKey: integer; // 0=none, 1=Default key, 2=Alternative key
|
||||
procedure ActivateGrabbing(AGrabbingKey: integer);
|
||||
procedure DeactivateGrabbing;
|
||||
procedure SetComboBox(AComboBox: TComboBox; AValue: string);
|
||||
public
|
||||
constructor Create(AOwner:TComponent); override;
|
||||
KeyCommandRelationList:TKeyCommandRelationList;
|
||||
@ -275,7 +285,10 @@ begin
|
||||
ecSave: Result:= 'save';
|
||||
ecOpen: Result:= 'open';
|
||||
ecClose: Result:= 'close';
|
||||
ecBuild: Result:= 'build program/project';
|
||||
ecRun: Result:= 'run program';
|
||||
ecJumpToEditor: Result:='jump to editor';
|
||||
ecToggleFormUnit: Result:='toggle between form and unit';
|
||||
ecGotoEditor1: Result:= 'goto editor 1';
|
||||
ecGotoEditor2: Result:= 'goto editor 2';
|
||||
ecGotoEditor3: Result:= 'goto editor 3';
|
||||
@ -398,6 +411,10 @@ begin
|
||||
VK_F1..VK_F24 :Result:=Result+'F'+IntToStr(Key-VK_F1+1);
|
||||
VK_NUMLOCK :Result:=Result+'Numlock';
|
||||
VK_SCROLL :Result:=Result+'Scroll';
|
||||
VK_EQUAL :Result:=Result+'=';
|
||||
VK_COMMA :Result:=Result+',';
|
||||
VK_POINT :Result:=Result+'.';
|
||||
VK_SLASH :Result:=Result+'/';
|
||||
else
|
||||
Result:=Result+'Word('''+IntToStr(Key)+''')';
|
||||
end;
|
||||
@ -411,8 +428,9 @@ var a:integer;
|
||||
begin
|
||||
inherited Create(AOwner);
|
||||
if LazarusResources.Find(ClassName)=nil then begin
|
||||
SetBounds((Screen.Width-200) div 2,(Screen.Height-270) div 2,220,250);
|
||||
SetBounds((Screen.Width-200) div 2,(Screen.Height-270) div 2,216,310);
|
||||
Caption:='Edit keys for command';
|
||||
OnKeyUp:=@FormKeyUp;
|
||||
|
||||
OkButton:=TButton.Create(Self);
|
||||
with OkButton do begin
|
||||
@ -443,9 +461,9 @@ begin
|
||||
Name:='CommandLabel';
|
||||
Parent:=Self;
|
||||
Caption:='Command';
|
||||
Left:=10;
|
||||
Left:=5;
|
||||
Top:=5;
|
||||
Width:=Self.ClientWidth-Left-Left-4;
|
||||
Width:=Self.ClientWidth-Left-Left;
|
||||
Height:=20;
|
||||
Show;
|
||||
end;
|
||||
@ -457,8 +475,8 @@ begin
|
||||
Caption:='Key';
|
||||
Left:=5;
|
||||
Top:=CommandLabel.Top+CommandLabel.Height+8;
|
||||
Width:=Self.ClientWidth-4-Left-Left;
|
||||
Height:=80;
|
||||
Width:=Self.ClientWidth-Left-Left;
|
||||
Height:=110;
|
||||
Show;
|
||||
end;
|
||||
|
||||
@ -502,9 +520,9 @@ begin
|
||||
with Key1KeyComboBox do begin
|
||||
Name:='Key1KeyComboBox';
|
||||
Parent:=Key1GroupBox;
|
||||
Left:=10;
|
||||
Left:=5;
|
||||
Top:=Key1CtrlCheckBox.Top+Key1CtrlCheckBox.Height+5;
|
||||
Width:=180;
|
||||
Width:=190;
|
||||
Items.BeginUpdate;
|
||||
Items.Add('none');
|
||||
for a:=1 to 145 do begin
|
||||
@ -516,6 +534,19 @@ begin
|
||||
ItemIndex:=0;
|
||||
Show;
|
||||
end;
|
||||
|
||||
Key1GrabButton:=TButton.Create(Self);
|
||||
with Key1GrabButton do begin
|
||||
Parent:=Key1GroupBox;
|
||||
Left:=5;
|
||||
Top:=Key1KeyComboBox.Top+Key1KeyComboBox.Height+5;
|
||||
Width:=Key1KeyComboBox.Width;
|
||||
Height:=25;
|
||||
Caption:='Grab Key';
|
||||
Name:='Key1GrabButton';
|
||||
OnClick:=@Key1GrabButtonClick;
|
||||
Show;
|
||||
end;
|
||||
|
||||
Key2GroupBox:=TGroupBox.Create(Self);
|
||||
with Key2GroupBox do begin
|
||||
@ -525,7 +556,7 @@ begin
|
||||
Left:=5;
|
||||
Top:=Key1GroupBox.Top+Key1GroupBox.Height+8;
|
||||
Width:=Key1GroupBox.Width;
|
||||
Height:=80;
|
||||
Height:=110;
|
||||
Show;
|
||||
end;
|
||||
|
||||
@ -569,9 +600,9 @@ begin
|
||||
with Key2KeyComboBox do begin
|
||||
Name:='Key2KeyComboBox';
|
||||
Parent:=Key2GroupBox;
|
||||
Left:=10;
|
||||
Left:=5;
|
||||
Top:=Key2CtrlCheckBox.Top+Key2CtrlCheckBox.Height+5;
|
||||
Width:=180;
|
||||
Width:=190;
|
||||
Items.BeginUpdate;
|
||||
Items.Add('none');
|
||||
for a:=1 to 145 do begin
|
||||
@ -584,7 +615,21 @@ begin
|
||||
Show;
|
||||
end;
|
||||
|
||||
Key2GrabButton:=TButton.Create(Self);
|
||||
with Key2GrabButton do begin
|
||||
Parent:=Key2GroupBox;
|
||||
Left:=5;
|
||||
Top:=Key2KeyComboBox.Top+Key2KeyComboBox.Height+5;
|
||||
Width:=Key2KeyComboBox.Width;
|
||||
Height:=25;
|
||||
Caption:='Grab Key';
|
||||
Name:='Key2GrabButton';
|
||||
OnClick:=@Key2GrabButtonClick;
|
||||
Show;
|
||||
end;
|
||||
|
||||
end;
|
||||
GrabbingKey:=0;
|
||||
end;
|
||||
|
||||
procedure TKeyMappingEditForm.OkButtonClick(Sender:TObject);
|
||||
@ -656,6 +701,94 @@ begin
|
||||
ModalResult:=mrCancel;
|
||||
end;
|
||||
|
||||
procedure TKeyMappingEditForm.Key1GrabButtonClick(Sender: TObject);
|
||||
begin
|
||||
ActivateGrabbing(1);
|
||||
end;
|
||||
|
||||
procedure TKeyMappingEditForm.Key2GrabButtonClick(Sender: TObject);
|
||||
begin
|
||||
ActivateGrabbing(2);
|
||||
end;
|
||||
|
||||
procedure TKeyMappingEditForm.DeactivateGrabbing;
|
||||
var i: integer;
|
||||
begin
|
||||
if GrabbingKey=0 then exit;
|
||||
// enable all components
|
||||
for i:=0 to ComponentCount-1 do begin
|
||||
if (Components[i] is TWinControl) then
|
||||
TWinControl(Components[i]).Enabled:=true;
|
||||
end;
|
||||
if GrabbingKey=1 then
|
||||
Key1GrabButton.Caption:='Grab Key'
|
||||
else if GrabbingKey=2 then
|
||||
Key2GrabButton.Caption:='Grab Key';
|
||||
GrabbingKey:=0;
|
||||
end;
|
||||
|
||||
procedure TKeyMappingEditForm.SetComboBox(AComboBox: TComboBox; AValue: string);
|
||||
var i: integer;
|
||||
begin
|
||||
i:=AComboBox.Items.IndexOf(AValue);
|
||||
if i>=0 then
|
||||
AComboBox.ItemIndex:=i
|
||||
else begin
|
||||
AComboBox.Items.Add(AValue);
|
||||
AComboBox.ItemIndex:=AComboBox.Items.IndexOf(AValue);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TKeyMappingEditForm.ActivateGrabbing(AGrabbingKey: integer);
|
||||
var i: integer;
|
||||
begin
|
||||
if GrabbingKey>0 then exit;
|
||||
GrabbingKey:=AGrabbingKey;
|
||||
if GrabbingKey=0 then exit;
|
||||
// disable all components
|
||||
for i:=0 to ComponentCount-1 do begin
|
||||
if (Components[i] is TWinControl) then begin
|
||||
if ((GrabbingKey=1) and (Components[i]<>Key1GrabButton)
|
||||
and (Components[i]<>Key1GroupBox))
|
||||
or ((GrabbingKey=2) and (Components[i]<>Key2GrabButton)
|
||||
and (Components[i]<>Key2GroupBox)) then
|
||||
TWinControl(Components[i]).Enabled:=false;
|
||||
end;
|
||||
end;
|
||||
if GrabbingKey=1 then
|
||||
Key1GrabButton.Caption:='Please press a key ...'
|
||||
else if GrabbingKey=2 then
|
||||
Key2GrabButton.Caption:='Please press a key ...';
|
||||
end;
|
||||
|
||||
procedure TKeyMappingEditForm.FormKeyUp(Sender: TObject; var Key: Word;
|
||||
Shift:TShiftState);
|
||||
begin
|
||||
writeln('TKeyMappingEditForm.FormKeyUp Sender=',Classname
|
||||
,' Key=',Key
|
||||
,' Ctrl=',ssCtrl in Shift
|
||||
,' Shift=',ssShift in Shift
|
||||
,' Alt=',ssAlt in Shift
|
||||
,' AsString=',KeyAndShiftStateToStr(Key,Shift)
|
||||
);
|
||||
if Key in [VK_CONTROL, VK_SHIFT, VK_LCONTROL, VK_RCONTROl,
|
||||
VK_LSHIFT, VK_RSHIFT] then exit;
|
||||
if (GrabbingKey in [1,2]) then begin
|
||||
if GrabbingKey=1 then begin
|
||||
Key1CtrlCheckBox.Checked:=(ssCtrl in Shift);
|
||||
Key1ShiftCheckBox.Checked:=(ssShift in Shift);
|
||||
Key1AltCheckBox.Checked:=(ssAlt in Shift);
|
||||
SetComboBox(Key1KeyComboBox,KeyAndShiftStateToStr(Key,[]));
|
||||
end else if GrabbingKey=2 then begin
|
||||
Key2CtrlCheckBox.Checked:=(ssCtrl in Shift);
|
||||
Key2ShiftCheckBox.Checked:=(ssShift in Shift);
|
||||
Key2AltCheckBox.Checked:=(ssAlt in Shift);
|
||||
SetComboBox(Key2KeyComboBox,KeyAndShiftStateToStr(Key,[]));
|
||||
end;
|
||||
DeactivateGrabbing;
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
{ TKeyCommandRelation }
|
||||
|
||||
|
||||
@ -222,6 +222,9 @@ begin
|
||||
'0'..'9',
|
||||
' ': VirtualKey := KeyCode;
|
||||
'a'..'z': VirtualKey := KeyCode - Ord('a') + Ord('A');
|
||||
'/': VirtualKey := VK_SLASH;
|
||||
',': VirtualKey := VK_COMMA;
|
||||
'.': VirtualKey := VK_POINT;
|
||||
end;
|
||||
|
||||
{ look for control code }
|
||||
@ -325,7 +328,7 @@ begin
|
||||
|
||||
GDK_KP_Equal:
|
||||
begin
|
||||
VirtualKey := $BB;
|
||||
VirtualKey := VK_EQUAL;
|
||||
if not CtrlDown then KeyCode := Ord('=');
|
||||
end;
|
||||
GDK_KP_Multiply:
|
||||
@ -449,6 +452,13 @@ begin
|
||||
GDK_F1..GDK_F24: VirtualKey := VK_F1 + (Event^.KeyVal - GDK_F1);
|
||||
end;
|
||||
|
||||
if VirtualKey=VK_UNKNOWN then
|
||||
// map all other keys to VK_IRREGULAR +
|
||||
VirtualKey := VK_IRREGULAR + KeyCode;
|
||||
|
||||
writeln('GetGTKKeyInfo KeyCode=',KeyCode,' VirtualKey=',VirtualKey
|
||||
,' SysKey=',SysKey,' Extended=',Extended,' Toggle=',Toggle);
|
||||
|
||||
// Assert(False, Format('Trace:[GetGTKKeyInfo] Event^.KeyVal %d, Event^.State %d, KeyCode %d, VirtualKey %d, SysKey %d, Extended %d, CtrlDown %d', [Integer(Event^.KeyVal), Integer(Event^.State), Integer(KeyCode), Integer(VirtualKey), Integer(SysKey), Integer(Extended), Integer(CtrlDown)]));
|
||||
end;
|
||||
|
||||
@ -730,6 +740,9 @@ end;
|
||||
{ =============================================================================
|
||||
|
||||
$Log$
|
||||
Revision 1.17 2001/06/20 13:35:51 lazarus
|
||||
MG: added VK_IRREGULAR and key grabbing
|
||||
|
||||
Revision 1.16 2001/06/16 09:14:39 lazarus
|
||||
MG: added lazqueue and used it for the messagequeue
|
||||
|
||||
|
||||
@ -314,6 +314,12 @@ PM_Remove = 1;
|
||||
VK_NUMLOCK = 144;
|
||||
VK_SCROLL = 145;
|
||||
|
||||
// not in VCL defined:
|
||||
VK_EQUAL = 187;
|
||||
VK_COMMA = 188;
|
||||
VK_POINT = 190;
|
||||
VK_SLASH = 191;
|
||||
|
||||
|
||||
// VK_L & VK_R - left and right Alt, Ctrl and Shift virtual keys.
|
||||
// Used only as parameters to GetAsyncKeyState() and GetKeyState().
|
||||
@ -335,7 +341,9 @@ PM_Remove = 1;
|
||||
VK_PA1 = 253;
|
||||
VK_OEM_CLEAR = 254;
|
||||
|
||||
|
||||
// all other keys with no virtial key code are mapped to
|
||||
// VK_IRREGULAR + KeyCode
|
||||
VK_IRREGULAR = 1000;
|
||||
|
||||
const
|
||||
|
||||
@ -1379,6 +1387,9 @@ end.
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.9 2001/06/20 13:35:51 lazarus
|
||||
MG: added VK_IRREGULAR and key grabbing
|
||||
|
||||
Revision 1.8 2001/06/15 10:31:06 lazarus
|
||||
MG: set longstrings as default
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user