Tipy a triky v Delphi, díl 67.

Regulace hlasitosti jednotlivých zvukových kanálů bude téma dnešního dílu. Ukážeme si, jak nezávisle regulovat hlasitost levého a pravého kanálu.
Již jsme si kdysi ukazovali, jakým způsobem regulovat celkové hlasitosti jednotlivých zařízení v systému a mohli jste si tak vytvořit například vlastní variantu systémového programu pro ovládání hlasitosti. Dnešní příklad bude vlastně na toto téma trošku navazovat. Funkčnost jednoduchého ovládání hlasitosti drobně rozšíříme a ukážeme si, jak ovládat hlasitost každého kanálu zvlášť. Opět nám bude pomáhat knihovna MMSystem.

A bez dalších zbytečných úvodů se rovnou vrhneme na popis našeho příkladu. Vytvořte si nový projekt a na formulář umístěte dvě komponenty Label. Ty nám poslouží pro výpis aktuální hlasitosti levého a pravého kanálu. Dále na formulář umístěte dvě komponenty TrackBar, pomocí kterých budeme regulovat samotnou hlasitost. Rozsah hodnot, kterých může hlasitost jednotlivých kanálů nabývat, se pohybuje od 0 do 65535 (typ Word). Nastavte proto vlastnosti komponent TrackBar v Object Inspectoru na tento rozsah. A to je vlastně vše. Funkce na zjištění aktuální hlasitosti a na nastavení hlasitosti podle vaší volby naleznete v přiloženém zdrojovém kódu:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, MMSystem, StdCtrls, ComCtrls;

type
  TForm1 = class(TForm)
    TrackBar1: TTrackBar;
    Label1: TLabel;
    TrackBar2: TTrackBar;
    Label2: TLabel;
    procedure TrackBar1Change(Sender: TObject);
    procedure TrackBar2Change(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure GetVolume(var volLeft, volRight: Word);
var
  hWO: HWAVEOUT;
  waveF: TWAVEFORMATEX;
  vol: DWORD;
begin
  volLeft := 0;
  volRight := 0;
  FillChar(waveF, SizeOf(waveF), 0);
  waveOutOpen(@hWO, WAVE_MAPPER, @waveF, 0, 0, 0);
  waveOutGetVolume(hWO, @vol);
  volLeft := vol and $FFFF;
  volRight := vol shr 16;
  waveOutClose(hWO);
end;

procedure SetVolume(const volLeft, volRight: Word);
var
  hWO: HWAVEOUT;
  waveF: TWAVEFORMATEX;
  vol: DWORD;
begin
  FillChar(waveF, SizeOf(waveF), 0);
  waveOutOpen(@hWO, WAVE_MAPPER, @waveF, 0, 0, 0);
  vol := volLeft + volRight shl 16;
  waveOutSetVolume(hWO, vol);
  waveOutClose(hWO);
end;

procedure TForm1.TrackBar1Change(Sender: TObject);
begin
  Label1.Caption := IntToStr(TrackBar1.Position);
  SetVolume(TrackBar1.Position, TrackBar2.Position);
end;

procedure TForm1.TrackBar2Change(Sender: TObject);
begin
  Label2.Caption := IntToStr(TrackBar2.Position);
  SetVolume(TrackBar1.Position, TrackBar2.Position);
end;

procedure TForm1.FormCreate(Sender: TObject);
var
  volL, volR: Word;
begin
  GetVolume(volL, volR);
  Trackbar1.Position := volL;
  Label1.Caption := IntToStr(TrackBar1.Position);
  Trackbar2.Position := volR;
  Label2.Caption := IntToStr(TrackBar2.Position);
end;

end.

Zbývá jen přiřadit dané události OnChange pro jednotlivé TrackBary a rovněž nezapomeňte přiřadit událost OnCreate formuláře, ve které se zjišťují počáteční (aktuální) hlasitosti a podle toho se nastaví poloha TrackBarů.

Úroveň hlasitosti, kterou zobrazují Label1 a Label2, je zobrazena jako číslo z intervalu 0..65535, což asi nebude pro reálné použití to pravé, ale jistě pro vás nebude problém tuto hodnotu přepočítat například na procenta či jiné hodnoty, které vám budou vyhovovat. Příklad si ještě můžete dále vylepšit tím, že přidáte na formulář třetí TrackBar, který bude sloužit jako vyvážení levé a pravé strany, tedy podobně jako ze systémového ovládacího programu.

A pro puntičkáře na samý závěr připomínám, že ve zdrojovém kódu nejsou pro přehlednost ošetřeny chybové stavy, ale věřím, že snad bude každý schopen konstrukci try..except do svého programu bez problému přidat.

Diskuze (1) Další článek: USB klíčenka s pamětí již s podporou USB 2.0

Témata článku: Software, Windows, Programování, Díl, Trik


Určitě si přečtěte

Byli tam! Důkazy o přistání na Měsíci, Lunochody i čínská sonda jsou vidět z vesmíru

Byli tam! Důkazy o přistání na Měsíci, Lunochody i čínská sonda jsou vidět z vesmíru

** Sonda LRO pořídila z oběžné dráhy Měsíce zajímavé snímky ** Jsou na nich vidět artefakty všech misí programu Apolla, které přistály na povrchu Měsíce ** Jde například o části lunárních modulů, rovery a dokonce i vlajky

Petr Kubala | 62

Porno insider: Jak virtuální realita vstupuje do filmů pro dospělé

Porno insider: Jak virtuální realita vstupuje do filmů pro dospělé

** Pornografie údajně představuje třetinu internetové obsahu a je technologický tahounem ** Do erotického obsahu postupně zasahuje i virtuální realita ** Kromě vizuálního vjemu se pracuje také na virtuálním uspokojení toho hmatového

Jan Dudek | 28

Apple dal do MacBooku procesor Core i9 a 4TB SSD. Ani se neptejte, co za to chce...

Apple dal do MacBooku procesor Core i9 a 4TB SSD. Ani se neptejte, co za to chce...

** Apple aktualizoval notebooky MacBook Pro, dostaly nový hardware ** Těšit se můžete na nové procesory a větší paměť ** Cena nejvybavenějšího modelu překročí 200 tisíc korun

Martin Miksa | 99

eObčanka: Jak a proč si zřídit elektronický občanský průkaz s čipem

eObčanka: Jak a proč si zřídit elektronický občanský průkaz s čipem

** Občanka s čipem už je standardně vydávaným osobním dokladem v Česku ** Umožní využívat Portál občana a funkce elektronické státní správy ** Pokud ji chcete naplno využívat, musíte si čip aktivovat

David Polesný | 114


Aktuální číslo časopisu Computer

Jak mobily určují svoji polohu?

Velký test notebooků pro studenty

Nejlepší reproduktory na párty

Služby a aplikace pro výuku angličtiny