Živě.cz o počítačích a internetu

Tipy a triky v Delphi, díl 12. - Změna tapety; Vytvoření zástupce

Jan Šindelář - 10.10.2001

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;

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.

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"

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.

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.

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;

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.