lazarus-ccr/components/rx/trunk/rxshortcutunit.pas

unit rxShortCutUnit;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ButtonPanel,
  StdCtrls;

type

  { TrxShortCutForm }

  TrxShortCutForm = class(TForm)
    Button1: TButton;
    ButtonPanel1: TButtonPanel;
    CheckBox1: TCheckBox;
    CheckBox2: TCheckBox;
    CheckBox3: TCheckBox;
    ComboBox1: TComboBox;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    function GetShortCut: TShortCut;
    procedure SetShortCut(AValue: TShortCut);
  public
    property ShortCut:TShortCut read GetShortCut write SetShortCut;
  end;


function RxSelectShortCut(var AShortCut:TShortCut):boolean;

implementation
uses LCLProc, LCLType, LCLStrConsts;

{$R *.lfm}

function RxSelectShortCut(var AShortCut: TShortCut): boolean;
var
  rxShortCutForm: TrxShortCutForm;
begin
  rxShortCutForm:=TrxShortCutForm.Create(Application);
  rxShortCutForm.ShortCut:=AShortCut;
  if rxShortCutForm.ShowModal = mrOk then
    AShortCut:=rxShortCutForm.ShortCut;
  rxShortCutForm.Free;
end;

type

  { TGrabForm }

  TGrabForm = class(TForm)
  private
    FShortCutEdt:TShortCut;
  protected
    procedure KeyDown(var Key: Word; Shift: TShiftState); override;
  public
    constructor CreateNew(AOwner: TComponent; Num: Integer = 0); override;
  end;


{ TGrabForm }

procedure TGrabForm.KeyDown(var Key: Word; Shift: TShiftState);
begin
  inherited KeyDown(Key, Shift);
  if (Key = VK_ESCAPE) and (Shift = []) then
    ModalResult:=mrCancel
  else
  if (Key <> VK_CONTROL) and (Key <> VK_SHIFT) and (Key <> VK_MENU) then
  begin
    FShortCutEdt:=KeyToShortCut(Key, Shift);
    ModalResult:=mrOK;
  end;
end;

constructor TGrabForm.CreateNew(AOwner: TComponent; Num: Integer);
var
  L: TLabel;
begin
  inherited CreateNew(AOwner, Num);
  Position:=poScreenCenter;
  Width:=200;
  Height:=80;
  Caption:='Press the key';
  BorderStyle:=bsDialog;
  KeyPreview:=true;

  L:=TLabel.Create(Self);
  L.Parent:=Self;
  L.Caption:=Caption;
  L.AnchorSide[akTop].Control:=Self;
  L.AnchorSide[akTop].Side:=asrCenter;

  L.AnchorSide[akLeft].Control:=Self;
  L.AnchorSide[akLeft].Side:=asrCenter;
end;

{ TrxShortCutForm }

procedure TrxShortCutForm.FormCreate(Sender: TObject);
var
  S: String;
  i:Word;
begin
  for i:=0 to $FF do
  begin
    S:=ShortCutToText(i);
    if S<>'' then
      ComboBox1.Items.Add(S);
  end;
end;

procedure TrxShortCutForm.Button1Click(Sender: TObject);
var
  F:TGrabForm;
begin
  F:=TGrabForm.CreateNew(Self);
  if F.ShowModal = mrOk then
    SetShortCut(F.FShortCutEdt);
  F.Free;
end;

procedure TrxShortCutForm.SetShortCut(AValue: TShortCut);
begin
  ComboBox1.Text:=ShortCutToText(AValue and $FF);
  CheckBox1.Checked:=AValue and scShift <> 0;
  CheckBox2.Checked:=AValue and scAlt <> 0;
  CheckBox3.Checked:=AValue and scCtrl <> 0;
  ///if ShortCut and scMeta <> 0 then Result := Result + MenuKeyCaps[mkcMeta];
end;

function TrxShortCutForm.GetShortCut: TShortCut;
var
  S: String;
begin
  S:='';

  if CheckBox1.Checked then
    S:=SmkcShift + S;

  if CheckBox2.Checked then
    S:=SmkcAlt + S;

  if CheckBox3.Checked then
    S:=SmkcCtrl + S;
  //SmkcMeta = 'Meta+';

  S:=S + ComboBox1.Text;
  Result:=TextToShortCut(S);
end;

end.