Midi Messages (Win32 VISTA) to LCL (visual) control event
lazarus / 8-Other

----------------------------------------------------------------------
chain_reaction · 2009-07-07 21:46

Hello everybody..i'm a newbie musician also a newbie in lazarus.
i'm programming my own midi controller devices also my keyboard
controller for live performance music by capturing/hooking their midi
byte messages then give responds to a an event LCL Control .
I put the event (method pointer) in the CALLBACK (stdcall type)
routine (define by microsoft API that is MidiInProc() ).

I have written the code in delphi (trial  ) using VCL control, and it
has NO PROBLEMO.

But when i wrote it in Lazarus by using LCL control, it's HANGED!
whereas i just wrote an event handler : Form1.Caption := 'A message is
coming'; .
It is strange that there is NO PROBLEMO when i wrote it with lazarus
console mode. I worte in the event handler : Writeln('A message is
coming'); .

I notice from the microsoft SDK doc:
Remarks :
Applications should not call any system-defined functions from inside
a callback function, except for EnterCriticalSection,
LeaveCriticalSection, midiOutLongMsg, midiOutShortMsg,
OutputDebugString, PostMessage, PostThreadMessage, SetEvent,
timeGetSystemTime, timeGetTime, timeKillEvent, and timeSetEvent.

is the messages flow is to fast for the LCL control?? or any idea what
cause is it??
thanx

----------------------------------------------------------------------
Paul Ishenin · 2009-07-07 23:47

Can you create a small example which hangs and a bug report?

----------------------------------------------------------------------
chain_reaction · 2009-07-08 08:19

This is the simple code : (works fine with std ctrl VCL Delphi but not
with std ctrl LCL Lazarus)

----------------------------------------------------------------------
---------------------
Code: [Select]procedure TMainForm.btnMidInOpenClick(Sender: TObject);
var
  MidiDevice: TMidiDevice;
begin
  with lbMidiIn do  //TListBox
    if ItemIndex <> -1 then
    begin
        MidiDevice :=
TMidiInDevice(MidiInDeviceList1.MidiDevices[ItemIndex]);
        if Assigned(MidiDevice) then
        begin
          //................
          MidiDevice.OnMidiMessage := @MidiMessageHandler;    //
method pointer is at last below
          MidiDevice.Open(True);
          //................
        end
       {$IFDEF DEBUG}
        else raise Exception.Create('Object not assigned');
       {$ENDIF}
    end;
end;

//--------------------------------------------------------------------
------------------------
// event handler
procedure TMainForm.MidiInOnOpenHandler(Sender: TObject);
begin
  StatusBar1.Panels[0].Text := (Format('Midi Device: %s is opened',
[TMidiDevice(Sender).ProductName]));
end;

//--------------------------------------------------------------------
------------------------
// event handler
procedure TMainForm.MidiInOnCloseHandler(Sender: TObject);
begin
  StatusBar1.Panels[0].Text := Format('Midi Device: %s is closed',
[TMidiDevice(Sender).ProductName]);
end;

//--------------------------------------------------------------------
------------------------ 
// event handler
{ NOTE:
1. I use some different seperated code handler below !
2. The midi message is fast, because sometimes i pushed 3-6
control(hardware) simultan!
}
procedure TMainForm.MidiMessageHandler(Sender: TObject; Msg: Cardinal;
  Param: Cardinal);
begin
  {converting Param parameter}
  Self.Tag := Param;                      // if i use this code, the
program works FINE!
  Self.Caption := IntToStr(Param);        // if i use this code, the
program is CRASHED!
  Self.Caption := Format('%d' , [Param]); // if i use this code, the
program is CRASHED!

  { converting Msg parameter }
  Self.Caption := IntToStr(Msg);          // program is SOMETIMES
CRASHED!
end; 

{ NOTE: the program is also CRASHED when i using other LCL control }

// -------------------------------------------------------------------
----------------------------
// the method pointer in the CALLBACK funct!
procedure MidiInputProc(hMidiIn: THMidiIn; wMsg, dwInstance, dwParam1,
dwParam2: Cardinal); stdcall;
begin
  // dwInstance is the address of the object
  {$IFDEF DELPHI}
  TMidiDevice(Ptr(dwInstance).DoMidiMessage(wMsg, dwParam1); //DELPHI
  {$ELSE}
  TMidiDevice(dwInstance).DoMidiMessage(wMsg, dwParam1);  //LAZARUS
  {$ENDIF}
end; 

// -------------------------------------------------------------------
------------------
When i run debug the program, it says : "project raise exception class
'External: SIGSEGV'."
Thanx Mr.Paul. But i'm sorry, how do i make a bug report?? i newbie in
LAZ

--
Edit: I put the code in a code tag (Vincent)

----------------------------------------------------------------------
ruggieri · 2010-01-24 16:39

Ciao I'm not professional programmer (excuse me for my english)
I have some code from Delphi (not VCL) and have the same problem with
MINI-IN.

No problem with Delphi but with Lazarus yes.
No problem with MIDI-OUT.

When MIDIIN message arrive Lazarus give error SIGSEGV...

Somebody has MIDI code for Lazarus?

Thanks Renzo

----------------------------------------------------------------------
marcov · 2010-01-24 17:20

I'm willing to have a look, but I need a complete working sample

(iow a simple as possible compilable Lazarus program, preferably with
a delphi equivalent (TurboE 2006) and a midi file to play.

----------------------------------------------------------------------
ruggieri · 2010-01-25 16:51

Thanks Markov.
This is the code for UNIT1

Code: [Select]unit Unit1;
{$MODE Delphi}

interface
uses
  Windows, LCLIntf, Messages, SysUtils, Classes, Graphics, Controls,
Forms, Dialogs,
  Menus, ExtCtrls, ComCtrls, StdCtrls, LResources, MmSystem;

type
  TForm1 = class(TForm)
    MainMenu1: TMainMenu;
    File1: TMenuItem;
    Quit2: TMenuItem;
    MIDI1: TMenuItem;
    MIDIIn1: TMenuItem;
    MIDIOut1: TMenuItem;
    N1: TMenuItem;
    ToStart1: TMenuItem;
    Help1: TMenuItem;
    N3: TMenuItem;
    Author1: TMenuItem;
    Led: TPanel;
    Button4: TButton;
    Label1: TLabel;
    procedure FormCreate(Sender: TObject);
    procedure Quit2Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
  private
    { Private declarations }
    procedure NewMenu(Sender : TObject);
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  devHandle: HMIDIIN;   //per MIDI IN/OUT
  inHandle: HMIDIIN;    //per MIDI-IN
  INdev : Integer;      //numero del DEVICE di INgresso
  OUTdev : Integer;     //numero del DEVICE di Uscita


implementation
//MIDI-IN CALLBACK-----
function midiCallback(inHandle: HMidiIn; uMsg: integer; dwInstance:
integer; dwParam1: integer;  dwParam2: integer): boolean; pascal;
var
   msg : byte;
   d1: byte;
   d2: byte;
begin
//separa il messaggio
msg := LoByte(LoWord(uMsg));
d1 := HiByte(LoWord(uMsg));
d2 := LoByte(HiWord(uMsg));
     if (msg > 127) and (msg < 254) then
        begin
        if d2 <> 0 then Form1.Led.Color := clRed
        else Form1.Led.Color := clMaroon;
        midiOutShortMsg(devHandle, uMsg);
        Form1.Label1.Caption := IntToHex(uMsg, 8);
        Form1.Label1.Caption := IntToStr(msg) + '-'+ IntToStr(d1) +
'-'+IntToStr(d2);
        end;
Application.ProcessMessages;
end;

//Apre MIDI-IN
procedure INOpen;
begin
if midiInOpen(@inHandle, INdev, DWORD(@midiCallback), 0,
CALLBACK_FUNCTION) = 0
        then midiInStart(inHandle)
        else ShowMessage('MIDI-IN error!');
end;
//Chiude MIDI-IN
Procedure INClose;
begin
midiInReset(inHandle);
midiInClose(inHandle);
end;

//MIDI-OUT Open-----
Procedure OUTOpen;
begin
//if per rivelare errori di apertura
if midiOutOpen(@devHandle, OUTdev, 0, 0, CALLBACK_NULL ) <> 0 then
   Begin
   ShowMessage('MIDI-OUT error!');
   end;

end;
//MIDI-OUT close
Procedure OUTClose;
Begin
midiOutClose(devHandle);
end;

//evento creato appositamente per i Menu creati RUN-TIM
//vedi dichiarazione nella sezione PRIVATE di TFORM1
procedure TForm1.NewMenu(Sender : TObject);
var
  i : integer;
begin
        // per menu del MIDI-In
        for i := 0 to midiInGetNumDevs -1 do
        begin
        MIDIIn1.Items[i].Checked := false;
        if Sender = MIDIIn1.Items[i]  then
                begin
                INClose;
                INdev := i;
                INOpen;
                MIDIIn1.Items[i].Checked := true;
                end;
        end;

        //per menu del MIDI-OUT
        for i := 0 to midiOutGetNumDevs -1 do
        begin
        MIDIOut1.Items[i].Checked := false;
        if Sender = MIDIOut1.Items[i]  then
                begin
                OUTClose;
                OUTdev := i;
                OUTOpen;
                MIDIOut1.Items[i].Checked := true;
                end;
        end;
end;


//------------------------------------------------------
procedure TForm1.FormCreate(Sender: TObject);
var
  MidiInCaps: TMidiInCapsA;
  MidiOutCaps: TMidiOutCapsA;
  i: integer;
  NewItem : Tmenuitem;
begin
//MIDI-IN DEV
        for i := 1 to midiInGetNumDevs do
        begin
        midiInGetDevCaps(i - 1, @MidiInCaps, sizeof(TMidiInCapsA));
        NewItem:=tmenuitem.create(Mainmenu1);
        NewItem.caption:= StrPas(MidiInCaps.szPname);
        NewItem.OnClick := NewMenu;
        MIDIIn1.Add(NewItem);
        end;
MIDIIn1.Items[0].Checked := true; // SPUNTA il primo MIDI-IN
disponibie su Menu
INdev := 0; //definisce il 0=primo device disponibile 1=secondo
INOpen; //apre MIDI-in

//MIDI OUT DEV
        for i := 1 to midiOutGetNumDevs do
        begin
        midiOutGetDevCaps(i - 1 , @MidiOutCaps,
sizeof(TMidiOutCapsA));
        NewItem:=tmenuitem.create(Mainmenu1);
        NewItem.caption:= StrPas(MidiOutCaps.szPname);
        NewItem.OnClick := NewMenu;
        MIDIOut1.Add(NewItem);
        end;

MIDIout1.Items[0].Checked := true; // SPUNTA il primo MIDI-OUT
disponibie su Menu
OUTdev := 0; //definisce il primo device disponibile
OUTOpen; //apre MIDI-OUT
end;

procedure TForm1.Quit2Click(Sender: TObject);
begin
INClose;
Application.ProcessMessages;
OUTClose;
Application.ProcessMessages;
Application.Terminate;
end;

procedure TForm1.Button4Click(Sender: TObject);
var
Msg: DWORD;
begin
//esempi di invio messaggi midi
//midiOutShortMsg(devHandle, $00503C90);
//sleep(300);
//midiOutShortMsg(devHandle, $00003C90);

Msg := DWORD($90) or
            (DWORD($3E) shl 8) or
            (DWORD(127) shl 16);
midiOutShortMsg(devHandle, Msg);
end;

initialization
  {$i Unit1.lrs}

end.                                                    


Renzo

----------------------------------------------------------------------
chain_reaction · 2012-03-18 10:19

Hello dear all friends

After long time, this threads is finally solved. THis might be also be
solution for other problems which using multiple threads for accessing
LCL control.

Notice: Accoring to the LCL developer guys, remark that lcl control
must be accessed by the main thread!
Please see http://wiki.lazarus.freepascal.org/Multithreaded_Applicatio
n_Tutorial#Lazarus_Widgetset_Interfaces

Code: [Select]// I made a little modification to the my first posted
code

const
  MY_MESSAGES = LM_USER + 1;

type
TMainForm = class(TForm)
// ....
private
//....
  procedure MyMessagesHandler(var Msg: TLMessage); message
MY_MESSAGES;
end;

procedure TMainForm.btnMidInOpenClick(Sender: TObject);
var
  MidiDevice: TMidiDevice;
begin
  with lbMidiIn do  //TListBox
    if ItemIndex <> -1 then
    begin
        MidiDevice :=
TMidiInDevice(MidiInDeviceList1.MidiDevices[ItemIndex]);
        if Assigned(MidiDevice) then
        begin
          //................
          MidiDevice.OnMidiMessage := @MidiMessageHandler;    //
method pointer is at last below
          MidiDevice.Open(True);
          //................
        end
       {$IFDEF DEBUG}
        else raise Exception.Create('Object not assigned');
       {$ENDIF}
    end;
end;

//--------------------------------------------------------------------
------------------------
// event handler
procedure TMainForm.MidiInOnOpenHandler(Sender: TObject);
begin
  StatusBar1.Panels[0].Text := (Format('Midi Device: %s is opened',
[TMidiDevice(Sender).ProductName]));
end;

//--------------------------------------------------------------------
------------------------
// event handler

procedure TMainForm.MidiInOnCloseHandler(Sender: TObject);
begin
  StatusBar1.Panels[0].Text := Format('Midi Device: %s is closed',
[TMidiDevice(Sender).ProductName]);
end;

//--------------------------------------------------------------------
------------------------ 
// event handler
{ NOTE:
1. I use some different seperated code handler below !
2. The midi message is fast, because sometimes i pushed 3-6
control(hardware) simultan!
}
procedure TMainForm.MidiMessageHandler(Sender: TObject; Msg: Cardinal;
  Param: Cardinal);
begin
  PostMessage(Handle, MY_MESSAGES, Param, 0);
end; 

{ NOTE: the program is also CRASHED when i using other LCL control }

// -------------------------------------------------------------------
----------------------------
// the method pointer in the CALLBACK funct!
procedure MidiInputProc(hMidiIn: THMidiIn; wMsg, dwInstance, dwParam1,
dwParam2: Cardinal); stdcall;
begin
  TMidiDevice(dwInstance).DoMidiMessage(wMsg, dwParam1);  //LAZARUS
end; 

// -------------------------------------------------------------------
------------------
procedure TMainForm.MyMessagesHandler(var Msg: TLMessage); message
MY_MESSAGES;
begin
  {converting Param parameter}
  Self.Tag := Msg.lParam;                      // if i use this code,
the program works FINE!
  Self.Caption := IntToStr(Msg.lParam);        // if i use this code,
the program is FINE!
  Self.Caption := Format('%d' , [Msg.lParam]); // if i use this code,
the program is FINE!
 
  { converting Msg parameter }
  Self.Caption := IntToStr(Msg.Msg);          // program is FINE!
end;