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

Tipy a triky v Delphi, díl 69. - Několik drobných tipů pro komponentu RichEdit

Jan Šindelář - 4.12.2002

Několik drobných tipů pro komponentu RichEdit

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.