mmdevice.pas

一套及时通讯的原码

      RetrieveDeviceCaps;
   end;

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

{-- TMMCustomAudioDevice ------------------------------------------------}
destructor TMMCustomAudioDevice.Destroy;
begin
   Close;
   FDeviceCaps.Free;
   FObservable.Free;
   FObservable:= nil;

   inherited Destroy;
end;

{-- TMMCustomAudioDevice ------------------------------------------------}
procedure TMMCustomAudioDevice.AddObserver(O: TMMObserver);
begin
   FObservable.AddObserver(O);
end;

{-- TMMCustomAudioDevice ------------------------------------------------}
procedure TMMCustomAudioDevice.RemoveObserver(O: TMMObserver);
begin
   if (FObservable <> nil) then
      FObservable.RemoveObserver(O);
end;

{-- TMMCustomAudioDevice ------------------------------------------------}
function TMMCustomAudioDevice.ValidDevice: Boolean;
begin
   Result:= (DeviceCount > 0) and (DeviceId <> InvalidId);
end;

{-- TMMCustomAudioDevice ------------------------------------------------}
procedure TMMCustomAudioDevice.SetDeviceType(Value: TMMAudioDeviceType);
begin
   if (Value <> FDeviceType) then
   begin
      Close;
      FDeviceType:= Value;
      FDeviceId  := defDeviceID;
      UpdateDevice;
   end;
end;

{-- TMMCustomAudioDevice ------------------------------------------------}
procedure TMMCustomAudioDevice.SetDeviceId(Value: TMMDeviceId);
var
   wasActive: Boolean;
begin
   if (Value <> 0) and (Value <> InvalidId) and (Value <> MapperId) and
      not InRange(Value, 0, DeviceCount - 1) then
        { TODO: Should be resource id }
      raise EMMDeviceError.Create('Device id is out of range');

   if (Value <> FDeviceId) then
   begin
      wasActive:= Active;
      Close;
      FDeviceId:= Value;
      UpdateDevice;
      if wasActive then Active := True;
   end;
end;

{-- TMMCustomAudioDevice ------------------------------------------------}
function TMMCustomAudioDevice.GetDeviceCount: Integer;
type
    TGetNumProc = function: UINT; stdcall;
const
    GetNums: array[TMMAudioDeviceType] of TGetNumProc = (midiInGetNumDevs,
                                                         midiOutGetNumDevs,
                                                         waveInGetNumDevs,
                                                         waveOutGetNumDevs,
                                                         auxGetNumDevs,
                                                         mixerGetNumDevs);
begin
   Result:= GetNums[FDeviceType];
end;

{-- TMMCustomAudioDevice ------------------------------------------------}
function TMMCustomAudioDevice.GetDevices(index: integer): string;
begin
   if (index < DeviceCount) then
       Result := GetGenericCaps(FDeviceType,index).szPName
   else
       Result := '';
end;

{-- TMMCustomAudioDevice ------------------------------------------------}
procedure TMMCustomAudioDevice.Open;
begin
   FActive := True;
end;

{-- TMMCustomAudioDevice ------------------------------------------------}
procedure TMMCustomAudioDevice.Close;
begin
   FActive := False;
end;

{-- TMMCustomAudioDevice ------------------------------------------------}
procedure TMMCustomAudioDevice.SetActive(Value: Boolean);
begin
   if csLoading in ComponentState then
   begin
      FTempActive:= Value;
      Exit;
   end;

   if (FActive <> Value) then
   begin
      if Value then
      begin
         Close;
         Open;
      end
      else Close;
   end;
end;

{-- TMMCustomAudioDevice ------------------------------------------------}
function TMMCustomAudioDevice.GetActive: Boolean;
begin
    if csLoading in ComponentState then
        Result:= FTempActive
    else
        Result:= FActive;
end;

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

   if (Active <> FTempActive) then
      Active := FTempActive;
end;

{-- TMMCustomAudioDevice ------------------------------------------------}
procedure TMMCustomAudioDevice.SetDeviceIdDirect(Value: TMMDeviceId);
begin
   FDeviceId:= Value;
end;

{-- TMMCustomAudioDevice ------------------------------------------------}
procedure TMMCustomAudioDevice.SetDeviceCaps(const Value: TMMDeviceCaps);
begin
  ;
