{ *************************************************************************** }
{                                                                             }
{ EControl Syntax Editor SDK                                                  }
{                                                                             }
{ Copyright (c) 2004 - 2008 EControl Ltd., Zaharov Michael                    }
{     www.econtrol.ru                                                         }
{     support@econtrol.ru                                                     }
{                                                                             }
{ *************************************************************************** }
{$I ecSyntEdit.INC}

unit ecKeyMapDlg;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
  {$IFDEF EC_DOTNET} Variants, {$ENDIF}
  Dialogs, StdCtrls, ComCtrls, ExtCtrls, ecKeyMap, ImgList, ActnList, Menus,
  ecHotKeyEdit, ecSyntDlg;

type
  TecFindInCmdTreeDlg = class(TecFindInTreeDialog)
  private
    FFindType: integer;
  protected
    function CreateDlg: TCustomForm; override;
    function MatchNode(Node: TTreeNode): Boolean; override;
    procedure GetDlgControls(Dlg: TCustomForm); override;
    procedure SetDlgControls(Dlg: TCustomForm); override;
  end;

  TecKeyMappingEditor = class(TFrame)
    ImageList1: TImageList;
    DesignGroup: TGroupBox;
    ActionList1: TActionList;
    NewKeyStroke: TAction;
    ExtendKeystroke: TAction;
    DeleteKeystroke: TAction;
    Label2: TLabel;
    Label3: TLabel;
    CheckBox1: TCheckBox;
    Edit1: TEdit;
    Edit2: TEdit;
    Panel1: TPanel;
    Panel2: TPanel;
    Label1: TLabel;
    GroupBox2: TGroupBox;
    LB: TListBox;
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    GroupBox1: TGroupBox;
    TV: TTreeView;
    DeleteCommand: TAction;
    AddCommand: TAction;
    Button4: TButton;
    Button5: TButton;
    KeyEdit: TecHotKey;
    PopupMenu1: TPopupMenu;
    ExpandAll1: TMenuItem;
    CollapseAll1: TMenuItem;
    N1: TMenuItem;
    Search1: TMenuItem;
    SearchAgain1: TMenuItem;
    procedure TVChange(Sender: TObject; Node: TTreeNode);
    procedure NewKeyStrokeUpdate(Sender: TObject);
    procedure NewKeyStrokeExecute(Sender: TObject);
    procedure ExtendKeystrokeUpdate(Sender: TObject);
    procedure ExtendKeystrokeExecute(Sender: TObject);
    procedure DeleteKeystrokeUpdate(Sender: TObject);
    procedure DeleteKeystrokeExecute(Sender: TObject);
    procedure TVEdited(Sender: TObject; Node: TTreeNode; var S: String);
    procedure CheckBox1Click(Sender: TObject);
    procedure Edit1Exit(Sender: TObject);
    procedure Edit2Exit(Sender: TObject);
    procedure TVDragOver(Sender, Source: TObject; X, Y: Integer;
      State: TDragState; var Accept: Boolean);
    procedure Edit1KeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure TVDragDrop(Sender, Source: TObject; X, Y: Integer);
    procedure DeleteCommandUpdate(Sender: TObject);
    procedure DeleteCommandExecute(Sender: TObject);
    procedure AddCommandExecute(Sender: TObject);
    procedure FrameEnter(Sender: TObject);
    procedure ExpandAll1Click(Sender: TObject);
    procedure CollapseAll1Click(Sender: TObject);
    procedure Search1Click(Sender: TObject);
    procedure SearchAgain1Click(Sender: TObject);
  private
    FKeyMapping: TSyntKeyMapping;
    FCurCommand: TecCommandItem;
    FFindDialog: TecFindInCmdTreeDlg;
    procedure SetKeyMapping(const Value: TSyntKeyMapping);
    procedure UpdateTree(Sel: TObject = nil);
    procedure FillKeyStrokes(SelIdx: integer = -1);
    procedure SetCurCommand(const Value: TecCommandItem);
    procedure UpdateDesignProps;
    function GetIsDesign: Boolean;
    procedure SetIsDesign(const Value: Boolean);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    property CurCommand: TecCommandItem read FCurCommand write SetCurCommand;
  published
    property KeyMapping: TSyntKeyMapping read FKeyMapping write SetKeyMapping;
    property IsDesign: Boolean read GetIsDesign write SetIsDesign;
  end;

implementation

{$R *.dfm}

uses ecSysUtils, ecFInCmdTreeDlg;

const
  SNoCategory = '[No Category]';

{ TecKeyMappingEditor }

procedure TecKeyMappingEditor.SetKeyMapping(const Value: TSyntKeyMapping);
begin
  FKeyMapping := Value;
  UpdateTree;
