Zobrazení dialogu "Vlastnosti"

A do třetice. Ukážeme si, jak k danému souboru zobrazit známý systémový dialog Vlastnosti, který je obvykle přístupný přes kontextové menu pravého tlačítka.
procedure Vlastnosti(Soubor:String);
var
sei: TShellExecuteInfo;
begin
FillChar(sei, SizeOf(sei), 0);
sei.cbSize := SizeOf(sei);
sei.lpFile := PChar(Soubor);
sei.lpVerb := 'properties';
sei.fMask := SEE_MASK_INVOKEIDLIST;
ShellExecuteEx(@sei);
end;

Zobrazení dialogu "Otevřít v programu"

Tento tip je ze stejného soudku jako ten předchozí a vlastně i princip je stejný. Otevře známé dialogové okno se seznamem aplikací nainstalovaných v systému, ze kterých si můžete vybrat tu, pomocí které se otevře dosud neasociovaný (což nemusí nutně znamenat že neznámý) typ souboru. Parametrem procedury je soubor, který chceme otevřít.
procedure Otevrit(Soubor: String);
begin
ShellExecute(Application.Handle, 'open', PChar('rundll32.exe'), PChar('shell32.dll,OpenAs_RunDLL ' + Soubor), nil, SW_SHOWNORMAL);
end;

Otevření zadaného adresáře v Průzkumníku Windows

Průzkumník Windows. Možná jedna z prvních aplikací, na kterou začali uživatelé po vydání Windows 95 nadávat (tedy někteří; obzvláště ti, co byli zvyklí na klasický dvojitý panel jako má NC). Někdy se nám může v našich aplikacích hodit umět otevřít danou složku právě v Průzkumníkovi (jako standardní aplikaci pro práci se soubory ve Windows) a umožnit tak třeba uživateli provést nepřímo některé drobné úpravy, pokud to není zrovna "náplní práce" naší aplikace či zkrátka z jakéhokoliv jiného důvodu. Následující funkce, jejímž jediným parametrem je adresář, to zařídí:
.
.
.
uses ShellApi;
.
.
.

procedure UkazSlozku(Slozka : string);
begin
ShellExecute(Application.Handle, PChar('explore'), PChar(Slozka), nil, nil, SW_SHOWNORMAL);
end;

Dneska trošku naťukneme poměrně rozsáhlé téma souborů a adresářů a všeho co s nimi souvisí. Ukážeme si jak zobrazit některé dialogy, související se soubory, dále se podíváme na tvorbu adresářového stromu, naučíme se zjišťovat umístění důležitých systémových složek a nakonec si ukážeme jednoduchý způsob vytvoření zkrácené verze dlouhých adresářových cest (názvů).

Jak vidíte, prvním parametrem je soubor včetně cesty, jehož zástupce vytváříme. Dále je to umístění zástupce, tj. jeden z výše definovaných typů, a nakonec je to volitelně přímo jméno složky (ať už na disku či v menu Start), kde bude zástupce vytvořen.
No a to je pro dnešek vše. Příště se zaměříme na některé funkce a tipy spojené se soubory a prací s nimi.

Vytvořit můžeme zástupce několika druhů

a jejich typy jsou nadefinovány hned na začátku. Pro upřesnění malý přehled v češtině:
_DESKTOP = pracovní plocha
_QUICKLAUNCH = panel rychlého spuštění (vpravo od tlačítka Start při standardním nastavení systému)
_SENDTO = odeslat (položka kontextového menu pravého tlačítka)
_STARTMENU = snad není třeba vysvětlovat :)
_OTHERFOLDER = libovolný jiný adresář, kde hodláte vytvořit zástupce
Zde tedy uvádíme zdrojový kód procedury včetně definice typů zástupce:
type ShortcutType = (_DESKTOP, _QUICKLAUNCH, _SENDTO, _STARTMENU, _OTHERFOLDER);

procedure CreateShortcut(SourceFileName: string; Location: ShortcutType; SubDirectory : string);
var
MyObject : IUnknown;
MySLink : IShellLink;
MyPFile : IPersistFile;
Directory,
LinkName : string;
WFileName : WideString;
MyReg,
QuickLaunchReg : TRegIniFile;
begin
MyObject := CreateComObject(CLSID_ShellLink);
MySLink := MyObject as IShellLink;
MyPFile := MyObject as IPersistFile;

MySLink.SetPath(PChar(SourceFileName));

MyReg := TRegIniFile.Create('Software\MicroSoft\Windows\CurrentVersion\Explorer');
try
LinkName := ChangeFileExt(SourceFileName, '.lnk');
LinkName := ExtractFileName(LinkName);
case Location of
_OTHERFOLDER : Directory := SubDirectory;
_DESKTOP : Directory := MyReg.ReadString('Shell Folders', 'Desktop', '');
_STARTMENU : Directory := MyReg.ReadString('Shell Folders', 'Start Menu', '');
_SENDTO : Directory := MyReg.ReadString('Shell Folders', 'SendTo', '');
_QUICKLAUNCH:
begin
QuickLaunchReg := TRegIniFile.Create('Software\MicroSoft\Windows\CurrentVersion\GrpConv');
try
Directory := QuickLaunchReg.ReadString('MapGroups', 'Quick Launch', '');
finally
QuickLaunchReg.Free;
end;
end;
end;
if Directory <> '' then
begin
if (SubDirectory <> '') and (Location <> _OTHERFOLDER) then
WFileName := Directory + '\'+ SubDirectory +'\' + LinkName
else
WFileName := Directory + '\' + LinkName;
MyPFile.Save(PWChar(WFileName), False);
end;
finally
MyReg.Free;
end;
end;
A zde již konkrétní příklad vytvoření několika zástupců. Vytvoříme si zástupce na ploše, v menu Start, v panelu rychlého spuštění a v jednom dalším libovolném adresáři.
procedure TForm1.Button1Click(Sender: TObject);
begin
CreateShortcut('c:\Vasprogram.exe',_STARTMENU,'Programy');
CreateShortcut('c:\Vasprogram.exe',_DESKTOP,'');
CreateShortcut('c:\Vasprogram.exe',_OTHERFOLDER,'c:\Vasadresar');
CreateShortcut('c:\Vasprogram.exe',_QUICKLAUNCH,'');
end;

