jclmultimedia.pas

East make Tray Icon in delphi

    raise EJclMmTimerError.CreateRes(@RsMmTimerGetCaps);
  FPeriod := FTimeCaps.wPeriodMin;
  if Notification <> nkCallback then
    FEvent := TJclEvent.Create(nil, Notification = nkSetEvent, False, '');
end;

destructor TJclMultimediaTimer.Destroy;
begin
  EndTimer;
  FreeAndNil(FEvent);
  FOnTimer := nil;
  inherited Destroy;
end;

procedure MmTimerCallback(TimerId, Msg: Cardinal; User, dw1, dw2: DWORD); stdcall;
begin
  TJclMultimediaTimer(User).Timer(TimerId);
end;

class function TJclMultimediaTimer.BeginPeriod(const Period: Cardinal): Boolean;
begin
  Result := timeBeginPeriod(Period) = TIMERR_NOERROR;
end;

procedure TJclMultimediaTimer.BeginTimer(const Delay, Resolution: Cardinal);
var
  Event: Cardinal;
  TimerCallback: TFNTimeCallBack;
begin
  if FTimerId <> 0 then
    raise EJclMmTimerError.CreateRes(@RsMmTimerActive);
  Event := 0;
  TimerCallback := nil;
  case FKind of
    tkPeriodic:
      Event := TIME_PERIODIC;
    tkOneShot:
      Event := TIME_ONESHOT;
  end;
  case FNotification of
    nkCallback:
      begin
        Event := Event or TIME_CALLBACK_FUNCTION;
        TimerCallback := @MmTimerCallback;
      end;
    nkSetEvent:
      begin
        Event := Event or TIME_CALLBACK_EVENT_SET;
        TimerCallback := TFNTimeCallback(FEvent.Handle);
      end;
    nkPulseEvent:
      begin
        Event := Event or TIME_CALLBACK_EVENT_PULSE;
        TimerCallback := TFNTimeCallback(FEvent.Handle);
      end;
  end;
  FStartTime := GetTime;
  if timeBeginPeriod(FPeriod) = TIMERR_NOERROR then
    FTimerId := timeSetEvent(Delay, Resolution, TimerCallBack, DWORD(Self), Event);
  if FTimerId = 0 then
    raise EJclMmTimerError.CreateRes(@RsMmSetEvent);
end;

function TJclMultimediaTimer.Elapsed(const Update: Boolean): Cardinal;
var
  CurrentTime: Cardinal;
begin
  if FTimerId = 0 then
    Result := 0
  else
  begin
    CurrentTime := GetTime;
    if CurrentTime >= FStartTime then
      Result := CurrentTime - FStartTime
    else
      Result := (High(Cardinal) - FStartTime) + CurrentTime;
    if Update then
      FStartTime := CurrentTime;
  end;
end;

class function TJclMultimediaTimer.EndPeriod(const Period: Cardinal): Boolean;
begin
  Result := timeEndPeriod(Period) = TIMERR_NOERROR;
end;

procedure TJclMultimediaTimer.EndTimer;
begin
  if FTimerId <> 0 then
  begin
    if FKind = tkPeriodic then
      timeKillEvent(FTimerId);
    timeEndPeriod(FPeriod);
    FTimerId := 0;
  end;
end;

function TJclMultimediaTimer.GetMinMaxPeriod(Index: Integer): Cardinal;
begin
  case Index of
    0:
      Result := FTimeCaps.wPeriodMax;
    1:
      Result := FTimeCaps.wPeriodMin;
  else
    Result := 0;
  end;
end;

class function TJclMultimediaTimer.GetTime: Cardinal;
begin
  Result := timeGetTime;
end;

procedure TJclMultimediaTimer.SetPeriod(Value: Cardinal);
begin
  if FTimerId <> 0 then
    raise EJclMmTimerError.CreateRes(@RsMmTimerActive);
  FPeriod := Value;
end;

{ TODO -cHelp : Applications should not call any system-defined functions from
    inside a callback function, except for PostMessage, timeGetSystemTime,
    timeGetTime, timeSetEvent, timeKillEvent, midiOutShortMsg, midiOutLongMsg,
    and OutputDebugString. }
procedure TJclMultimediaTimer.Timer(Id: Cardinal);
begin
  { TODO : A exception in the callbacl i very likely very critically }
  if Id <> FTimerId then
    raise EJclMmTimerError.CreateRes(@RsMmInconsistentId);
  if Assigned(FOnTimer) then
    FOnTimer(Self);