end;

procedure TecKeyMappingEditor.UpdateTree(Sel: TObject);
var Exp, NoCat: TList;
    Cat: TStringList;
    i, idx: integer;
    CurCat: TTreeNode;
  procedure AddCmd(Cmd: TecCommandItem);
  begin
    with TV.Items.AddChildObject(CurCat, Cmd.DisplayName, Cmd) do
      begin
        ImageIndex := 1;
        SelectedIndex := 1;
      end;
  end;
begin
  if Sel = nil then
    if TV.Selected <> nil then
      Sel := TObject(TV.Selected.Data)
    else
      Sel := nil;

  Exp := TList.Create;
  NoCat := TList.Create;
  Cat := TStringList.Create;
  Cat.Sorted := True;
  {$IFNDEF EC_VCL5}
  Cat.CaseSensitive := False;
  {$ENDIF}
  TV.Items.BeginUpdate;
  try
    for i := 0 to TV.Items.Count - 1 do
      if TV.Items[i].Expanded then
        Exp.Add(TV.Items[i].Data);

    TV.Items.Clear;

    if Assigned(FKeyMapping) then
     with FKeyMapping do
      for i := 0 to Items.Count - 1 do
       if Items[i].Customizable or IsDesign then
        begin
          idx := Cat.IndexOf(Items[i].Category);
          if idx = -1 then
            begin
              if Items[i].Category = '' then
                begin
                  NoCat.Add(Items[i]);
                  Continue;
                end
              else
                begin
                  CurCat := TV.Items.AddChildObject(nil, Items[i].Category, TObject(- Cat.Count - 1));
                  Cat.AddObject(Items[i].Category, CurCat);
                end;
            end else CurCat := TTreeNode(Cat.Objects[idx]);
          AddCmd(Items[i]);
        end;

    if NoCat.Count > 0 then
      begin
        CurCat := TV.Items.AddChildObject(nil, SNoCategory, TObject(-Cat.Count-1));
        for i := 0 to NoCat.Count - 1 do
          AddCmd(TecCommandItem(NoCat[i]));
      end;

    for i := 0 to TV.Items.Count - 1 do
      begin
        if Exp.IndexOf(TV.Items[i].Data) <> -1 then
          TV.Items[i].Expand(False);
        if TV.Items[i].Data = Sel then
          TV.Items[i].Selected := True;
      end;
  finally
    TV.Items.EndUpdate;
    Cat.Free;
    Exp.Free;
    NoCat.Free;
  end;
  TVChange(TV, TV.Selected);
end;

procedure TecKeyMappingEditor.FillKeyStrokes(SelIdx: integer);
var i: integer;
begin
  LB.Items.BeginUpdate;
  try
    if SelIdx = -1 then
      SelIdx := LB.ItemIndex;
    LB.Items.Clear;
    if Assigned(FCurCommand) then
      for i := 0 to FCurCommand.KeyStrokes.Count - 1 do
        LB.Items.Add(FCurCommand.KeyStrokes[i].AsString);
    if (SelIdx > 0) and (SelIdx < LB.Items.Count) then
      LB.ItemIndex := SelIdx else
    if LB.Items.Count > 0 then
      LB.ItemIndex := 0;
  finally
    LB.Items.EndUpdate;
  end;
end;

procedure TecKeyMappingEditor.TVChange(Sender: TObject; Node: TTreeNode);
begin
  if Assigned(TV.Selected) and (TV.Selected.Level = 1) then
    CurCommand := TecCommandItem(TV.Selected.Data)
  else
    CurCommand := nil;
end;

procedure TecKeyMappingEditor.SetCurCommand(const Value: TecCommandItem);
begin
  FCurCommand := Value;
  FillKeyStrokes(0);
  EnableControl(LB, Assigned(FCurCommand));
  EnableControl(KeyEdit, Assigned(FCurCommand));
  UpdateDesignProps;
end;

procedure TecKeyMappingEditor.NewKeyStrokeUpdate(Sender: TObject);
begin
  NewKeyStroke.Enabled := Assigned(FCurCommand) and (KeyEdit.Text <> '');
end;

procedure TecKeyMappingEditor.NewKeyStrokeExecute(Sender: TObject);
begin
  FCurCommand.KeyStrokes.Add.KeyDefs.Add.ShortCut := KeyEdit.HotKey;
  FillKeyStrokes(FCurCommand.KeyStrokes.Count - 1);
end;

procedure TecKeyMappingEditor.ExtendKeystrokeUpdate(Sender: TObject);
begin
  ExtendKeystroke.Enabled := Assigned(FCurCommand) and (KeyEdit.Text <> '') and (LB.ItemIndex <> -1);
