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, Pointer, Format, Díl, Zelené pozadí, Message


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

Byli tam! Důkazy o přistání na Měsíci, Lunochody i čínská sonda jsou vidět z vesmíru

Byli tam! Důkazy o přistání na Měsíci, Lunochody i čínská sonda jsou vidět z vesmíru

** Sonda LRO pořídila z oběžné dráhy Měsíce zajímavé snímky ** Jsou na nich vidět artefakty všech misí programu Apolla, které přistály na povrchu Měsíce ** Jde například o části lunárních modulů, rovery a dokonce i vlajky

Petr Kubala | 65

Astronomové objevili daleko za Plutem objekt s extrémní dráhou. Může ukazovat na existenci planety Devět

Astronomové objevili daleko za Plutem objekt s extrémní dráhou. Může ukazovat na existenci planety Devět

** Astronomové objevili daleko za Neptunem těleso 2015 TG387 ** Okolo Slunce se pohybuje po extrémně protáhlé dráze ** Jeho dráha může ukazovat na existenci planety Devět

Petr Kubala | 10

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

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

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 | 44

Dell XPS 13: Když vás ostatní doženou až za tři roky

Dell XPS 13: Když vás ostatní doženou až za tři roky

** XPS 13 nastartoval trend notebooků bez rámečků ** Letošní model kompletně přechází na USB-C ** Navzdory malému tělu se řadí výkon ke špičce

Tomáš Holčík | 34


Aktuální číslo časopisu Computer

Jak vytvořit a spravovat vlastní web

Velký test herních klávesnic a DVB-T2 tunerů

Vše o formátu RAW

Vybíráme nejlepší základní desku