Vytvoření zástupce

Další věcí, kterou se naučíme, bude vytváření zástupců, a to nejen na ploše, ale též v menu Start, v panelu rychlého spuštění a prakticky v libovolné složce, kterou si zvolíte.
Potřeba budou tyto knihovny: Registry, ActiveX, Comobj, ShlObj
Vše potřebné zajistí následující procedura CreateShortCut, kterou potom v naší ukázce použijeme ke konkrétnímu příkladu vytvoření několika zástupců po stisknutí tlačítka.

Druhý způsob je kratší,

tapetu zobrazí na střed a parametrem je pouze soubor s obrázkem. Návratovým parametrem funkce je true nebo false v závislosti na úspěšném či neúspěšném pokusu o provedení akce.
function Wallpaper(soubor: string):boolean;
type a=array [0..255] of char;
var nazev: ^a;
begin
new(nazev);
strpcopy(nazev^,soubor);
dispose(nazev);
if SystemParametersInfo(SPI_SETDESKWALLPAPER,0,nazev,SPIF_SENDCHANGE ) then Result:=true
else Result:=false;
end;
Na závěr jedno téma na volnou diskusi. Jeden ze čtenářů přišel se zajímavým dotazem, zda by nebylo možné nejen tapetu tímto celkem jednoduchým způsobem změnit, ale jestli by nebylo možné přímo tuto bitmapu animovat. Pokud snad někdo ví, zda a jak je to možné provést, ať nám zkusí poradit v diskusi. Jde nám ale o opravdovou animaci, ne o pouhé "rychlé" střídání obrazovek, které by mělo do plynulosti daleko.

Ještě přidám malou tabulku, ve které přesně vidíte, jaké parametry pro daný způsob používají samotná Windows, abyste se vyvarovali "nestandardních" kombinací :
"Na střed" - TileWallpaper="0" WallpaperStyle="0"
"Vedle sebe" - TileWallpaper="1" WallpaperStyle="0"
"Roztáhnout" - TileWallpaper="0" WallpaperStyle="2"

Prvním parametrem je obrázek ve formátu BMP, který bude použit jako tapeta. Druhý parametr logického typu nám určuje, zda se má obrázek nakopírovat na plochu vedle sebe (v případě, že není dostatečně velký), a nakonec třetím parametrem nastavíme, jestli se má obrázek roztáhnout (místo aby se nakopíroval vedle sebe). Myslím, že to každý stejně dobře zná a není třeba nic více vysvětlovat.

Změna tapety

Ukážeme si dva způsoby, jak změnit tapetu pracovní plochy. První pracuje přímo s registry a je řekněme komplexnější, druhý způsob je zase o něco kratší. Osobně bych se přikláněl k prvnímu způsobu, protože i zdrojový kód je o něco přehlednější a jasnější.
Tak tedy první způsob. Jak bylo řečeno, budeme pracovat s registry, takže nezapomeňte připojit jednotku Registry.
procedure Wallpaper(nazevsouboru:string;dlazdice,roztahnout:boolean);
var reg : TRegIniFile;
begin
reg := TRegIniFile.Create('Control Panel\Desktop');
with reg do
begin

WriteString('', 'Wallpaper', nazevsouboru);
if dlazdice then WriteString('', 'TileWallpaper', '1')
else WriteString('', 'TileWallpaper', '0');

if roztahnout then WriteString('', 'WallpaperStyle', '2')
else WriteString('', 'WallpaperStyle', '0');

end;
reg.Free;
SystemParametersInfo(SPI_SETDESKWALLPAPER, 0, Nil, SPIF_SENDWININICHANGE);
end;

závěr

Na úplný závěr snad jen jedno malé doporučení. Všechny tyto a další vizuální tipy, které jste si dnes či v jiném dílu přečetli, používejte s rozumem a jenom tehdy, když to má smysl a účel. Nemá cenu snažit se uživateli předvádět tím, co všechno umíme, a snažit se do aplikace nacpat všechny efekty najednou. Vždy by mělo jít hlavně o funkci programu a ne o pouťové atrakce kolem.
A to je pro dnešek všechno. Příště si opět trošku pohrajeme s pracovní plochou, naučíme se měnit tapetu, vytvářet zástupce a další tipy.

Po opětovném kliknutí

se okno opět objeví v plné velikosti. S použitím předchozích tipů o animaci oken při jejich zobrazení si můžete vylepšit i tento příklad a dosáhnout tak opravdového vyrolování nahoru.
Určitým omezením tohoto příkladu je použití pouze na okna typu bsSizeable a bsDialog.
private
{ Private declarations }
PuvodniVyska : Integer;
procedure WMNCRButtonDown(var Msg : TWMNCRButtonDown); message WM_NCRBUTTONDOWN;

.
.
.

procedure TForm1.WMNCRButtonDown(var Msg : TWMNCRButtonDown);
begin
if (Msg.HitTest = HTCAPTION) then
if (ClientHeight = 0) then
begin
ClientHeight := PuvodniVyska;
Application.ProcessMessages;
end
else
begin
PuvodniVyska := ClientHeight;
ClientHeight := 0;
Application.ProcessMessages;
end
end;