end;

{-- TMMCustomAudioDevice ------------------------------------------------}
procedure TMMCustomAudioDevice.UpdateDevice;
begin
   RetrieveDeviceCaps;
   Changed;
end;

{-- TMMCustomAudioDevice ------------------------------------------------}
procedure TMMCustomAudioDevice.Changed;
var
   UpdChange: TMMDeviceChange;
begin
   UpdChange:= TMMDeviceChange.Create;
   try
      FObservable.NotifyObservers(UpdChange);
   finally
      UpdChange.Free;
   end;
   DoChange;
end;

{-- TMMCustomAudioDevice ------------------------------------------------}
procedure TMMCustomAudioDevice.RetrieveDeviceCaps;
var
   Caps: TGenericCaps;
begin
   with FDeviceCaps do
   if not ValidDevice then Clear
   else
   begin
      Caps           := GetGenericCaps(FDeviceType,FDeviceId);
      FManufacturerId:= Caps.wMid;
      FProductId     := Caps.wPid;
      FVerMajor      := Hi(Caps.vDriverVersion);
      FVerMinor      := Lo(Caps.vDriverVersion);
      FProductName   := StrPas(Caps.szPName);
   end;
end;

{-- TMMCustomAudioDevice ------------------------------------------------}
function TMMCustomAudioDevice.GetDeviceCapsByID(AnID: TMMDeviceId): TMMDeviceCaps;
var
  Caps: TGenericCaps;
begin
  try
    Caps := GetGenericCaps(FDeviceType, AnId);
    Result := TMMDeviceCaps.Create;
    with Result do
    begin
      FManufacturerId := Caps.wMid;
      FProductId := Caps.wPid;
      FVerMajor := Hi(Caps.vDriverVersion);
      FVerMinor := Lo(Caps.vDriverVersion);
      FProductName := StrPas(Caps.szPName);
    end;
  except
    Result := nil;
  end;
end;

{-- TMMCustomAudioDevice ------------------------------------------------}
procedure TMMCustomAudioDevice.GetDeviceList(List: TStrings; IncludeMapper: Boolean);
var
    i: Integer;
begin
   List.Clear;
   if IncludeMapper and Mapper then
      List.Add(GetGenericCaps(FDeviceType,-1).szPName);
   for i:= 0 to DeviceCount - 1 do
       List.Add(GetGenericCaps(FDeviceType,i).szPName);
end;

{-- TMMCustomAudioDevice ------------------------------------------------}
function TMMCustomAudioDevice.GetDeviceType: TMMAudioDeviceType;
begin
   Result:= DeviceType;
end;

{-- TMMCustomAudioDevice ------------------------------------------------}
procedure TMMCustomAudioDevice.DoChange;
begin
   if Assigned(FOnChange) then
      FOnChange(Self);
end;

{-- TMMCustomAudioDevice ------------------------------------------------}
function TMMCustomAudioDevice.GetMixerId: TMMDeviceId;
const
    MixerFlags: array[TMMAudioDeviceType] of DWORD = (MIXER_OBJECTF_MIDIIN,
                                                      MIXER_OBJECTF_MIDIOUT,
                                                      MIXER_OBJECTF_WAVEIN,
                                                      MIXER_OBJECTF_WAVEOUT,
                                                      MIXER_OBJECTF_AUX,
                                                      MIXER_OBJECTF_MIXER);
var
    Res: DWORD;
begin
   CheckExcl(mixerGetId(DeviceId, Res, MixerFlags[DeviceType]),[MMSYSERR_NODRIVER]);
   if integer(Res) = -1 then
    Result := InvalidId
   else
    Result := Res;
end;

{-- TMMCustomAudioDevice ------------------------------------------------}
function TMMCustomAudioDevice.GetMapper: Boolean;
begin
    Result := HasMapper(DeviceType);
end;

{== EMMMCIError =========================================================}
constructor EMMMCIError.CreateRes(Res: MMResult);
var
   Buf: array[0..1023] of char;
begin
   FResult := Res;

   if mciGetErrorString(Res, @Buf, SizeOf(Buf) - 1) then
      inherited Create(StrPas(Buf))
   else
      inherited CreateFmt('MMSystem error: %d', [Res]);
end;

end.