end;

function TJclMultimediaTimer.WaitFor(const TimeOut: Cardinal): TJclWaitResult;
begin
  if FNotification = nkCallback then
    Result := wrError
  else
    Result := FEvent.WaitFor(TimeOut);
end;

//=== { TJclMixerLineControl } ===============================================

function MixerLeftRightToArray(Left, Right: Cardinal): TDynCardinalArray;
begin
  SetLength(Result, 2);
  Result[0] := Left;
  Result[1] := Right;
end;

constructor TJclMixerLineControl.Create(AMixerLine: TJclMixerLine; const AControlInfo: TMixerControl);
begin
  FControlInfo := AControlInfo;
  FMixerLine := AMixerLine;
  FIsList := (ControlInfo.dwControlType and MIXERCONTROL_CT_CLASS_MASK) = MIXERCONTROL_CT_CLASS_LIST;
  FIsMultiple := FControlInfo.fdwControl and MIXERCONTROL_CONTROLF_MULTIPLE <> 0;
  FIsUniform := FControlInfo.fdwControl and MIXERCONTROL_CONTROLF_UNIFORM <> 0;
end;

destructor TJclMixerLineControl.Destroy;
begin
  FreeAndNil(FListText);
  inherited Destroy;
end;

function TJclMixerLineControl.FormatValue(AValue: Cardinal): string;
begin
  case FControlInfo.dwControlType and MIXERCONTROL_CT_UNITS_MASK of
    MIXERCONTROL_CT_UNITS_BOOLEAN:
      Result := BooleanToStr(Boolean(AValue));
    MIXERCONTROL_CT_UNITS_SIGNED:
      Result := Format('%d', [AValue]);
    MIXERCONTROL_CT_UNITS_UNSIGNED:
      Result := Format('%u', [AValue]);
    MIXERCONTROL_CT_UNITS_DECIBELS:
      Result := Format('%.1fdB', [AValue / 10]);
    MIXERCONTROL_CT_UNITS_PERCENT:
      Result := Format('%.1f%%', [AValue / 10]);
  else
    Result := '';
  end;
end;

function TJclMixerLineControl.GetID: DWORD;
begin
  Result := ControlInfo.dwControlID;
end;

function TJclMixerLineControl.GetIsDisabled: Boolean;
begin
  Result := FControlInfo.fdwControl and MIXERCONTROL_CONTROLF_DISABLED <> 0;
end;

function TJclMixerLineControl.GetListText: TStrings;
var
  ControlDetails: TMixerControlDetails;
  ListTexts, P: PMixerControlDetailsListText;
  I: Cardinal;
begin
  if FListText = nil then
  begin
    FListText := TStringList.Create;
    if IsMultiple and IsList then
    begin
      PrepareControlDetailsStruc(ControlDetails, True, IsMultiple);
      ControlDetails.cbDetails := SizeOf(TMixerControlDetailsListText);
      GetMem(ListTexts, SizeOf(TMixerControlDetailsListText) * ControlDetails.cMultipleItems);
      try
        ControlDetails.paDetails := ListTexts;
        if mixerGetControlDetails(MixerLine.MixerDevice.Handle, @ControlDetails, MIXER_GETCONTROLDETAILSF_LISTTEXT) = MMSYSERR_NOERROR then
        begin
          P := ListTexts;
          for I := 1 to ControlDetails.cMultipleItems do
          begin
            FListText.AddObject(P^.szName, Pointer(P^.dwParam1));
            Inc(P);
          end;
        end;  
      finally
        FreeMem(ListTexts);
      end;
    end;
  end;
  Result := FListText;
end;

function TJclMixerLineControl.GetName: string;
begin
  Result := FControlInfo.szName;
end;

function TJclMixerLineControl.GetUniformValue: Cardinal;
var
  ControlDetails: TMixerControlDetails;
begin
  PrepareControlDetailsStruc(ControlDetails, True, False);
  ControlDetails.cbDetails := SizeOf(Cardinal);
  ControlDetails.paDetails := @Result;
  MMCheck(mixerGetControlDetails(MixerLine.MixerDevice.Handle, @ControlDetails, MIXER_GETCONTROLDETAILSF_VALUE));
