paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-11-10 01:41:35 +01:00
Code Issues Packages Projects Releases Wiki Activity

IDEIntf: moved IDE key grabbing to propedits, added button to TShortCutPropertyEditor

Browse Source 
git-svn-id: trunk@16136 -
This commit is contained in:
mattias 2008-08-19 02:57:17 +00:00
parent 903f90de7a
commit e374b51dd5
20 changed files with 658 additions and 610 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
components/codetools/codetoolsstrconsts.pas
View File

@ -55,6 +55,7 @@ ResourceString
ctsStrExpectedButAtomFound = '%s expected, but %s found';
ctsPositionNotInSource = 'Position not in source';
ctsInvalidClassName = 'invalid class name=%s%s%s';
ctsSourceOfUnitNotFound = 'source of unit not found: %s';
ctsclassNotFound = 'class %s%s%s not found';
ctsinvalidClassName2 = 'invalid class name %s%s%s';
ctsinvalidVariableName = 'invalid variable name %s%s%s';

4
components/codetools/stdcodetools.pas
View File

@ -3056,6 +3056,10 @@ function TStandardCodeTool.GatherResourceStringSections(
//DebugLn('TStandardCodeTool.GatherResourceStringSections Uses ',GetAtom(UnitNameAtom));
// open the unit
NewCodeTool:=OpenCodeToolForUnit(UnitNameAtom,InAtom,false);
if NewCodeTool=nil then begin
MoveCursorToAtomPos(UnitNameAtom);
RaiseException(Format(ctsSourceOfUnitNotFound, [GetAtom]));
end;
NewCodeTool.BuildTree(true);
// search all resource string sections in the interface
ANode:=NewCodeTool.FindInterfaceNode;

2
ide/cleandirdlg.pas
View File

@ -137,7 +137,7 @@ begin
KeepTextFilesCheckbox.Caption:=lisClDirKeepAllTextFiles;
OkButton.Caption:=lisLazBuildOk;
CancelButton.Caption:=dlgCancel;
HelpButton.Caption:=srVK_HELP;
HelpButton.Caption:=lisPckEditHelp;
end;
procedure TCleanDirectoryDialog.HelpButtonClick(Sender: TObject);

2
ide/codetoolsdefines.pas
View File

@ -1111,7 +1111,7 @@ begin
MoveFilePathUpBitBtn.Caption:=dlgUpWord;
MoveFilePathDownBitBtn.Caption:=dlgDownWord;
DeleteFilePathBitBtn.Caption:=dlgEdDelete;
InsertFilePathBitBtn.Caption:=srVK_INSERT;
InsertFilePathBitBtn.Caption:=lisEdtExtToolInsert;
end;
function TCodeToolsDefinesEditor.CreateSeperator : TMenuItem;

2
ide/compileroptionsdlg.pp
View File

@ -1560,7 +1560,7 @@ begin
btnCheck.Caption := lisCompTest;
btnLoadSave.Hint := dlgCOLoadSave;
btnLoadSave.Caption := '...';
HelpButton.Caption:=srVK_HELP;
HelpButton.Caption:=lisPckEditHelp;
end;
function TfrmCompilerOptions.CheckSearchPath(const Context,

2
ide/condef.pas
View File

@ -171,7 +171,7 @@ begin
AddBtn.Caption := liswlAdd;
AddInverse.Caption := rsAddInverse;
RemoveBtn.Caption := rsRemove;
OkBtn.Caption := srVK_INSERT;
OkBtn.Caption := 'Insert';
CancelButton.Caption := dlgCancel;
try

2
ide/extractprocdlg.pas
View File

@ -149,7 +149,7 @@ begin
NameEdit.Text:=MiscellaneousOptions.ExtractProcName;
MissingIdentifiersGroupBox.Caption:=lisMissingIdentifiers;
HelpButton.Caption:=srVK_HELP;
HelpButton.Caption:=lisPckEditHelp;
OkButton.Caption:=lisExtract;
CancelButton.Caption:=dlgCancel;
end;

2
ide/exttooleditdlg.pas
View File

@ -45,7 +45,7 @@ uses
Classes, SysUtils, LCLType, Controls, Forms, Buttons, StdCtrls, ComCtrls,
Dialogs, LResources, ExtCtrls, LCLProc,
IDEMsgIntf, IDEExternToolIntf,
KeyMapping, KeyMapShortCutDlg, TransferMacros, LazarusIDEStrConsts,
PropEdits, KeyMapShortCutDlg, TransferMacros, LazarusIDEStrConsts,
EditMsgScannersDlg;
type

21
ide/fpdocselectlink.pas
View File

@ -31,7 +31,7 @@ interface
uses
Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, ExtCtrls,
StdCtrls, ButtonPanel;
StdCtrls, ButtonPanel, LazarusIDEStrConsts;
type
@ -74,17 +74,14 @@ end;
procedure TFPDocLinkEditorDlg.FormCreate(Sender: TObject);
begin
Caption:='Choose a FPDoc link';
LinkLabel.Caption:='Link target';
LinkLabel.Hint:='Examples:'#13
+'Identifier'#13
+'TMyEnum.Enum'#13
+'Unitname.Identifier'#13
+'#PackageName.UnitName.Identifier';
TitleLabel.Caption:='Title (leave empty for default)';
ButtonPanel1.OKButton.Caption:='Ok';
ButtonPanel1.CancelButton.Caption:='Cancel';
ButtonPanel1.HelpButton.Caption:='Help';
Caption:=lisChooseAFPDocLink;
LinkLabel.Caption:=lisLinkTarget;
LinkLabel.Hint:=Format(lisExamplesIdentifierTMyEnumEnumUnitnameIdentifierPac,
[#13, #13, #13, #13]);
TitleLabel.Caption:=lisTitleLeaveEmptyForDefault;
ButtonPanel1.OKButton.Caption:=lisOkBtn;
ButtonPanel1.CancelButton.Caption:=dlgCancel;
ButtonPanel1.HelpButton.Caption:=lisPckEditHelp;
LinkEdit.Text:='';
TitleEdit.Text:='';

2
ide/helpoptions.pas
View File

@ -141,7 +141,7 @@ begin
Caption:=lisHlpOptsHelpOptions;
OkButton.Caption:=lisLazBuildOk;
CancelButton.Caption:=dlgCancel;
HelpButton.Caption:=srVK_HELP;
HelpButton.Caption:=lisPckEditHelp;
GeneralPage.Caption:=lisMenuInsertGeneral;
FPCDocHTMLLabel.Caption:=lisHOFPCDocHTMLPath;
ViewersPage.Caption:=lisHlpOptsViewers;

186
ide/keymapping.pp
View File

@ -36,7 +36,7 @@ uses
Forms, Classes, SysUtils, Buttons, LResources, StdCtrls, Controls,
Dialogs, StringHashList, ExtCtrls,
SynEditKeyCmds, Laz_XMLCfg,
IDECommands, LazarusIDEStrConsts;
PropEdits, IDECommands, LazarusIDEStrConsts;
type
TKeyMapScheme = (
@ -137,15 +137,12 @@ type
property RelationCount:integer read GetRelationCount;
end;
function KeyAndShiftStateToEditorKeyString(
Key: word; ShiftState: TShiftState): String;
function KeyAndShiftStateToEditorKeyString(const Key: TIDEShortCut): String;
function FindKeymapConflicts(Keymap: TKeyCommandRelationList;
Protocol: TStrings; out Index1, Index2: integer): integer;
function EditorCommandToDescriptionString(cmd: word): String;
function EditorCommandLocalizedName(cmd: word;
const DefaultName: string): string;
function EditorKeyStringToVKCode(const s: string): word;
procedure GetDefaultKeyForCommand(Command: word;
out TheKeyA, TheKeyB: TIDEShortCut);
@ -157,11 +154,6 @@ function KeySchemeNameToSchemeType(const SchemeName: string): TKeyMapScheme;
function ShiftStateToStr(Shift: TShiftState): string;
function KeyValuesToStr(const ShortcutA, ShortcutB: TIDEShortCut): string;
function EditorKeyStringIsIrregular(const s: string): boolean;
const
UnknownVKPrefix = 'Word(''';
UnknownVKPostfix = ''')';
implementation
@ -169,8 +161,6 @@ implementation
const
KeyMappingFormatVersion = 5;
VirtualKeyStrings: TStringHashList = nil;
function EditorCommandLocalizedName(cmd: word;
const DefaultName: string): string;
begin
@ -179,30 +169,6 @@ begin
Result:=DefaultName;
end;
function EditorKeyStringToVKCode(const s: string): word;
var
i: PtrInt;
Data: Pointer;
begin
Result:=VK_UNKNOWN;
//debugln('EditorKeyStringToVKCode A "',s,'"');
if EditorKeyStringIsIrregular(s) then begin
Result:=word(StrToIntDef(copy(s,7,length(s)-8),VK_UNKNOWN));
exit;
end;
if (s<>'none') and (s<>'') then begin
if VirtualKeyStrings=nil then begin
VirtualKeyStrings:=TStringHashList.Create(true);
for i:=1 to 300 do
VirtualKeyStrings.Add(KeyAndShiftStateToEditorKeyString(word(i),[]), Pointer(i));
end;
end else
exit;
Data:=VirtualKeyStrings.Data[s];
if Data<>nil then
Result:=word(PtrUInt(Data));
end;
procedure GetDefaultKeyForCommand(Command: word;
out TheKeyA, TheKeyB: TIDEShortCut);
@ -1392,22 +1358,12 @@ begin
IntToStr(ShortcutB.Key2) + ',' + ShiftStateToStr(ShortcutB.Shift2);
end;
function EditorKeyStringIsIrregular(const s: string): boolean;
begin
if (length(UnknownVKPrefix)<length(s))
and (AnsiStrLComp(PChar(s),PChar(UnknownVKPrefix),length(UnknownVKPrefix))=0)
then
Result:=true
else
Result:=false;
end;
function EditorCommandToDescriptionString(cmd: word): String;
begin
case cmd of
ecNone : Result:= dlgEnvNone;
ecLeft : Result:= srvk_left;
ecRight : Result:= srvk_right;
ecLeft : Result:= lisLeft;
ecRight : Result:= lisRight;
ecUp : Result:= dlgUpWord;
ecDown : Result:= dlgDownWord;
ecWordLeft : Result:= srkmecWordLeft;
@ -1467,7 +1423,7 @@ begin
ecToggleMode : Result:= srkmecToggleMode;
ecBlockIndent : Result:= srkmecBlockIndent;
ecBlockUnindent : Result:= srkmecBlockUnindent;
ecTab : Result:= srVK_TAB;
ecTab : Result:= lisTab;
ecShiftTab : Result:= srkmecShiftTab;
ecMatchBracket : Result:= srkmecMatchBracket;
ecNormalSelect : Result:= srkmecNormalSelect;
@ -1767,134 +1723,11 @@ begin
end;
end;
function KeyAndShiftStateToEditorKeyString(
Key: word; ShiftState: TShiftState): string;
var
p: integer;
procedure AddStr(const s: string);
begin
if s <> '' then
begin
inc(p);
Result := Result + s;
end;
end;
procedure AddAttribute(const s: string);
begin
if p > 0 then
AddStr('+');
AddStr(s);
end;
procedure AddAttributes;
begin
if ssCtrl in ShiftState then AddAttribute(srkm_Ctrl);
if ssAlt in ShiftState then AddAttribute(srkm_Alt);
if ssShift in ShiftState then AddAttribute(srVK_SHIFT);
if ssMeta in ShiftState then
{$IFDEF LCLcarbon}
AddAttribute(srVK_CMD);
{$ELSE}
AddAttribute(srVK_SHIFT);
{$ENDIF}
if ssSuper in ShiftState then AddAttribute(srVK_SUPER);
end;
// Tricky routine. This only works for western languages
// TODO: This should be replaces by the winapi VKtoChar functions
//
procedure AddKey;
begin
if p>0 then AddStr(' ');
case Key of
VK_UNKNOWN :AddStr(srVK_UNKNOWN);
VK_LBUTTON :AddStr(srVK_LBUTTON);
VK_RBUTTON :AddStr(srVK_RBUTTON);
VK_CANCEL :AddStr(dlgCancel);
VK_MBUTTON :AddStr(srVK_MBUTTON);
VK_BACK :AddStr(srVK_BACK);
VK_TAB :AddStr(srVK_TAB);
VK_CLEAR :AddStr(srVK_CLEAR);
VK_RETURN :AddStr(srVK_RETURN);
VK_SHIFT :AddStr(srVK_SHIFT);
VK_CONTROL :AddStr(srVK_CONTROL);
VK_MENU :AddStr(srVK_MENU);
VK_PAUSE :AddStr(srVK_PAUSE);
VK_CAPITAL :AddStr(srVK_CAPITAL);
VK_KANA :AddStr(srVK_KANA);
// VK_HANGUL :AddStr('Hangul');
VK_JUNJA :AddStr(srVK_JUNJA);
VK_FINAL :AddStr(srVK_FINAL);
VK_HANJA :AddStr(srVK_HANJA );
// VK_KANJI :AddStr('Kanji');
VK_ESCAPE :AddStr(srVK_ESCAPE);
VK_CONVERT :AddStr(srVK_CONVERT);
VK_NONCONVERT :AddStr(srVK_NONCONVERT);
VK_ACCEPT :AddStr(srVK_ACCEPT);
VK_MODECHANGE :AddStr(srVK_MODECHANGE);
VK_SPACE :AddStr(srVK_SPACE);
VK_PRIOR :AddStr(srVK_PRIOR);
VK_NEXT :AddStr(srVK_NEXT);
VK_END :AddStr(srVK_END);
VK_HOME :AddStr(srVK_HOME);
VK_LEFT :AddStr(srVK_LEFT);
VK_UP :AddStr(srVK_UP);
VK_RIGHT :AddStr(srVK_RIGHT);
VK_DOWN :AddStr(dlgdownword);
VK_SELECT :AddStr(lismenuselect);
VK_PRINT :AddStr(srVK_PRINT);
VK_EXECUTE :AddStr(srVK_EXECUTE);
VK_SNAPSHOT :AddStr(srVK_SNAPSHOT);
VK_INSERT :AddStr(srVK_INSERT);
VK_DELETE :AddStr(dlgeddelete);
VK_HELP :AddStr(srVK_HELP);
VK_0..VK_9 :AddStr(IntToStr(Key-VK_0));
VK_A..VK_Z :AddStr(chr(ord('A')+Key-VK_A));
VK_LWIN :AddStr(srVK_LWIN);
VK_RWIN :AddStr(srVK_RWIN);
VK_APPS :AddStr(srVK_APPS);
VK_NUMPAD0..VK_NUMPAD9: AddStr(Format(srVK_NUMPAD,[Key-VK_NUMPAD0]));
VK_MULTIPLY :AddStr('*');
VK_ADD :AddStr('+');
VK_SEPARATOR :AddStr('|');
VK_SUBTRACT :AddStr('-');
VK_DECIMAL :AddStr('.');
VK_DIVIDE :AddStr('/');
VK_F1..VK_F24 : AddStr('F'+IntToStr(Key-VK_F1+1));
VK_NUMLOCK :AddStr(srVK_NUMLOCK);
VK_SCROLL :AddStr(srVK_SCROLL);
// VK_EQUAL :AddStr('=');
// VK_COMMA :AddStr(',');
// VK_POINT :AddStr('.');
// VK_SLASH :AddStr('/');
// VK_AT :AddStr('@');
else
AddStr(UnknownVKPrefix);
AddStr(IntToStr(Key));
AddStr(UnknownVKPostfix);
end;
end;
procedure AddAttributesAndKey;
begin
AddAttributes;
AddKey;
end;
begin
Result := '';
p := 0;
AddAttributesAndKey;
end;
function KeyAndShiftStateToEditorKeyString(const Key: TIDEShortCut): String;
begin
Result := KeyAndShiftStateToEditorKeyString(Key.Key1, Key.Shift1);
Result := KeyAndShiftStateToKeyString(Key.Key1, Key.Shift1);
if (Key.Key2<>VK_UNKNOWN) then
Result := Result + ', ' + KeyAndShiftStateToEditorKeyString(Key.Key2, Key.Shift2);
Result := Result + ', ' + KeyAndShiftStateToKeyString(Key.Key2, Key.Shift2);
end;
{ TKeyCommandRelation }
@ -2979,12 +2812,5 @@ begin
FScope:=TheScope;
end;
//------------------------------------------------------------------------------
finalization
VirtualKeyStrings.Free;
VirtualKeyStrings:=nil;
end.

346
ide/keymapshortcutdlg.pas
View File

@ -33,110 +33,10 @@ interface
uses
Classes, SysUtils, LResources, LCLProc, Forms, Controls, Graphics, Dialogs,
ExtCtrls, StdCtrls, LCLType,
IDECommands, IDEWindowIntf,
PropEdits, IDECommands, IDEWindowIntf,
KeyMapping, LazarusIDEStrConsts;
type
{ 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 AllowedShifts;
property Anchors;
property AutoSize;
property BevelInner;
property BevelOuter;
property BevelWidth;
property BorderSpacing;
property BorderStyle;
property BorderWidth;
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 Key;
property OnClick;
property OnDblClick;
property OnDockDrop;
property OnDockOver;
property OnDragDrop;
property OnDragOver;
property OnEndDock;
property OnEndDrag;
property OnEnter;
property OnExit;
property OnGetDockCaption;
property OnGetSiteInfo;
property OnMouseDown;
property OnMouseMove;
property OnMouseUp;
property OnResize;
property OnStartDock;
property OnStartDrag;
property OnUnDock;
property ParentColor;
property ParentFont;
property ParentShowHint;
property PopupMenu;
property ShiftButtons;
property ShiftState;
property ShowHint;
property TabOrder;
property TabStop;
property UseDockManager default True;
property Visible;
end;
{ TShortCutDialog }
@ -223,250 +123,6 @@ begin
end;
end;
{ TCustomShortCutGrabBox }
procedure TCustomShortCutGrabBox.SetKey(const AValue: Word);
var
s: String;
i: LongInt;
begin
if FKey=AValue then exit;
FKey:=AValue;
s:=KeyAndShiftStateToEditorKeyString(FKey,[]);
i:=KeyComboBox.Items.IndexOf(s);
if i>=0 then
KeyComboBox.ItemIndex:=i
else if EditorKeyStringIsIrregular(s) then begin
KeyComboBox.Items.Add(s);
KeyComboBox.ItemIndex:=KeyComboBox.Items.IndexOf(s);
end else
KeyComboBox.ItemIndex:=0;
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;
FreeAndNil(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_LWIN, VK_RWIN,
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
FreeAndNil(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:=srkmGrabKey;
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;
BevelOuter:=bvNone;
ShiftButtons:=GetDefaultShiftButtons;
ShiftState:=[];
Key:=VK_UNKNOWN;
KeyComboBox.Text:=KeyAndShiftStateToEditorKeyString(Key,[]);
end;
function TCustomShortCutGrabBox.GetDefaultShiftButtons: TShiftState;
begin
{$IFDEF Darwin}
Result:=[ssCtrl,ssShift,ssAlt,ssMeta];
{$ELSE}
Result:=[ssCtrl,ssShift,ssAlt];
{$ENDIF}
end;
{ TShortCutDialog }

69
ide/lazarusidestrconsts.pas
View File

@ -938,6 +938,7 @@ resourcestring
dlgProjFiles = 'Project files';
dlgEnvType = 'Type';
dlgEnvNone = 'None';
lisLeft = 'Left';
dlgSmbFront = 'Symbol in front (.~pp)';
lisNoBackupFiles = 'No backup files';
dlgSmbBehind = 'Symbol behind (.pp~)';
@ -1565,6 +1566,7 @@ resourcestring
lisFRForwardSearch = 'Forwar&d search';
lisFRBackwardSearch = '&Backward search';
dlgUpWord = 'Up';
lisRight = 'Right';
dlgDownWord = 'Down';
dlgReplaceAll = 'Replace &All';
@ -1778,6 +1780,7 @@ resourcestring
srkmecBlockIndent = 'Indent block';
srkmecBlockUnindent = 'Unindent block';
srkmecShiftTab = 'Shift Tab';
lisTab = 'Tab';
srkmecMatchBracket = 'Go to matching bracket';
srkmecNormalSelect = 'Normal selection mode';
srkmecColumnSelect = 'Column selection mode';
@ -1959,62 +1962,6 @@ resourcestring
// help menu
srkmecunknown = 'unknown editor command';
//Key strings
//TODO: remove, they are moved to IntfStrConsts
srVK_UNKNOWN = 'Unknown';
srVK_LBUTTON = 'Mouse Button Left';
srVK_RBUTTON = 'Mouse Button Right';
//srVK_CANCEL = 'Cancel'; = dlgCancel
srVK_MBUTTON = 'Mouse Button Middle';
srVK_BACK = 'Backspace';
srVK_TAB = 'Tab';
srVK_CLEAR = 'Clear';
srVK_RETURN = 'Return';
srVK_SHIFT = 'Shift';
srVK_CONTROL = 'Control';
srVK_SUPER = 'Super';
srVK_META = 'Meta';
srVK_CMD = 'Cmd';
srVK_MENU = 'Menu';
srVK_PAUSE = 'Pause key';
srVK_CAPITAL = 'Capital';
srVK_KANA = 'Kana';
srVK_JUNJA = 'Junja';
srVK_FINAL = 'Final';
srVK_HANJA = 'Hanja';
srVK_ESCAPE = 'Escape';
srVK_CONVERT = 'Convert';
srVK_NONCONVERT = 'Nonconvert';
srVK_ACCEPT = 'Accept';
srVK_MODECHANGE = 'Mode Change';
srVK_SPACE = 'Space key';
srVK_PRIOR = 'Prior';
srVK_NEXT = 'Next';
srVK_END = 'End';
srVK_HOME = 'Home';
srVK_LEFT = 'Left';
srVK_UP = 'Up';
srVK_RIGHT = 'Right';
//srVK_DOWN = 'Down'; = dlgdownword
//srVK_SELECT = 'Select'; = lismenuselect
srVK_PRINT = 'Print';
srVK_EXECUTE = 'Execute';
srVK_SNAPSHOT = 'Snapshot';
srVK_INSERT = 'Insert';
//srVK_DELETE = 'Delete'; dlgeddelete
srVK_HELP = 'Help';
lisMissingIdentifiers = 'Missing identifiers';
srVK_LWIN = 'left windows key';
srVK_RWIN = 'right windows key';
srVK_APPS = 'application key';
srVK_NUMPAD = 'Numpad %d';
srVK_NUMLOCK = 'Numlock';
srVK_SCROLL = 'Scroll';
srVK_IRREGULAR = 'Irregular ';
srVK_NONE = 'none';
srkm_Alt = 'Alt';
srkm_Ctrl = 'Ctrl';
// Category
srkmCatCursorMoving = 'Cursor moving commands';
srkmCatSelection = 'Text selection commands';
@ -2098,6 +2045,7 @@ resourcestring
dlgUnitDepCaption = 'Unit dependencies';
dlgUnitDepBrowse = 'Open';
dlgUnitDepRefresh = 'Refresh';
lisPrint = 'Print';
lisToDoGoto = 'Goto';
// Doc Editor
@ -3852,7 +3800,14 @@ resourcestring
lisTheUnitSearchPathOfContainsTheSourceDirectoryOfPac = 'The unit search '
+'path of %s%s%s contains the source directory %s%s%s of package %s';
lisFPCVersionEG222 = 'FPC Version (e.g. 2.2.2)';
lisMissingIdentifiers = 'Missing identifiers';
lisChooseAFPDocLink = 'Choose a FPDoc link';
lisLinkTarget = 'Link target';
lisExamplesIdentifierTMyEnumEnumUnitnameIdentifierPac = 'Examples:%'
+'sIdentifier%sTMyEnum.Enum%sUnitname.Identifier%s#PackageName.UnitName.'
+'Identifier';
lisTitleLeaveEmptyForDefault = 'Title (leave empty for default)';
implementation
end.

2
ide/makeresstrdlg.pas
View File

@ -304,7 +304,7 @@ begin
// ok+cancel buttons
OkButton.Caption:=lisLazBuildOk;
CancelButton.Caption:=dlgCancel;
HelpButton.Caption:=srVK_HELP;
HelpButton.Caption:=lisPckEditHelp;
end;
constructor TMakeResStrDialog.Create(TheOwner: TComponent);

4
ide/msgview.pp
View File

@ -229,7 +229,7 @@ begin
Path := MessagesMenuRoot.Name;
MsgQuickFixIDEMenuSection := RegisterIDEMenuSection(Path, 'Quick Fix');
MsgClearIDEMenuCommand :=
RegisterIDEMenuCommand(Path, 'Clear', srVK_CLEAR);
RegisterIDEMenuCommand(Path, 'Clear', lisUIDClear);
MsgCopyIDEMenuCommand := RegisterIDEMenuCommand(Path, 'Copy selected',
lisCopySelectedMessagesToClipboard);
MsgCopyAllIDEMenuCommand := RegisterIDEMenuCommand(Path, 'Copy all',
@ -238,7 +238,7 @@ begin
'Copy all, including hidden messages',
lisCopyAllAndHiddenMessagesToClipboard);
MsgHelpIDEMenuCommand := RegisterIDEMenuCommand(Path, 'Help',
srVK_HELP);
lisPckEditHelp);
MsgSaveAllToFileIDEMenuCommand :=
RegisterIDEMenuCommand(Path, 'Copy selected',
lisSaveAllMessagesToFile);

2
ide/newdialog.pas
View File

@ -345,7 +345,7 @@ begin
DescriptionLabel.Caption := '';
OkButton.Caption := lisLazBuildOk;
CancelButton.Caption := dlgCancel;
HelpButton.Caption := srVK_HELP;
HelpButton.Caption := lisPckEditHelp;
DefaultControl := OkButton;
CancelControl := CancelButton;
end;

2
ide/todolist.pas
View File

@ -388,7 +388,7 @@ begin
tbOptions.Hint := lisToDoListOptions;
tbOptions.Caption:=dlgFROpts;
tbPrint.Caption:=srVK_PRINT;
tbPrint.Caption:=lisPrint;
tbRefresh.Caption:=dlgUnitDepRefresh;
tbGoto.Caption:=lisToDoGoto;

2
ide/viewunit_dlg.pp
View File

@ -151,7 +151,7 @@ begin
IDEDialogLayoutList.ApplyLayout(Self,450,300);
btnOK.Caption := lisOkBtn;
btnCancel.Caption := dlgCancel;
HelpButton.Caption := srVK_HELP;
HelpButton.Caption := lisPckEditHelp;
MultiSelectCheckBox.Caption := dlgMultiSelect;
end;

57
ideintf/objinspstrconsts.pas
View File

@ -314,6 +314,8 @@ resourcestring
ois0Lines0Chars = '0 lines, 0 chars';
oisInvalidPropertyValue = 'Invalid property value';
oisNone = '(none)';
oisSelectShortCut = 'Select short cut';
srGrabKey = 'Grab key';
oisComponentNameIsNotAValidIdentifier = 'Component name %s%s%s is not a '
+'valid identifier';
oisLoadImageDialog = 'Load Image Dialog';
@ -362,6 +364,61 @@ resourcestring
peFilterName = 'Filter name';
peFilter = 'Filter';
//Key strings
srVK_UNKNOWN = 'Unknown';
srVK_LBUTTON = 'Mouse Button Left';
srVK_RBUTTON = 'Mouse Button Right';
//srVK_CANCEL = 'Cancel'; = dlgCancel
srVK_MBUTTON = 'Mouse Button Middle';
srVK_BACK = 'Backspace';
srVK_TAB = 'Tab';
srVK_CLEAR = 'Clear';
srVK_RETURN = 'Return';
srVK_SHIFT = 'Shift';
srVK_CONTROL = 'Control';
srVK_SUPER = 'Super';
srVK_META = 'Meta';
srVK_CMD = 'Cmd';
srVK_MENU = 'Menu';
srVK_PAUSE = 'Pause key';
srVK_CAPITAL = 'Capital';
srVK_KANA = 'Kana';
srVK_JUNJA = 'Junja';
srVK_FINAL = 'Final';
srVK_HANJA = 'Hanja';
srVK_ESCAPE = 'Escape';
srVK_CONVERT = 'Convert';
srVK_NONCONVERT = 'Nonconvert';
srVK_ACCEPT = 'Accept';
srVK_MODECHANGE = 'Mode Change';
srVK_SPACE = 'Space key';
srVK_PRIOR = 'Prior';
srVK_NEXT = 'Next';
srVK_END = 'End';
srVK_HOME = 'Home';
srVK_LEFT = 'Left';
srVK_UP = 'Up';
srVK_RIGHT = 'Right';
//srVK_DOWN = 'Down'; = dlgdownword
//srVK_SELECT = 'Select'; = lismenuselect
srVK_PRINT = 'Print';
srSelect = 'Select';
srVK_EXECUTE = 'Execute';
srVK_SNAPSHOT = 'Snapshot';
srVK_INSERT = 'Insert';
//srVK_DELETE = 'Delete'; dlgeddelete
srVK_HELP = 'Help';
srVK_LWIN = 'left windows key';
srVK_RWIN = 'right windows key';
srVK_APPS = 'application key';
srVK_NUMPAD = 'Numpad %d';
srVK_NUMLOCK = 'Numlock';
srVK_SCROLL = 'Scroll';
srVK_IRREGULAR = 'Irregular ';
srVK_NONE = 'none';
srkm_Alt = 'Alt';
srkm_Ctrl = 'Ctrl';
implementation
end.

558
ideintf/propedits.pp
View File

@ -35,7 +35,7 @@ interface
uses
Classes, TypInfo, SysUtils, LResources,
FPCAdds, // for StrToQWord in older fpc versions
LCLProc, Forms, Controls, GraphType,
LCLProc, Forms, Controls, GraphType, StringHashList, ButtonPanel,
Graphics, StdCtrls, Buttons, ComCtrls, Menus, LCLType, ExtCtrls, LCLIntf,
Dialogs, Grids, EditBtn, PropertyStorage, TextTools, FrmSelectProps,
StringsPropEditDlg, ColumnDlg, FileUtil, ObjInspStrConsts, IDEImagesIntf;
@ -702,6 +702,7 @@ type
TShortCutPropertyEditor = class(TOrdinalPropertyEditor)
public
procedure Edit; override;
function GetAttributes: TPropertyAttributes; override;
function OrdValueToVisualValue(OrdValue: longint): string; override;
procedure GetValues(Proc: TGetStrProc); override;
@ -1414,6 +1415,12 @@ type
//==============================================================================
const
UnknownVKPrefix = 'Word(''';
UnknownVKPostfix = ''')';
function KeyAndShiftStateToKeyString(Key: word; ShiftState: TShiftState): String;
function KeyStringIsIrregular(const s: string): boolean;
function KeyStringToVKCode(const s: string): word;
type
TStringsPropEditorDlg = class(TStringsPropEditorFrm)
@ -1421,6 +1428,108 @@ type
Editor: TPropertyEditor;
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 AllowedShifts;
property Anchors;
property AutoSize;
property BevelInner;
property BevelOuter;
property BevelWidth;
property BorderSpacing;
property BorderStyle;
property BorderWidth;
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 Key;
property OnClick;
property OnDblClick;
property OnDockDrop;
property OnDockOver;
property OnDragDrop;
property OnDragOver;
property OnEndDock;
property OnEndDrag;
property OnEnter;
property OnExit;
property OnGetDockCaption;
property OnGetSiteInfo;
property OnMouseDown;
property OnMouseMove;
property OnMouseUp;
property OnResize;
property OnStartDock;
property OnStartDrag;
property OnUnDock;
property ParentColor;
property ParentFont;
property ParentShowHint;
property PopupMenu;
property ShiftButtons;
property ShiftState;
property ShowHint;
property TabOrder;
property TabStop;
property UseDockManager default True;
property Visible;
end;
//==============================================================================
@ -1486,8 +1595,9 @@ procedure EditCollection(AComponent: TComponent; ACollection: TCollection; AProp
implementation
const
var
ListPropertyEditors: TList = nil;
VirtualKeyStrings: TStringHashList = nil;
procedure RegisterListPropertyEditor(AnEditor: TListPropertyEditor);
begin
@ -4708,9 +4818,49 @@ const
VK_BACK or scAlt,
VK_BACK or scShift or scAlt);
procedure TShortCutPropertyEditor.Edit;
var
Box: TShortCutGrabBox;
OldValue, NewValue: TShortCut;
OldKey: Word;
OldShift: TShiftState;
Dlg: TForm;
BtnPanel: TButtonPanel;
begin
try
Dlg:=TForm.Create(nil);
Dlg.Caption:=oisSelectShortCut;
Dlg.Position:=poScreenCenter;
Dlg.Constraints.MinWidth:=350;
Dlg.Constraints.MinHeight:=30;
Box:=TShortCutGrabBox.Create(Dlg);
Box.Parent:=Dlg;
Box.Align:=alClient;
OldValue := TShortCut(GetOrdValue);
ShortCutToKey(OldValue,OldKey,OldShift);
Box.ShiftState:=OldShift;
Box.Key:=OldKey;
BtnPanel:=TButtonPanel.Create(Dlg);
BtnPanel.Parent:=Dlg;
BtnPanel.Align:=alBottom;
BtnPanel.ShowButtons:=[pbOk,pbCancel];
Dlg.AutoSize:=true;
if Dlg.ShowModal=mrOk then begin
NewValue:=ShortCut(Box.Key,Box.ShiftState);
if OldValue<>NewValue then
SetOrdValue(NewValue);
end;
finally
Dlg.Free;
end;
end;
function TShortCutPropertyEditor.GetAttributes: TPropertyAttributes;
begin
Result := [paMultiSelect, paValueList, paRevertable, paHasDefaultValue];
Result := [paMultiSelect,paValueList,paRevertable,paHasDefaultValue,paDialog];
end;
function TShortCutPropertyEditor.OrdValueToVisualValue(OrdValue: longint
@ -6219,6 +6369,162 @@ begin
end;
end;
function KeyAndShiftStateToKeyString(Key: word; ShiftState: TShiftState
): String;
var
p: integer;
procedure AddStr(const s: string);
begin
if s <> '' then
begin
inc(p);
Result := Result + s;
end;
end;
procedure AddAttribute(const s: string);
begin
if p > 0 then
AddStr('+');
AddStr(s);
end;
procedure AddAttributes;
begin
if ssCtrl in ShiftState then AddAttribute(srkm_Ctrl);
if ssAlt in ShiftState then AddAttribute(srkm_Alt);
if ssShift in ShiftState then AddAttribute(srVK_SHIFT);
if ssMeta in ShiftState then
{$IFDEF LCLcarbon}
AddAttribute(srVK_CMD);
{$ELSE}
AddAttribute(srVK_SHIFT);
{$ENDIF}
if ssSuper in ShiftState then AddAttribute(srVK_SUPER);
end;
// Tricky routine. This only works for western languages
// TODO: This should be replaces by the winapi VKtoChar functions
//
procedure AddKey;
begin
if p>0 then AddStr(' ');
case Key of
VK_UNKNOWN :AddStr(srVK_UNKNOWN);
VK_LBUTTON :AddStr(srVK_LBUTTON);
VK_RBUTTON :AddStr(srVK_RBUTTON);
VK_CANCEL :AddStr(oiStdActDataSetCancel1Hint);
VK_MBUTTON :AddStr(srVK_MBUTTON);
VK_BACK :AddStr(srVK_BACK);
VK_TAB :AddStr(srVK_TAB);
VK_CLEAR :AddStr(srVK_CLEAR);
VK_RETURN :AddStr(srVK_RETURN);
VK_SHIFT :AddStr(srVK_SHIFT);
VK_CONTROL :AddStr(srVK_CONTROL);
VK_MENU :AddStr(srVK_MENU);
VK_PAUSE :AddStr(srVK_PAUSE);
VK_CAPITAL :AddStr(srVK_CAPITAL);
VK_KANA :AddStr(srVK_KANA);
// VK_HANGUL :AddStr('Hangul');
VK_JUNJA :AddStr(srVK_JUNJA);
VK_FINAL :AddStr(srVK_FINAL);
VK_HANJA :AddStr(srVK_HANJA );
// VK_KANJI :AddStr('Kanji');
VK_ESCAPE :AddStr(srVK_ESCAPE);
VK_CONVERT :AddStr(srVK_CONVERT);
VK_NONCONVERT :AddStr(srVK_NONCONVERT);
VK_ACCEPT :AddStr(srVK_ACCEPT);
VK_MODECHANGE :AddStr(srVK_MODECHANGE);
VK_SPACE :AddStr(srVK_SPACE);
VK_PRIOR :AddStr(srVK_PRIOR);
VK_NEXT :AddStr(srVK_NEXT);
VK_END :AddStr(srVK_END);
VK_HOME :AddStr(srVK_HOME);
VK_LEFT :AddStr(srVK_LEFT);
VK_UP :AddStr(srVK_UP);
VK_RIGHT :AddStr(srVK_RIGHT);
VK_DOWN : AddStr(clbDown);
VK_SELECT : AddStr(srSelect);
VK_PRINT :AddStr(srVK_PRINT);
VK_EXECUTE :AddStr(srVK_EXECUTE);
VK_SNAPSHOT :AddStr(srVK_SNAPSHOT);
VK_INSERT :AddStr(srVK_INSERT);
VK_DELETE : AddStr(oisDelete);
VK_HELP :AddStr(srVK_HELP);
VK_0..VK_9 :AddStr(IntToStr(Key-VK_0));
VK_A..VK_Z :AddStr(chr(ord('A')+Key-VK_A));
VK_LWIN :AddStr(srVK_LWIN);
VK_RWIN :AddStr(srVK_RWIN);
VK_APPS :AddStr(srVK_APPS);
VK_NUMPAD0..VK_NUMPAD9: AddStr(Format(srVK_NUMPAD,[Key-VK_NUMPAD0]));
VK_MULTIPLY :AddStr('*');
VK_ADD :AddStr('+');
VK_SEPARATOR :AddStr('|');
VK_SUBTRACT :AddStr('-');
VK_DECIMAL :AddStr('.');
VK_DIVIDE :AddStr('/');
VK_F1..VK_F24 : AddStr('F'+IntToStr(Key-VK_F1+1));
VK_NUMLOCK :AddStr(srVK_NUMLOCK);
VK_SCROLL :AddStr(srVK_SCROLL);
// VK_EQUAL :AddStr('=');
// VK_COMMA :AddStr(',');
// VK_POINT :AddStr('.');
// VK_SLASH :AddStr('/');
// VK_AT :AddStr('@');
else
AddStr(UnknownVKPrefix);
AddStr(IntToStr(Key));
AddStr(UnknownVKPostfix);
end;
end;
procedure AddAttributesAndKey;
begin
AddAttributes;
AddKey;
end;
begin
Result := '';
p := 0;
AddAttributesAndKey;
end;
function KeyStringIsIrregular(const s: string): boolean;
begin
if (length(UnknownVKPrefix)<length(s))
and (AnsiStrLComp(PChar(s),PChar(UnknownVKPrefix),length(UnknownVKPrefix))=0)
then
Result:=true
else
Result:=false;
end;
function KeyStringToVKCode(const s: string): word;
var
i: PtrInt;
Data: Pointer;
begin
Result:=VK_UNKNOWN;
if KeyStringIsIrregular(s) then begin
Result:=word(StrToIntDef(copy(s,7,length(s)-8),VK_UNKNOWN));
exit;
end;
if (s<>'none') and (s<>'') then begin
if VirtualKeyStrings=nil then begin
VirtualKeyStrings:=TStringHashList.Create(true);
for i:=1 to 255 do
VirtualKeyStrings.Add(KeyAndShiftStateToKeyString(word(i),[]), Pointer(i));
end;
end else
exit;
Data:=VirtualKeyStrings.Data[s];
if Data<>nil then
Result:=word(PtrUInt(Data));
end;
function GetClassUnitName(Value: TClass): string;
var
TheTypeInfo: PTypeInfo;
@ -6364,6 +6670,7 @@ begin
PropertyClassList:=nil;
FreeAndNil(ListPropertyEditors);
FreeAndNil(VirtualKeyStrings);
// XXX workaround for buggy typeinfo function
DummyClassForPropTypes.Free;
@ -6411,6 +6718,251 @@ begin
Proc(TComponent(Notebook.PageList[i]).Name);
end;
{ TCustomShortCutGrabBox }
procedure TCustomShortCutGrabBox.SetKey(const AValue: Word);
var
s: String;
i: LongInt;
begin
if FKey=AValue then exit;
FKey:=AValue;
s:=KeyAndShiftStateToKeyString(FKey,[]);
i:=KeyComboBox.Items.IndexOf(s);
if i>=0 then
KeyComboBox.ItemIndex:=i
else if KeyStringIsIrregular(s) then begin
KeyComboBox.Items.Add(s);
KeyComboBox.ItemIndex:=KeyComboBox.Items.IndexOf(s);
end else
KeyComboBox.ItemIndex:=0;
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;
FreeAndNil(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_LWIN, VK_RWIN,
VK_UNKNOWN, VK_UNDEFINED])
then begin
Key:=AKey;
ShiftState:=AShift;
FGrabForm.ModalResult:=mrOk;
end;
end;
procedure TCustomShortCutGrabBox.OnKeyComboboxEditingDone(Sender: TObject);
begin
Key:=KeyStringToVKCode(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
FreeAndNil(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:=srGrabKey;
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 := KeyAndShiftStateToKeyString(i, []);
if not KeyStringIsIrregular(s) then
Items.Add(s);
end;
Items.EndUpdate;
OnEditingDone:=@OnKeyComboboxEditingDone;
Parent:=Self;
AnchorToNeighbour(akRight,6,FGrabButton);
AnchorVerticalCenterTo(FGrabButton);
end;
BevelOuter:=bvNone;
ShiftButtons:=GetDefaultShiftButtons;
ShiftState:=[];
Key:=VK_UNKNOWN;
KeyComboBox.Text:=KeyAndShiftStateToKeyString(Key,[]);
end;
function TCustomShortCutGrabBox.GetDefaultShiftButtons: TShiftState;
begin
{$IFDEF Darwin}
Result:=[ssCtrl,ssShift,ssAlt,ssMeta];
{$ELSE}
Result:=[ssCtrl,ssShift,ssAlt];
{$ENDIF}
end;
initialization
{$I collectionpropeditform.lrs}