mmdsmidi.pas

一套及时通讯的原码

   FIMIDISegState := nil;

   FmtStart       := 0;
   FmtOffset      := 0;
   FrtStart       := 0;
   FrtOffset      := 0;

   FTimer         := TTimer.Create(Self);
   FTimer.Enabled := False;
   FTimer.OnTimer := DoTimer;
   FTimer.Interval:= 250;

   ErrorCode := ComponentRegistered(InitCode, Self, ClassName);
   if (ErrorCode <> 0) then RegisterFailed(InitCode, Self , ClassName);
end;

{------------------------------------------------------------------------------}
destructor TMMDSMidiChannel.Destroy;
begin
   Close;

   if FMixer <> nil then FMixer.Close;

   F3DBuffer.Free;

   inherited Destroy;
end;

{------------------------------------------------------------------------------}
procedure TMMDSMidiChannel.Loaded;
begin
   inherited Loaded;

   with Sound3D do
   if MM3DVectorEqual(ConeOrientation.AsVector,ZeroVector) then
      ConeOrientation.AsVector := MM3DVector(defConeOrientX,defConeOrientY,defConeOrientZ);
end;

{------------------------------------------------------------------------------}
procedure TMMDSMidiChannel.Notification(AComponent: TComponent; Operation: TOperation);
begin
   inherited Notification(AComponent, Operation);

   if (Operation = opRemove) and (AComponent = FMixer) then FMixer := nil;
end;

{------------------------------------------------------------------------------}
procedure TMMDSMidiChannel.Set3DBuffer(Value: TMMDS3DBuffer);
begin
    F3DBuffer.Assign(Value);
end;

{------------------------------------------------------------------------------}
function TMMDSMidiChannel.GetDirectSound: IDirectSound;
begin
   Result := nil;

   if (FMixer <> nil) then
   begin
      Result := FMixer.DirectSound;
   end;
end;

{------------------------------------------------------------------------------}
procedure TMMDSMidiChannel.SetFileName(aValue: string);
begin
   if (aValue <> FFileName) then
   begin
      FFileName := aValue;
      Close;
   end;
end;

{------------------------------------------------------------------------------}
function TMMDSMidiChannel.Open: Boolean;
var
   S: string;
   wfxsize: DWORD;

begin
   Result := False;
   if not FOpen and (FFileName <> '') then
   begin
      try
         if (FMixer <> nil) then FMixer.Open;

         // DirectMusic initialization
         FIMusic := CreateDirectMusic(DirectSound);
         if (FIMusic <> nil) then
         begin
            FIPerf := CreatePerformance(FIMusic,DirectSound);
            if (FIPerf <> nil) then
            begin
               FIPort := CreateMusicPort(FIMusic);

               FIPerf.AddPort(FIPort);
               if (FIPort <> nil) and (FMixer <> nil) then
               begin
                   FIPerf.AssignPChannelBlock(0, FIPort, 1);
                   wfxsize := sizeOf(FWaveFormat);
                   if FIPort.GetFormat(@FWaveFormat,wfxsize, FBufferLength) = S_OK then
                   begin
                      FMixer.CreateSoundBuffer(@FWaveFormat, FBufferLength, FSoundBuffer, False);
                      FIPort.SetDirectSound(DirectSound,FSoundBuffer.SoundBuffer);
                   end;
                   // Activate the synthesizer port
	           FIPort.Activate(True);
               end;

               FILoader := CreateLoader;
               if (FILoader <> nil) then
               begin
                  FIMIDIseg := LoadSegment(FILoader,FFileName);
                  if (FIMIDIseg <> nil) then
                  begin
                     S := UpperCase(ExtractFileExt(FFileName));
                     if (S = '.MID') or (S = '.RMI') then
                     begin
                        FIMIDIseg.SetParam(GUID_StandardMIDIFile,$FFFFFFFF, 0, 0, Pointer(FIPerf));
                     end;
                     FIMIDIseg.SetParam(GUID_Download, $FFFFFFFF, 0, 0, Pointer(FIPerf));
                     Result := True;
                  end;
               end;
            end;
         end;

      finally
         if not Result then
         begin
            FIMIDIseg  := nil;
            FILoader   := nil;
            FIPerf     := nil;
            FIPort     := nil;
            FIMusic    := nil;
         end
         else FOpen := True;
      end;
   end;
end;

{------------------------------------------------------------------------------}
procedure TMMDSMidiChannel.Close;
begin
   if FOpen then
   begin
      Stop;
      FOpen     := False;

      if (FMixer <> nil) then FMixer.ClearBuffer(FSoundBuffer);

      if (FIMusic <> nil) then FIMusic.Activate(False);

      if (FIPerf <> nil) then FIPerf.CloseDown;

      FIPort    := nil;
      FIPerf    := nil;
      FIMIDIseg := nil;
      FILoader  := nil;
      FIMusic   := nil;

      CoUninitialize;
   end;
end;