end;

function TJclMixerLineControl.GetValue: TDynCardinalArray;
var
  ControlDetails: TMixerControlDetails;
  ItemCount: Cardinal;
begin
  PrepareControlDetailsStruc(ControlDetails, IsUniform, IsMultiple);
  if IsUniform then
    ItemCount := 1
  else
    ItemCount := ControlDetails.cChannels;
  if IsMultiple then
    ItemCount := ItemCount * ControlDetails.cMultipleItems;
  SetLength(Result, ItemCount);
  ControlDetails.cbDetails := SizeOf(Cardinal);
  ControlDetails.paDetails := @Result[0];
  MMCheck(mixerGetControlDetails(MixerLine.MixerDevice.Handle, @ControlDetails, MIXER_GETCONTROLDETAILSF_VALUE));
end;

function TJclMixerLineControl.GetValueString: string;
var
  TempValue: TDynCardinalArray;
  I: Integer;
begin
  TempValue := Value;
  Result := '';
  for I := Low(TempValue) to High(TempValue) do
    Result := Result + ',' + FormatValue(TempValue[I]);
  Delete(Result, 1, 1);
end;

procedure TJclMixerLineControl.PrepareControlDetailsStruc(var ControlDetails: TMixerControlDetails;
  AUniform, AMultiple: Boolean);
begin
  FillChar(ControlDetails, SizeOf(ControlDetails), 0);
  ControlDetails.cbStruct := SizeOf(ControlDetails);
  ControlDetails.dwControlID := FControlInfo.dwControlID;
  if AUniform then
    ControlDetails.cChannels := MIXERCONTROL_CONTROLF_UNIFORM
  else
    ControlDetails.cChannels := MixerLine.LineInfo.cChannels;
  if AMultiple then
    ControlDetails.cMultipleItems := FControlInfo.cMultipleItems;
end;

procedure TJclMixerLineControl.SetUniformValue(const Value: Cardinal);
var
  ControlDetails: TMixerControlDetails;
begin
  PrepareControlDetailsStruc(ControlDetails, True, False);
  ControlDetails.cbDetails := SizeOf(Cardinal);
  ControlDetails.paDetails := @Value;
  MMCheck(mixerSetControlDetails(MixerLine.MixerDevice.Handle, @ControlDetails, MIXER_GETCONTROLDETAILSF_VALUE));
end;

procedure TJclMixerLineControl.SetValue(const Value: TDynCardinalArray);
var
  ControlDetails: TMixerControlDetails;
  {$IFDEF ASSERTIONS_ON}
  ItemCount: Cardinal;
  {$ENDIF ASSERTIONS_ON}
begin
  PrepareControlDetailsStruc(ControlDetails, IsUniform, IsMultiple);
  {$IFDEF ASSERTIONS_ON}
  if IsUniform then
    ItemCount := 1
  else
    ItemCount := ControlDetails.cChannels;
  if IsMultiple then
    ItemCount := ItemCount * ControlDetails.cMultipleItems;
  Assert(ItemCount = Cardinal(Length(Value)));
  {$ENDIF ASSERTIONS_ON}
  ControlDetails.cbDetails := SizeOf(Cardinal);
  ControlDetails.paDetails := @Value[0];
  MMCheck(mixerSetControlDetails(MixerLine.MixerDevice.Handle, @ControlDetails, MIXER_GETCONTROLDETAILSF_VALUE));
end;

//=== { TJclMixerLine } ======================================================

function MixerLineCompareID(Item1, Item2: Pointer): Integer;
begin
  Result := Integer(TJclMixerLine(Item1).ID) - Integer(TJclMixerLine(Item2).ID);
end;

function MixerLineSearchID(Param: Pointer; ItemIndex: Integer; const Value): Integer;
begin
  Result := Integer(TJclMixerDevice(Param).Lines[ItemIndex].ID) - Integer(Value);
end;

constructor TJclMixerLine.Create(AMixerDevice: TJclMixerDevice);
begin
  FMixerDevice := AMixerDevice;
  FLineControls := TObjectList.Create;
end;

destructor TJclMixerLine.Destroy;
begin
  FreeAndNil(FLineControls);
  inherited Destroy;
end;

procedure TJclMixerLine.BuildLineControls;
var
  MixerControls: TMixerLineControls;
  Controls, P: PMixerControl;
  I: Cardinal;