hkedit.pas

Delphi 开发的的热键操作 很值得看的

unit hkEdit;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ComCtrls, StdCtrls, WComp, SysHot, ShellAPI, AniTray, Menus, ExtCtrls, IniFiles,
  Buttons, BrowseEdit, hkClpbrd;

const
  WM_EDITKEYS = WM_USER+2001;
  WM_SENDKEYS = WM_USER+2002;
  WM_MULTKEYS = WM_USER+2003;
  WM_QUITHOTK = WM_USER+2004;

type
  TfrmHotkeyEdit = class(TForm)
    lvHotkeys: TListView;
    SysHotkeys: TSysHotKey;
    ppmTrayMenu: TPopupMenu;
    mnuEditHotkeys: TMenuItem;
    mnuAbout: TMenuItem;
    mnuSeparator2: TMenuItem;
    mnuExit: TMenuItem;
    atiHotkeys: TAnimatedTrayIcon;
    pnlControls: TPanel;
    pnlEdit: TPanel;
    pnlButtons: TPanel;
    btnNew: TButton;
    btnDelete: TButton;
    btnApply: TButton;
    btnClose: TButton;
    grpHotkey: TGroupBox;
    lblDescription: TLabel;
    lblCommandLine: TLabel;
    lblHotkey: TLabel;
    edtDescription: TEdit;
    chkCtrl: TCheckBox;
    chkAlt: TCheckBox;
    chkShift: TCheckBox;
    chkWin: TCheckBox;
    cboHotkey: TComboBox;
    chkActive: TCheckBox;
    mnuListHotkeys: TMenuItem;
    pnlOptions: TPanel;
    chkShowIcon: TCheckBox;
    mnuSeparator1: TMenuItem;
    mnuHotkeys: TMenuItem;
    lblAction: TLabel;
    cboActions: TComboBox;
    edtCommandLine: TBrowseEdit;
    cboParams: TComboBox;
    mnuHelp: TMenuItem;
    mnuSeparator0: TMenuItem;
    edtKeysToSend: TEdit;
    opdOpenFile: TOpenDialog;
    edtID: TEdit;
    lblID: TLabel;
    lblShow: TLabel;
    cboShow: TComboBox;
    cboClipboard: TComboBox;
    lblClipboards: TLabel;
    edtClipboards: TEdit;
    udClipboards: TUpDown;
    imgIcon: TImage;
    procedure btnNewClick(Sender: TObject);
    procedure chkActiveClick(Sender: TObject);
    procedure edtDescriptionChange(Sender: TObject);
    procedure edtCommandLineChange(Sender: TObject);
    procedure edtCommandLineButtonClick(Sender: TObject);
    procedure edtCommandLineExit(Sender: TObject);
    procedure chkCtrlClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure lvHotkeysClick(Sender: TObject);
    procedure btnDeleteClick(Sender: TObject);
    procedure btnCloseClick(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure SysHotkeysHotKey(Sender: TObject; Index: Integer);
    procedure FormDestroy(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure mnuEditHotkeysClick(Sender: TObject);
    procedure mnuExitClick(Sender: TObject);
    procedure btnApplyClick(Sender: TObject);
    procedure FormResize(Sender: TObject);
    procedure atiHotkeysEndAnimation(Sender: TObject);
    procedure mnuAboutClick(Sender: TObject);
    procedure mnuListHotkeysClick(Sender: TObject);
    procedure chkShowIconClick(Sender: TObject);
    procedure FormKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure cboActionsClick(Sender: TObject);
    procedure cboParamsClick(Sender: TObject);
    procedure edtKeysToSendChange(Sender: TObject);
    procedure mnuHelpClick(Sender: TObject);
    procedure edtIDChange(Sender: TObject);
    procedure edtIDExit(Sender: TObject);
    procedure edtDescriptionExit(Sender: TObject);
    procedure lvHotkeysChange(Sender: TObject; Item: TListItem;
      Change: TItemChange);
    procedure cboShowClick(Sender: TObject);
    procedure cboClipboardClick(Sender: TObject);
    procedure edtClipboardsExit(Sender: TObject);
    procedure edtClipboardsChange(Sender: TObject);
  private
    FChanged        : Boolean;
    Quitting, Ignore: Boolean;
    CurModifiers    : THKModifiers;
    CurVirtKey      : TVirtKey;
    CommandLines    : TStringList;
    WindowList      : TList;
    Clipboards      : TClipboards;
    hwndClipViewer  : hWnd;
    procedure Quit;
    procedure SetChanged(Value: Boolean);
    function  WindowAnimation(Value: Integer): Integer;
    function  HotkeyOK(sHotkey: String): Boolean;
    procedure MultipleHotkeys(Command: String);
    function  GetDelay(var Sel: String): Integer;
    function  WindowsVersion: DWord;
    procedure ExitWindowsCommand(Command: Integer);
    procedure PerformAction(Action: Integer; Command: String; Index: Integer; Immediate: Boolean);
    function  NextItem(var Commands: String): String;
    procedure SetControls;
    procedure ExecProgram(Command: String);
    procedure SetClipboards;
    procedure SwitchToClipboard(Index: Integer);
    procedure DrawClipOnBmp(IcoBmp: TBitmap; sText: String);
    procedure DrawClipboardStatus(Index: Integer);
  protected
    property IsChanged: Boolean read FChanged write SetChanged;
    procedure EditHotkeys;
    procedure ViewHotkeys;
    procedure AboutBox;
    procedure HelpIndex;
    procedure MinimizeAll;
    procedure UndoMinimize;
    function  VirtKey(sHotkey: String): TVirtKey;
    function  Modifiers(sHotkey: String): THKModifiers;
    procedure AddTo(var sKey: String; Value: String);
    procedure SetItem;
    procedure GetHotkey;
    procedure SetHotkey;
    procedure ReadHotkeys;
    procedure SaveHotkeys;
    procedure LoadHotkeys;
    procedure wmGetMinMaxInfo(var Msg: TWMGETMINMAXINFO); message WM_GETMINMAXINFO;
    procedure wmDrawClipboard(var Msg: TMessage); message WM_DRAWCLIPBOARD;
    procedure wmChangeCBChain(var Msg: TMessage); message WM_CHANGECBCHAIN;
    procedure wmEditKeys(var Msg: TMessage); message WM_EDITKEYS;
    procedure wmSendKeys(var Msg: TMessage); message WM_SENDKEYS;
    procedure wmMultKeys(var Msg: TMessage); message WM_MULTKEYS;
    procedure wmQuitHotK(var Msg: TMessage); message WM_QUITHOTK;
  public
    Item: TListItem;
    function  ReadHotkey(Reader: TReader): String;
    procedure HotkeyMenuClick(Sender: TObject);
    procedure HotkeyPressed(Index: Integer);
  end;

function MakeID(ListView: TListView; CurItem: TListItem; Command: String): String;

var
  frmHotkeyEdit: TfrmHotkeyEdit;

const
  ITEM_ID     = 0;
  ITEM_ACTION = 1;
  ITEM_DATA   = 2;
  ITEM_HOTKEY = 3;
  ITEM_ACTIVE = 4;
  ITEM_SHOW   = 5;

implementation

{$R *.DFM}

uses hkAbout, hkList, hkError, hkSend, hkSelect;

const
  Actives  : array[Boolean] of string = ('False', 'True');

  Params   : array[0..5] of String  = ('Shutdown', 'Log off', 'Reboot System', 'Restart Windows', 'Exit to DOS', 'Suspend');

  Actions  : array[0..10] of String = ('Execute Program',   'Send keystrokes',
                                       'Execute Multiple Commands',
                                       'Exit Windows',      'Edit Hotkeys',
                                       'View Hotkeys',      'Display About Box',
                                       'Hotkeys Help',      'Minimize All Windows',
                                       'Undo Minimize All', 'Switch To Virtual Clipboard');

function MakeAlfa(Command: String): String;
begin
  Result := '';
  while (Length(Result)<4) and (Command<>'') do
   begin
     if Command[1] in ['A'..'Z', 'a'..'z', '0'..'9'] then Result := Result + UpCase(Command[1]);
     Delete(Command, 1, 1);
   end;
end;

function MakeID(ListView: TListView; CurItem: TListItem; Command: String): String;
var
  i, Counter : integer;
  sCounter   : String;
  Found: Boolean;
begin
  Result := MakeAlfa(Command);
  Counter := 0;
  while Length(Result)<4 do Result := Result + '0';

  i := 0;
  Found := False;
  if ListView.Items.Count>1 then
   repeat
     if i=ListView.Items.Count then i := 0;
     if i=0 then Found := False;
     if (ListView.Items[i]<>CurItem) and (ListView.Items[i].SubItems[ITEM_ID]=Result) then
      begin
        inc(Counter);
        sCounter := IntToStr(Counter);
        Result := Copy(Result, 1, 4-Length(sCounter)) + sCounter;
        Found := True;
      end
     else
      inc(i);
   until (i=ListView.Items.Count) and not Found;
end;

procedure TfrmHotkeyEdit.lvHotkeysClick(Sender: TObject);
begin
  if lvHotkeys.Selected<>nil then
   begin
     Item := lvHotkeys.Selected;
     grpHotkey.Caption := 'Edit hotkey';
     SetItem;
   end
  else if Item<>nil then lvHotkeys.Selected := Item;
end;

procedure TfrmHotkeyEdit.btnNewClick(Sender: TObject);
begin
  Item := lvHotkeys.Items.Add;
  Item.SubItems.Add('');
  Item.SubItems.Add(cboActions.Items[0]);
  Item.SubItems.Add('');
  Item.SubItems.Add('');
  Item.SubItems.Add('True');
  Item.SubItems.Add(cboShow.Items[0]);
  grpHotkey.Caption := 'Add hotkey';
  SetItem;
  lvHotkeys.Selected := Item;
  IsChanged := True;
end;

procedure TfrmHotkeyEdit.SetItem;
begin
  Ignore := True;
  edtDescription.Text := Item.Caption;
  cboActions.ItemIndex := cboActions.Items.IndexOf(Item.SubItems[ITEM_ACTION]);
  edtID.Text := Item.SubItems[ITEM_ID];
  case cboActions.ItemIndex of
    0, 2 : edtCommandLine.Text := Item.SubItems[ITEM_DATA];
    1    : edtKeysToSend.Text := Item.SubItems[ITEM_DATA];
    3    : cboParams.ItemIndex := cboParams.Items.IndexOf(Item.SubItems[ITEM_DATA]);
    10   : cboClipboard.ItemIndex := cboClipboard.Items.IndexOf(Item.SubItems[ITEM_DATA]);
  end;
  if cboActions.ItemIndex=0 then cboShow.ItemIndex := cboShow.Items.IndexOf(Item.SubItems[ITEM_SHOW]);
  SetControls;
  SetHotkey;
  chkActive.Checked := (Item.SubItems[ITEM_ACTIVE] = 'True');
  Ignore := False;
end;

procedure TfrmHotkeyEdit.chkActiveClick(Sender: TObject);
begin
  if (Item<>nil) and not Ignore then
   begin
     if chkActive.Checked then Item.SubItems[ITEM_ACTIVE] := 'True' else Item.SubItems[ITEM_ACTIVE] := 'False';
     IsChanged := True;
   end;
end;

procedure TfrmHotkeyEdit.edtDescriptionChange(Sender: TObject);
begin
  if (Item<>nil) and not Ignore then
   begin
     Item.Caption := edtDescription.Text;
     IsChanged := True;
   end;
end;

procedure TfrmHotkeyEdit.edtCommandLineChange(Sender: TObject);
begin
  if (Item<>nil) and not Ignore then
   begin
     Item.SubItems[ITEM_DATA] := edtCommandLine.Text;
     IsChanged := True;
   end;
end;

procedure TfrmHotkeyEdit.chkCtrlClick(Sender: TObject);
begin
  GetHotkey;
end;

procedure TfrmHotkeyEdit.AddTo(var sKey: String; Value: String);
begin
  if sKey<>'' then sKey := sKey + '+';
  sKey := sKey + Value;
end;

function TfrmHotkeyEdit.HotkeyOK(sHotkey: String): Boolean;
const
  ErrorDescription = 'If you continue the hotkey combination for ''%s'' will not work.';
var
  i: Integer;
begin
  with lvHotkeys do
   for i:=0 to Items.Count-1 do
    if (Items[i]<>Item) and (Items[i].SubItems[ITEM_HOTKEY]=sHotkey) and (Items[i].SubItems[ITEM_ACTIVE]='True') then
     with frmHotkeyError do
      begin
        ConflictingEntry := Items[i].Caption;
        if Items[i].Index<Item.Index then
         Description := Format(ErrorDescription, [Items[i].Caption])
        else
         Description := Format(ErrorDescription, [Item.Caption]);
        Result := ShowModal = mrOk;
        Exit;
      end;
  if not SysHotkeys.AddHotkey(Virtkey(sHotkey), Modifiers(sHotkey)).Registered then
   begin
     MessageBox(Handle, 'This hotkey combination is in use by another application.', 'Hotkey combination error', MB_ICONINFORMATION or MB_OK);
     Result := False;
   end
  else
   Result := True;
  SysHotkeys.Delete(SysHotkeys.HotkeyCount-1);
end;

procedure TfrmHotkeyEdit.GetHotkey;
var
  sHotkey: String;
begin
  sHotkey := '';
  if (Item<>nil) and not Ignore then
   begin
     if chkCtrl.Checked then AddTo(sHotkey, 'Ctrl');
     if chkAlt.Checked then AddTo(sHotkey, 'Alt');
     if chkShift.Checked then AddTo(sHotkey, 'Shift');
     if chkWin.Checked then AddTo(sHotkey, 'Win');
     AddTo(sHotkey, cboHotkey.Items[cboHotkey.ItemIndex]);
     if HotkeyOk(sHotkey) then
      begin
        Item.SubItems[ITEM_HOTKEY] := sHotkey;
        IsChanged := True;
      end
     else
      SetHotkey;
   end;

end;

procedure TfrmHotkeyEdit.SetHotkey;
var
  sHotkey: String;
begin
  if Item<>nil then
   begin
     sHotkey := Item.SubItems[ITEM_HOTKEY];
     CurVirtkey   := VirtKey(sHotkey);
     CurModifiers := Modifiers(sHotkey);