jclmultimedia.pas

East make Tray Icon in delphi

{**************************************************************************************************}
{                                                                                                  }
{ Project JEDI Code Library (JCL)                                                                  }
{                                                                                                  }
{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); }
{ you may not use this file except in compliance with the License. You may obtain a copy of the    }
{ License at http://www.mozilla.org/MPL/                                                           }
{                                                                                                  }
{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF   }
{ ANY KIND, either express or implied. See the License for the specific language governing rights  }
{ and limitations under the License.                                                               }
{                                                                                                  }
{ The Original Code is JclMultimedia.pas.                                                          }
{                                                                                                  }
{ The Initial Developers of the Original Code are Marcel van Brakel and Bernhard Berger.           }
{ Portions created by these individuals are Copyright (C) of these individuals.                    }
{ All Rights Reserved.                                                                             }
{                                                                                                  }
{ Contributor(s):                                                                                  }
{   Marcel van Brakel                                                                              }
{   Robert Marquardt (marquardt)                                                                   }
{   Robert Rossmair (rrossmair)                                                                    }
{   Matthias Thoma (mthoma)                                                                        }
{   Petr Vones (pvones)                                                                            }
{                                                                                                  }
{**************************************************************************************************}
{                                                                                                  }
{ Contains a high performance timer based on the MultiMedia API and a routine to open or close the }
{ CD-ROM drive.                                                                                    }
{                                                                                                  }
{**************************************************************************************************}

// Last modified: $Date: 2005/03/08 08:33:22 $
// For history see end of file

unit JclMultimedia;

{$I jcl.inc}

interface

uses
  Windows, Classes, MMSystem, Contnrs,
  JclBase, JclSynch, JclStrings;

type
  {$IFDEF FPC}
  // declarations missing from mmsystem.pp
  // see also implementation section
  TTimeCaps = TIMECAPS;
  TMixerControl = MIXERCONTROL;
  TMixerCaps = MIXERCAPS;
  TMixerLine = MIXERLINE;
  TMCI_Open_Parms = MCI_OPEN_PARMS;
  {$ENDIF FPC}

  // Multimedia timer
  TMmTimerKind = (tkOneShot, tkPeriodic);
  TMmNotificationKind = (nkCallback, nkSetEvent, nkPulseEvent);

  TJclMultimediaTimer = class(TObject)
  private
    FEvent: TJclEvent;
    FKind: TMmTimerKind;
    FNotification: TMmNotificationKind;
    FOnTimer: TNotifyEvent;
    FPeriod: Cardinal;
    FStartTime: Cardinal;
    FTimeCaps: TTimeCaps;
    FTimerId: Cardinal;
    function GetMinMaxPeriod(Index: Integer): Cardinal;
    procedure SetPeriod(Value: Cardinal);
  protected
    procedure Timer(Id: Cardinal); virtual;
  public
    constructor Create(Kind: TMmTimerKind; Notification: TMmNotificationKind);
    destructor Destroy; override;
    class function GetTime: Cardinal;
    class function BeginPeriod(const Period: Cardinal): Boolean; { TODO -cHelp : Doc }
    class function EndPeriod(const Period: Cardinal): Boolean;   { TODO -cHelp : Doc }
    procedure BeginTimer(const Delay, Resolution: Cardinal);
    procedure EndTimer;
    function Elapsed(const Update: Boolean): Cardinal;
    function WaitFor(const TimeOut: Cardinal): TJclWaitResult;
    property Event: TJclEvent read FEvent;
    property Kind: TMmTimerKind read FKind;
    property MaxPeriod: Cardinal index 0 read GetMinMaxPeriod;
    property MinPeriod: Cardinal index 1 read GetMinMaxPeriod;
    property Notification: TMmNotificationKind read FNotification;
    property OnTimer: TNotifyEvent read FOnTimer write FOnTimer;
    property Period: Cardinal read FPeriod write SetPeriod;
  end;

  EJclMmTimerError = class(EJclError);

  // Audio Mixer
  { TODO -cDoc : mixer API wrapper code. Author: Petr Vones }

  EJclMixerError = class(EJclError);

  TJclMixerDevice = class;
  TJclMixerLine = class;
  TJclMixerDestination = class;

  TJclMixerLineControl = class(TObject)
  private
    FControlInfo: TMixerControl;
    FIsList: Boolean;
    FIsMultiple: Boolean;
    FIsUniform: Boolean;
    FListText: TStringList;
    FMixerLine: TJclMixerLine;
    function GetIsDisabled: Boolean;
    function GetID: DWORD;
    function GetListText: TStrings;
    function GetName: string;
    function GetUniformValue: Cardinal;
    function GetValue: TDynCardinalArray;
    function GetValueString: string;
    procedure SetUniformValue(const Value: Cardinal);
    procedure SetValue(const Value: TDynCardinalArray);
  protected
    constructor Create(AMixerLine: TJclMixerLine; const AControlInfo: TMixerControl);
    procedure PrepareControlDetailsStruc(var ControlDetails: TMixerControlDetails; AUniform, AMultiple: Boolean);
  public
    destructor Destroy; override;
    function FormatValue(AValue: Cardinal): string;
    property ControlInfo: TMixerControl read FControlInfo;
    property ID: DWORD read GetID;
    property IsDisabled: Boolean read GetIsDisabled;
    property IsList: Boolean read FIsList;
    property IsMultiple: Boolean read FIsMultiple;
    property IsUniform: Boolean read FIsUniform;
    property ListText: TStrings read GetListText;
    property MixerLine: TJclMixerLine read FMixerLine;
    property Name: string read GetName;
    property UniformValue: Cardinal read GetUniformValue write SetUniformValue;
    property Value: TDynCardinalArray read GetValue write SetValue;
    property ValueString: string read GetValueString;
  end;

  TJclMixerLine = class(TObject)
  private
    FLineControls: TObjectList;
    FLineInfo: TMixerLine;
    FMixerDevice: TJclMixerDevice;
    function GetComponentString: string;
    function GetLineControlByType(ControlType: DWORD): TJclMixerLineControl;
    function GetLineControlCount: Integer;
    function GetLineControls(Index: Integer): TJclMixerLineControl;
    function GetHasControlType(ControlType: DWORD): Boolean;
    function GetID: DWORD;
    function GetName: string;
  protected
    procedure BuildLineControls;
    constructor Create(AMixerDevice: TJclMixerDevice);
  public
    destructor Destroy; override;
    class function ComponentTypeToString(const ComponentType: DWORD): string;
    property ComponentString: string read GetComponentString;
    property HasControlType[ControlType: DWORD]: Boolean read GetHasControlType;
    property ID: DWORD read GetID;
    property LineControlByType[ControlType: DWORD]: TJclMixerLineControl read GetLineControlByType;
    property LineControls[Index: Integer]: TJclMixerLineControl read GetLineControls; default;
    property LineControlCount: Integer read GetLineControlCount;
    property LineInfo: TMixerLine read FLineInfo;
    property Name: string read GetName;
    property MixerDevice: TJclMixerDevice read FMixerDevice;
  end;

  TJclMixerSource = class(TJclMixerLine)
  private
    FMixerDestination: TJclMixerDestination;
  protected
    constructor Create(AMixerDestination: TJclMixerDestination; ASourceIndex: Cardinal);
  public
    property MixerDestination: TJclMixerDestination read FMixerDestination;
  end;

  TJclMixerDestination = class(TJclMixerLine)
  private
    FSources: TObjectList;
    function GetSourceCount: Integer;
    function GetSources(Index: Integer): TJclMixerSource;
  protected
    constructor Create(AMixerDevice: TJclMixerDevice; ADestinationIndex: Cardinal);
    procedure BuildSources;
  public
    destructor Destroy; override;
    property Sources[Index: Integer]: TJclMixerSource read GetSources; default;
    property SourceCount: Integer read GetSourceCount;
  end;

  TJclMixerDevice = class(TObject)
  private
    FCapabilities: TMixerCaps;
    FDestinations: TObjectList;
    FDeviceIndex: Cardinal;
    FHandle: HMIXER;
    FLines: TList;
    function GetProductName: string;
    function GetDestinationCount: Integer;
    function GetDestinations(Index: Integer): TJclMixerDestination;
    function GetLineCount: Integer;
    function GetLines(Index: Integer): TJclMixerLine;
    function GetLineByComponentType(ComponentType: DWORD): TJclMixerLine;
    function GetLineByID(LineID: DWORD): TJclMixerLine;
    function GetLineControlByID(ControlID: DWORD): TJclMixerLineControl;
    function GetLineUniformValue(ComponentType, ControlType: DWORD): Cardinal;
    procedure SetLineUniformValue(ComponentType, ControlType: DWORD; const Value: Cardinal);
  protected
    constructor Create(ADeviceIndex: Cardinal; ACallBackWnd: HWND);
    procedure BuildDestinations;
    procedure BuildLines;
    procedure Close;
    procedure Open(ACallBackWnd: HWND);
  public
    destructor Destroy; override;
    function FindLineControl(ComponentType, ControlType: DWORD): TJclMixerLineControl;
    property Capabilities: TMixerCaps read FCapabilities;
    property DeviceIndex: Cardinal read FDeviceIndex;
    property Destinations[Index: Integer]: TJclMixerDestination read GetDestinations; default;
    property DestinationCount: Integer read GetDestinationCount;
    property Handle: HMIXER read FHandle;
    property LineByID[LineID: DWORD]: TJclMixerLine read GetLineByID;
    property LineByComponentType[ComponentType: DWORD]: TJclMixerLine read GetLineByComponentType;
    property Lines[Index: Integer]: TJclMixerLine read GetLines;
    property LineCount: Integer read GetLineCount;
    property LineControlByID[ControlID: DWORD]: TJclMixerLineControl read GetLineControlByID;
    property LineUniformValue[ComponentType, ControlType: DWORD]: Cardinal read GetLineUniformValue write SetLineUniformValue;
    property ProductName: string read GetProductName;
  end;

  TJclMixer = class(TObject)
  private
    FCallbackWnd: HWND;
    FDeviceList: TObjectList;
    function GetDeviceCount: Integer;
    function GetDevices(Index: Integer): TJclMixerDevice;
    function GetFirstDevice: TJclMixerDevice;
    function GetLineMute(ComponentType: Integer): Boolean;
    function GetLineVolume(ComponentType: Integer): Cardinal;
    function GetLineByID(MixerHandle: HMIXER; LineID: DWORD): TJclMixerLine;
    function GetLineControlByID(MixerHandle: HMIXER; LineID: DWORD): TJclMixerLineControl;
    procedure SetLineMute(ComponentType: Integer; const Value: Boolean);
    procedure SetLineVolume(ComponentType: Integer; const Value: Cardinal);
  protected
    procedure BuildDevices;
  public
    constructor Create(ACallBackWnd: HWND = 0);
    destructor Destroy; override;
    property CallbackWnd: HWND read FCallbackWnd;
    property Devices[Index: Integer]: TJclMixerDevice read GetDevices; default;
    property DeviceCount: Integer read GetDeviceCount;
    property FirstDevice: TJclMixerDevice read GetFirstDevice;
    property LineByID[MixerHandle: HMIXER; LineID: DWORD]: TJclMixerLine read GetLineByID;
    property LineControlByID[MixerHandle: HMIXER; LineID: DWORD]: TJclMixerLineControl read GetLineControlByID;
    property LineMute[ComponentType: Integer]: Boolean read GetLineMute write SetLineMute;
    property LineVolume[ComponentType: Integer]: Cardinal read GetLineVolume write SetLineVolume;
    property SpeakersMute: Boolean index MIXERLINE_COMPONENTTYPE_DST_SPEAKERS read GetLineMute write SetLineMute;
    property SpeakersVolume: Cardinal index MIXERLINE_COMPONENTTYPE_DST_SPEAKERS read GetLineVolume write SetLineVolume;
  end;

  function MixerLeftRightToArray(Left, Right: Cardinal): TDynCardinalArray;

type
  // MCI Error checking
  EJclMciError = class(EJclError)
  private
    FMciErrorNo: DWORD;
    FMciErrorMsg: string;
  public
    constructor Create(MciErrNo: MCIERROR; const Msg: string);
    constructor CreateFmt(MciErrNo: MCIERROR; const Msg: string; const Args: array of const);
    constructor CreateRes(MciErrNo: MCIERROR; Ident: Integer);
    property MciErrorNo: DWORD read FMciErrorNo;
    property MciErrorMsg: string read FMciErrorMsg;
  end;

function MMCheck(const MciError: MCIERROR; const Msg: string = ''): MCIERROR;
function GetMciErrorMessage(const MciErrNo: MCIERROR): string;

// CD Drive MCI Routines
function OpenCdMciDevice(var OpenParams: TMCI_Open_Parms; Drive: Char = #0): MCIERROR;
function CloseCdMciDevice(var OpenParams: TMCI_Open_Parms): MCIERROR;

// CD Drive specific routines
procedure OpenCloseCdDrive(OpenMode: Boolean; Drive: Char = #0);

function IsMediaPresentInDrive(Drive: Char = #0): Boolean;

type
  TJclCdMediaInfo = (miProduct, miIdentity, miUPC);

  TJclCdTrackType = (ttAudio, ttOther);
  TJclCdTrackInfo = record
    Minute: Byte;
    Second: Byte;
    TrackType: TJclCdTrackType;
  end;
  TJclCdTrackInfoArray = array of TJclCdTrackInfo;

function GetCdInfo(InfoType: TJclCdMediaInfo; Drive: Char = #0): string;

function GetCDAudioTrackList(var TrackList: TJclCdTrackInfoArray; Drive: Char = #0): TJclCdTrackInfo; overload;
function GetCDAudioTrackList(TrackList: TStrings; IncludeTrackType: Boolean = False; Drive: Char = #0): string; overload;

implementation

uses
  SysUtils,
  JclResources, JclSysUtils;

{ TODO : move to JclWin32? }  
{$IFDEF FPC}
// declarations missing from mmsystem.pp
const
  mmsyst = 'winmm.dll';

type
  TFNTimeCallBack = procedure(uTimerID, uMessage: UINT;
    dwUser, dw1, dw2: DWORD) stdcall;

  PMixerControlDetailsListText = ^TMixerControlDetailsListText;
  TMixerControlDetailsListText = MIXERCONTROLDETAILS_LISTTEXTA;

  TMixerLineControlsA          = MIXERLINECONTROLSA;
  TMixerLineControls           = TMixerLineControlsA;
  TMCI_Status_Parms            = MCI_STATUS_PARMS;
  TMCI_Info_Parms              = MCI_INFO_PARMS;
  TMCI_Set_Parms               = MCI_SET_PARMS;
  
function mixerSetControlDetails(hmxobj: HMIXEROBJ; pmxcd: PMixerControlDetails; fdwDetails: DWORD): MMRESULT; stdcall;
  external mmsyst name 'mixerSetControlDetails';
{$ENDIF FPC}

//=== { TJclMultimediaTimer } ================================================

constructor TJclMultimediaTimer.Create(Kind: TMmTimerKind; Notification: TMmNotificationKind);
begin
  FKind := Kind;
  FNotification := Notification;
  FPeriod := 0;
  FTimerID := 0;
  FEvent := nil;
  FillChar(FTimeCaps, SizeOf(FTimeCaps), #0);
  if timeGetDevCaps(@FTimeCaps, SizeOf(FTimeCaps)) = TIMERR_STRUCT then