⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 hkedit.pas

📁 HOOK
💻 PAS
📖 第 1 页 / 共 4 页
字号:
    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.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -