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

Tipy a triky v Delphi, díl 39. - Přidání vlastního tlačítka do panelu nástrojů v IE; Zobrazení HTML kódu v komponentě WebBrowser; Zobrazení vlastností komponent; Zmizení kurzoru myši; Kopírování souboru se zobrazením průběhu

Jan Šindelář - 24.4.2002

Přidání vlastního tlačítka do panelu nástrojů v IE

Možná znáte různé programy, které se snaží vylepšit a rozšířit funkce Internet Exploreru. Oblíbenou módou zejména různých vyhledávačů (a to i českých) je vnutit svým uživatelům drobné utility, které například rozšíří nástrojový panel IE o vyhledávací políčko daného vyhledávače nebo umožní například odeslat zprávu SMS. Ponechme teď stranou, jak užitečné či neužitečné podobné prográmky jsou a zkusme si něco obdobného. Ukážeme si, jak přidat do panelu nástrojů vlastní tlačítko, které spustí námi definovanou aplikaci. Zároveň se do menu Nástroje přidá další položka se stejnou funkcí.

Celé je to vlastně velmi jednoduché a je to opět záležitost systémového registru, kam do příslušné větve IE vložíme náš záznam. Zdrojový kód tedy může vypadat například takto:

procedure TlacitkoIE(Path: string);
const
  Tagit = `\{10954C80-4F0F-11d3-B17C-00C0DFE39736}\`;
var
  Reg: TRegistry;
  Vetev: string;
begin
  Reg := TRegistry.Create;
  try
    with Reg do
    begin
      RootKey := HKEY_LOCAL_MACHINE;
      Vetev := `Software\Microsoft\Internet Explorer\Extensions` + Tagit;
      OpenKey(Vetev, True);
      WriteString(`ButtonText`, `Text tlačítka`);
      WriteString(`MenuText`, `Název položky v menu`);
      WriteString(`MenuStatusBar`, `Run Script`);
      WriteString(`ClSid`, `{1FBA04EE-3024-11d2-8F1F-0000F87ABD16}`);
      WriteString(`Default Visible`, `Yes`);
      WriteString(`Exec`, Path);
      WriteString(`HotIcon`, `,4`);
      WriteString(`Icon`, `,4`);
    end
  finally
    Reg.CloseKey;
    Reg.Free;
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
TlacitkoIE(`c:\windows\calc.exe`);
end;

Náš příklad přidá do nástrojové lišty tlačítko s nadpisem Text tlačítka a přidá do menu položku Název položky v menu. Pokud se vám na lištu tlačítko nepřidá, budete ho muset přes menu Zobrazit -> Panely nástrojů -> Vlastní přidat ručně a najdete ho mezi dostupnými položkami.

Aktivací tlačítka nebo položky z menu dojde ke spuštění Kalkulačky. Jak vidíte podle parametrů, lze též nastavit ikonku, která bude na tlačítku zobrazena a to jak ve své neaktivní podobě, tak po najetí myší. Místo mnou zvolené systémové ikony s číslem 4 můžete jako parametr pochopitelně uvést cestu k libovolné ikoně v souboru ICO nebo k nějaké jiné knihovně.

A jak se tlačítka a položky v menu zbavit, když už nás omrzí ? Jednoduše z registru smažeme příslušnou větev. To jsme ale již prováděli několikrát a tak věřím, že to každý zvládne sám.

V registrech se dá ale nastavit ohledně IE ještě řada dalších zajímavých věcí, takže zájemci nechť si otevřou Editor registru a pustí se do hledání dalších lahůdek.

Zobrazení HTML kódu v komponentě WebBrowser

Ukážeme si velmi jednoduchý příklad, jak pomocí kratičké funkce zobrazit v komponentě WebBrowser HTML kód. Funkce bude vypadat takto:

procedure WB_LoadHTML(WebBrowser: TWebBrowser; HTMLCode: string);
var
  sl: TStringList;
  ms: TMemoryStream;
begin
  WebBrowser.Navigate(`about:blank`);
  if Assigned(WebBrowser.Document) then
  begin
    sl := TStringList.Create;
    try
      ms := TMemoryStream.Create;
      try
        sl.Text := HTMLCode;
        sl.SaveToStream(ms);
        ms.Seek(0, 0);
        (WebBrowser.Document as IPersistStreamInit).Load(TStreamAdapter.Create(ms));
      finally
        ms.Free;
      end;
    finally
      sl.Free;
    end;
  end;
end;

Nyní si na formulář umístěte komponentu WebBrowser. Ne každá verze Delphi ji má, takže pokud ji na záložce Internet nevidíte a nebo podobnou záložku vůbec nemáte, není tento příklad bohužel pro vás.

Samotné použití naší funkce demonstruje poněkud neohrabaným způsobem následující kód, který berte spíše jako odstrašující příklad, nicméně je ideální pro pochopení celého principu. Tedy pokud ovládáte alespoň základy HTML, v opačném případě si zřejmě z tohoto tipu nic neodnesete.

procedure TForm1.Button1Click(Sender: TObject);
begin
WB_LoadHTML(WebBrowser1,`<html><body  bgcolor="#0000FF" text="#FFFFFF">Testovací stránka</html>`);
end;

Tato kratičká ukázka zobrazí v okně "prohlížeče" jednoduchý text bílou barvou na modrém pozadí. Jak vidíte, tímto způsobem zobrazovat celé stránky pochopitelně není moc praktické, ale věřím, že si již dokážete poradit sami a určitě pro vás nebude problém načíst stránku například z komponenty Memo a nebo přímo ze souboru.

Zobrazení vlastností komponent

Tento příklad zřejmě nevyužijete v reálných aplikacích či přesněji řečeno, nejedná o funkci, kterou by uživatelé vašich aplikací na první pohled mohli ocenit. Ukážeme si, jak jednoduchým způsobem zjišťovat za běhu aplikace vlastnosti všech komponent, které obsahuje. Může to být neocenitelná pomoc při ladění aplikace při fázi vývoje, při logování chyb v případě pádu aplikace a podobně.

Umístěte si na formulář komponentu Memo, do které budeme v naší ukázce vlastnosti komponent vypisovat. Poté můžete na formulář umístit libovolné další komponenty, na kterých si ověříte funkčnost našeho příkladu.

procedure ListComponentProperties(Component: TComponent; Strings: TStrings);
var
  Count, Size, I: Integer;
  List: PPropList;
  PropInfo: PPropInfo;
  PropOrEvent, PropValue: string;
begin
  Count := GetPropList(Component.ClassInfo, tkAny, nil);
  Size  := Count * SizeOf(Pointer);
  GetMem(List, Size);
  try
    Count := GetPropList(Component.ClassInfo, tkAny, List);
    for I := 0 to Count - 1 do
    begin
      PropInfo := List^[I];
      if PropInfo^.PropType^.Kind in tkMethods then
        PropOrEvent := `Event`
      else
        PropOrEvent := `Property`;
      PropValue := VarToStr(GetPropValue(Component, PropInfo^.Name));
      Strings.Add(Format(`[%s] %s: %s = %s`, [PropOrEvent, PropInfo^.Name,
        PropInfo^.PropType^.Name, PropValue]));
    end;
  finally
    FreeMem(List);
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  Memo1.Lines.BeginUpdate;
  Memo1.Lines.Clear;
  ListComponentProperties(Button1, Memo1.Lines);
  Memo1.Lines.EndUpdate;
end;

Nejdůležitějším parametrem je pochopitelně komponenta, jejíž vlastnosti chceme zjistit (v naší ukázce je to Button1).

Zmizení kurzoru myši

Velice krátký a jednoduchý tip. Zmizení kurzoru myši docílíme takto:

ShowCursor(false);

a jeho opětovné zobrazení celkem logicky takto:

ShowCursor(true);

Je třeba něco dodávat ? Myslím, že určitě ne. Využití tohoto tipu nechám na vás.

Kopírování souboru se zobrazením průběhu

Chcete si vytvořit vlastní souborový manažer ? Pak se vám možná bude hodit tento tip, ve kterém si ukážeme kopírování souborů s ukazatelem průběhu celé akce. O stupínek výš bychom se s naším příkladem dostali, pokud by kopírování probíhalo v samostatném vlákně na pozadí, ale to poněkud přesahuje prostorové možnosti tohoto dílu seriálu. Takže nám opět pomůže obvyklé Application.ProcessMessages, aby nedošlo k "zamrznutí" aplikace po dobu kopírování.

procedure CopyFileWithProgressBar(Source, Destination : string);
var
  FromF,
  ToF        : file of byte;
  Buffer    : array[0..4096] of char;
  NumRead    : integer;
  FileLength : longint;
begin
  AssignFile(FromF,Source);
  reset(FromF);
  AssignFile(ToF,Destination);
  rewrite(ToF);
  FileLength:=FileSize(FromF);
  with Form1.Progressbar1 do
  begin
    Min := 0;
    Max := FileLength;
    while FileLength > 0 do
    begin
      BlockRead(FromF,Buffer[0],SizeOf(Buffer),NumRead);
      FileLength := FileLength - NumRead;
      BlockWrite(ToF,Buffer[0],NumRead);
      Position := Position + NumRead;
      Application.ProcessMessages;
    end;
    CloseFile(FromF);
    CloseFile(ToF);
  end;
end;

procedure TForm1.Button16Click(Sender: TObject);
begin
CopyFileWithProgressBar(`c:\zdroj.exe`,`c:\cíl.exe`);
end;

Jak vidíte, princip je velmi jednoduchý a snadno pochopitelný. Samozřejmě je nutné, aby byla formuláři umístěna komponenta ProgressBar.