HyperLinky v RTF - aktualizováno

vložil Radek Červinka 27. března 2012 21:31

Snažím se udělat v RTF hyperlink, který má skrytou část adresy. Prostě klasický odkaz, který něco zobrazuje ale odkazovaná část je jiná (Delphi na webu), s tím že v programu odkazovanou část si odchytím a místo toho zobrazím úplně něco jiného.

aktualizováno

TRichEdit od verze 2 (tj. Windows 2000) umožňuje zobrazovat automatické linky (tj. když napíšete http://delphi.cz tak to zobrazí jako link, ve verzi 3 i bez toho http), popis co která verze richedit umí (což je ten control od MS).

Delphi standardně obsahuje wrapper pro verzi 3, popis jak na 4.1 (using-richedit-4-1-with-d2010) jsem tu měl - lepší varianta níže. Problém je, že 4.1 (XP+) je asi první verze, která má pro to přímo podporu (pro ten typ linku co potřebuji) - resp. podporu ve smyslu že to umí zobrazit (ale vložit to tam musíte přes RTF).

Ohledně podpory normálních linků můžete použít Detect click on URL in RichEdit - TJvRichEdit na to má přímo property (TJvRichEdit je z JVCL a property je AutoURLDetect).

Pro použití RichEdit verze 4 použijte kód na konci (TJvCustomRichEdit je použit, protože se s ním pracuje lépe). Dále budete potřebovat Unicode Delphi (D2009), protože verze 4 je jen unicode a s neunicode verzí to bude o moc komplikovanější. Minimální verze přeloženého programu používající RE4 ja pak Windows XP.

Link vložíte injektováním RTF (všimněte si jak to má JvRichEdit pěkně udělané, kód vloží RTF kódy, ale zbytek zůstane zachován):

procedure TForm1.Button2Click(Sender: TObject);
var
  Stream : TMemoryStream;
const
 cHyperlink = '{\rtf1{\field {\*\fldinst {HYPERLINK "%s" }}{\fldrslt {\ul %s }}}}';
var
  s: AnsiString;
begin
 Stream := TMemoryStream.Create;
 try
   s := Format(cHyperLink, ['http://jvcl.sourceforge.net', 'JVCL']);

   Stream.Write(PChar(s)^, Length(s));
   Stream.Position := 0;
   rtf.StreamFormat := sfRichText;

   rtf.StreamMode := [smSelection, smPlainRtf];
   rtf.Lines.LoadFromStream(Stream);
   rtf.StreamMode := [];
 finally
   Stream.Free;
 end;
end;

Pozor na ten AnsiString, pokud to tam nebude tak string je unicode a musíte na začátek vložit BOM (tohle bolelo).

unit RichEdit4;

interface
uses
  jvRichEdit, ComCtrls, Controls;
var
FMoudlEdit:THandle;
const
  RichEdit41ModuleName = 'Msftedit.dll';
  RichEdit41ClassName = 'RichEdit50W';

type
TRichEdit41=class(TJvCustomRichEdit)
private
protected
    procedure CreateParams(var Params: TCreateParams);override;
public
  published
    property AdvancedTypography;
    property Align;
    property Alignment;
    property AutoAdvancedTypography;
    property AutoSize default False;
    property AutoURLDetect;
    property AutoVerbMenu;
    property AllowObjects;
    property AllowInPlace;
    property Anchors;
    property BevelEdges;
    property BevelInner;
    property BevelKind default bkNone;
    property BevelOuter;
    property BiDiMode;
    property BorderWidth;
    property DragKind;
    property BorderStyle;
    property ClipboardCommands;
    property Color;
    property DragCursor;
    property DragMode;
    property Enabled;
    property Flat;
    property Font;
    property ForceUndo;
    property HideSelection;
    property HideScrollBars;
    property HintColor;
    property Title;
    property ImeMode;
    property ImeName;
    property Constraints;
    property ParentBiDiMode;
    property LangOptions;
    property Lines;
    property MaxLength;
    property OLEDragDrop;
    property ParentColor;
    property ParentFlat;
    property ParentFont;
    property ParentShowHint;
    property PlainText;
    property PopupMenu;
    property ReadOnly;
    property ScrollBars;
    property SelectionBar;
    property SelText;
    property ShowHint;
    property StreamFormat;
    property StreamMode;
    property TabOrder;
    property TabStop;
    property UndoLimit;
    property UseFixedPopup;
    property Visible;
    property WantTabs;
    property WantReturns;
    property WordSelection;
    property WordWrap;
    property Zoom; // added by J.G. Boerema
    property OnChange;
	property OnClick;
    property OnDblClick;
    property OnDragDrop;
    property OnDragOver;
    property OnContextPopup;
    property OnConversionProgress;
    property OnEndDock;
    property OnStartDock;
    property OnEndDrag;
    property OnEnter;
    property OnExit;
    property OnKeyDown;
    property OnKeyPress;
    property OnKeyUp;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnMouseWheel;
    property OnMouseWheelDown;
    property OnMouseWheelUp;
    property OnProtectChange; { obsolete }
    property OnProtectChangeEx;
    property OnResizeRequest;
    property OnSaveClipboard;
    property OnSelectionChange;
    property OnStartDrag;
    property OnTextNotFound;
    property OnCloseFindDialog;
    property OnDragAllowed;
    property OnGetDragDropEffect;
    property OnQueryAcceptData;
    property OnURLClick;
    property OnMouseEnter;
    property OnMouseLeave;
    property OnParentColorChange;
    property OnVerticalScroll;
    property OnHorizontalScroll;
    // From CCR
    property OnInPlaceActivate;
    property OnInPlaceDeactivate;
end;

implementation
uses
  Windows, SysUtils;

procedure TRichEdit41.CreateParams(var Params: TCreateParams);
begin
if FMoudlEdit = 0 then
begin
    FMoudlEdit := LoadLibrary(RichEdit41ModuleName);
    if FMoudlEdit <= HINSTANCE_ERROR then FMoudlEdit := 0;
end;

inherited CreateParams(Params);

CreateSubClass(Params, RichEdit41ClassName);
with Params do
begin
//
end;
end;

initialization
finalization
  if FMoudlEdit <> 0 then FreeLibrary(FMoudlEdit);
end.


Nabízíme Delphi školení na různá témata, primárně ve Vaší firmě.

Tagy:

Komponenty | Praxe

Komentování ukončeno

Naše nabídka

Partial English version.

MVP
Ing. Radek Červinka - Embarcadero MVP
profil na linkedin, Twitter:@delphicz

Nabízím placené poradenství a konzultace v oblasti programování a vývoje SW.
Dále nabízíme i vývoj speciálního software na zakázku.

Neváhejte nás kontaktovat (i ohledně reklamy nebo burzy práce).

Pokud chcete podpořit tento server libovolnou částkou, můžete použít PayPal. Moc děkuji.

Delphi Certified Developer

O Delphi.cz

Delphi je jediný moderní RAD nástroj podporující tvorbu nativních aplikací pro platformu Win32, Win64 , Mac OSX a na iPhone a Android (s výhledem na další platformy díky FireMonkey) na současném trhu (včetně Windows 8.1).

V současnosti je světová komunita přes dva miliónů vývojářů.

Delphi.cz je nezávislý portál pro uživatele Delphi. Portál není koncipován pro úplné začátečníky, i když i ti se zde nebudou nudit, ale spíše na programátory, kteří již něco znají a chtějí své znalosti dále rozvíjet a sledovat novinky.

Anketa

Poslední komentáře

Comment RSS