home *** CD-ROM | disk | FTP | other *** search
Wrap
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); chkCtrl.Checked := Pos('Ctrl', sHotkey)>0; chkAlt.Checked := Pos('Alt', sHotkey)>0; chkShift.Checked := Pos('Shift', sHotkey)>0; chkWin.Checked := Pos('Win', sHotkey)>0; while Pos('+', sHotkey)>0 do Delete(sHotkey, 1, Pos('+', sHotkey)); if sHotkey<>'' then cboHotkey.ItemIndex := cboHotkey.Items.IndexOf(sHotkey) else cboHotkey.ItemIndex := -1; end; end; procedure TfrmHotkeyEdit.FormCreate(Sender: TObject); var i : integer; IniFile: String; begin Application.ShowMainForm := False; if FindWindow('Shell_TrayWnd', nil)=0 then WindowState := wsMinimized; atiHotkeys.HideAppIcon; for i:= Low(Actions) to High(Actions) do cboActions.Items.Add(Actions[i]); for i:= Low(Params) to High(Params) do cboParams.Items.Add(Params[i]); cboParams.ItemIndex := 0; Quitting := False; Ignore := False; cboShow.ItemIndex := 0; Clipboards := TClipboards.Create; hwndClipViewer := SetClipboardViewer(Handle); CommandLines := TStringList.Create; WindowList := TList.Create; IniFile := ChangeFileExt(Application.ExeName, '.ini'); WindowState := wsNormal; with TInifile.Create(IniFile) do begin chkShowIcon.Checked := ReadInteger('Settings', 'ShowTaskbarIcon', 1)=1; chkShowIconClick(Self); Ignore := True; udClipboards.Position := ReadInteger('Settings', 'ClipboardCount', 5); edtClipboards.Text := IntToStr(udClipboards.Position); Ignore := False; Width := ReadInteger('EditorWindow', 'Width', Width); Height := ReadInteger('EditorWindow', 'Height', Height); for i:=0 to lvHotkeys.Columns.Count-1 do with lvHotkeys.Columns[i] do Width := ReadInteger('EWColumns', Caption, Width); Free; end; SetClipboards; SwitchToClipboard(0); ReadHotkeys; LoadHotkeys; end; procedure TfrmHotkeyEdit.SetClipboards; var sClip: String; i : integer; begin Clipboards.NumClipboards := udClipboards.Position; sClip := cboClipboard.Text; cboClipboard.Clear; for i:=1 to Clipboards.NumClipboards do cboClipboard.Items.Add(IntToStr(i)); cboClipboard.ItemIndex := cboClipboard.Items.IndexOf(sClip); if cboClipboard.ItemIndex=-1 then cboClipboard.ItemIndex := 0; end; function TfrmHotkeyEdit.ReadHotkey(Reader: TReader): String; begin Result := ''; if Reader.ReadBoolean then AddTo(Result, 'Ctrl'); if Reader.ReadBoolean then AddTo(Result, 'Alt'); if Reader.ReadBoolean then AddTo(Result, 'Shift'); if Reader.ReadBoolean then AddTo(Result, 'Win'); AddTo(Result, cboHotKey.Items[Reader.ReadInteger]); end; procedure TfrmHotkeyEdit.ReadHotkeys; var Stream : TFileStream; Reader : TReader; sVersion : String; iVersion : Integer; Action, Index : Integer; begin if Item<>nil then Index := Item.Index else Index := 0; lvHotkeys.Items.BeginUpdate; try Stream := TFileStream.Create(ChangeFileExt(Application.ExeName, '.HKD'), fmOpenRead); try Reader := TReader.Create(Stream, 4096); try lvHotkeys.Items.Clear; sVersion := Reader.ReadString; iVersion := 120; if sVersion = 'Hotkey definitions, version 1.0' then iVersion := 100; if sVersion = 'Hotkey definitions, version 1.05' then iVersion := 105; Reader.ReadListBegin; while not Reader.EndOfList do begin Item := lvHotkeys.Items.Add; Item.Caption := Reader.ReadString; if iVersion=100 then Item.SubItems.Add(MakeID(lvHotkeys, Item, Item.Caption)) else Item.SubItems.Add(Reader.ReadString); Action := Reader.ReadInteger; if (iVersion=100) and (Action>1) then inc(Action); Item.SubItems.Add(cboActions.Items[Action]); case Action of 0, 1, 2: Item.SubItems.Add(Reader.ReadString); 3 : Item.SubItems.Add(cboParams.Items[Reader.ReadInteger]); 10 : Item.SubItems.Add(cboClipboard.Items[Reader.ReadInteger]); else Item.SubItems.Add(''); end; Item.SubItems.Add(ReadHotkey(Reader)); Item.SubItems.Add(Actives[Reader.ReadBoolean]); if (Action=0) then begin if (iVersion=120) then Item.SubItems.Add(Reader.ReadString) else Item.SubItems.Add(cboShow.Items[0]); end; end; Reader.ReadListEnd; finally Reader.Free; end; finally Stream.Free; end; except end; if lvHotkeys.Items.Count=0 then btnNewClick(Self) else begin lvHotkeys.Selected := lvHotkeys.Items[Index]; lvHotkeysClick(Self); IsChanged := False; end; lvHotkeys.Items.EndUpdate; end; procedure TfrmHotkeyEdit.SaveHotkeys; var Stream: TFileStream; Writer: TWriter; i, Index : Integer; Hotkey: String; begin try Stream := TFileStream.Create(ChangeFileExt(Application.ExeName, '.HKD'), fmCreate); try Writer := TWriter.Create(Stream, 4096); try Writer.WriteString('Hotkey definitions, version 1.2'); Writer.WriteListBegin; with lvHotkeys do for i:=0 to Items.Count-1 do begin Writer.WriteString(Items[i].Caption); Writer.WriteString(Items[i].SubItems[ITEM_ID]); Index := cboActions.Items.IndexOf(Items[i].SubItems[ITEM_ACTION]); Writer.WriteInteger(Index); case Index of 0, 1, 2: Writer.WriteString(Items[i].SubItems[ITEM_DATA]); 3 : Writer.WriteInteger(cboParams.Items.IndexOf(Items[i].SubItems[ITEM_DATA])); 10 : Writer.WriteInteger(cboClipboard.Items.IndexOf(Items[i].SubItems[ITEM_DATA])); end; Hotkey := Items[i].SubItems[ITEM_HOTKEY]; Writer.WriteBoolean(Pos('Ctrl', Hotkey)>0); Writer.WriteBoolean(Pos('Alt', Hotkey)>0); Writer.WriteBoolean(Pos('Shift', Hotkey)>0); Writer.WriteBoolean(Pos('Win', Hotkey)>0); while Pos('+', Hotkey)>0 do Delete(Hotkey, 1, Pos('+', Hotkey)); Writer.WriteInteger(cboHotkey.Items.IndexOf(Hotkey)); Writer.WriteBoolean(Items[i].SubItems[ITEM_ACTIVE]=Actives[True]); if (Index=0) then Writer.WriteString(Items[i].SubItems[ITEM_SHOW]); end; Writer.WriteListEnd; finally Writer.Free; end; finally Stream.Free; end; except end; IsChanged := False; LoadHotkeys; if Assigned(frmHotkeyList) and (frmHotkeyList.Visible) then frmHotkeyList.ReadHotkeys; end; procedure TfrmHotkeyEdit.btnDeleteClick(Sender: TObject); begin if Item<>nil then begin Item.Free; if lvHotkeys.Items.Count>0 then begin lvHotkeys.Selected := lvHotkeys.Items[0]; lvHotkeysClick(Self); IsChanged := True; end else btnNewClick(Self); end; end; procedure TfrmHotkeyEdit.btnCloseClick(Sender: TObject); begin Close; end; procedure TfrmHotkeyEdit.FormCloseQuery(Sender: TObject; var CanClose: Boolean); begin if IsChanged then case Application.MessageBox('Hotkey definitions have changed. Save changes?', 'Hotkey Editor', MB_ICONQUESTION or MB_YESNOCANCEL) of IDYES: SaveHotkeys; IDNO : begin IsChanged := False; ReadHotkeys; LoadHotkeys; end; IDCANCEL: CanClose := False; end; end; procedure TfrmHotkeyEdit.LoadHotkeys; var Stream : TFileStream; Reader : TReader; Action : Integer; sVersion : String; iVersion : Integer; sDescription, sID, sHotkey, sCommandLine : String; Item : TMenuItem; begin with SysHotkeys do begin try try Stream := TFileStream.Create(ChangeFileExt(Application.ExeName, '.HKD'), fmOpenRead); try Reader := TReader.Create(Stream, 4096); try CommandLines.Clear; mnuEditHotkeys.Caption := '&Edit hotkeys...'; mnuListHotkeys.Caption := '&View hotkey list...'; mnuAbout.Caption := '&About...'; mnuHelp.Caption := 'Hotkeys &Help'; while mnuHotkeys.Count>0 do mnuHotkeys.Items[0].Free; Clear; sVersion := Reader.ReadString; iVersion := 120; if sVersion = 'Hotkey definitions, version 1.0' then iVersion:=100; if sVersion = 'Hotkey definitions, version 1.05' then iVersion:=105; Reader.ReadListBegin; while not Reader.EndOfList do begin sDescription := Reader.ReadString; // Hotkey description if (iVersion>100) then sID := Reader.ReadString; Action := Reader.ReadInteger; if (iVersion=100) and (Action>1) then inc(Action); case Action of 0, 1, 2: sCommandLine := Reader.ReadString; // Commandline 3 : sCommandLine := IntToStr(Reader.ReadInteger); // Parameter 10 : sCommandLine := IntToStr(Reader.ReadInteger); // Clipboard end; sHotkey := ReadHotkey(Reader); if Reader.ReadBoolean and ((Action>1) or (sCommandLine<>'')) then begin if (Action=0) then begin if (iVersion=120) then CommandLines.Add(IntToStr(Action) + '=' + sCommandLine+';'+Reader.ReadString) else CommandLines.Add(IntToStr(Action) + '=' + sCommandLine+';'+cboShow.Items[0]); end else CommandLines.Add(IntToStr(Action) + '=' + sCommandLine); AddHotkey(Virtkey(sHotkey), Modifiers(sHotkey)); case Action of 0,2: begin Item := NewItem(sDescription+#9+sHotkey, 0, False, True, HotkeyMenuClick, 0, ''); Item.Tag := CommandLines.Count-1; mnuHotkeys.Add(Item); end; 4: mnuEditHotkeys.Caption := '&Edit hotkeys...'+#9+sHotkey; 5: mnuListHotkeys.Caption := '&View hotkey list...'+#9+sHotkey; 6: mnuAbout.Caption := '&About...'+#9+sHotkey; 7: mnuHelp.Caption := 'Hotkeys &Help'+#9+sHotkey; end; end; end; Reader.ReadListEnd; finally Reader.Free; end; finally Stream.Free; end; finally mnuHotkeys.Visible := mnuHotkeys.Count>0; mnuSeparator1.Visible := mnuHotkeys.Count>0; end; except end; end; end; function TfrmHotkeyEdit.VirtKey(sHotkey: String): TVirtKey; begin Result := vkNone; while Pos('+', sHotkey)>0 do Delete(sHotkey, 1, Pos('+', sHotkey)); case cboHotKey.Items.IndexOf(sHotkey) of 0: Result := vkBack; // Backspace 1: Result := vkTab; // Tab 2: Result := vkReturn; // Return 3: Result := vkPause; // Pause 4: Result := vkCapital; // Capslock 5: Result := vkEscape; // Escape 6: Result := vkSpace; // Space 7: Result := vkPrior; // PgUp 8: Result := vkNext; // PgDn 9: Result := vkHome; // Home 10: Result := vkEnd; // End 11: Result := vkLeft; // Left Arrow 12: Result := vkUp; // Up Arrow 13: Result := vkRight; // Right Arrow 14: Result := vkDown; // Down Arrow 15: Result := vkSnapshot; // PrintScreen 16: Result := vkInsert; // Insert 17: Result := vkDelete; // Delete 18: Result := vk0; // 0 19: Result := vk1; // 1 20: Result := vk2; // 2 21: Result := vk3; // 3 22: Result := vk4; // 4 23: Result := vk5; // 5 24: Result := vk6; // 6 25: Result := vk7; // 7 26: Result := vk8; // 8 27: Result := vk9; // 9 28: Result := vkA; // A 29: Result := vkB; // B 30: Result := vkC; // C 31: Result := vkD; // D 32: Result := vkE; // E 33: Result := vkF; // F 34: Result := vkG; // G 35: Result := vkH; // H 36: Result := vkI; // I 37: Result := vkJ; // J 38: Result := vkK; // K 39: Result := vkL; // L 40: Result := vkM; // M 41: Result := vkN; // N 42: Result := vkO; // O 43: Result := vkP; // P 44: Result := vkQ; // Q 45: Result := vkR; // R 46: Result := vkS; // S 47: Result := vkT; // T 48: Result := vkU; // U 49: Result := vkV; // V 50: Result := vkW; // W 51: Result := vkX; // X 52: Result := vkY; // Y 53: Result := vkZ; // Z 54: Result := vkNumpad0; // Num 0 55: Result := vkNumpad1; // Num 1 56: Result := vkNumpad2; // Num 2 57: Result := vkNumpad3; // Num 3 58: Result := vkNumpad4; // Num 4 59: Result := vkNumpad5; // Num 5 60: Result := vkNumpad6; // Num 6 61: Result := vkNumpad7; // Num 7 62: Result := vkNumpad8; // Num 8 63: Result := vkNumpad9; // Num 9 64: Result := vkMultiply; // Num * 65: Result := vkAdd; // Num + 66: Result := vkSubtract; // Num - 67: Result := vkDecimal; // Num . 68: Result := vkDivide; // Num / 69: Result := vkF1; // F1 70: Result := vkF2; // F2 71: Result := vkF3; // F3 72: Result := vkF4; // F4 73: Result := vkF5; // F5 74: Result := vkF6; // F6 75: Result := vkF7; // F7 76: Result := vkF8; // F8 77: Result := vkF9; // F9 78: Result := vkF10; // F10 79: Result := vkF11; // F11 80: Result := vkF12; // F12 81: Result := vkF13; // F13 82: Result := vkF14; // F14 83: Result := vkF15; // F15 84: Result := vkF16; // F16 85: Result := vkF17; // F17 86: Result := vkF18; // F18 87: Result := vkF19; // F19 88: Result := vkF20; // F20 89: Result := vkF21; // F21 90: Result := vkF22; // F22 91: Result := vkF23; // F23 92: Result := vkF24; // F24 93: Result := vkNumlock; // Numlock 94: Result := vkScroll; // Scrolllock 95: Result := vkApps; // Application key end; end; function TfrmHotkeyEdit.Modifiers(sHotkey: String): THKModifiers; begin Result := []; if Pos('Ctrl', sHotkey) > 0 then Include(Result, hkCtrl); if Pos('Alt', sHotkey) > 0 then Include(Result, hkAlt); if Pos('Shift', sHotkey) > 0 then Include(Result, hkShift); if Pos('Win', sHotkey) > 0 then Include(Result, hkExt); end; procedure TfrmHotkeyEdit.SysHotkeysHotKey(Sender: TObject; Index: Integer); begin HotkeyPressed(Index); end; procedure TfrmHotkeyEdit.FormDestroy(Sender: TObject); var i : integer; begin CommandLines.Free; WindowList.Free; ChangeClipboardChain(Handle, hwndClipViewer); Clipboards.Free; with TInifile.Create(ChangeFileExt(Application.ExeName, '.ini')) do begin WriteInteger('Settings', 'ClipboardCount', udClipboards.Position); WriteInteger('EditorWindow', 'Width', Width); WriteInteger('EditorWindow', 'Height', Height); for i:=0 to lvHotkeys.Columns.Count-1 do with lvHotkeys.Columns[i] do WriteInteger('EWColumns', Caption, Width); Free; end; end; procedure TfrmHotkeyEdit.FormClose(Sender: TObject; var Action: TCloseAction); begin if not Quitting then begin Action := caNone; Hide; end; end; procedure TfrmHotkeyEdit.mnuEditHotkeysClick(Sender: TObject); begin EditHotkeys; end; procedure TfrmHotkeyEdit.wmEditKeys(var Msg: TMessage); begin if Msg.wParam = WM_EDITKEYS then EditHotkeys; end; procedure TfrmHotkeyEdit.wmQuitHotK(var Msg: TMessage); begin if Msg.wParam = WM_QUITHOTK then Quit; end; procedure TfrmHotkeyEdit.EditHotkeys; begin WindowState := wsNormal; Show; SetWindowPos(Handle, HWND_TOP, 0, 0, 0, 0, SWP_NOMOVE or SWP_NOSIZE or SWP_SHOWWINDOW); SetForeGroundWindow(Handle); end; procedure TfrmHotkeyEdit.mnuExitClick(Sender: TObject); begin Quit; end; procedure TfrmHotkeyEdit.Quit; begin Quitting := True; Close; end; procedure TfrmHotkeyEdit.SetChanged(Value: Boolean); begin if FChanged<>Value then begin FChanged := Value; if FChanged then SysHotkeys.Clear; btnApply.Enabled := FChanged; end; end; procedure TfrmHotkeyEdit.btnApplyClick(Sender: TObject); begin SaveHotkeys; end; procedure TfrmHotkeyEdit.FormResize(Sender: TObject); begin cboHotkey.Width := ClientWidth - 376; edtDescription.Width := ClientWidth - 184; edtKeysToSend.Width := ClientWidth - 184; cboActions.Width := ClientWidth - 184; cboParams.Width := ClientWidth - 184; cboClipboard.Width := ClientWidth - 184; lblShow.Left := ClientWidth - 220; cboShow.Left := ClientWidth - 185; udClipboards.Left := ClientWidth - 107; edtClipboards.Left := udClipboards.Left - edtClipboards.Width; lblClipboards.Left := edtClipboards.Left - lblClipboards.Width - 5; edtCommandLine.Width := ClientWidth - 310; end; procedure TfrmHotkeyEdit.wmGetMinMaxInfo(var Msg: TWMGETMINMAXINFO); begin Msg.MinMaxInfo^.ptMinTrackSize.X := 411; Msg.MinMaxInfo^.ptMinTrackSize.Y := 244; end; procedure TfrmHotkeyEdit.wmDrawClipboard(var Msg: TMessage); begin DrawClipboardStatus(Clipboards.ActiveClipboard); SendMessage(hWnd(Msg.lParam), Msg.Msg, Msg.wParam, Msg.lParam); end; procedure TfrmHotkeyEdit.wmChangeCBChain(var Msg: TMessage); begin if hWnd(Msg.wParam)=hwndClipViewer then hwndClipViewer := hWnd(Msg.wParam) else SendMessage(hWnd(Msg.lParam), Msg.Msg, Msg.wParam, Msg.lParam); end; procedure TfrmHotkeyEdit.atiHotkeysEndAnimation(Sender: TObject); begin atiHotkeys.Style := tsNormal; end; procedure TfrmHotkeyEdit.mnuAboutClick(Sender: TObject); begin AboutBox; end; procedure TfrmHotkeyEdit.AboutBox; begin frmAbout.Show; SetForeGroundWindow(frmAbout.Handle); end; procedure TfrmHotkeyEdit.ViewHotkeys; begin frmHotkeyList.Show; SetForeGroundWindow(frmHotkeyList.Handle); end; procedure TfrmHotkeyEdit.mnuListHotkeysClick(Sender: TObject); begin ViewHotkeys; end; procedure TfrmHotkeyEdit.HotkeyMenuClick(Sender: TObject); begin HotkeyPressed(TMenuItem(Sender).Tag); end; function TfrmHotkeyEdit.GetDelay(var Sel: String): Integer; var P : Integer; begin P := Pos('D=', Sel); if P=1 then begin Delete(Sel, 1, P+1); P := Pos(';', Sel); Result := StrToIntDef(Copy(Sel, 1, P-1), 0); Delete(Sel, 1, P); end else Result := -1 end; function TfrmHotkeyEdit.NextItem(var Commands: String): String; var P : Integer; begin P := Pos(';', Commands); if P>0 then begin Result := Copy(Commands, 1, P-1); Delete(Commands, 1, P); end else begin Result := Commands; Commands := ''; end; end; procedure TfrmHotkeyEdit.MultipleHotkeys(Command: String); var i, iDelay, iNDelay : Integer; ItemID : String; First : Boolean; begin iDelay := GetDelay(Command); if iDelay = -1 then iDelay := 0; ItemID := NextItem(Command); First := True; while ItemID<>'' do begin i := 0; while i<lvHotkeys.Items.Count do with lvHotkeys.Items[i] do if SubItems[ITEM_ID]=ItemID then begin if First then First := False else Sleep(iDelay); PerformAction(cboActions.Items.IndexOf(SubItems[ITEM_ACTION]), SubItems[ITEM_DATA], 0, True); i := lvHotkeys.Items.Count; end else inc(i); iNDelay := GetDelay(Command); if iNDelay<>-1 then iDelay := iNDelay; ItemID := NextItem(Command); end; end; function TfrmHotkeyEdit.WindowsVersion: DWord; var Version : TOSVersionInfo; begin Version.dwOSVersionInfoSize := SizeOf(TOSVersionInfo); GetVersionEx(Version); Result := Version.dwPlatformId; end; procedure TfrmHotkeyEdit.ExitWindowsCommand(Command: Integer); const Flags: array[0..2] of integer = (EWX_SHUTDOWN, EWX_LOGOFF, EWX_REBOOT); var OldPriv, CurPriv : TTokenPrivileges; TokenHandle, CP : THandle; PrivLen : DWord; begin if WindowsVersion = VER_PLATFORM_WIN32_NT then begin CP := GetCurrentProcess; if OpenProcessToken(CP, DWord(TOKEN_ADJUST_PRIVILEGES or TOKEN_QUERY), TokenHandle) then begin if LookupPrivilegeValue(nil, 'SeShutdownPrivilege', CurPriv.Privileges[0].LUID) then begin CurPriv.PrivilegeCount := 1; CurPriv.Privileges[0].Attributes := SE_PRIVILEGE_ENABLED; AdjustTokenPrivileges(TokenHandle, False, CurPriv, 0, OldPriv, PrivLen); end; end; end; case Command of 0..2 : ExitWindowsEx(Flags[Command], 0); 3 : WinExec(PChar(ExtractFilePath(Application.ExeName) + 'HKRESTRT.EXE'), SW_SHOW); 4 : WinExec(PChar('HKTODOS.PIF'), SW_SHOW); 5 : SetSystemPowerState(True, False); end; end; procedure TfrmHotkeyEdit.ExecProgram(Command: String); const ShowModes: array[0..2] of UINT = (SW_NORMAL, SW_SHOWMAXIMIZED, SW_SHOWMINIMIZED); var ShowMode: String; P : Integer; begin P := Pos(';', Command); if P=0 then ShowMode := cboShow.Items[0] else begin ShowMode := Copy(Command, P+1, Length(Command)); Delete(Command, P, Length(Command)); end; WinExec(PChar(Command), ShowModes[cboShow.Items.IndexOf(ShowMode)]); end; procedure TfrmHotkeyEdit.DrawClipOnBmp(IcoBmp: TBitmap; sText: String); var iWidth, iHeight: Integer; begin with IcoBmp do begin Canvas.Font.Name := 'Small Fonts'; Canvas.Font.Size := 6; Canvas.Font.Color := clWhite; if Clipboards.DataOnClipboard then Canvas.Brush.Color := clBlue else Canvas.Brush.Color := clNavy; Canvas.Pen.Style := psClear; iHeight := Canvas.TextHeight(sText); iWidth := Canvas.TextWidth(sText)+1; Canvas.Ellipse(Width-iWidth-2, Height-iHeight-1, Width+1, Height+1); Canvas.Brush.Style := bsClear; Canvas.TextOut(Width- ((iWidth+2) div 2) - (Canvas.TextWidth(sText) div 2)-1, Height-iHeight, sText); Canvas.Brush.Style := bsSolid; end; end; procedure TfrmHotkeyEdit.DrawClipboardStatus(Index: Integer); var AndMask, XOrMask: TBitmap; NewIcon : TIcon; IconInfo : TIconInfo; begin {Create the "XOr" mask} XOrMask := TBitmap.Create; try XOrMask.Width := imgIcon.Picture.Width; XOrMask.Height := imgIcon.Picture.Height; {Draw on the "XOr" mask} imgIcon.Transparent := False; XOrMask.Canvas.Draw(0, 0, imgIcon.Picture.Bitmap); DrawClipOnBmp(XorMask, IntToStr(Index+1)); XOrMask.Canvas.Brush.Color := imgIcon.Picture.Bitmap.Canvas.Pixels[0,0]; {Create the "And" mask} AndMask := TBitmap.Create; try AndMask.Monochrome := true; AndMask.Width := imgIcon.Picture.Width; AndMask.Height := imgIcon.Picture.Height; {Draw on the "And" mask} AndMask.Canvas.Brush.Color := clWhite; AndMask.Canvas.FillRect(Rect(0, 0, 16, 16)); { Draw the "XOr" mask on the "And" mask } AndMask.Canvas.Draw(0, 0, XOrMask); {Redraw the image on the XOr mask} imgIcon.Transparent := True; XorMask.Canvas.Brush.Color := clBlack; XorMask.Canvas.FillRect(Rect(0, 0, 16, 16)); XOrMask.Canvas.Draw(0, 0, imgIcon.Picture.Bitmap); DrawClipOnBmp(XorMask, IntToStr(Index+1)); {Create a icon} NewIcon := TIcon.Create; try IconInfo.fIcon := True; IconInfo.xHotspot := 0; IconInfo.yHotspot := 0; IconInfo.hbmMask := AndMask.Handle; IconInfo.hbmColor := XOrMask.Handle; NewIcon.Handle := CreateIconIndirect(IconInfo); atiHotkeys.Icon := NewIcon; finally NewIcon.Free; end; finally AndMask.Free; end; finally XOrMask.Free; end end; procedure TfrmHotkeyEdit.SwitchToClipboard(Index: Integer); begin Clipboards.SwitchToClipboard(Index, False); DrawClipboardStatus(Index); end; procedure TfrmHotkeyEdit.PerformAction(Action: Integer; Command: String; Index: Integer; Immediate: Boolean); begin case Action of 0: ExecProgram(Command); 1: if Immediate then SendKeys(Command, True) else PostMessage(Handle, WM_SENDKEYS, WM_SENDKEYS, Index); 2: PostMessage(Handle, WM_MULTKEYS, WM_MULTKEYS, Index); 3: ExitWindowsCommand(StrToInt(Command)); 4: EditHotkeys; 5: ViewHotkeys; 6: AboutBox; 7: HelpIndex; 8: MinimizeAll; 9: UndoMinimize; 10: SwitchToClipboard(StrToIntDef(Command, 1)); end; end; procedure TfrmHotkeyEdit.HotkeyPressed(Index: Integer); var P, Action : Integer; Command: String; begin if Index>CommandLines.Count then Exit; if CommandLines[Index]<>'' then begin atiHotkeys.Style := tsAnimated; P := Pos('=', CommandLines[Index]); Action := StrToInt(Copy(CommandLines[Index], 1, P-1)); Command := Copy(CommandLines[Index], P+1, Length(CommandLines[Index])); PerformAction(Action, Command, Index, False); end; end; procedure TfrmHotkeyEdit.wmMultKeys(var Msg: TMessage); var sCommand: String; begin if Msg.wParam=WM_MULTKEYS then begin sCommand := CommandLines[Msg.lParam]; Delete(sCommand, 1, Pos('=', sCommand)); MultipleHotkeys(sCommand); end; end; procedure TfrmHotkeyEdit.wmSendKeys(var Msg: TMessage); var sKeys: String; begin if Msg.wParam=WM_SENDKEYS then begin sKeys := CommandLines[Msg.lParam]; Delete(sKeys, 1, Pos('=', sKeys)); SendKeys(sKeys, False); end; end; procedure TfrmHotkeyEdit.chkShowIconClick(Sender: TObject); begin atiHotkeys.Active := chkShowIcon.Checked; with TInifile.Create(ChangeFileExt(Application.ExeName, '.INI')) do begin if chkShowIcon.Checked then WriteInteger('Settings', 'ShowTaskbarIcon', 1) else WriteInteger('Settings', 'ShowTaskbarIcon', 0); Free; end; end; procedure TfrmHotkeyEdit.FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); begin if Key=VK_F1 then WinHelp(Handle, PChar(ChangeFileExt(Application.ExeName, '.hlp')+'>EditWnd'), HELP_CONTEXT, 3); end; procedure TfrmHotkeyEdit.SetControls; var Index : Integer; begin Index := cboActions.ItemIndex; edtCommandLine.Visible := (Index=0) or (Index=2); lblShow.Visible := edtCommandLine.Visible; cboShow.Visible := edtCommandLine.Visible; edtKeysToSend.Visible := (Index=1); cboParams.Visible := (Index=3); lblCommandLine.Visible := (Index<=3) or (Index=10); cboClipboard.Visible := (Index=10); case Index of 0 : begin lblCommandLine.Caption := 'Co&mmandline:'; lblCommandLine.FocusControl := edtCommandLine; edtCommandLine.Dialog := opdOpenFile; end; 1 : begin lblCommandLine.Caption := '&Keys to send:'; lblCommandLine.FocusControl := edtKeysToSend; end; 2 : begin lblCommandLine.Caption := 'Com&mand IDs:'; lblCommandLine.FocusControl := edtCommandLine; edtCommandLine.Dialog := nil; end; 3 : begin lblCommandLine.Caption := 'Para&meters:'; lblCommandLine.FocusControl := cboParams; end; 10: begin lblCommandLine.Caption := 'Clip&board:'; lblCommandLine.FocusControl := cboClipboard; end; end; end; procedure TfrmHotkeyEdit.cboActionsClick(Sender: TObject); begin if Item.SubItems[ITEM_ACTION] <> cboActions.Items[cboActions.ItemIndex] then begin Item.SubItems[ITEM_ACTION] := cboActions.Items[cboActions.ItemIndex]; case cboActions.ItemIndex of 0,2: Item.SubItems[ITEM_DATA] := edtCommandLine.Text; 1 : Item.SubItems[ITEM_DATA] := edtKeysToSend.Text; 3 : Item.SubItems[ITEM_DATA] := cboParams.Items[cboParams.ItemIndex]; 10 : Item.SubItems[ITEM_DATA] := cboClipboard.Items[cboClipboard.ItemIndex]; else Item.SubItems[ITEM_DATA] := ''; end; IsChanged := True; SetControls; end; end; procedure TfrmHotkeyEdit.HelpIndex; begin WinHelp(Handle, PChar(ChangeFileExt(Application.ExeName, '.hlp')), HELP_CONTENTS, 0); end; function EnumProc(Wnd: hWnd; lp: lParam): Bool; stdcall; var pClass: array[0..255] of char; begin // if GetWindowLong(Wnd, GWL_HWNDPARENT)<>0 then // repeat // Wnd := GetWindowLong(Wnd, GWL_HWNDPARENT); // until GetWindowLong(Wnd, GWL_HWNDPARENT)=0; GetClassName(Wnd, pClass, 255); if IsWindowVisible(Wnd) and not IsIconic(Wnd) and (StrPas(pClass)<>'Shell_TrayWnd') then frmHotkeyEdit.WindowList.Add(Pointer(Wnd)); Result := True; end; function TfrmHotkeyEdit.WindowAnimation(Value: Integer): Integer; var AniInfo: TAnimationInfo; begin AniInfo.cbSize := Sizeof(TAnimationInfo); SystemParametersInfo(SPI_GETANIMATION, 0, @AniInfo, 0); Result := AniInfo.iMinAnimate; if AniInfo.iMinAnimate<>Value then begin AniInfo.iMinAnimate := Value; SystemParametersInfo(SPI_SETANIMATION, 0, @AniInfo, 0); end; end; procedure TfrmHotkeyEdit.MinimizeAll; var i, Anim: Integer; begin WindowList.Clear; EnumWindows(@EnumProc, 0); Anim := WindowAnimation(0); for i:=0 to WindowList.Count-1 do SendMessage(hWnd(WindowList[i]), WM_SYSCOMMAND, SC_MINIMIZE, 0); WindowAnimation(Anim); end; procedure TfrmHotkeyEdit.UndoMinimize; var i, Anim: Integer; begin Anim := WindowAnimation(0); for i:=WindowList.Count-1 downto 0 do SendMessage(hWnd(WindowList[i]), WM_SYSCOMMAND, SC_RESTORE, 0); WindowAnimation(Anim); end; procedure TfrmHotkeyEdit.cboParamsClick(Sender: TObject); begin if Item.SubItems[ITEM_DATA] <> cboParams.Items[cboParams.ItemIndex] then begin Item.SubItems[ITEM_DATA] := cboParams.Items[cboParams.ItemIndex]; IsChanged := True; end; end; procedure TfrmHotkeyEdit.edtKeysToSendChange(Sender: TObject); begin if (Item<>nil) and not Ignore then begin Item.SubItems[ITEM_DATA] := edtKeysToSend.Text; IsChanged := True; end; end; procedure TfrmHotkeyEdit.mnuHelpClick(Sender: TObject); begin HelpIndex; end; procedure TfrmHotkeyEdit.edtIDChange(Sender: TObject); begin if (Item<>nil) and not Ignore then begin Item.SubItems[ITEM_ID] := MakeID(lvHotkeys, Item, edtID.Text); IsChanged := True; end; end; procedure TfrmHotkeyEdit.edtIDExit(Sender: TObject); begin if (Item<>nil) and (edtID.Text <> Item.SubItems[ITEM_ID]) then edtID.Text := Item.SubItems[ITEM_ID]; end; procedure TfrmHotkeyEdit.edtDescriptionExit(Sender: TObject); begin if (Item<>nil) and (edtID.Text='') then edtID.Text := MakeID(lvHotkeys, Item, edtDescription.Text); end; procedure TfrmHotkeyEdit.edtCommandLineButtonClick(Sender: TObject); begin if frmSelect.Execute(lvHotkeys, edtCommandLine.Text) then edtCommandLine.Text := frmSelect.Selection; end; procedure TfrmHotkeyEdit.lvHotkeysChange(Sender: TObject; Item: TListItem; Change: TItemChange); begin if (Change=ctState) and Item.Selected then lvHotkeysClick(Sender); end; procedure TfrmHotkeyEdit.edtCommandLineExit(Sender: TObject); var i : Integer; sCommand, sItemID : String; bFound, bError : Boolean; begin if cboActions.ItemIndex=2 then begin sCommand := edtCommandLine.Text; GetDelay(sCommand); sItemID := NextItem(sCommand); bError := False; while (sItemID<>'') and (not bError) do begin bFound := False; i := 0; while not bError and not bFound and (i<lvHotkeys.Items.Count) do if lvHotkeys.Items[i].SubItems[ITEM_ID]=sItemID then begin if cboActions.Items.IndexOf(lvHotkeys.Items[i].SubItems[ITEM_ACTION])=2 then bError := True else bFound := True; end else inc(i); if bFound then begin GetDelay(sCommand); sItemID := NextItem(sCommand); end else bError := True end; if bError then begin Application.MessageBox('This entry contains one or more invalid IDs (ID does not exist or ID belongs to Multiple Action command).', 'Invalid IDs found', MB_ICONEXCLAMATION or MB_OK); edtCommandLine.SetFocus; end; end; end; procedure TfrmHotkeyEdit.cboShowClick(Sender: TObject); begin if Item.SubItems[ITEM_SHOW] <> cboShow.Items[cboShow.ItemIndex] then begin Item.SubItems[ITEM_SHOW] := cboShow.Items[cboShow.ItemIndex]; IsChanged := True; end; end; procedure TfrmHotkeyEdit.cboClipboardClick(Sender: TObject); begin if Item.SubItems[ITEM_DATA] <> cboClipboard.Items[cboClipboard.ItemIndex] then begin Item.SubItems[ITEM_DATA] := cboClipboard.Items[cboClipboard.ItemIndex]; IsChanged := True; end; end; procedure TfrmHotkeyEdit.edtClipboardsExit(Sender: TObject); begin edtClipboards.Text := IntToStr(udClipboards.Position); end; procedure TfrmHotkeyEdit.edtClipboardsChange(Sender: TObject); begin if not Ignore then SetClipboards; end; end.