jclmultimedia.pas

East make Tray Icon in delphi

  FDeviceList := TObjectList.Create;
  FCallbackWnd := ACallBackWnd;
  BuildDevices;
end;

destructor TJclMixer.Destroy;
begin
  FreeAndNil(FDeviceList);
  inherited Destroy;
end;

procedure TJclMixer.BuildDevices;
var
  I: Cardinal;
  Item: TJclMixerDevice;
begin
  for I := 1 to mixerGetNumDevs do
  begin
    Item := TJclMixerDevice.Create(I - 1, FCallbackWnd);
    FDeviceList.Add(Item);
  end;
end;

function TJclMixer.GetDeviceCount: Integer;
begin
  Result := FDeviceList.Count;
end;

function TJclMixer.GetDevices(Index: Integer): TJclMixerDevice;
begin
  Result := TJclMixerDevice(FDeviceList.Items[Index]);
end;

function TJclMixer.GetFirstDevice: TJclMixerDevice;
begin
  if DeviceCount = 0 then
    raise EJclMixerError.CreateRes(@RsMmMixerNoDevices);
  Result := Devices[0];
end;

function TJclMixer.GetLineByID(MixerHandle: HMIXER; LineID: DWORD): TJclMixerLine;
var
  I: Integer;
  TempDevice: TJclMixerDevice;
begin
  Result := nil;
  for I := 0 to DeviceCount - 1 do
  begin
    TempDevice := Devices[I];
    if TempDevice.Handle = MixerHandle then
    begin
      Result := TempDevice.LineByID[LineID];
      if Result <> nil then
        Break;
    end;
  end;
end;

function TJclMixer.GetLineControlByID(MixerHandle: HMIXER; LineID: DWORD): TJclMixerLineControl;
var
  I: Integer;
  TempDevice: TJclMixerDevice;
begin
  Result := nil;
  for I := 0 to DeviceCount - 1 do
  begin
    TempDevice := Devices[I];
    if TempDevice.Handle = MixerHandle then
    begin
      Result := TempDevice.LineControlByID[LineID];
      if Result <> nil then
        Break;
    end;
  end;
end;

function TJclMixer.GetLineMute(ComponentType: Integer): Boolean;
begin
  Result := Boolean(FirstDevice.LineUniformValue[Cardinal(ComponentType), MIXERCONTROL_CONTROLTYPE_MUTE]);
end;

function TJclMixer.GetLineVolume(ComponentType: Integer): Cardinal;
begin
  Result := FirstDevice.LineUniformValue[Cardinal(ComponentType), MIXERCONTROL_CONTROLTYPE_VOLUME];
end;

procedure TJclMixer.SetLineMute(ComponentType: Integer; const Value: Boolean);
begin
  FirstDevice.LineUniformValue[Cardinal(ComponentType), MIXERCONTROL_CONTROLTYPE_MUTE] := Cardinal(Value);
end;

procedure TJclMixer.SetLineVolume(ComponentType: Integer; const Value: Cardinal);
begin
  FirstDevice.LineUniformValue[Cardinal(ComponentType), MIXERCONTROL_CONTROLTYPE_VOLUME] := Value;
end;

//=== { EJclMciError } =======================================================

constructor EJclMciError.Create(MciErrNo: MCIERROR; const Msg: string);
begin
  FMciErrorNo := MciErrNo;
  FMciErrorMsg := GetMciErrorMessage(MciErrNo);
  inherited Create(Msg + AnsiLineBreak + RsMmMciErrorPrefix + FMciErrorMsg);
end;

constructor EJclMciError.CreateFmt(MciErrNo: MCIERROR; const Msg: string;
  const Args: array of const);
begin
  FMciErrorNo := MciErrNo;
  FMciErrorMsg := GetMciErrorMessage(MciErrNo);
  inherited CreateFmt(Msg + AnsiLineBreak + RsMmMciErrorPrefix + FMciErrorMsg, Args);
end;

constructor EJclMciError.CreateRes(MciErrNo: MCIERROR; Ident: Integer);
begin
  FMciErrorNo := MciErrNo;
  FMciErrorMsg := GetMciErrorMessage(MciErrNo);
  inherited Create(LoadStr(Ident)+ AnsiLineBreak + RsMmMciErrorPrefix + FMciErrorMsg);
end;

function GetMciErrorMessage(const MciErrNo: MCIERROR): string;
var
  Buffer: array [0..MMSystem.MAXERRORLENGTH - 1] of Char;
begin
  if mciGetErrorString(MciErrNo, Buffer, SizeOf(Buffer)) then
    Result := Buffer
  else
    Result := Format(RsMmUnknownError, [MciErrNo]);
