Tipy a triky v Delphi, díl 32.

Ukážeme si, jak se dá nastavit globální hlasitost v systému (Master Volume). V dnešní době multimediálních aplikací, kdy zkouší kde kdo naprogramovat nějaký vlastní video nebo mp3 přehrávač, vlastní hru a nebo prostě jakoukoliv aplikaci pracující se zvukem, je to jistě užitečný tip. Budeme potřebovat knihovnu MMSystem a praktické použití si budeme demonstrovat na jednoduchém příkladu, kdy bude hlasitost ovládána pomocí posuvníku (TrackBar). Na formulář tedy umístěte TrackBar, do zdrojového kódu vložte níže uvedené funkce a příslušně upravte událost OnChange u TrackBaru. Ve vlastnostech posuvníku též musíte upravit rozsah povolených hodnot. Jako minimum zvolíme pochopitelně nulu, horní hranice je maximem číselného typu Word (čili 65535 či chcete-li MaxWord).

.
.
.
private
  { Private declarations }
    function GetMasterVolumeControl(Mixer: hMixerObj; var Control: TMixerControl): MMResult;
    procedure SetMasterVolume(Mixer: hMixerObj; Value: Word);
.
.
.

procedure TForm1.SetMasterVolume(Mixer: hMixerObj; Value: Word);
var
    MasterVolume : TMixerControl;
    Details : TMixercontrolDetails;
    UnsignedDetails: TMixercontrolDetailsUnsigned;
    Code: MMResult;
begin
    code := GetMasterVolumecontrol(Mixer, MasterVolume);
    if code = MMSYSERR_NOERROR then
        begin
        with Details do begin
            cbStruct := SizeOf(Details);
            dwControlId := MasterVolume.dwControlId;
            cChannels := 1;
            cMultipleItems := 0;
            cbDetails := SizeOf(UnsignedDetails);
            paDetails := @UnsignedDetails;
        end;
        UnsignedDetails.dwValue := Value;
        code := mixerSetControlDetails(Mixer, @Details, Mixer_SetControlDetailsf_value);
    end;
if Code <> MMSYSERR_NOERROR then ShowMessage(`Došlo k chybě při pokusu o změnu hlasitosti.`);
end;

function TForm1.GetMasterVolumeControl(Mixer: hMixerObj; var Control: TMixerControl): MMResult;
var
    Line: TMixerLine;
    Controls: TMixerLineControls;
begin
    ZeroMemory(@line, SizeOf(line));
    Line.cbStruct := SizeOf(Line);
    Line.dwComponentType := MIXERLINE_COMPONENTTYPE_DST_SPEAKERS;
    result := mixerGetLineInfo(Mixer, @Line, MIXER_GETLINEINFOF_COMPONENTTYPE);
    if Result = MMSYSERR_NOERROR then
    begin
        ZeroMemory(@Controls, SizeOf(Controls));
        Controls.cbStruct := sizeOf(Controls);
        Controls.dwLineID := Line.dwLineID;
        Controls.cControls := 1;
        Controls.dwControlType := MIXERCONTROL_CONTROLTYPE_VOLUME;
        Controls.cbmxctrl := SizeOf(Control);
        Controls.pamxctrl := @Control;
        Result := MixerGetLineControls(Mixer, @Controls, Mixer_GETLINECONTROLSF_ONEBYTYPE);
    end;
end;

procedure TForm1.TrackBar1Change(Sender: TObject);
begin
SetMasterVolume(0,TrackBar1.Position);
end;

Náhrada nějakého textu v souboru (textovém) patří mezi velmi časté a běžné úkony, takže si ukážeme jeden z jednoduchých způsobů. Netvrdím, že je to ten nejideálnější způsob, avšak pro jednoduché použití postačí. Parametrem funkce je pouze soubor, ve kterém bude hledání a nahrazování probíhat, a dále dva textové řetězce – hledaný text a jeho náhrada. Pohledem na zdrojový kód snadno zjistíte, že hlavní díl práce vykonává funkce StringReplace, která se stará o vlastní hledání a náhradu. Pomocí jejích parametrů můžete též nastavit, zda se mají nahradit všechny výskyty daného textu nebo jen ten první (rfReplaceAll), a zda se mají nebo nemají brát v úvahu velká písmena (rfIgnoreCase). Kvůli zjednodušení příkladu není testována úspěšnost výměny (zda byl vůbec nalezen soubor atd..), ale to již myslím nebude pro čtenáře problém doplnit podle vlastních požadavků.

procedure FileReplaceString(const FileName, searchstring, replacestring: string);
var
  fs: TFileStream;
  S, N: string;
begin
  fs := TFileStream.Create(FileName, fmOpenread or fmShareDenyNone);
  try
    SetLength(S, fs.Size);
    fs.ReadBuffer(S[1], fs.Size);
  finally
    fs.Free;
  end;
  N := StringReplace(S, SearchString, replaceString, [rfReplaceAll, rfIgnoreCase]);
  fs := TFileStream.Create(FileName, fmCreate);
  try
    fs.WriteBuffer(N[1], Length(N));
  finally
    fs.Free;
  end;
end;

To, co si teď ukážeme, asi v praxi příliš nevyužijete, ale přesto je to zajímavý tip. Naučíme se, jak přímo do naší aplikace vložit další program a ten poté spustit. Dalo by se s jistou nadsázkou říci, se jedná o určitou formu trojského koně, a praktické využití tohoto tipu ponechám čistě na vaší fantazii. Postup je vlastně velmi jednoduchý. Externí program, který chceme do aplikace vložit, si přidáme do resources naší aplikace. V těle naší aplikace pak podobným způsobem, jako se z resources například přehrávají zvuky, spustíme onen externí program.