end;

procedure TecKeyMappingEditor.ExtendKeystrokeExecute(Sender: TObject);
begin
  FCurCommand.KeyStrokes[LB.ItemIndex].KeyDefs.Add.ShortCut := KeyEdit.HotKey;
  FillKeyStrokes;
end;

procedure TecKeyMappingEditor.DeleteKeystrokeUpdate(Sender: TObject);
begin
  DeleteKeystroke.Enabled := Assigned(FCurCommand) and (LB.ItemIndex <> -1);
end;

procedure TecKeyMappingEditor.DeleteKeystrokeExecute(Sender: TObject);
begin
  FCurCommand.KeyStrokes.Delete(LB.ItemIndex);
  FillKeyStrokes;
end;

procedure TecKeyMappingEditor.TVEdited(Sender: TObject; Node: TTreeNode;
  var S: String);
var i: integer;
begin
  if Assigned(FKeyMapping) then
  if Node.Level = 0 then
    begin
      for i := 0 to FKeyMapping.Items.Count - 1 do
        if SameText(FKeyMapping.Items[i].Category, Node.Text) then
          FKeyMapping.Items[i].Category := S;
    end else
    begin
      TecCommandItem(Node.Data).DisplayName := S;
    end;
end;

procedure TecKeyMappingEditor.UpdateDesignProps;
begin
  if not DesignGroup.Visible then Exit;
  if FCurCommand = nil then
    begin
      EnableControl(Edit1, False);
      EnableControl(Edit2, False);
      CheckBox1.Enabled := False;
    end else
    begin
      EnableControl(Edit1, True);
      EnableControl(Edit2, True);
      Edit1.Text := FCurCommand.Caption;
      Edit1.Modified := False;
      Edit2.Text := IntToStr(FCurCommand.Command);
      Edit2.Modified := True;
      CheckBox1.Enabled := True;
      CheckBox1.Checked := FCurCommand.Customizable;
    end;
end;

procedure TecKeyMappingEditor.CheckBox1Click(Sender: TObject);
begin
  FCurCommand.Customizable := CheckBox1.Visible;
end;

procedure TecKeyMappingEditor.Edit1Exit(Sender: TObject);
begin
  if Edit1.Modified then
    begin
      FCurCommand.Caption := Edit1.Text;
      Edit1.Modified := False;
    end;
end;

procedure TecKeyMappingEditor.Edit2Exit(Sender: TObject);
begin
  if Edit2.Modified then
    begin
      try
        FCurCommand.Command := StrToInt(Edit2.Text);
      except
        Application.HandleException(Self);
        Edit2.Text := IntToStr(FCurCommand.Command);
      end;
      Edit1.Modified := False;
    end;
end;

procedure TecKeyMappingEditor.Edit1KeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if Key = VK_RETURN then
    TEdit(Sender).OnExit(Sender);
end;

procedure TecKeyMappingEditor.TVDragOver(Sender, Source: TObject; X,
  Y: Integer; State: TDragState; var Accept: Boolean);
var Node: TTreeNode;
begin
  Accept := (Source = TV) and (TV.Selected <> nil);
  if Accept then
    begin
      Node := TV.GetNodeAt(X, Y);
      Accept := (Node <> nil) and (Node <> TV.Selected) and
                (Node.Level <= TV.Selected.Level);
    end;
end;

procedure TecKeyMappingEditor.TVDragDrop(Sender, Source: TObject; X,
  Y: Integer);
var Node: TTreeNode;
    i, Idx: integer;
begin
  Node := TV.GetNodeAt(X, Y);
  if TV.Selected.Level = 0 then // Dragging category
    begin
      Idx := TecCommandItem(Node.Item[0].Data).Index;
      for i := TV.Selected.Count - 1 downto 0 do
        TecCommandItem(TV.Selected.Item[i].Data).Index := Idx;
    end else
    begin
      if Node.Level = 0 then
        TecCommandItem(TV.Selected.Data).Category := TecCommandItem(Node.Item[0].Data).Category
      else
        begin
          TecCommandItem(TV.Selected.Data).Category := TecCommandItem(Node.Data).Category;
          TecCommandItem(TV.Selected.Data).Index := TecCommandItem(Node.Data).Index;
        end;
    end;
  UpdateTree;
end;

function TecKeyMappingEditor.GetIsDesign: Boolean;
begin
  Result := DesignGroup.Visible;
end;

procedure TecKeyMappingEditor.SetIsDesign(const Value: Boolean);
begin
  DesignGroup.Visible := Value;
  TV.ReadOnly := not Value;
  if Value then
    TV.DragMode := dmAutomatic
  else
    TV.DragMode := dmManual;
  if Value then
    ClientHeight := Panel1.Height + DesignGroup.Height
  else
    ClientHeight := Panel1.Height;
