Delphi (9.) - Download 2

Jak jsem minule slíbil tak vám dnes přináším další díl článku o Downloadu v Delphi. Dnes se podíváme na různá vylepšení, jako skrytí ze System Tray, nastavení klávesových zkratek a automatické přidání do START menu a na plochu.

Těm, kteří si ještě nestáhnuli zdrojový kód Delphi Download v0.0.1.2 z minulého dílu doporučuji stáhnout si zde.

Delphi download: Vzhled aplikace
//Zobrazení v tray icon
procedure TForm1.Trayicon1Click(Sender: TObject);
begin
  //Deaktivace klavesovych zkratek
  ZkratkyZapnuty;
  // nastavíme jednotlivé položky
  with NotifyIconData do
  begin
    cbSize := SizeOf(NotifyIconData);
    Wnd := Handle;
    uID := 0;
    uFlags := NIF_ICON + NIF_MESSAGE + NIF_TIP;
    uCallbackMessage := WM_TRAYAPPNOTIFY;
    hIcon := Application.Icon.Handle;
    szTip:='Pokusná tray aplikace';
  end;
  // přidáme ikonu na lištu
  Shell_NotifyIcon(NIM_ADD, @NotifyIconData);
  Zobrazeni := 'TRAY_ICON';
end;

Pokud klikneme na tlačítko TrayIcon z nabídky zobrazení, měly by se vypnout klávesové zkratky (Ty jsou zapnuty jen když nemáme zobrazenu žádnou ikonku). WinAPI funkce vytvoří ikonku v SystemTray liště. Nastavíme také proměnnou Zobrazení na 'TRAY_ICON' kvůli pozdějšímu uložení do INI souboru a zálohování.

//Nezobrazovat nikde
procedure TForm1.dn1Click(Sender: TObject);
begin
  //Oznameni o aktivaci klavesovych zkratek
  ShowMessage('Program lze aktivovat zkratkou CTRL+F7');
  ZkratkyZapnuty;
  // odebereme ikonu z lišty
  Shell_NotifyIcon(NIM_DELETE, @NotifyIconData);
  Zobrazeni := 'NONE';
end;

Další tlačítko v nabídce zobrazení je nezobrazovat nikde. Pro jeho obsluhu nám slouží tato procedura, která vymaže ikonku ze system tray, zapne klávesové zkratky a nastavíme proměnnou zobrazení na 'NONE'.

//Zobrazit formulář
procedure TForm1.Zobrazit1Click(Sender: TObject);
begin
  Form1.visible := true;
end;

//Skrýt formulář
procedure TForm1.Skrtformul1Click(Sender: TObject);
begin
  Form1.visible := false;
end;

Tyto procedury slouží ke skrytí a zobrazení formuláře. Skrýt můžeme tlačítkem Minimalizovat nebo v Zobrazení/Skrýt formulář. Zobrazit jej můžeme buď klávesovou zkratkou CTRL+F7(Pokud máme vypnuto zobrazení v System Tray) nebo kliknutím pravým tlačítkem na ikonku v System Tray a vybráním položky Zobrazit Formulář.

//Události nad System Tray ikonou
procedure TForm1.WMTrayAppNotify(var M: TMessage);
var
  P: TPoint;
begin
  with M do
    case lParam of
      WM_RBUTTONUP:   // pravé tlačítko
      begin
        GetCursorPos(P);
        PopupMenu1.Popup(P.X, P.Y);
      end;
    end;
end;

Tato procedura se stará o události nad ikonou System Tray. lParam může nabývat také jiných hodnot a na každé můžeme přiřadit jinou akci. Já jsem využil pouze kliknutí pravým tlačítkem pro zobrazení PupUp menu. (hodnoty lze najít v nápovědě - hledejte WM_). Do proměnné P vložíme pozici kurzoru a PopUp zobrazíme na těchto souřadnicích.

procedure TForm1.ZkratkyZapnuty();
begin
  RegisterHotKey(Handle,131632,MOD_CONTROL,VK_F7);
end;


procedure TForm1.ZkratkyVypnuty();
begin
  UnregisterHotKey(Handle,131632);
end;


procedure TForm1.WMHotKey(var Message: TMessage);
begin
  Form1.visible := true;
end;

Funkce ZkratkyZapnuty nám zaregistruje klávesovou zkratku CTRL+F7, ZkratkyVypnuty nám klávesové zkratky vypne. Reakce na klávesovou zkratku se provede v proceduře TForm1.WMHotKey

procedure TForm1.CreateLink(WorkingDirectory,
   FileName,Arguments: String;TargetLinkFile: WideString;
   Description,IconPath: String;IconIdex: Integer);
var
  MyObject : IUnknown;
  MySLink : IShellLink;
  MyPFile : IPersistFile;
begin
  MyObject := CreateComObject(CLSID_ShellLink);
  MySLink := MyObject as IShellLink;
  MyPFile := MyObject as IPersistFile;
  with MySLink do
  begin
    SetArguments (PChar(Arguments ));
    SetPath (PChar(FileName));
    SetWorkingDirectory(PChar(WorkingDirectory));
    SetDescription (PChar(Description));
    SetIconLocation (PChar(IconPath), IconIdex);
  end;

  if not DirectoryExists(ExtractFileDir(TargetLinkFile)) 
    then CreateDir(ExtractFileDir(TargetLinkFile));
  MyPFile.Save(PWChar(TargetLinkFile),False);
  MySLink := Nil;
  MyPFile := Nil;
  MyObject := Nil;
end;

