Article View: comp.lang.pascal.borland
Article #630Re: I need a .MID player for Pascal
From: Joe C. Hecht
Date: Mon, 31 Mar 1997 00:00
Date: Mon, 31 Mar 1997 00:00
184 lines
6421 bytes
6421 bytes
SubKick wrote:
>
> I want a source code to play .MID songs in Pascal using the SoundBlaster or the
> Adlib cards. I want to load the music from disk, send to the card and let it
> play continuously until another music is loaded.
> If you want to help me, contact-me via email to bfe2257@mail.telepac.pt
I have some code that works in Turbo Pascal for Windows:
Program PlayMidi;
{$C MOVEABLE PRELOAD PERMANENT}
Uses WinTypes,
WinProcs,
Win31,
mmSystem;
const idm_Exit=100;
type MCI_OPEN_PARMS= Record
dwCallback:LONGINT;
wDeviceID :WORD;
wReserved0:WORD;
lpstrDeviceType:PCHAR;
lpstrElementName:PCHAR;
lpstrAlias:PCHAR;
End;
type MCI_PLAY_PARMS = Record
dwCallback:LONGINT;
dwFrom:LONGINT;
dwTo:LONGINT;
End;
Var MainWindow:hWnd;
Var s:STRING;
mciOpen:MCI_OPEN_PARMS;
mciPlay:MCI_PLAY_PARMS;
rtrn:LONGINT;
soundId:WORD;
i:LONGINT;
Opened:BOOL;
Function MainWindowProc(Window :hWnd;
Message:Word;
WParam :Word;
LParam :Longint):Longint;Export;
begin
MainWindowProc:=0;
Case Message of
wm_Create:Begin
s:=ParamStr(1)+#0;
mciOpen.wDeviceId:=0;
mciOpen.lpstrDeviceType:='sequencer';
mciOpen.lpstrElementName:=@s[1];
If mciSendCommand(0,
MCI_OPEN,
MCI_OPEN_TYPE OR MCI_OPEN_ELEMENT,
LONGINT(@mciOpen)) <> 0 then
begin
MessageBox(0,'Cannot Open Midi File or
Device!','PlayMidi',mb_ok);
SendMessage(Window,wm_Command,idm_exit,0);
end;
SoundId:=mciOpen.WDeviceId;
mciPlay.dwCallback:=Window;
Opened:=True;
if mciSendCommand(soundId,
MCI_PLAY,
MCI_NOTIFY,
LONGINT(@mciPlay)) <> 0 then
begin
MessageBox(0,'Cannot Open Midi File or
Device!','PlayMidi',mb_ok);
SendMessage(Window,wm_Command,idm_exit,0);
end;
End;
mm_mciNotify: begin
SendMessage(Window,wm_Command,idm_exit,0);
end;
wm_Command:begin
Case WParam of
idm_Exit:begin
If Opened = TRUE then
mciSendCommand(soundId,
MCI_CLOSE,
0,
0);
SendMessage(Window,Wm_Close,0,0);
Exit
end;
end; {case WParam Of}
end; {wm_Command}
wm_Destroy:begin
PostQuitMessage(0);
Exit
end;
end; {Case Message Of}
MainWindowProc:=DefWindowProc(Window,Message,WParam,LParam)
end;
Procedure Init;
Var WindowClass:TWndClass;
begin
Opened:=FALSE;
If ParamCount < 1 then
begin
Messagebox(0,'Midi File not Specified','Play Midi',mb_ok);
Halt(1);
end;
if hPrevInst = 0 then
begin
WindowClass.lpszClassName:='PLAYmyMIDI';
WindowClass.lpfnWndProc :=@MainWindowProc;
WindowClass.Style :=Cs_VRedraw or
Cs_HRedraw or
Cs_ByteAlignWindow or
Cs_ByteAlignClient;
WindowClass.cbClsExtra :=0;
WindowClass.cbWndExtra :=0;
WindowClass.hInstance :=hInstance;
WindowClass.hIcon :=0;
WindowClass.hCursor :=LoadCursor(0,idc_Arrow);
WindowClass.hbrBackground:=GetStockObject(White_Brush);
WindowClass.lpszMenuName :=Nil;
RegisterClass(WindowClass)
end;
MainWindow:=CreateWindow('PLAYmyMIDI',
'PLAYMIDI',
ws_ThickFrame or
ws_Maximize or
ws_Caption or
ws_SysMenu or
ws_MinimizeBox or
ws_MaximizeBox,
cw_UseDefault,
cw_UseDefault,
cw_UseDefault,
cw_UseDefault,
0,
0,
hInstance,
nil);
end;
Procedure WinMain;
Var Message:TMsg;
begin
Init;
while GetMessage(Message,0,0,0) do
begin
TranslateMessage(Message);
DispatchMessage(Message)
end;
Halt(1)
end;
Begin
WinMain
End.
--
Joe C. Hecht
Borland Delphi Developer Support Group
Technical Documents and Online Forums are available at
http://www.borland.com
Technical Details
Message-ID:
<333FF334.3771@corp.borland.com>Path:
arc1-ca.pugleaf.net!unknown!not-for-mailReferences:
<333d12d0.3609995@news.telepac.pt>Show Full Headers
Complete Article Headers
X-Google-Language: ENGLISH,ASCII-7-bit X-Google-Thread: 111e75,b4552d8277179fd6 X-Google-Attributes: gid111e75,public X-Google-Thread: 111659,b4552d8277179fd6 X-Google-Attributes: gid111659,public X-Google-Thread: 1006de,b4552d8277179fd6 X-Google-Attributes: gid1006de,public X-Google-Thread: 102601,b4552d8277179fd6 X-Google-Attributes: gid102601,public X-Google-Thread: 1031de,b4552d8277179fd6 X-Google-Attributes: gid1031de,public From: "Joe C. Hecht" <jhecht@corp.borland.com> Subject: Re: I need a .MID player for Pascal Date: 1997/03/31 Message-ID: <333FF334.3771@corp.borland.com> X-Deja-AN: 229686714 References: <333d12d0.3609995@news.telepac.pt> To: SubKick <bfe2257@mail.telepac.pt> Organization: GTE Intelligent Network Services, GTE INS Reply-To: jhecht@corp.borland.com Newsgroups: comp.lang.pascal.borland,ctdl.lang.pascal,de.comp.lang.pascal.misc,de.rec.games.rpg.live,de.rec.games.rpg.misc