home *** CD-ROM | disk | FTP | other *** search
/ Prima Shareware 3 / DuCom_Prima-Shareware-3_cd1.bin / PROGRAMO / PASCAL / HUBI / MIDLPBK.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1995-05-28  |  8.2 KB  |  277 lines
  1. (*
  2. {$A-,B-,D-,F-,G+,I-,K+,L-,N-,P-,Q-,R-,S-,T-,V+,W-,X+,Y-}
  3. *)
  4. {$M 8192,128}   { Stacksize is ignored }
  5. Library MidLpBk;
  6.  
  7. {                   MIDI LoopBack Device                             }
  8. { (c) Hubert Winkler, Neunkirchnerstr.17, A-2732 Willendorf, Austria }
  9. {   Send your comments to winkler@cobra.gud.siemens.co.at (office)   }
  10.  
  11.  
  12. { Based on Microsoft's Soundblaster Driver Source (MMDDK) }
  13.  
  14.  
  15. {Version
  16.   1.0 original release
  17.   1.1 added Port-Naming
  18.   1.2 never released
  19.  
  20. 2.0 - Major Update : Multi Client (max. 4 In/10 Out !)
  21.       Matrix is no more necessary !
  22.       Splitted into 3 sources
  23.         MLB_FIX MIDI OUT routines with FIXED+PERMANENT Code Segment
  24.         MLB_NFIX MIDI Code with DISCARDABLE Code Segment
  25.         midlpbk Configuration Code with DISCARDABLE Code Segment
  26. }
  27.  
  28. {$D midi:Hubi's LoopBack - PD Edition}
  29. {$C PRELOAD FIXED DISCARDABLE}
  30.  
  31. {$R MIDLPBK.RES}
  32.  
  33. {$DEFINE USE_CTL3D}
  34.  
  35. uses wintypes
  36.     ,winprocs
  37.     ,win31
  38.     ,mmsystem
  39.     ,strings
  40. {$IFDEF USE_CTL3D}
  41.     ,Ctl3D
  42. {$ENDIF}
  43.     ,Cpl
  44.     ,MLB_FIX,MLB_nFIX;
  45.  
  46.  
  47. { ---------------------------------------------------------------------------
  48.   Configuration Part
  49.   --------------------------------------------------------------------------- }
  50. const
  51.       gszActivePorts : PChar = 'ActivePorts';
  52.  
  53. {set name of port[id]}
  54. procedure SetPortName( name:PChar; id:integer );
  55. var key:array [0..MAXPNAMELEN-1] of Char;
  56. begin
  57.    inc(id,Ord('1'));
  58.    wvsprintf(key,gszPort,id);
  59.    WritePrivateProfileString(gszSection,key,name,gszIniFile);
  60. end;
  61.  
  62. procedure WriteConfig;
  63. var buf : array [0..11] of Char;
  64. begin
  65.    wvsprintf(buf,'%d',gActivePorts);
  66.    WritePrivateProfileString(gszSection,gszActivePorts,buf,gszIniFile);
  67. end;
  68.  
  69. procedure ReadConfig;
  70. begin
  71.    gActivePorts:=GetPrivateProfileInt(gszSection,gszActivePorts,gNumPorts,gszIniFile);
  72.    if gActivePorts<0 then gActivePorts:=0
  73.    else if gActivePorts>gNumPorts then gActivePorts:= gNumPorts;
  74. end;
  75.  
  76. var RenamePortName:PChar;
  77. function RenamePort(Dialog: HWnd; Message, WParam: Word;
  78.   LParam: Longint): Bool; export;
  79. const id_edit = 100;
  80. begin
  81.   RenamePort := True;
  82.   case Message of
  83.     wm_InitDialog:
  84.       begin
  85.          RenamePortName := PChar(LParam);
  86.          SendDlgItemMessage(Dialog,id_edit,WM_SETTEXT,0,LParam);
  87.          SendDlgItemMessage(Dialog,id_edit,EM_LIMITTEXT,MAXPNAMELEN-1,0);
  88.          Exit;
  89.       end;
  90.     wm_Command:
  91.       if (WParam = id_Ok) then begin
  92.         SendDlgItemMessage(Dialog,id_edit,WM_GETTEXT,MAXPNAMELEN-1,Longint(RenamePortName));
  93.         EndDialog(Dialog, id_ok);
  94.         Exit;
  95.       end else if (WParam = id_Cancel) then begin
  96.         EndDialog(Dialog, id_Cancel);
  97.         Exit;
  98.       end {else if (WParam = id_Default) then begin
  99.       end};
  100.   end;
  101.   RenamePort := False;
  102. end;
  103.  
  104. function HelpDlg(Dialog: HWnd; Message, WParam: Word;
  105.   LParam: Longint): Bool; export;
  106. begin
  107.   HelpDlg:=False;
  108.   if (Message=wm_Command) and (WParam = id_Ok) then begin
  109.         EndDialog(Dialog, id_OK);
  110.         HelpDlg:=True;
  111.         Exit;
  112.   end;
  113. end;
  114.  
  115. var local_ActivePorts : integer;
  116. function Config(Dialog: HWnd; Message, WParam: Word;
  117.   LParam: Longint): Bool; export;
  118. const id_Names = 101;
  119.       id_NumActPort = 301;
  120.       id_help = 99;
  121.  
  122. var i:Integer;
  123.     x:bool;
  124.     name:array[0..MaxPNameLen-1] of Char;
  125.     pt : TPoint;
  126.  
  127. begin
  128.   Config := True;
  129.   case Message of
  130.     wm_InitDialog:
  131.       begin
  132.          local_ActivePorts:=gActivePorts;
  133.          for i:=0 to gNumPorts-1 do begin
  134.  
  135.             PortName(name,i);
  136.             SendDlgItemMessage(Dialog,id_Names+i,WM_SETTEXT,0,LongInt(@name[0]));
  137.  
  138.             { if i>gActivePorts gray names }
  139.             if i>=local_ActivePorts then begin
  140.                EnableWindow(GetDlgItem(Dialog,id_Names+i),WordBool(False));
  141.             end;
  142.          end;
  143.          CheckRadioButton(Dialog,id_NumActPort,id_NumActPort+gNumPorts-1,id_NumActPort+local_ActivePorts-1);
  144.          Exit;
  145.       end;
  146.     wm_Command:
  147.       if (WParam = id_Ok) then begin
  148.         for i:=0 to gNumPorts-1 do begin
  149.             SendDlgItemMessage(Dialog,id_Names+i,WM_GETTEXT,MAXPNAMELEN,LongInt(@name[0]));
  150.             SetPortName(name,i);
  151.         end;
  152.         gActivePorts:=local_ActivePorts;
  153.         WriteConfig;
  154.         EndDialog(Dialog, id_OK);
  155.         Exit;
  156.       end else if (WParam = id_Cancel) then begin
  157.         EndDialog(Dialog, id_Cancel);
  158.         Exit;
  159.       end else if (WParam = id_Help) then begin
  160.         DialogBox(HInstance, PChar(3), Dialog, @HelpDlg);
  161.         Exit;
  162.       end else if (wParam >= id_NumActPort) and (wParam < id_NumActPort+gNumPorts) and (HiWord(LParam)=BN_CLICKED) then
  163.          begin
  164.            local_ActivePorts:=wParam - id_NumActPort+1;
  165.            for i:=1 to gNumPorts do begin
  166.                x := Bool(i<=local_ActivePorts);
  167.                EnableWindow(GetDlgItem(Dialog,id_Names+i-1),x);
  168.            end;
  169.         end;
  170.     WM_LBUTTONDBLCLK:
  171.       begin
  172.          pt.x := LoWord(LParam);
  173.          pt.y := HiWord(LParam);
  174.          i := GetDlgCtrlId(ChildWindowFromPoint(Dialog,pt));
  175.          if ((i>=id_Names)and(i<id_Names+local_ActivePorts))
  176.          then begin
  177.             SendDlgItemMessage(Dialog,i,WM_GETTEXT,MAXPNAMELEN,LongInt(@name[0]));
  178.             if DialogBoxParam(HInstance, PChar(2), Dialog, @RenamePort,Longint(@name[0]))=id_ok
  179.             then SendDlgItemMessage(Dialog,i,WM_SETTEXT,0,LongInt(@name[0]));
  180.          end;
  181.      end;
  182.   end;
  183.   Config := False;
  184. end;
  185.  
  186.  
  187. {-------------------------------------------------------------------------
  188.   INSTALLABLE DRIVER PART
  189.  -------------------------------------------------------------------------}
  190. function DrvDefDriverProc(DriverIdentifier: Longint; DriverId: THandle; Message:
  191. Word; lParam1, lParam2: Longint): Longint; far; external 'MMSYSTEM' index 1104;
  192.  
  193. function DriverProc(
  194.          dwDriverID :LongInt;
  195.          hDriver    :WORD;
  196.          uiMessage  :WORD;
  197.          lParam1,
  198.          LParam2:LongInt)
  199.           : LongInt; export;
  200. VAR old_ActivePorts : integer;
  201. BEGIN
  202.     case uiMessage of
  203.     DRV_LOAD: begin
  204.         ReadConfig;
  205.         DriverProc := 1;
  206.         end;
  207.     DRV_FREE:
  208.         DriverProc := 1;
  209.     DRV_OPEN:
  210.         DriverProc := 1;
  211.     DRV_CLOSE:
  212.         DriverProc := 1;
  213.     DRV_ENABLE:
  214.         DriverProc := 1;
  215.     DRV_DISABLE:
  216.         DriverProc := 1;
  217.     DRV_QUERYCONFIGURE:
  218.         DriverProc := 1;
  219.     DRV_CONFIGURE:
  220.         begin
  221.            old_ActivePorts := gActivePorts;
  222. {$IFDEF USE_CTL3D}
  223.            Ctl3dRegister(HInstance);
  224.            Ctl3dAutoSubclass(HInstance);
  225.            DialogBox(HInstance, PChar(1), LoWord(lparam1), @Config);
  226.            Ctl3dUnregister(HInstance);
  227. {$ELSE}
  228.            DialogBox(HInstance, PChar(1), LoWord(lparam1), @Config);
  229. {$ENDIF}
  230.            if old_ActivePorts<>gActivePorts then
  231.               DriverProc := drv_Restart
  232.            else
  233.               DriverProc := 0;
  234.         end;
  235.    DRV_INSTALL:
  236.         begin
  237.          WriteConfig; { Create new system.ini entries }
  238.          { PDrvConfigInfo(LParam2)^.lpszDCISectionName is "drivers" }
  239.          { PDrvConfigInfo(LParam2)^.lpszDCIAliasName id "MIDI3" or so }
  240.          DriverProc := drv_Restart;
  241.         end;
  242.     DRV_REMOVE:
  243.         begin { Remove all related entries from system.ini }
  244.          WritePrivateProfileString(gszSection,nil,nil,gszIniFile);
  245.          DriverProc := drv_Restart;
  246.         end
  247.     else
  248.         DriverProc := DrvDefDriverProc(dwDriverID, hDriver, uiMessage, lParam1, lParam2);
  249.     end;
  250. END;
  251.  
  252.  
  253. { ---------------------------------------------------------------------------
  254.   Exported Functions
  255.   --------------------------------------------------------------------------- }
  256. exports
  257.         DriverProc index 1,
  258.         modMessage index 2,
  259.         midMessage index 3;
  260.  
  261.  
  262. { ---------------------------------------------------------------------------
  263.   Init variables
  264.   --------------------------------------------------------------------------- }
  265. VAR id,cl:integer;
  266. BEGIN
  267.    for id:=0 to gNumPorts-1 do begin
  268.       for cl:=0 to gNumInClients-1 do begin
  269.        gMidiInClient[id,cl].h_Midi := 0;
  270.        gMIMC[id,cl].bStarted := false;
  271.       end;
  272.       for cl:=0 to gNumOutClients-1 do begin
  273.        gMidiOutClient[id,cl].h_Midi := 0;
  274.        gbMidiOutCurrentStatus[id,cl] := 0;
  275.       end;
  276.    end;
  277. END.