Tipy a triky v Delphi, díl 69.

Několik drobných tipů pro komponentu RichEdit, to bude náplní celého dnešního dílu.
Ukážeme si dnes několik vylepšení standardní komponenty RichEdit. Bude se jednat o čtyři ukázky a jelikož spolu všechny vzájemně souvisí, budou součástí jednoho zdrojového kódu, který naleznete v druhé polovině článku.

Na formulář umístěte komponentu RichEdit a dále tři tlačítka. Ta budou sloužit pro jednotlivé funkce, přičemž čtvrtá slibovaná funkce bude aktivována automaticky.

První tlačítko nám poslouží pro barevné zvýraznění vybraného textu. Musím zdůraznit, že vybraného textu, protože se toto pravidlo bude týkat i dalších dvou funkcí. Po označení textu a kliknutí na tlačítko bude mít text světle zelené pozadí. Pochopitelně si můžete barvu libovolně zvolit, protože je součástí parametrů.

Druhé a třetí tlačítko slouží pro nastavení horního a dolního indexu vybraného textu. Znamená to tedy, že označený text bude posunut oproti úrovni ostatního textu o půl řádku výš nebo níž a vytvoří se tak dojem horního a dolního indexu. Řešení to sice není úplně ideální, ale pokud máte v textu jen několik míst, kde je třeba horní či dolní index nastavit, dá se celkem použít.

Poslední funkce, která však není spouštěna tlačítkem a běží automaticky, je zvýrazňování webových adres v textu. Bude-li tedy text identifikován jako webová adresa, změní se na odkaz, tj. bude mít modrou barvu, kurzor myši bude mít podobu ruky a po kliknutí na odkaz se samozřejmě otevře příslušná webová stránka (pochopitelně v prohlížeči, ne v komponentě RichEdit).

K fungování našich příkladů budeme potřebovat knihovnu RichEdit a kvůli spouštění webové stránky rovněž ShellAPI. Zde je tedy celý zdrojový kód:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ComCtrls, StdCtrls, RichEdit, ShellAPI;

type
  TForm1 = class(TForm)
    RichEdit1: TRichEdit;
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  protected
    procedure WndProc(var Message: TMessage); override;

  end;

  TCharacterFormat = (CFM_Superscript, CFM_Subscript, CFM_Normal);


var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure SetSelBgColor(RichEdit: TRichEdit; AColor: TColor);
var
  Format: CHARFORMAT2;
begin
  FillChar(Format, SizeOf(Format), 0);
  with Format do
  begin
    cbSize := SizeOf(Format);
    dwMask := CFM_BACKCOLOR;
    crBackColor := AColor;
    Richedit.Perform(EM_SETCHARFORMAT, SCF_SELECTION, Longint(@Format));
  end;
end;

procedure SetCharFormat(RichEdit: TRichEdit; CharacterFormat: TCharacterFormat);
var
  Format: TCharFormat;
begin
  FillChar(Format, SizeOf(Format), 0);
  with Format do
  begin
    cbSize := SizeOf(Format);
    dwMask := CFM_OFFSET;
    case CharacterFormat of
      CFM_Superscript: yOffset := 60;
      CFM_Subscript: yOffset := -60;
      CFM_Normal: yOffset := 0;
    end;
  end;
  Richedit.Perform(EM_SETCHARFORMAT, SCF_SELECTION, Longint(@Format));
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  SetSelBgColor(RichEdit1, clLime);
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  SetCharFormat(RichEdit1, CFM_Superscript);
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
  SetCharFormat(RichEdit1, CFM_Subscript);
end;

procedure TForm1.FormCreate(Sender: TObject);
var
  mask: Word;
begin
  mask := SendMessage(RichEdit1.Handle, EM_GETEVENTMASK, 0, 0);
  SendMessage(RichEdit1.Handle, EM_SETEVENTMASK, 0, mask or ENM_LINK);
  SendMessage(RichEdit1.Handle, EM_AUTOURLDETECT, Integer(True), 0);
end;

procedure TForm1.WndProc(var Message: TMessage);
var
  p: TENLink;
  strURL: string;
begin
  if (Message.Msg = WM_NOTIFY) then
  begin
    if (PNMHDR(Message.lParam).code = EN_LINK) then
    begin
      p := TENLink(Pointer(TWMNotify(Message).NMHdr)^);
      if (p.Msg = WM_LBUTTONDOWN) then
      begin
        SendMessage(RichEdit1.Handle, EM_EXSETSEL, 0, Longint(@(p.chrg)));
        strURL := RichEdit1.SelText;
        ShellExecute(Handle, `open`, PChar(strURL), 0, 0, SW_SHOWNORMAL);
      end
    end
  end;
  inherited;
end;

end.

Na závěr jako už tradičně opět zmínka o operačních systémech. Nevím, zda je to problém pouze mého počítače, ale pod Windows 98 mi příklady nefungovaly. V systému Windows 2000 ale vše pracovalo bezproblémově a správně a předpokládám, že ani pod XP nebudou potíže.

Diskuze (7) Další článek: Společnosti VIA a SiS zveřejnily hospodářské výsledky za listopad

Témata článku: Software, Windows, Programování, Trik, Zelené pozadí, Format, Pointer, Message, Díl


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

Šmírování na Street View: Koukněte se, co zachytily kamery Googlu

Šmírování na Street View: Koukněte se, co zachytily kamery Googlu

Google stále fotí celý svět do své služby Street View. A novodobou zábavou je hledat v mapách Googlu vtipné záběry. Podívejte se na výběr nejlepších!

redakce | 45

Jak funguje největší akumulátor v Česku: podívejte se do elektrárny Dlouhé Stráně

Jak funguje největší akumulátor v Česku: podívejte se do elektrárny Dlouhé Stráně

** Přečerpávací vodní elektrárna Dlouhé stráně je obdivuhodné technické dílo ** Stejná turbína vyrábí elektřinu i tlačí vodu zpět do horního jezera ** Strojovna elektrárny je zabudována v podzemí

David Polesný | 36

Co udělat s novým počítačem s Windows, než ho začnete používat

Co udělat s novým počítačem s Windows, než ho začnete používat

** Čerstvě zakoupený počítač je vhodné trochu připravit ** Věnujte pozornost instalaci a předinstalovaným aplikacím ** Zamyslete se nad zálohou a antivirem

David Polesný | 83

Na čem běží Seznam.cz: Běžný standard už nestačí, přechází na vlastní cloud i servery

Na čem běží Seznam.cz: Běžný standard už nestačí, přechází na vlastní cloud i servery

** Seznam nám prozradil detaily k jeho nové platformě SCIF ** V rámci jednoho privátního cloudu sjednocuje většinu služeb ** Vedle softwaru vyvíjí i vlastní hardware

Karel Javůrek | 14