end;

function MMCheck(const MciError: MCIERROR; const Msg: string): MCIERROR;
begin
  if MciError <> MMSYSERR_NOERROR then
    raise EJclMciError.Create(MciError, Msg);
  Result := MciError;
end;

//=== CD Drive MCI Routines ==================================================

function OpenCdMciDevice(var OpenParams: TMCI_Open_Parms; Drive: Char): MCIERROR;
var
  OpenParam: DWORD;
  DriveName: array [0..2] of Char;
begin
  FillChar(OpenParams, SizeOf(OpenParams), 0);
  OpenParam := MCI_OPEN_TYPE or MCI_OPEN_TYPE_ID or MCI_OPEN_SHAREABLE;
  OpenParams.lpstrDeviceType := PChar(MCI_DEVTYPE_CD_AUDIO);
  if Drive <> #0 then
  begin
    OpenParams.lpstrElementName := StrFmt(DriveName, '%s:', [UpCase(Drive)]);
    Inc(OpenParam, MCI_OPEN_ELEMENT);
  end;
  Result := mciSendCommand(0, MCI_OPEN, OpenParam, Cardinal(@OpenParams));
end;

function CloseCdMciDevice(var OpenParams: TMCI_Open_Parms): MCIERROR;
begin
  Result := mciSendCommand(OpenParams.wDeviceID, MCI_CLOSE, MCI_WAIT, 0);
  if Result = MMSYSERR_NOERROR then
    FillChar(OpenParams, SizeOf(OpenParams), 0);
end;

//=== CD Drive specific routines =============================================

procedure OpenCloseCdDrive(OpenMode: Boolean; Drive: Char);
const
  OpenCmd: array [Boolean] of DWORD =
    (MCI_SET_DOOR_CLOSED, MCI_SET_DOOR_OPEN);
var
  Mci: TMCI_Open_Parms;
begin
  MMCheck(OpenCdMciDevice(Mci, Drive), LoadResString(@RsMmNoCdAudio));
  try
    MMCheck(mciSendCommand(Mci.wDeviceID, MCI_SET, OpenCmd[OpenMode], 0));
  finally
    CloseCdMciDevice(Mci);
  end;
end;

function IsMediaPresentInDrive(Drive: Char): Boolean;
var
  Mci: TMCI_Open_Parms;
  StatusParams: TMCI_Status_Parms;
begin
  MMCheck(OpenCdMciDevice(Mci, Drive), LoadResString(@RsMmNoCdAudio));
  try
    FillChar(StatusParams, SizeOf(StatusParams), 0);
    StatusParams.dwItem := MCI_STATUS_MEDIA_PRESENT;
    MMCheck(mciSendCommand(Mci.wDeviceID, MCI_STATUS, MCI_STATUS_ITEM or MCI_WAIT, Cardinal(@StatusParams)));
    Result := Boolean(StatusParams.dwReturn);
  finally
    CloseCdMciDevice(Mci);
  end;
end;

function GetCdInfo(InfoType: TJclCdMediaInfo; Drive: Char): string;
const
  InfoConsts: array [TJclCdMediaInfo] of DWORD =
    (MCI_INFO_PRODUCT, MCI_INFO_MEDIA_IDENTITY, MCI_INFO_MEDIA_UPC);
var
  Mci: TMCI_Open_Parms;
  InfoParams: TMCI_Info_Parms;
  Buffer: array [0..255] of Char;
begin
  Result := '';
  MMCheck(OpenCdMciDevice(Mci, Drive), LoadResString(@RsMmNoCdAudio));
  try
    InfoParams.dwCallback := 0;
    InfoParams.lpstrReturn := Buffer;
    InfoParams.dwRetSize := SizeOf(Buffer) - 1;
    if mciSendCommand(Mci.wDeviceID, MCI_INFO, InfoConsts[InfoType], Cardinal(@InfoParams)) = MMSYSERR_NOERROR then
      Result := Buffer;
  finally
    CloseCdMciDevice(Mci);
  end;
end;

function GetCDAudioTrackList(var TrackList: TJclCdTrackInfoArray; Drive: Char): TJclCdTrackInfo;
var
  Mci: TMCI_Open_Parms;
  SetParams: TMCI_Set_Parms;
  TrackCnt, Ret: Cardinal;
  I: Integer;

  function GetTrackInfo(Command, Item, Track: DWORD): DWORD;
  var
    StatusParams: TMCI_Status_Parms;
  begin
    FillChar(StatusParams, SizeOf(StatusParams), 0);
    StatusParams.dwItem := Item;
    StatusParams.dwTrack := Track;
    if mciSendCommand(Mci.wDeviceID, MCI_STATUS, Command, Cardinal(@StatusParams)) = MMSYSERR_NOERROR then
      Result := StatusParams.dwReturn
    else
      Result := 0;
  end;

