🚀 go-pugleaf

RetroBBS NetNews Server

Inspired by RockSolid Light RIP Retro Guy

Article View: comp.lang.pascal.borland
Article #630

Re: I need a .MID player for Pascal

#630
From: Joe C. Hecht
Date: Mon, 31 Mar 1997 00:00
184 lines
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-mail
References: <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