Tipy a triky v Delphi, díl 159. - drobné chuťovky

Dnešní díl bude po čase zase všehochuť čtyř nesouvisejících ale užitečných tipů, které se nevešly jinam.

Více jednou ranou

Nejprve se naučíme detekovat stisk několika kláves najednou. Obvykle není problém detekovat stisk dvou kláves, takže klasické kombinace CTRL+něco nebo ALT+něco jistě běžně používáte, protože mají interní podporu v událostech komponent. Pokud ale budeme potřebovat poněkud "brutálnější" kombinaci, třeba CTRL+F3+X, musíme použít trošku odlišnější způsob. Těch existuje jako obvykle víc, tohle je jeden z nich:

procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
var
  KeybState: TKeyboardState;
begin
  GetKeyboardState(KeybState);
  if ((KeybState[VK_CONTROL] and 128) = 128) and ((KeybState[VK_F3] and 128) = 128) and ((KeybState[Ord(`X`)] and 128) = 128) then ShowMessage(`Stisknuto CTRL+F3+X`);
end;

Jsme na NTFS?

Druhý tip je z jiného soudku. Ukážeme si, jak zjistit, zda-li se konkrétní soubor nachází na disku se souborovým systémem NTFS. Může se to někdy hodit, protože pokud se soubor nachází na NTFS disku, může být omezen přístupovými právy a je třeba s tím v programech počítat. Příslušná funkce využívá knihovnu ComObj a vypadá takto:

function IsNTFS(AFileName: string): Boolean;
var
  fso, drv: OleVariant;
begin
  IsNTFS := False;
  fso := CreateOleObject(`Scripting.FileSystemObject`);
  drv := fso.GetDrive(fso.GetDriveName(AFileName));
  IsNTFS := drv.FileSystem = `NTFS`
end;

Hledáme vypalovačku

Třetí dnešní tip se týká vypalovačky. Jednoduchým testem zjistíme, zda je v systému nainstalovaná vypalovací mechanika CD/DVD. Nebude to žádný složitý hardwarový test, požadovaná informace se totiž dá nalézt v registrech systému. Proto budeme také potřebovat knihovnu Registry a pak jen jednoduchým způsobem ověříme existenci určité větve. Postup je funkční pod Windows XP.

function CDRecorder: Boolean;
var
  reg: TRegistry;
begin
  reg := TRegistry.Create;
  try
    reg.RootKey := HKEY_CURRENT_USER;
    reg.OpenKey(`Software\Microsoft\Windows\CurrentVersion\Explorer\CD Burning`, False);
    Result := reg.ValueExists(`CD Recorder Drive`);
    reg.CloseKey;
  finally
    reg.Free;
  end;
end;

IE: Reloaded

Poslední tip pracuje s Internet Explorerem. Budeme tentokrát potřebovat knihovny MSHTML a SHDocVw a naše funkce slouží k znovunačtení stránky v právě otevřených oknech IE.

procedure TForm1.Button3Click(Sender: TObject);
var
ShellWindow: IShellWindows;
WB: IWebbrowser2;
spDisp: IDispatch;
IDoc1: IHTMLDocument2;
k: Integer;
begin
ShellWindow := CoShellWindows.Create;
for k := 0 to ShellWindow.Count do
begin
  spDisp := ShellWindow.Item(k);
  if spDisp = nil then Continue;
  spDisp.QueryInterface(iWebBrowser2, WB);
  if WB <> nil then
  begin
    WB.Document.QueryInterface(IHTMLDocument2, iDoc1);
    if iDoc1 <> nil then
    begin
      WB := ShellWindow.Item(k) as IWebbrowser2;
      WB.Refresh;
    end;
  end;
end;
end;

A to už je z dnešního mixu úplně všechno. Ukázkový projekt s použitím všech uvedených funkcí můžete stahovat zde.

Diskuze (1) Další článek: AMD uvedlo nové procesory, snížilo ceny až o 50 %

Témata článku: Software, Windows, Programování, Díl, TRI, Trik, Chuť, DEL, Požadovaná informace


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

Zkusili jsme Ryzen 7 4800HS v notebooku Asus: drtí Intel výkonem a umí být potichu

Zkusili jsme Ryzen 7 4800HS v notebooku Asus: drtí Intel výkonem a umí být potichu

** Nové osmijádro AMD pro herní notebooky překvapuje výkonem ** V rámci notebooku ROG Zephyrus G15 umí být tiché i výkonné** Rozhodnou hlavně prodávané konfigurace s lepší grafikou

Tomáš Holčík | 57

Teachable Machine: Umělá inteligence za pět minut i bez doktorátu z ČVUT

Teachable Machine: Umělá inteligence za pět minut i bez doktorátu z ČVUT

** Pochopit techniky a principy A.I. je složité ** Ale nebojte, jde to i bez doktorátu z IT a matematiky ** Vyzkoušíme generátor neuronových sítí od Googlu

Jakub Čížek | 9

Jak nahradit webkameru: jde to telefonem, zadarmo a s lepším obrazem

Jak nahradit webkameru: jde to telefonem, zadarmo a s lepším obrazem

** Koronavirus donutil mnohé zaměstnance pracovat z domova ** V souvislosti s tím vzrostla poptávka po webových kamerách ** Webkameru ale nemusíte kupovat – stačí mobil a aplikace!

Karel Kilián | 13

Jak vlastně funguje Flightradar24: Posloucháme letadla nad celým Českem

Jak vlastně funguje Flightradar24: Posloucháme letadla nad celým Českem

** Flightradar24 zobrazuje polohu letadel v reálném čase ** Když mu pomůžete sbírat data, dostanete nejvyšší paušál zdarma ** Jak to vlastně celé funguje a co je k tomu potřeba?

Jakub Čížek | 28

Geniální programátor Edsger Dijkstra: hledal nové postupy a zavrhoval GoTo

Geniální programátor Edsger Dijkstra: hledal nové postupy a zavrhoval GoTo

** Edsger Dijkstra je osobností historie programování ** Vynalezl algoritmus pro nalezení nejkratší cesty v grafu a dostal Turingovu cenu ** Zasloužil se o blízké propojení programování a matematiky

Jiří Nahodil | 13

Android Auto a Apple CarPlay představují v autech větší nebezpečí než alkohol v těle řidiče

Android Auto a Apple CarPlay představují v autech větší nebezpečí než alkohol v těle řidiče

Výsledky této studie vás zřejmě vůbec nepřekvapí. Aspoň tak ale můžeme obecně známý názor podložit čísly.

Daniel Fuglevič | 28


Aktuální číslo časopisu Computer

Megatest 24 PC zdrojů

Jak využít umělou inteligenci

10 špičkových sluchátek s ANC

Playstation 5 vs Xbox Series X