Nejprve je tedy potřeba vytvořit zdrojový kód resources. Jedná se o běžný textový soubor (vytvořený například v Poznámkovém bloku), obsahující pouze následující řádek:

TESTFILE EXEFILE C:\Windows\Calc.exe

Ti bystřejší z vás již jistě pochopili, že program, který budeme vkládat do naší aplikace, je Kalkulačka z Windows. Pokud máte systémový adresář jinde, nebo chcete využít jiný program než Kalkulačku, je pochopitelně potřeba udat cestu. Takto vytvořený soubor uložte například pod názvem "kalkulacka.rc".

Dalším krokem je kompilace s využitím Resource Compileru z Delphi. Naleznete jej v adresáři {Delphi}/Bin pod názvem "brcc32.exe" a kompilaci provedete snadno tak, že spustíte compiler a jako parametr uvedete název našeho zdrojového souboru. Kvůli ulehčení práce si můžete oba soubory zkopírovat do stejného adresáře a samotnou kompilaci spustíte například tímto "příkazem":

c:\Pomocnyadresar\brcc32.exe kalkulacka.rc

Výsledkem by měl být soubor "kalkulacka.res", který zkopírujeme do adresáře s naší hlavní aplikací. A nyní již zbývá jen zahrnout zdrojový soubor do naší aplikace a pomocí několika dalších důležitých funkcí se postarat o její načtení a spuštění. Pravidelným čtenářům našeho seriálu se omlouvám, že jsem opět zopakoval tento postup vytváření resource souboru, který je stejný, jaký jsme použili při vytváření resources pro Windows XP, ale každý pochopitelně není pravidelným čtenářem a trocha opakování neuškodí. :)

Zbytek najdete v následujícím kódu:

.
.
.
var
  Form1: TForm1;
  SOUBOR_KALKULACKA : string;

implementation

{$R *.DFM}
{$R KALKULACKA.RES}
.
.
.

function GetTempDir : string;
var
  Buffer: array[0..MAX_PATH] OF Char;
begin
  GetTempPath(Sizeof(Buffer)-1,Buffer);
  result := StrPas(Buffer);
end;

procedure ExtractRes(ResType, ResName, ResNewName : String);
var
  Res : TResourceStream;
begin
  Res := TResourceStream.Create(Hinstance, Resname, Pchar(ResType));
  try
  Res.SavetoFile(ResNewName);
  finally
  Res.Free;
  end;
end;

Procedure ShellExecute_AndWait(FileName : String);
var
exInfo : TShellExecuteInfo;
Ph    : DWORD;
begin
  FillChar( exInfo, Sizeof(exInfo), 0 );
  with exInfo do
  begin
    cbSize:= Sizeof( exInfo );
    fMask := SEE_MASK_NOCLOSEPROCESS or SEE_MASK_FLAG_DDEWAIT;
    Wnd := GetActiveWindow();
    ExInfo.lpVerb := `open`;
    lpFile:= PChar(FileName);
    nShow := SW_SHOWNORMAL;
  end;
  if ShellExecuteEx(@exInfo) then
  begin
    Ph := exInfo.HProcess;
  end
  else
  begin
    ShowMessage(SysErrorMessage(GetLastError));
    exit;
  end;
  while WaitForSingleObject(ExInfo.hProcess, 50) <> WAIT_OBJECT_0 do
  Application.ProcessMessages;
  CloseHandle(Ph);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
SOUBOR_KALKULACKA := GetTempDir + `kalkulacka.EXE`;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  ExtractRes(`EXEFILE`,`TESTFILE`,SOUBOR_KALKULACKA);
  If FileExists(SOUBOR_KALKULACKA) then
  begin
    ShellExecute_AndWait(SOUBOR_KALKULACKA);
    ShowMessage(`Kalkulačka byla ukončena...`);
    DeleteFile(SOUBOR_KALKULACKA);
  end;
end;

A jak to vlastně celé funguje ? Po stisknutí příslušného tlačítka se nejprve vložený soubor "rozbalí" do složky pro dočasné soubory, poté se spustí a naše aplikace zároveň čeká na jeho ukončení (viz procedura ShellExecute_AndWait, kterou můžete velmi dobře použít i v jiných případech). Po ukončení "vnořené" aplikace se zobrazí informační dialog a nakonec je tato aplikace z dočasné složky opět vymazána.

Po dobu, co jsou spuštěny hlavní i "vnořená" aplikace, se obě chovají zcela nezávisle jako běžné současně spuštěné programy. Nelze však ukončit hlavní aplikaci do té doby, dokud nebude ukončena i aplikace vložená (to je právě práce procedury ShellExecute_AndWait).

A poznámka na úplný závěr. Nepokoušejte se vnořenou aplikaci spouštět vícekrát (vícenásobným stiskem příslušného tlačítka), protože dokud nebude ukončena, stále je rozbalena v pracovní složce a pokusem o další spuštění se vlastně snažíte vytvořit stejný soubor znovu. To pochopitelně vede k chybě, takže to buď nedělejte vůbec, nebo musíte vždy zajistit vytvoření unikátního názvu pro každou instanci vnořené aplikace. Připomínám, že název je vytvořen v události OnCreate hlavního formuláře naší aplikace.