{------------------------------------------------------------------------------}
function TMMDSMidiChannel.Play: Boolean;
begin
   Result := False;
   if not FOpen then Open;
   if FOpen and not FPlaying then
   begin
      if (FIPerf <> nil) then
      begin
         if (FLoops < 0) then FLoops := 0;
         FIMIDISeg.SetRepeats(FLoops);
         if FIPerf.PlaySegment(FIMIDISeg, DMUS_SEGF_BEAT, 0, nil) = S_OK then
         begin
            Result   := True;
            FPlaying := True;
            FTimer.Enabled := True;
         end;
      end;
   end;
end;

{------------------------------------------------------------------------------}
procedure TMMDSMidiChannel.Stop;
begin
   if FPlaying then
   begin
      FIPerf.Stop(nil, nil, 0, 0);
      FPlaying := False;
      FTimer.Enabled := False;
      if not (csDestroying in ComponentState) and
         assigned(FOnplayEnd) then FOnPlayEnd(Self);
   end;
end;

{------------------------------------------------------------------------------}
procedure TMMDSMidiChannel.DoTimer(Sender: TObject);
begin
   if FOpen and FPlaying and FTimer.Enabled then
   begin
      if (FIPerf.IsPlaying(FIMIDISeg,nil) <> S_OK) then
      begin
         Stop;
      end;
   end;
end;

{------------------------------------------------------------------------------}
procedure TMMDSMidiChannel.SetVolume(aValue: Longint);
begin
   FSoundBuffer.Volume := aValue;
end;

{------------------------------------------------------------------------------}
function TMMDSMidiChannel.GetVolume: Longint;
begin
   Result := FSoundBuffer.Volume;
end;

{------------------------------------------------------------------------------}
procedure TMMDSMidiChannel.SetPanning(aValue: Longint);
begin
   FSoundBuffer.Panning := aValue;
end;

{------------------------------------------------------------------------------}
function TMMDSMidiChannel.GetPanning: Longint;
begin
   Result := FSoundBuffer.Panning;
end;

{------------------------------------------------------------------------------}
procedure TMMDSMidiChannel.SetMuted(aValue: Boolean);
begin
   FSoundBuffer.Muted := aValue;
end;

{------------------------------------------------------------------------------}
function TMMDSMidiChannel.GetMuted: Boolean;
begin
   Result := FSoundBuffer.Muted;
end;

{------------------------------------------------------------------------------}
procedure TMMDSMidiChannel.GetVUMeter(var LeftValue, RightValue, BothValue: integer; Interval: integer);
var
   dwPlayPos,dwLen1,dwLen2: DWORD;
   lpWrite1,lpWrite2: PChar;
   PeakLeft,PeakRight: Smallint;
   PeakLeft2,PeakRight2: Smallint;
   VolLeft,VolRight: Longint;

begin
   LeftValue  := 0;
   RightValue := 0;
   BothValue  := 0;

   if (FFileName <> '') and (FSoundBuffer.SoundBuffer <> nil) and
      IsPlaying and {TODO: not Paused and }not Muted then
   begin
      PeakLeft := -1;
      PeakRight:= -1;

      dwPlayPos := FSoundBuffer.Position;

      { lock the buffer }
      if FSoundBuffer.SoundBuffer.Lock(dwPlayPos, 4412, lpWrite1, dwLen1, lpWrite2, dwLen2, 0) = DS_OK then
      begin
         pcmFindPeak(@FWaveFormat, lpWrite1, dwLen1, PeakLeft, PeakRight);

         if (dwLen2 > 0) then
         begin
            pcmFindPeak(@FWaveFormat, lpWrite2, dwLen2, PeakLeft2, PeakRight2);
            if abs(PeakLeft2) > abs(PeakLeft) then PeakLeft := PeakLeft2;
            if abs(PeakRight2) > abs(PeakRight) then PeakRight := PeakRight2;
         end;

         { unlock the buffer }
         FSoundBuffer.Soundbuffer.Unlock(lpWrite1, dwLen1, lpWrite2, dwLen2);
      end;

      if (PeakLeft <> -1) and (PeakRight <> -1) then
      begin
         if (FWaveFormat.wBitsPerSample = 8) then
         begin
            PeakLeft := (PeakLeft -128)*255;
            PeakRight:= (PeakRight-128)*255;
         end;

         CalcVolume(2*VOLUMEBASE,
                    DBToVolume(Volume/100,VOLUMEBASE),
                    RangeScale(Panning, DSBPAN_LEFT, DSBPAN_RIGHT, -32768, 32768),
                    VolLeft,VolRight);

         LeftValue := MulDiv(PeakLeft,VolLeft,VOLUMEBASE);
         RightValue := MulDiv(PeakRight,VolRight,VOLUMEBASE);

         if (abs(LeftValue) > abs(RightValue)) then
             BothValue := LeftValue
         else
             BothValue := RightValue;
      end;
   end;
end;

end.