FORCER UNE GAMME MUSICALE EN MIDI
jackalunion
Messages postés
128
Date d'inscription
mercredi 8 janvier 2003
Statut
Membre
Dernière intervention
14 juillet 2008
-
10 juil. 2008 à 11:12
cs_dirk Messages postés 1 Date d'inscription jeudi 12 août 2004 Statut Membre Dernière intervention 12 avril 2009 - 12 avril 2009 à 11:48
cs_dirk Messages postés 1 Date d'inscription jeudi 12 août 2004 Statut Membre Dernière intervention 12 avril 2009 - 12 avril 2009 à 11:48
Cette discussion concerne un article du site. Pour la consulter dans son contexte d'origine, cliquez sur le lien ci-dessous.
https://codes-sources.commentcamarche.net/source/47242-forcer-une-gamme-musicale-en-midi
https://codes-sources.commentcamarche.net/source/47242-forcer-une-gamme-musicale-en-midi
12 avril 2009 à 11:48
10 juil. 2008 à 15:10
Ca pourra aider certains mais quelques remarques:
*En Snippet cela aurait été mieux
*Pourquoi utiliser le type integer : status,channel,data1,data2 sont des bytes
*time ce n'est pas un integer : c'est légèrement plus complexe car il s'agit d'un type de longueur variable. Ton truc marchera pas dans bon nombres de cas
@Jack : Normal que ca ne fasse rien. L'entrée et la sortie Midi ne sont pas sélectionnée. Si tu veux un truc qui fonctionne :
unit MidiCom;
interface
uses
Windows, SysUtils, Classes, MmSystem, Contnrs;
type
TOnMidiInReceiveData = procedure(const Status, Data1, Data2: byte) of object;
TOnMidiInBuffer = procedure(const AStream: TMemoryStream) of object;
TMidiCom = class(TComponent)
private
MidiIn: THandle;
MidiOut: THandle;
ResultCom: MMResult;
MidiInCount: integer;
MidiOutCount: integer;
fDataStream: TMemoryStream;
fDataHeader: TMidiHdr;
fExData: array[0..2048] of char;
fOnMidiInReceiveData: TOnMidiInReceiveData;
fOnMidiInBuffer: TOnMidiInBuffer;
procedure Send_MidiInBuffer;
procedure Send(const AStream: TMemoryStream); overload;
procedure Send(const AString: string); overload;
procedure StrToStream(const AString: string; const AStream: TMemoryStream);
protected
public
function Open_MidiIn(Index: integer): boolean;
function Open_MidiOut(Index: integer): boolean;
function Close_MidiIn: boolean;
function Close_MidiOut: boolean;
procedure MidiIn_List(AStrings: TStrings);
procedure MidiOut_List(AStrings: TStrings);
procedure SendData(Status, Data1, Data2: byte);
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
published
property OnMidiInReceiveData: TOnMidiInReceiveData
Read fOnMidiInReceiveData Write fOnMidiInReceiveData;
property OnMidiInBuffer: TOnMidiInBuffer Read fOnMidiInBuffer Write fOnMidiInBuffer;
end;
var
AMidiCom: TMidiCom;
procedure Register;
implementation
procedure Register;
begin
RegisterComponents('MUSIC_PRO', [TMidiCom]);
end;
procedure MidiInCallBack(AMidiInHandle: PhMidiIn; aMsg: UInt;
aData, aMidiData, aTimeStamp: integer); stdcall;
begin
if AMsg = Mim_Data then
if AMidiCom.MidiIn <> 0 then
AMidiCom.OnMidiInReceiveData(aMidiData and $000000FF, (aMidiData and $0000FF00) shr
8, (aMidiData and $00F0000) shr 16);
if AMsg = Mim_LongData then
AMidiCom.Send_MidiInBuffer;
end;
constructor TMidiCom.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
MidiInCount := -1;
MidiOutCount := -1;
MidiIn := 0;
MidiOut := 0;
fDataHeader.dwBufferLength := 2048;
fDataHeader.lpData := fExData;
fDataStream := TMemoryStream.Create;
AMidiCom := Self;
end;
destructor TMidiCom.Destroy;
begin
fDataStream.Free;
Close_MidiIn;
Close_MidiOut;
inherited;
end;
{>>ENTREE MIDI}
procedure TMidiCom.MidiIn_List(AStrings: TStrings);
var
Index: integer;
InCaps: TMidiInCaps;
begin
AStrings.Clear;
for Index := 0 to (MidiInGetNumDevs - 1) do
begin
//On récupère les capacités de l'entrée Midi numéro Index
ResultCom := MidiInGetDevCaps(Index, @InCaps, SizeOf(TMidiInCaps));
if ResultCom = MmSysErr_NoError then
begin
AStrings.Add(InCaps.szPName);
Inc(MidiInCount);
end;
end;
end;
function TMidiCom.Open_MidiIn(Index: integer): boolean;
begin
Result := False;
if (MidiInCount > -1) and (Index > -1) and (Index <= MidiInCount) then
begin
//Si l'entrée Midi a déjà été définit on sort
if MidiIn <> 0 then
Exit;
//On ouvre l'entrée midi : MidiInCallBack sera le callback utilisé pour récupérer les données recues
ResultCom := MidiInOpen(@MidiIn, Index, cardinal(@MidiInCallBack),
Index, CallBack_Function);
if ResultCom = MmSysErr_NoError then
begin
fDataHeader.dwFlags := 0;
//On prépare le buffer pour l'entrée Midi
ResultCom := MidiInPrepareHeader(MidiIn, @fDataHeader, SizeOf(TMidiHdr));
if ResultCom = MmSysErr_NoError then
begin
//On envoit un buffer d'entré dans l'entrée Midi
ResultCom := MidiInAddBuffer(MidiIn, @fDataHeader, SizeOf(TMidiHdr));
if ResultCom = MmSysErr_NoError then
begin
//On allume l'entrée Midi
ResultCom := MidiInStart(MidiIn);
if ResultCom = MmSysErr_NoError then
Result := True;
end;
end;
end;
end;
end;
function TMidiCom.Close_MidiIn: boolean;
begin
Result := False;
if MidiIn = 0 then
Exit;
//On arrète l'entrée midi
ResultCom := MidiInStop(MidiIn);
if ResultCom = MmSysErr_NoError then
begin
//On détruit l'entrée Midi
ResultCom := MidiInReset(MidiIn);
if ResultCom = MmSysErr_NoError then
begin
//On nettoye le Buffer
ResultCom := MidiInUnPrepareHeader(MidiIn, @fDataHeader, SizeOf(TMidiHdr));
if ResultCom = MmSysErr_NoError then
Result := True;
end;
end;
end;
procedure TMidiCom.Send_MidiInBuffer;
begin
if fDataHeader.dwBytesRecorded = 0 then
Exit;
fDataStream.Write(fExData, fDataHeader.dwBytesRecorded);
if fDataHeader.dwFlags and MHdr_Done = MHdr_Done then
begin
fDataStream.Position := 0;
fOnMidiInBuffer(fDataStream);
fDataStream.Clear;
end;
fDataHeader.dwBytesRecorded := 0;
//On prépare le buffer pour l'entrée Midi
ResultCom := MidiInPrepareHeader(MidiIn, @fDataHeader, SizeOf(TMidiHdr));
if ResultCom = MmSysErr_NoError then
begin
//On envoit un buffer d'entré dans l'entrée Midi
ResultCom := MidiInAddBuffer(MidiIn, @fDataHeader, SizeOf(TMidiHdr));
end;
end;
{>>SORTIE MIDI}
procedure TMidiCom.MidiOut_List(AStrings: TStrings);
var
Index: integer;
OutCaps: TMidiOutCaps;
begin
AStrings.Clear;
for Index := 0 to (MidiOutGetNumDevs - 1) do
begin
//On récupère les capacités de la sortie Midi numéro Index
ResultCom := MidiOutGetDevCaps(Index, @OutCaps, SizeOf(TMidiOutCaps));
if ResultCom = MmSysErr_NoError then
begin
AStrings.Add(OutCaps.szPName);
Inc(MidiOutCount);
end;
end;
end;
function TMidiCom.Close_MidiOut: boolean;
begin
Result := False;
ResultCom := MidiOutClose(MidiOut);
if ResultCom = MmSysErr_NoError then
Result := True;
end;
function TMidiCom.Open_MidiOut(Index: integer): boolean;
begin
Result := False;
if (MidiOutCount > -1) and (Index > -1) and (Index <= MidiOutCount) then
begin
if MidiOut <> 0 then
Exit;
//Ouverture de la sortie Midi
ResultCom := MidiOutOpen(@MidiOut, Index, 0, 0, CallBack_Null);
if ResultCom = MmSysErr_NoError then
Result := True;
end;
end;
procedure TMidiCom.SendData(Status, Data1, Data2: byte);
var
AMsg: cardinal;
begin
if MidiOut = 0 then
Exit;
AMsg := Status + (Data1 * $100) + (Data2 * $10000);
//On envoit le message à la sortie Midi
ResultCom := MidiOutShortMsg(MidiOut, AMsg);
end;
procedure TMidiCom.Send(const AString: string);
var
AStream: TMemoryStream;
begin
AStream := TMemoryStream.Create;
try
StrToStream(AString, AStream);
Send(AStream);
finally
AStream.Free;
end;
end;
procedure TMidiCom.Send(const AStream: TMemoryStream);
var
ADataHeader: TMidiHdr;
begin
AStream.Position := 0;
ADataHeader.dwBufferLength := AStream.Size;
ADataHeader.lpData := AStream.Memory;
ADataHeader.dwFlags := 0;
//Préparation de la zone tambon pour la sortie Midi
ResultCom := MidiOutPrepareHeader(MidiOut, @ADataHeader, SizeOf(TMidiHdr));
if ResultCom = MmSysErr_NoError then
begin
//On envoit le message à la sortie Midi
ResultCom := MidiOutLongMsg(MidiOut, @ADataHeader, SizeOf(TMidiHdr));
if ResultCom = MmSysErr_NoError then
//On nettoye le Buffer
ResultCom := MidiOutUnPrepareHeader(MidiOut, @ADataHeader, SizeOf(TMidiHdr));
end;
end;
procedure TMidiCom.StrToStream(const AString: string; const AStream: TMemoryStream);
const
HexChar = '123456789ABCDEF';
var
Index: integer;
Str: string;
begin
Str := StringReplace(AnsiUpperCase(AString), ' ', '', [rfReplaceAll]);
AStream.Position := 0;
for Index := 1 to (Length(Str) div 2 - 1) do
PChar(AStream.Memory)[Index - 1] :=
char(AnsiPos(Str[Index * 2 - 1], HexChar) shl 4 + AnsiPos(Str[Index * 2], HexChar));
end;
L'idée est cependant louable ;).
10 juil. 2008 à 11:12