end;

procedure TecKeyMappingEditor.DeleteCommandUpdate(Sender: TObject);
begin
  DeleteCommand.Enabled := FCurCommand <> nil;
end;

procedure TecKeyMappingEditor.DeleteCommandExecute(Sender: TObject);
var Node: TTreeNode;
begin
  Node := TV.Selected.getNextSibling;
  FreeAndNil(FCurCommand);
  if TV.Selected.Parent.Count = 1 then
    TV.Selected.Parent.Delete
  else
    TV.Selected.Delete;
  if Assigned(Node) then
    Node.Selected := True;
end;

procedure TecKeyMappingEditor.AddCommandExecute(Sender: TObject);
var Cat: string;
    Item: TecCommandItem;
begin
  Cat := '';
  if Assigned(TV.Selected) then
    if TV.Selected.Level = 0 then
      Cat := TV.Selected.Text
    else
      Cat := TV.Selected.Parent.Text;
  if Cat = SNoCategory then
    Cat := '';

  Item := FKeyMapping.Items.Add;
  Item.Category := Cat;
  Item.DisplayName := 'New command';
  UpdateTree(Item);
end;

procedure TecKeyMappingEditor.FrameEnter(Sender: TObject);
begin
  if (Parent <> nil) and (Parent is TForm) then
    TForm(Parent).OnCloseQuery := FormCloseQuery;
end;

procedure TecKeyMappingEditor.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
var i: integer;
begin
  if Assigned(FKeyMapping) then
    try
      FKeyMapping.Validate;
    except
      on e: EDuplicateKeyStroke do
        begin
          CanClose := False;
          for i := 0 to TV.Items.Count - 1 do
           if TecCommandItem(TV.Items[i].Data) = e.Command then
            begin
              TV.Items[i].Selected := True;
              if e.KeyStrokeIdx < LB.Items.Count then
                LB.ItemIndex := e.KeyStrokeIdx;
              Break;
            end;
          Application.HandleException(Self);
        end;
    end;
end;

constructor TecKeyMappingEditor.Create(AOwner: TComponent);
begin
  inherited;
  FFindDialog := TecFindInCmdTreeDlg.Create(nil{to remove from resource});
  FFindDialog.Control := TV;
end;

destructor TecKeyMappingEditor.Destroy;
begin
  FFindDialog.Free;
  inherited;
end;

procedure TecKeyMappingEditor.ExpandAll1Click(Sender: TObject);
begin
  TV.FullExpand;
end;

procedure TecKeyMappingEditor.CollapseAll1Click(Sender: TObject);
begin
  TV.FullCollapse;
end;

procedure TecKeyMappingEditor.Search1Click(Sender: TObject);
begin
  FFindDialog.Execute;
end;

{ TecFindInCmdTreeDlg }

function TecFindInCmdTreeDlg.CreateDlg: TCustomForm;
begin
  Result := TFindTextInCmdTreeDlg.Create(Application);
end;

procedure TecFindInCmdTreeDlg.GetDlgControls(Dlg: TCustomForm);
begin
  inherited;
  FFindType := (Dlg as TFindTextInCmdTreeDlg).RadioGroup4.ItemIndex;
end;

function TecFindInCmdTreeDlg.MatchNode(Node: TTreeNode): Boolean;
var Cmd: TecCommandItem;
    i, j: integer;
    sc: TShortCut;
begin
  case FFindType of
    1: begin
         Result := Node.ImageIndex = 1;
         if Result then
           begin
             Cmd := TecCommandItem(Node.Data);
             sc := TextToShortCut(FindText);
             for i := 0 to Cmd.KeyStrokes.Count - 1 do
               for j := 0 to Cmd.KeyStrokes[i].KeyDefs.Count - 1 do
                 if Cmd.KeyStrokes[i].KeyDefs[j].ShortCut = sc then
                   Exit;
             Result := False;
           end;
       end;
    2: Result := (Node.ImageIndex = 1) and
                 (TecCommandItem(Node.Data).Command = StrToInt(FindText));
    else Result := inherited MatchNode(Node);
  end;
end;

procedure TecFindInCmdTreeDlg.SetDlgControls(Dlg: TCustomForm);
begin
  inherited;
  (Dlg as TFindTextInCmdTreeDlg).RadioGroup4.ItemIndex := FFindType;
end;

procedure TecKeyMappingEditor.SearchAgain1Click(Sender: TObject);
begin
  if FFindDialog.FindText = '' then
    FFindDialog.Execute
  else
    FFindDialog.SearchAgain;
end;

end.