begin
  MMCheck(OpenCdMciDevice(Mci, Drive), LoadResString(@RsMmNoCdAudio));
  try
    FillChar(SetParams, SizeOf(SetParams), 0);
    SetParams.dwTimeFormat := MCI_FORMAT_MSF;
    MMCheck(mciSendCommand(Mci.wDeviceID, MCI_SET, MCI_SET_TIME_FORMAT, Cardinal(@SetParams)));
    Result.TrackType := ttOther;
    TrackCnt := GetTrackInfo(MCI_STATUS_ITEM, MCI_STATUS_NUMBER_OF_TRACKS, 0);
    SetLength(TrackList, TrackCnt);
    for I := 0 to TrackCnt - 1 do
    begin
      Ret := GetTrackInfo(MCI_STATUS_ITEM or MCI_TRACK, MCI_STATUS_LENGTH, I + 1);
      TrackList[I].Minute := mci_MSF_Minute(Ret);
      TrackList[I].Second := mci_MSF_Second(Ret);
      Ret := GetTrackInfo(MCI_STATUS_ITEM or MCI_TRACK, MCI_CDA_STATUS_TYPE_TRACK, I + 1);
      if Ret = MCI_CDA_TRACK_AUDIO then
      begin
        Result.TrackType := ttAudio;
        TrackList[I].TrackType := ttAudio;
      end  
      else
        TrackList[I].TrackType := ttOther;
    end;
    Ret := GetTrackInfo(MCI_STATUS_ITEM, MCI_STATUS_LENGTH, 0);
    Result.Minute := mci_MSF_Minute(Ret);
    Result.Second := mci_MSF_Second(Ret);
  finally
    CloseCdMciDevice(Mci);
  end;
end;

function GetCDAudioTrackList(TrackList: TStrings; IncludeTrackType: Boolean; Drive: Char): string;
var
  Tracks: TJclCdTrackInfoArray;
  TotalTime: TJclCdTrackInfo;
  I: Integer;
  S: string;
begin
  TotalTime := GetCDAudioTrackList(Tracks, Drive);
  TrackList.BeginUpdate;
  try
    for I := Low(Tracks) to High(Tracks) do
      with Tracks[I] do
      begin
        if IncludeTrackType then
        begin
          case TrackType of
            ttAudio:
              S := RsMMTrackAudio;
            ttOther:
              S := RsMMTrackOther;
          end;
          S := Format('[%s]', [S]);
        end
        else
          S := '';
        S := Format(RsMmCdTrackNo, [I + 1]) + ' ' + S;
        S := S + ' ' + Format(RsMMCdTimeFormat, [I + 1, Minute, Second]);
        TrackList.Add(S);
      end;
  finally
    TrackList.EndUpdate;
  end;
  Result := Format(RsMMCdTimeFormat, [TotalTime.Minute, TotalTime.Second]);
end;

// History:

// $Log: JclMultimedia.pas,v $
// Revision 1.17  2005/03/08 08:33:22  marquardt
// overhaul of exceptions and resourcestrings, minor style cleaning
//
// Revision 1.16  2005/02/25 07:20:16  marquardt
// add section lines
//
// Revision 1.15  2005/02/24 16:34:52  marquardt
// remove divider lines, add section lines (unfinished)
//
// Revision 1.14  2004/10/17 21:00:15  mthoma
// cleaning
//
// Revision 1.13  2004/08/01 11:40:23  marquardt
// move constructors/destructors
//
// Revision 1.12  2004/07/31 06:21:03  marquardt
// fixing TStringLists, adding BeginUpdate/EndUpdate, finalization improved
//
// Revision 1.11  2004/07/28 18:00:53  marquardt
// various style cleanings, some minor fixes
//
// Revision 1.10  2004/06/16 07:30:31  marquardt
// added tilde to all IFNDEF ENDIFs, inherited qualified
//
// Revision 1.9  2004/06/14 11:05:53  marquardt
// symbols added to all ENDIFs and some other minor style changes like removing IFOPT
//
// Revision 1.8  2004/05/05 07:33:49  rrossmair
// header updated according to new policy: initial developers & contributors listed
//
// Revision 1.7  2004/04/08 16:59:17  mthoma
// Fixed #1115. Changed $Data$ to $Date: 2005/03/08 08:33:22 $
//
// Revision 1.6  2004/04/06 04:55:17
// adapt compiler conditions, add log entry
//

end.