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.
RSS