mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-08-11 21:36:27 +02:00
IDE: implemented TCustomShortCutGrabBox
git-svn-id: trunk@15881 -
This commit is contained in:
mattias
parent
60e3f56061
commit
3aed0552c5
@ -38,7 +38,7 @@ uses
|
||||
Classes, SysUtils,
|
||||
// LCL
|
||||
Buttons, ComCtrls, Controls, Dialogs, ExtCtrls, Forms, Graphics,
|
||||
GraphType, LCLIntf, LCLProc, LCLType, LResources, StdCtrls,
|
||||
GraphType, LCLIntf, LCLProc, LCLType, LResources, StdCtrls, Spin,
|
||||
// synedit
|
||||
SynEdit, SynEditAutoComplete, SynEditHighlighter, SynEditKeyCmds,
|
||||
SynEditStrConst,
|
||||
@ -52,7 +52,7 @@ uses
|
||||
IDECommands, IDEWindowIntf, SrcEditorIntf,
|
||||
// IDE
|
||||
LazarusIDEStrConsts, IDEOptionDefs, IDEProcs, InputHistory, KeyMapping,
|
||||
KeymapSchemeDlg, LazConf, Spin;
|
||||
KeymapSchemeDlg, LazConf;
|
||||
|
||||
type
|
||||
|
||||
|
||||
@ -34,7 +34,7 @@ interface
|
||||
uses
|
||||
LCLIntf, LCLType, LCLProc,
|
||||
Forms, Classes, SysUtils, Buttons, LResources, StdCtrls, Controls,
|
||||
Dialogs, StringHashList,
|
||||
Dialogs, StringHashList, ExtCtrls,
|
||||
SynEditKeyCmds, Laz_XMLCfg,
|
||||
LazarusIDEStrConsts, IDECommands;
|
||||
|
||||
@ -137,6 +137,105 @@ type
|
||||
property RelationCount:integer read GetRelationCount;
|
||||
end;
|
||||
|
||||
|
||||
{ TCustomShortCutGrabBox }
|
||||
|
||||
TCustomShortCutGrabBox = class(TCustomPanel)
|
||||
private
|
||||
FAllowedShifts: TShiftState;
|
||||
FGrabButton: TButton;
|
||||
FKey: Word;
|
||||
FKeyComboBox: TComboBox;
|
||||
FShiftButtons: TShiftState;
|
||||
FShiftState: TShiftState;
|
||||
FCheckBoxes: array[TShiftStateEnum] of TCheckBox;
|
||||
FGrabForm: TForm;
|
||||
function GetShiftCheckBox(Shift: TShiftStateEnum): TCheckBox;
|
||||
procedure SetAllowedShifts(const AValue: TShiftState);
|
||||
procedure SetKey(const AValue: Word);
|
||||
procedure SetShiftButtons(const AValue: TShiftState);
|
||||
procedure SetShiftState(const AValue: TShiftState);
|
||||
procedure OnGrabButtonClick(Sender: TObject);
|
||||
procedure OnShitCheckBoxClick(Sender: TObject);
|
||||
procedure OnGrabFormKeyDown(Sender: TObject; var AKey: Word;
|
||||
AShift: TShiftState);
|
||||
procedure OnKeyComboboxEditingDone(Sender: TObject);
|
||||
protected
|
||||
procedure Loaded; override;
|
||||
procedure UpdateShiftButons;
|
||||
procedure Notification(AComponent: TComponent; Operation: TOperation);
|
||||
override;
|
||||
function ShiftToStr(s: TShiftStateEnum): string;
|
||||
public
|
||||
constructor Create(TheOwner: TComponent); override;
|
||||
function GetDefaultShiftButtons: TShiftState;
|
||||
property ShiftState: TShiftState read FShiftState write SetShiftState;
|
||||
property Key: Word read FKey write SetKey;
|
||||
property ShiftButtons: TShiftState read FShiftButtons write SetShiftButtons;
|
||||
property AllowedShifts: TShiftState read FAllowedShifts write SetAllowedShifts;
|
||||
property KeyComboBox: TComboBox read FKeyComboBox;
|
||||
property GrabButton: TButton read FGrabButton;
|
||||
property ShiftCheckBox[Shift: TShiftStateEnum]: TCheckBox read GetShiftCheckBox;
|
||||
end;
|
||||
|
||||
{ TShortCutGrabBox }
|
||||
|
||||
TShortCutGrabBox = class(TCustomShortCutGrabBox)
|
||||
published
|
||||
property Align;
|
||||
property Alignment;
|
||||
property Anchors;
|
||||
property AutoSize;
|
||||
property BorderSpacing;
|
||||
property BevelInner;
|
||||
property BevelOuter;
|
||||
property BevelWidth;
|
||||
property BorderWidth;
|
||||
property BorderStyle;
|
||||
property Caption;
|
||||
property ChildSizing;
|
||||
property ClientHeight;
|
||||
property ClientWidth;
|
||||
property Color;
|
||||
property Constraints;
|
||||
property DockSite;
|
||||
property DragCursor;
|
||||
property DragKind;
|
||||
property DragMode;
|
||||
property Enabled;
|
||||
property Font;
|
||||
property FullRepaint;
|
||||
property ParentColor;
|
||||
property ParentFont;
|
||||
property ParentShowHint;
|
||||
property PopupMenu;
|
||||
property ShowHint;
|
||||
property TabOrder;
|
||||
property TabStop;
|
||||
property UseDockManager default True;
|
||||
property Visible;
|
||||
property OnClick;
|
||||
property OnDockDrop;
|
||||
property OnDockOver;
|
||||
property OnDblClick;
|
||||
property OnDragDrop;
|
||||
property OnDragOver;
|
||||
property OnEndDock;
|
||||
property OnEndDrag;
|
||||
property OnEnter;
|
||||
property OnExit;
|
||||
property OnGetSiteInfo;
|
||||
property OnGetDockCaption;
|
||||
property OnMouseDown;
|
||||
property OnMouseMove;
|
||||
property OnMouseUp;
|
||||
property OnResize;
|
||||
property OnStartDock;
|
||||
property OnStartDrag;
|
||||
property OnUnDock;
|
||||
end;
|
||||
|
||||
|
||||
TKMEditFormMode = (
|
||||
kmefmEdit,
|
||||
kmefmGrab
|
||||
@ -1910,6 +2009,7 @@ begin
|
||||
end;
|
||||
end; // for k
|
||||
end; // for j
|
||||
|
||||
end;
|
||||
GrabbingKey := 0;
|
||||
end;
|
||||
@ -3268,6 +3368,239 @@ end;
|
||||
|
||||
|
||||
//------------------------------------------------------------------------------
|
||||
|
||||
{ TCustomShortCutGrabBox }
|
||||
|
||||
procedure TCustomShortCutGrabBox.SetKey(const AValue: Word);
|
||||
begin
|
||||
if FKey=AValue then exit;
|
||||
FKey:=AValue;
|
||||
FKeyComboBox.Text:=KeyAndShiftStateToEditorKeyString(Key,[]);
|
||||
end;
|
||||
|
||||
procedure TCustomShortCutGrabBox.OnGrabButtonClick(Sender: TObject);
|
||||
begin
|
||||
FGrabForm:=TForm.Create(Self);
|
||||
FGrabForm.KeyPreview:=true;
|
||||
FGrabForm.Position:=poDesktopCenter;
|
||||
FGrabForm.OnKeyDown:=@OnGrabFormKeyDown;
|
||||
FGrabForm.Caption:='Press a key ...';
|
||||
with TLabel.Create(Self) do begin
|
||||
Caption:='Press a key ...';
|
||||
BorderSpacing.Around:=25;
|
||||
Parent:=FGrabForm;
|
||||
end;
|
||||
FGrabForm.AutoSize:=true;
|
||||
FGrabForm.ShowModal;
|
||||
FreeThenNil(FGrabForm);
|
||||
end;
|
||||
|
||||
procedure TCustomShortCutGrabBox.OnShitCheckBoxClick(Sender: TObject);
|
||||
var
|
||||
s: TShiftStateEnum;
|
||||
begin
|
||||
for s:=Low(TShiftStateEnum) to High(TShiftStateEnum) do
|
||||
if FCheckBoxes[s]=Sender then
|
||||
if FCheckBoxes[s].Checked then
|
||||
Include(FShiftState,s)
|
||||
else
|
||||
Exclude(FShiftState,s);
|
||||
end;
|
||||
|
||||
procedure TCustomShortCutGrabBox.OnGrabFormKeyDown(Sender: TObject;
|
||||
var AKey: Word; AShift: TShiftState);
|
||||
begin
|
||||
//DebugLn(['TCustomShortCutGrabBox.OnGrabFormKeyDown ',AKey,' ',dbgs(AShift)]);
|
||||
if not (AKey in [VK_CONTROL, VK_LCONTROL, VK_RCONTROL,
|
||||
VK_SHIFT, VK_LSHIFT, VK_RSHIFT,
|
||||
VK_MENU, VK_LMENU, VK_RMENU,
|
||||
VK_UNKNOWN, VK_UNDEFINED])
|
||||
then begin
|
||||
Key:=AKey;
|
||||
ShiftState:=AShift;
|
||||
FGrabForm.ModalResult:=mrOk;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TCustomShortCutGrabBox.OnKeyComboboxEditingDone(Sender: TObject);
|
||||
begin
|
||||
Key:=EditorKeyStringToVKCode(KeyComboBox.Text);
|
||||
end;
|
||||
|
||||
function TCustomShortCutGrabBox.GetShiftCheckBox(Shift: TShiftStateEnum
|
||||
): TCheckBox;
|
||||
begin
|
||||
Result:=FCheckBoxes[Shift];
|
||||
end;
|
||||
|
||||
procedure TCustomShortCutGrabBox.SetAllowedShifts(const AValue: TShiftState);
|
||||
begin
|
||||
if FAllowedShifts=AValue then exit;
|
||||
FAllowedShifts:=AValue;
|
||||
ShiftState:=ShiftState*FAllowedShifts;
|
||||
end;
|
||||
|
||||
procedure TCustomShortCutGrabBox.SetShiftButtons(const AValue: TShiftState);
|
||||
begin
|
||||
if FShiftButtons=AValue then exit;
|
||||
FShiftButtons:=AValue;
|
||||
UpdateShiftButons;
|
||||
end;
|
||||
|
||||
procedure TCustomShortCutGrabBox.SetShiftState(const AValue: TShiftState);
|
||||
var
|
||||
s: TShiftStateEnum;
|
||||
begin
|
||||
if FShiftState=AValue then exit;
|
||||
FShiftState:=AValue;
|
||||
for s:=low(TShiftStateEnum) to High(TShiftStateEnum) do
|
||||
if FCheckBoxes[s]<>nil then
|
||||
FCheckBoxes[s].Checked:=s in FShiftState;
|
||||
end;
|
||||
|
||||
procedure TCustomShortCutGrabBox.Loaded;
|
||||
begin
|
||||
inherited Loaded;
|
||||
UpdateShiftButons;
|
||||
end;
|
||||
|
||||
procedure TCustomShortCutGrabBox.UpdateShiftButons;
|
||||
var
|
||||
s: TShiftStateEnum;
|
||||
LastCheckBox: TCheckBox;
|
||||
begin
|
||||
if [csLoading,csDestroying]*ComponentState<>[] then exit;
|
||||
LastCheckBox:=nil;
|
||||
DisableAlign;
|
||||
try
|
||||
for s:=low(TShiftStateEnum) to High(TShiftStateEnum) do begin
|
||||
if s in FShiftButtons then begin
|
||||
if FCheckBoxes[s]=nil then begin
|
||||
FCheckBoxes[s]:=TCheckBox.Create(Self);
|
||||
with FCheckBoxes[s] do begin
|
||||
Name:='CheckBox'+ShiftToStr(s);
|
||||
Caption:=ShiftToStr(s);
|
||||
AutoSize:=true;
|
||||
Checked:=s in FShiftState;
|
||||
if LastCheckBox<>nil then
|
||||
AnchorToNeighbour(akLeft,6,LastCheckBox)
|
||||
else
|
||||
AnchorParallel(akLeft,0,Self);
|
||||
AnchorParallel(akTop,0,Self);
|
||||
AnchorParallel(akBottom,0,Self);
|
||||
Parent:=Self;
|
||||
OnClick:=@OnShitCheckBoxClick;
|
||||
end;
|
||||
end;
|
||||
LastCheckBox:=FCheckBoxes[s];
|
||||
end else begin
|
||||
FreeThenNil(FCheckBoxes[s]);
|
||||
end;
|
||||
end;
|
||||
if LastCheckBox<>nil then
|
||||
FKeyComboBox.AnchorToNeighbour(akLeft,6,LastCheckBox)
|
||||
else
|
||||
FKeyComboBox.AnchorParallel(akLeft,0,Self);
|
||||
finally
|
||||
EnableAlign;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TCustomShortCutGrabBox.Notification(AComponent: TComponent;
|
||||
Operation: TOperation);
|
||||
var
|
||||
s: TShiftStateEnum;
|
||||
begin
|
||||
inherited Notification(AComponent, Operation);
|
||||
if Operation=opRemove then begin
|
||||
if AComponent=FGrabButton then
|
||||
FGrabButton:=nil;
|
||||
if AComponent=FKeyComboBox then
|
||||
FKeyComboBox:=nil;
|
||||
if AComponent=FGrabForm then
|
||||
FGrabForm:=nil;
|
||||
for s:=Low(TShiftStateEnum) to High(TShiftStateEnum) do
|
||||
if FCheckBoxes[s]=AComponent then begin
|
||||
FCheckBoxes[s]:=nil;
|
||||
Exclude(FShiftButtons,s);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TCustomShortCutGrabBox.ShiftToStr(s: TShiftStateEnum): string;
|
||||
begin
|
||||
case s of
|
||||
ssShift: Result:='Shift';
|
||||
ssAlt: Result:='Alt';
|
||||
ssCtrl: Result:='Ctrl';
|
||||
ssMeta: Result:='Meta';
|
||||
ssSuper: Result:='Super';
|
||||
ssHyper: {$IFDEF Darwin}
|
||||
Result:='Cmd';
|
||||
{$ELSE}
|
||||
Result:='Hyper';
|
||||
{$ENDIF}
|
||||
ssAltGr: Result:='AltGr';
|
||||
ssCaps: Result:='Caps';
|
||||
ssNum: Result:='Numlock';
|
||||
ssScroll: Result:='Scroll';
|
||||
else Result:='Modifier'+IntToStr(ord(s));
|
||||
end;
|
||||
end;
|
||||
|
||||
constructor TCustomShortCutGrabBox.Create(TheOwner: TComponent);
|
||||
var
|
||||
i: Integer;
|
||||
s: String;
|
||||
begin
|
||||
inherited Create(TheOwner);
|
||||
|
||||
FAllowedShifts:=[ssShift, ssAlt, ssCtrl,
|
||||
ssMeta, ssSuper, ssHyper, ssAltGr,
|
||||
ssCaps, ssNum, ssScroll];
|
||||
|
||||
FGrabButton:=TButton.Create(Self);
|
||||
with FGrabButton do begin
|
||||
Name:='GrabButton';
|
||||
Caption:='Grab key';
|
||||
Align:=alRight;
|
||||
AutoSize:=true;
|
||||
Parent:=Self;
|
||||
OnClick:=@OnGrabButtonClick;
|
||||
end;
|
||||
|
||||
FKeyComboBox:=TComboBox.Create(Self);
|
||||
with FKeyComboBox do begin
|
||||
Name:='FKeyComboBox';
|
||||
AutoSize:=true;
|
||||
Items.BeginUpdate;
|
||||
for i:=1 to 145 do begin
|
||||
s := KeyAndShiftStateToEditorKeyString(i, []);
|
||||
if not EditorKeyStringIsIrregular(s) then
|
||||
Items.Add(s);
|
||||
end;
|
||||
Items.EndUpdate;
|
||||
OnEditingDone:=@OnKeyComboboxEditingDone;
|
||||
Parent:=Self;
|
||||
AnchorToNeighbour(akRight,6,FGrabButton);
|
||||
AnchorVerticalCenterTo(FGrabButton);
|
||||
end;
|
||||
|
||||
ShiftButtons:=GetDefaultShiftButtons;
|
||||
ShiftState:=[];
|
||||
Key:=VK_UNKNOWN;
|
||||
KeyComboBox.Text:=KeyAndShiftStateToEditorKeyString(Key,[]);
|
||||
end;
|
||||
|
||||
function TCustomShortCutGrabBox.GetDefaultShiftButtons: TShiftState;
|
||||
begin
|
||||
{$IFDEF Darwin}
|
||||
Result:=[ssCtrl,ssShift,ssAlt,ssHyper];
|
||||
{$ELSE}
|
||||
Result:=[ssCtrl,ssShift,ssAlt];
|
||||
{$ENDIF}
|
||||
end;
|
||||
|
||||
initialization
|
||||
KeyMappingEditForm:=nil;
|
||||
|
||||
|
||||
@ -35,6 +35,9 @@ uses
|
||||
ExtCtrls, Buttons, LazarusIDEStrConsts;
|
||||
|
||||
type
|
||||
|
||||
{ TChooseKeySchemeDlg }
|
||||
|
||||
TChooseKeySchemeDlg = class(TForm)
|
||||
OkButton: TBUTTON;
|
||||
CancelButton: TBUTTON;
|
||||
|
||||
Loading…
Reference in New Issue
Block a user