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

Na čem běží Seznam.cz: Běžný standard už nestačí, přechází na vlastní cloud i servery

Na čem běží Seznam.cz: Běžný standard už nestačí, přechází na vlastní cloud i servery

** Seznam nám prozradil detaily k jeho nové platformě SCIF ** V rámci jednoho privátního cloudu sjednocuje většinu služeb ** Vedle softwaru vyvíjí i vlastní hardware

Karel Javůrek | 14

Apple ukázal novinky: iPad Pro má překonat notebooky a vrací se Mac mini!

Apple ukázal novinky: iPad Pro má překonat notebooky a vrací se Mac mini!

** Apple v New Yorku představoval počítačové novinky ** iPad Pro prý zatočí s notebooky ** Dočkali jsme se také návratu Mac mini

Jakub Čížek | 81

Více systémů na jednom počítači: Vybrali jsme nejlepší programy pro virtualizaci

Více systémů na jednom počítači: Vybrali jsme nejlepší programy pro virtualizaci

** Chcete na svém počítači vyzkoušet jiný operační systém? ** Jednoduchá cesta vede přes virtualizaci ** Přinášíme pět nejlepších programů virtualizaci operačních systémů

Karel Kilián | 104

Zbavujeme se Googlu: vybíráme nejlepší alternativy, které nahradí jeho služby

Zbavujeme se Googlu: vybíráme nejlepší alternativy, které nahradí jeho služby

** Google nabízí spoustu služeb, ale většina z nich má i dobré alternativy ** Pokud z nějakého důvodu nechcete používat služby Googlu, nemusíte ** Připravili jsme přehled služeb, kterými lze ty od Googlu nahradit

Karel Javůrek, David Polesný | 90

Nejlepší hardware: Skládáme nenáročnou sestavu i extrém na hry

Nejlepší hardware: Skládáme nenáročnou sestavu i extrém na hry

** Poradíme, jaký se teď vyplatí koupit hardware ** Procesory, desky, paměti, grafické karty... je z čeho vybírat ** Počítač ale nemusíte skládat, ukážeme i výhodné hotové počítače

Stanislav Janů | 8



Aktuální číslo časopisu Computer

Jak nastavit a ochránit nový mobil

Velký test bezdrátových klávesnicí a myší

Počítače v roce 2019

Srovnání barevných laserových multifunkcí