[Qwed86]

Есть клавиатуры на которых имеются клавиши мультимедиа, у меня не такая). Можно настроить переключение песен в проигрывателе(windows media player) на определённую клавишу? Чтоб как на мультимедийной клаве вперед и назад.

[Qwed86]

Ну что-то нашёл

Код:

function TForm1.GetWMPHandle: hwnd;
begin
 result := FindWindow('WMPlayerApp', nil); 
 result := FindWindowEx(result, 0, 'WMPAppHost', 'WMPAppHost');
 if result = 0 then result := Findwindow(nil,'Windows Media Player');
end;

//На бутон или имя клавиши
var wnd:hwnd;
begin
 wnd := GetWMPHandle;
 if wnd <> 0 then SendMessage(wnd,WM_APPCOMMAND,0,$B0000);
end;

{Windows Media Player API}
WMP_VOLUME_MUTE = $80000;
WMP_VOLUME_DOWN = $90000;
WMP_VOLUME_UP = $a0000;
WMP_MEDIA_NEXTTRACK = $B0000;
WMP_MEDIA_PREVIOUSTRACK = $C0000;
WMP_MEDIA_STOP = $D0000;
WMP_MEDIA_PLAY_PAUSE = $E0000;

Но это работает только если прога имеет фокус, а как теперь сделать чтоб это работало независимо от активного на данный момент приложения?
Т.е. например на VK_NUMPAD0 переключался трек?

[Alexo]

регистрировать их как глобальные горячие клавиши.

[Qwed86]

Ну теперь всё работает

Код:

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  TForm1 = class(TForm)
    function GetWMPHandle : hwnd;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure FormActivate(Sender: TObject);
    private
    procedure WMHotKey(var Msg: TWMHotKey); message WM_HOTKEY;
       { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  var wnd:hwnd;

implementation

{$R *.dfm}

function TForm1.GetWMPHandle: hwnd;
begin
 result := FindWindow('WMPlayerApp', nil);
 result := FindWindowEx(result, 0, 'WMPAppHost', 'WMPAppHost');
 if result = 0 then result := Findwindow(nil,'Windows Media Player');
end;

procedure TForm1.WMHotKey(var Msg: TWMHotKey);
begin
 wnd := GetWMPHandle;
 if msg.HotKey=1 then
    if wnd <> 0 then SendMessage(wnd,WM_APPCOMMAND,0,$C0000);
 if msg.HotKey=2 then
    if wnd <> 0 then SendMessage(wnd,WM_APPCOMMAND,0,$B0000);
 if msg.HotKey=3 then
    if wnd <> 0 then SendMessage(wnd,WM_APPCOMMAND,0,$E0000);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  RegisterHotKey(Form1.Handle, 1, 0, vk_f1);
  RegisterHotKey(Form1.Handle, 2, 0, vk_f2);
  RegisterHotKey(Form1.Handle, 3, 0, vk_f3);
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  UnRegisterHotKey(Form1.Handle, vk_f1);
  UnRegisterHotKey(Form1.Handle, vk_f2);
  UnRegisterHotKey(Form1.Handle, vk_f3);
end;

procedure TForm1.FormActivate(Sender: TObject);
begin
  ShowWindow(Handle,SW_MINIMIZE);
  ShowWindow(Application.Handle,SW_MINIMIZE);
end;

end.

А можно это всё на winapi полностью без формы, нах она не нужна просто? У меня не выходит что-то.
Если просто переделывать ругается на procedure WMHotKey(var Msg: TWMHotKey); message WM_HOTKEY; в часности на слово message типа unknown directive?

[Alexo]

Сервис писать, или еще проще просто спрятать форму.

[Qwed86]

Alexo Ну спрятать это понятно, я чтоб весила меньше хочу, щас я допру уже почти родил).

[Qwed86]

Вот оно), теперь всё нормал, exeшник 49,5кб весит

Код:

program Project1;

uses windows, messages, sysutils;

{$R *.res}
 var wnd, Instance, Handle : hwnd;
     WindowClass           : TWndClass;
     msg                   : TMsg;

Procedure Close;
begin
  UnRegisterHotKey(Handle, vk_f1);
  UnRegisterHotKey(Handle, vk_f2);
  UnRegisterHotKey(Handle, vk_f3);
  UnRegisterHotKey(Handle, vk_f4);
  Halt(255);
end;

function GetWMPHandle: hwnd;
begin
 result := FindWindow('WMPlayerApp', nil);
 result := FindWindowEx(result, 0, 'WMPAppHost', 'WMPAppHost');
 if result = 0 then result := Findwindow(nil,'Windows Media Player');
end;

function WindowProc (Hwn,msg,wpr,Ipr: longint): longint; stdcall;
begin
  wnd := GetWMPHandle;

  if Msg=WM_KEYDOWN then
  if Wpr=WM_Destroy then Close;

  if msg=WM_HOTKEY then
  case Wpr of
    1: if wnd <> 0 then SendMessage(wnd,WM_APPCOMMAND,0,$C0000);
    2: if wnd <> 0 then SendMessage(wnd,WM_APPCOMMAND,0,$B0000);
    3: if wnd <> 0 then SendMessage(wnd,WM_APPCOMMAND,0,$E0000);
    4: Close;
  end;

result:=defwindowproc(hwn,msg,wpr,Ipr);
end;

begin
instance :=GetModuleHandle(nil);
WindowClass.style:=CS_HRedraw or CS_VRedraw;
WindowClass.HbrBackground:= color_btnface;
WindowClass.Hcursor:=LoadCursor(0,IDC_ARROW);
WindowClass.Lpfnwndproc:=@windowproc;
WindowClass.LpszClassName:='DX';
WindowClass.Hinstance:=Instance;

RegisterClass (WindowClass);

Handle:=CreateWindowEx (0,'DX', '' , WS_POPUP, 1,1, 200, 200,0,0,Instance, nil);

RegisterHotKey(Handle, 1, 0, vk_f1);
RegisterHotKey(Handle, 2, 0, vk_f2);
RegisterHotKey(Handle, 3, 0, vk_f3);
RegisterHotKey(Handle, 4, 0, vk_f4);

//ShowWindow(Handle,SW_SHOW);
//UpdateWindow(Handle);

while (GetMessage(msg, 0, 0, 0)) do
begin
  translatemessage (msg) ;
  dispatchmessage (msg);
end;

end.

[Qwed86]

Ну не совсем хорошо, переключается, но в играх нет(. Если фокус на окне с игрой то нифига не посылается. В чём причина и как исправить кто знает? Игры чё блокируют всё сразу? Не все конечно например в pes2009 не работет.