home *** CD-ROM | disk | FTP | other *** search
/ Sound, Music & MIDI Collection 2 / SMMVOL2.bin / PROG / MIDICOMP.ZIP / MULTIMNP.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1995-07-01  |  3.7 KB  |  145 lines
  1. { $Header:   F:/delphi/midi/vcs/multimnp.pas   1.2   02 Jul 1995 00:51:04   DAVEC  $ }
  2.  
  3. { This demo shows how MIDI input devices can be created at runtime.
  4.   It creates one MidiInput component for each physical MIDI input device
  5.   on the system, and uses a common input handler procedure to display
  6.   the input data, including the name of the input device. }
  7.  
  8. unit Multimnp;
  9.  
  10. interface
  11.  
  12. uses
  13.   SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  14.   Forms, Dialogs, MMSystem, StdCtrls, MIDIIn, MidiOut, ExtCtrls,
  15.   Menus, Monprocs;
  16.  
  17. type
  18.   TForm1 = class(TForm)
  19.     lstLog: TListBox;
  20.     pnlColumnHeading: TPanel;
  21.     MainMenu1: TMainMenu;
  22.     File1: TMenuItem;
  23.     mnuExit: TMenuItem;
  24.     procedure MIDIInput1MidiInput(Sender: TObject);
  25.     procedure LogMessage(devName: String; ThisEvent:TMidiEvent);
  26.     procedure FormCreate(Sender: TObject);
  27.     procedure FormResize(Sender: TObject);
  28.     procedure FormClose(Sender: TObject; var Action: TCloseAction);
  29.     procedure mnuExitClick(Sender: TObject);
  30.   private
  31.     logItemMax: Integer;
  32.     MidiInControls: TList;
  33.   public
  34.     { Public declarations }
  35.   end;
  36.  
  37. var
  38.   Form1: TForm1;
  39.   inh: HMidiIn;
  40.  
  41. implementation
  42.  
  43. {$R *.DFM}
  44.  
  45.  
  46. procedure TForm1.LogMessage(devName: String; ThisEvent: TMidiEvent);
  47. { Logging MIDI messages with a Windows list box is rather slow and ugly,
  48.   but it makes the example very simple.  If you need a faster and less
  49.   flickery log you could port the rest of Microsoft's MIDIMON.C example. }
  50. begin
  51.     if logItemMax > 0 then
  52.         begin
  53.         With lstLog.Items do
  54.             begin
  55.             if Count >= logItemMax then
  56.                 Delete(0);
  57.             Add(Copy(devName,1,7) + ' ' + MonitorMessageText(ThisEvent));
  58.             end;
  59.         end;
  60. end;
  61.  
  62. procedure TForm1.MIDIInput1MidiInput(Sender: TObject);
  63. var
  64.     thisEvent: TMidiEvent;
  65. begin
  66.     with (Sender As TMidiInput) do
  67.         begin
  68.         while (MessageCount > 0) do
  69.             begin
  70.  
  71.             { Get the event as an object }
  72.             thisEvent := GetMidiEvent;
  73.  
  74.             { Log it, using the name of the current device }
  75.             LogMessage(Copy(ProductName,1,7), thisEvent);
  76.  
  77.             { Event was dynamically created by GetMidiEvent so must
  78.                 free it here }
  79.             thisEvent.Free;
  80.  
  81.             end;
  82.         end;
  83. end;
  84.  
  85. procedure TForm1.FormCreate(Sender: TObject);
  86. var
  87.     testDeviceID: Word;
  88.     thisControl: TMidiInput;
  89. begin
  90.     { Create and open one MIDI input control for each installed MIDI input device }
  91.     midiInControls := TList.Create;
  92.     if midiInGetNumDevs > 0 then
  93.          for testDeviceID := 0 To (midiInGetNumDevs-1) do
  94.              begin
  95.              thisControl := TMidiInput.Create(Self);
  96.              thisControl.DeviceID := testDeviceID;
  97.              thisControl.OnMidiInput := Form1.MIDIInput1MidiInput;
  98.              thisControl.Open;
  99.              thisControl.Start;
  100.              MidiInControls.Add(thisControl);
  101.              end;
  102. end;
  103.  
  104. procedure TForm1.FormResize(Sender: TObject);
  105. var
  106.     logTop: Integer;
  107. const
  108.     logMargin = 8;
  109. begin
  110.     { Set maximum items that can be stored in the list box without scrolling }
  111.     if lstLog.ItemHeight > 0 then
  112.         begin
  113.         logItemMax := (lstLog.Height div lstLog.ItemHeight)-1;
  114.         { If there are currently more items than the max, remove them
  115.           otherwise the list will have scrollbars when resized }
  116.         with lstLog.Items do
  117.             begin
  118.             while (Count >= logItemMax) and (Count > 0) do
  119.                 Delete(0);
  120.                 end;
  121.             end
  122.     else
  123.         logItemMax := 0;
  124. end;
  125.  
  126. procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
  127. var
  128.     controlCtr: Integer;
  129. begin
  130.     { This is not strictly necessary since the objects close themselves
  131.       when the form containing them is destroyed }
  132.     with MidiInControls do
  133.         if Count > 0 then
  134.             for controlCtr := 0 to Count-1 do
  135.                 TMidiInput(Items[controlCtr]).Free;
  136. end;
  137.  
  138. procedure TForm1.mnuExitClick(Sender: TObject);
  139. begin
  140.     Application.Terminate;
  141. end;
  142.  
  143.  
  144. end.
  145.