Tuto proceduru jsem našel kdesi na internetu a slouží k vytvoření zástupce. Stačí ji zavolat následovně: CreateLink('C:\Win98', 'C:\Win98\Sndrec32.exe', '', 'C:\Win98\sndrec32.lnk', 'Záznam zvuku', 'C:\icon.ico', 0); a vytvoří zástupce C:\Win98\sndrec32.lnk pro program Sndrec32.exe v adresáři C:\Win98 s 1. ikonou v souboru C:\icon.ico s nápisem Záznam zvuku.

procedure TForm1.AddToDesktop(Sender: TObject);
var MyReg: TRegIniFile;
  Directory: WideString;
begin
  MyReg := TRegIniFile.Create
      ('Software\MicroSoft\Windows\CurrentVersion\Explorer');

  Directory := MyReg.ReadString('Shell Folders','Desktop','');

  CreateLink(ExtractFilePath(Application.ExeName),
    Application.ExeName,
    '',
    Directory+'\Download Manager.lnk',
    'Download Manager',
    Application.ExeName,
    0);

  MyReg.Free;
end;

Procedura pro přidání zástupce na plochu. Do proměnné directory zjistíme z registrů pozici adresáře plocha, kam vytvoříme zástupce na náš program pomocí procedury CreateLink

procedure TForm1.AddToStart(Sender: TObject);
var MyReg: TRegIniFile;
  Directory: WideString;
begin
  MyReg := TRegIniFile.Create
      ('Software\MicroSoft\Windows\CurrentVersion\Explorer');

  Directory := MyReg.ReadString('Shell Folders','Start Menu','')+
      '\Programy\Download Manager\';

  //Zástupce na program
  CreateLink(ExtractFilePath(Application.ExeName),
    Application.ExeName,
    '',
    Directory+'Download Manager v0.0.1.1.lnk',
    'Download Manager v0.0.1.1',
    Application.ExeName,
    0);

  //Zástupce na homepage GAME Developer Serveru
  CreateLink(ExtractFilePath(Application.ExeName),
    ExtractFilePath(Application.ExeName)+'Homepage.url',
    '',
    Directory+'GAME Developer Server.lnk',
    'Server o programování v DirectX a OpenGL.',
    '',
    0);

  //Zástupce na clanek o Download Manageru
  CreateLink(ExtractFilePath(Application.ExeName),
    ExtractFilePath(Application.ExeName)+'Clanek.url',
    '',
    Directory+'Zdrojové kódy a popis Download Manageru.lnk',
    'Stáhněte si zdarma zdrojové kódy a popis Download Manageru',
    '',
    0);

  //Zástupce na diskusi o Download Manageru
  CreateLink(ExtractFilePath(Application.ExeName),
    ExtractFilePath(Application.ExeName)+'Diskuse.url',
    '',
    Directory+'Diskuse o Download Manageru.lnk',
    'Zajímá vás, co si o tomto programu myslí i jiní uživatelé?',
    '',
    0);

  MyReg.Free;
end;

Procedura vytvoří adresář v nabídce START a vloží na něj zástupce na program Download Manager, a zástupce na GAME Developer Server, článek o Download Manageru, a diskusi o DM na tomto serveru.

//Odkaz na moje internetove stranky
procedure TForm1.SearchforHelpOn1Click(Sender: TObject);
begin
  if (ShellExecute(0,'open',Pchar
      ('http://gds.oceany.cz/index.php'),
      nil,nil,Sw_ShowNormal)<35)
  then ShowMessage
      ('Došlo k chybě k připojení na internetový server');
end;

Procedura otevře Internet Explorer nebo jiný, defaultní, prohlížeč internetových stránek a otevře stránku http://gds.oceany.cz/index.php. Spustí se po kliknutí Nápověda/Hledat na internetu.

procedure TForm1.About1Click(Sender: TObject);
begin
  ShowMessage('Download Manager v. 0.0.1.1'+chr(13) 
      +'Copyright: Roman Schulz (rschulz@centrum.cz)'+chr(13)
      +'Tento program je freeware'+chr(13)+chr(13)
      +'Popis a zdrojáky: GAME Developer Server'
      +chr(13)+'http://gds.oceany.cz');
end;

Procedura otevře dialogové okno s popisem a verzí programu, copyrightem a spojením na autora.

procedure TForm1.FormDestroy(Sender: TObject);
begin
  // odebereme ikonu z lišty
  Shell_NotifyIcon(NIM_DELETE, @NotifyIconData);
end;

procedure TForm1.Exit1Click(Sender: TObject);
begin
  Close;
end;


procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  Settings.WriteString('Options','Destination',Destination);
  Settings.WriteString('Options','Zobrazeni',Zobrazeni);
  Settings.Free;
end;

K tomuto snad není co dodat. Ukončení programu a uložení hodnot do INI souboru.

Kompletní zdrojový kód Delphi Download ve verzi 0.0.1.2 si můžete stáhnout zde (20kB). Jedná se o freeware. Jakékoliv další šíření alespoň čiňte s poznámkou o autorovi.

Vyšlo 14.04.2002, v blogu: 0 1 2 3 4 5 6 7 8

Děkuji, že jste se rozhodl(a) přečíst tento článek. Budu rád i za komentář. Pokud Vás tento článek zaujal a rádi byste jej doporučili ostatním, podpořte mně prosím tím, že věnujete minutku svého času a uděláte mi reklamu na linkuj.cz, vybrali.sme.sk či jagg.cz. Přeji příjemné čtení

Poslední články

Diskuse k blogu

Zatím nikdo nevložil komentář. Chcete být první? Přidání příspěvku
©PC-guru.cz 2000-2008 | Optimalizováno pro 1024*768