среда, 4 февраля 2015 г.

MIDI-In. Тест приема сообщений с MIDI-синтезатора

В рамках одной из консультаций накидывал тест приема сообщений с MIDI-синтезатора на WinAPI, подключенного по USB. Как известно, MIDI интерфейс  физически - токовый интерфейс (по сути токовая петля ИРПС) и позволяет кодировать в цифровой форме нажатие клавиш, выбор тембра, темпа, тональности, настройку громкости и других акустических параметров с точной привязкой во времени (на скорости 31250 бод ±1%). Сам код каллбэка на Midi In простейший по midiInOpen(). Приложение не содержит никаких форм, вывод сообщений прямо на канвас экрана пользователя.

Код:
program raxp_midi_in;
// Test MIDI-IN Callback
// Developer: Badlo Sergey
// H-page: http://raxp.radioliga.com

uses Messages, Windows, classes, mmsystem;

type
  sample = class
  public
    constructor Create;
    destructor Destroy; override;
    procedure WndProc(var Msg:TMessage);
  end;

var
  Msg: tmsg;
  smp: sample;
  FWND: HWND;
  _hdc: hDC;
  // вход midi
  _in: HMIDIIn;

procedure midiCallback(handle: HMIDIIn; uMsg: uint; dwInstance, dwParam1, dwParam2: dword); stdcall;
var t, t1, t2, t3, text: string;
begin
 RedrawWindow(GetDesktopWindow,nil,0,RDW_INVALIDATE + RDW_UPDATENOW + RDW_ALLCHILDREN);

 str(dwInstance, t1);
 str(dwParam1, t2);
 str(dwParam2, t3);
 str(uMsg, text);

 t:= t1 + ' | ' + t3 + ' | ' + t3;
 sleep(100);
 TextOut(_hdc, 100, 70, pansichar(t), length(t));
 TextOut(_hdc, 100, 100, pansichar(text), length(text));
end;

procedure sample.WndProc(var Msg:TMessage);
begin
 case dword(Msg.lparam) of
  WM_MBUTTONDOWN : ;
  WM_LBUTTONUP   : ;
  WM_RBUTTONUP   : ;
 end
end;



constructor sample.Create;
Begin
 inherited Create;
 FWnd:= AllocateHWnd(WndProc);
 _hdc:= GetDC(0);

 midiInOpen(@_In, 0, cardinal(@midiCallback), 0, CALLBACK_FUNCTION);
 midiInStart(_In)
End;

destructor sample.Destroy;
Begin
 midiInStop(_In);
 midiInReset(_In);
 midiOutClose(_In);

 ReleaseDC(0, _hdc);
 RedrawWindow(GetDesktopWindow,nil,0,RDW_INVALIDATE + RDW_UPDATENOW + RDW_ALLCHILDREN);
 //
 deAllocateHWnd(fwnd);
 inherited Destroy
End;
// END СЕРВИС МОДУЛЬ ----------------


begin
 smp:= sample.Create;

 try while GetMessage(Msg, 0, 0, 0) do begin
  TranslateMessage(Msg);
  DispatchMessage(Msg)
 end
 finally smp.Free end
end.
скачать сабж

Комментариев нет:

Отправить комментарий

В комментариях уважайте собеседника, внимательно читайте посты и не додумывайте. Просьбы и предложения из разряда: «можно ваш Skype/Viber/телефон», «напишите мне в vk/FB», а также другие им подобные — игнорируются. Выход новых версий ПО, внешняя ссылка, переставшая работать с течением времени и т.п. не является основанием для претензий. Желающие спокойно подискутировать и высказаться — Welcome. Желающие спонсировать блог — Donate. Нарушение этих простых правил ведет к бану и удалению комментариев без предупреждения.