Richedit und Hyperlinks

[Neutral General]

Hi,

Habe über die DP-Suche folgendes gefunden:

http://www.swissdelphicenter.ch/de/showcode.php?id=1652

Habe mich dann gewundert, dass es nicht funktioniert hat. Jetzt habe ich in MSDN nachgeschaut und den Grund gefunden:

Zitat:

The parent window of the control receives this notification message through a WM_NOTIFY message.

Tja nur blöd, dass das "parent window" meines Richedits ein Panel ist und das "parent window" des Panels ist ein TTabsheet und erst das parent window des Tabsheets ist meine Form...

Was kann ich da machen? Ableiten/neue Komponente wäre die allerletzte Alternative weil ich den TDE benutze und ich nicht gerne Komponenten zur Laufzeit erzeuge..

Gruß
Neutral General

[STS301]

wenn ich es richtig verstanden habe, dann sollte das funktionieren

Form1.Tabsheet1.Panel1.Richedit1.Text

[Neutral General]

Du hast mich falsch verstanden.

Das Problem ist, dass die Message, die ich abfangen muss an das Panel geschickt wird auf dem mein Richedit liegt. Ich kann sie also (scheinbar o.O) nicht abfangen indem ich die WndProc der Form überschreibe.

Hab probiert das Richedit direkt auf die Form zu legen und dann gings. Aber ich glaub ich habn Plan. Ich könnte dem Panel ein neues WndProc verpassen...

[Apollonius]

Du kannst ganz leicht die Fensterprozedur eines VCL-Controls austauschen. Schau dir mal TControl.WindowProc an.

[Neutral General]

Hi,

Mhh.. Zu spät *g* Habs jetzt mit Get/SetWindowLong gemacht. Funktioniert jetzt

Danke

[baumina]

Zitat von Neutral General:

Hi,

Mhh.. Zu spät *g* Habs jetzt mit Get/SetWindowLong gemacht. Funktioniert jetzt

Danke

Hätte mich jetzt interessiert wie du das genau gemacht hast, denn ich stehe gerade vor dem selben Problem und möchte keine eigene Komponente draus machen, weißt du noch wie dein Code dazu aussah? (Ich weiß, das ist schon ne Ecke her)

[Sigi Sandl]

Grüß euch und einen schönen Sonntag wünsche ich !

Schade, ich hatte gedacht, hier eine Lösung zu finden, aber dann kam nichts mehr.

Meine Links werden erkannt, entsprechend formatiert und aus dem TextCursor wird der HandCursor, sobald ich mich mit der Maus darüber bewege.
Weil mein Richedit aber auf einem Panel liegt, und später soll es auf einem Image liegen, wird bei LinkerMausTaste der HandCursor wieder zum TextCursor und der Link wird nicht geöffnet.

Also hoffe ich jetzt, hier doch noch eine Lösung zu kriegen.

Viele Grüße
Sigi

[DeddyH]

Versuch es mal so (Units ShellAPI und RichEdit müssen eingebunden werden): Du brauchst eine Variable/ein Feld für den originalen Methodenzeiger und die neue auszuführende Methode.

Delphi-Quellcode:

type
  TForm5 = class(TForm)
    RichEdit1: TRichEdit;
    Panel1: TPanel;
    procedure FormCreate(Sender: TObject);
  private
    { Private-Deklarationen }
    FOldWndProc: TWndMethod;
    procedure NewWndProc(var Message: TMessage);
  public
    { Public-Deklarationen }
  end;

Die Methode sieht dann (fast) wie in dem verlinkten Beispiel aus:

Delphi-Quellcode:

procedure TForm5.NewWndProc(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), nil, nil, SW_SHOWNORMAL);
      end
    end
  end;
  if Assigned(FOldWndProc) then
    FOldWndProc(Message);
end;

Im OnCreate merkst Du Dir jetzt die originale Methode des RichtEdit.Parent und weist ihm Deine eigene zu.

Delphi-Quellcode:

procedure TForm5.FormCreate(Sender: TObject);
var
  mask: Word;
begin
  mask := SendMessage(Handle, EM_GETEVENTMASK, 0, 0);
  SendMessage(RichEdit1.Handle, EM_SETEVENTMASK, 0, mask or ENM_LINK);
  SendMessage(RichEdit1.Handle, EM_AUTOURLDETECT, Integer(True), 0);
  RichEdit1.Text := 'SwissDelphiCenter.com: '#13#10 +
    ' Site is located at www.SwissDelphiCenter.com';
  FOldWndProc := RichEdit1.Parent.WindowProc;
  RichEdit1.Parent.WindowProc := NewWndProc;
end;

Das dürfte auch in etwa dem entsprechen, was die Doku zu TControl.WindowProc zu sagen hat.

Zitat:

Zeigt auf die Fensterprozedur, die auf an das Steuerelement gesendete Botschaften reagiert.

Mit Hilfe von WindowProc können Sie die Fensterprozedur des Steuerelements vorübergehend ersetzen oder unterklassifizieren. Die Methode sollte von Komponentenentwickler überschrieben werden, die diese Prozedur für eine abgeleitete Klasse selbst definieren.

Speichern Sie den alten Wert, bevor Sie WindowProc einen neuen Zeiger zuweisen. WindowProc wird zu Anfang mit der Methode WndProc initialisiert, und daher braucht der ursprüngliche Wert nicht gespeichert zu werden, wenn dieser seitdem nicht geändert wurde. Übergeben Sie in der zugewiesenen Prozedur alle nicht behandelten Botschaften an die Originalprozedur, die zuvor für WindowProc verwendet wurde. Nach einer speziellen Botschaftsbehandlung muss der Wert von WindowProc wieder in den ursprünglichen Zustand versetzt werden.

[KodeZwerg]

Wenn ich noch eine zwei Lösungen vorschlagen darf, gefunden bei SO.

Zitat:

You need to do the following:

send the RichEdit an EM_SETEVENTMASK message to enable the ENM_LINK flag. Do this once after the RichEdit has been created, and then do it again every time the RichEdit receives a CM_RECREATEWND message.

select the desired text you want to turn into a link. You can use the RichEdit's SelStart and SelLength properties, or send the RichEdit an EM_SETSEL or EM_EXSETSEL message. Either way, then send the RichEdit an EM_SETCHARFORMAT message with a CHARFORMAT2 struct to enable the CFE_LINK effect on the selected text.

subclass the RichEdit's WindowProc property to handle CN_NOTIFY(EN_LINK) and CM_RECREATEWND messages. When EN_LINK is received, you can use ShellExecute/Ex() to launch the desired URL.

For example:

Delphi-Quellcode:

unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.ComCtrls;

type
  TForm1 = class(TForm)
    RichEdit1: TRichEdit;
    Button1: TButton;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
    PrevRichEditWndProc: TWndMethod;
    procedure InsertHyperLink(const HyperlinkText: string);
    procedure SetRichEditMasks;
    procedure RichEditWndProc(var Message: TMessage);
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

uses
  Winapi.RichEdit, Winapi.ShellAPI;

procedure TForm1.FormCreate(Sender: TObject);
begin
  PrevRichEditWndProc := RichEdit1.WindowProc;
  RichEdit1.WindowProc := RichEditWndProc;

  SetRichEditMasks;

  RichEdit1.Text := 'Would you like to Download Now?';

  RichEdit1.SelStart := 18;
  RichEdit1.SelLength := 12;    
  InsertHyperLink('Download Now');
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  InsertHyperLink('Another Link');
end;

procedure TForm1.InsertHyperLink(const HyperlinkText: string);
var
  Fmt: CHARFORMAT2;
  StartPos: Integer;
begin
  StartPos := RichEdit1.SelStart;
  RichEdit1.SelText := HyperlinkText;

  RichEdit1.SelStart := StartPos;
  RichEdit1.SelLength := Length(HyperlinkText);

  FillChar(Fmt, SizeOf(Fmt), 0);
  Fmt.cbSize := SizeOf(Fmt);
  Fmt.dwMask := CFM_LINK;
  Fmt.dwEffects := CFE_LINK;

  SendMessage(RichEdit1.Handle, EM_SETCHARFORMAT, SCF_SELECTION, LPARAM(@Fmt));

  RichEdit1.SelStart := StartPos + Length(HyperlinkText);
  RichEdit1.SelLength := 0;
end;

procedure TForm1.SetRichEditMasks;
var
  Mask: DWORD;
begin
  Mask := SendMessage(RichEdit1.Handle, EM_GETEVENTMASK, 0, 0);
  SendMessage(RichEdit1.Handle, EM_SETEVENTMASK, 0, Mask or ENM_LINK);
  SendMessage(RichEdit1.Handle, EM_AUTOURLDETECT, 1, 0);
end;

procedure TForm1.RichEditWndProc(var Message: TMessage);
type
  PENLINK = ^ENLINK;
var
  tr: TEXTRANGE;
  str: string;
  p: PENLINK;
begin
  PrevRichEditWndProc(Message);

  case Message.Msg of
    CN_NOTIFY: begin
     if TWMNotify(Message).NMHdr.code = EN_LINK then
      begin
        P := PENLINK(Message.LParam);
        if p.msg = WM_LBUTTONDOWN then
        begin
          SetLength(str, p.chrg.cpMax - p.chrg.cpMin);
          tr.chrg := p.chrg;
          tr.lpstrText := PChar(strURL);
          SendMessage(RichEdit1.Handle, EM_GETTEXTRANGE, 0, LPARAM(@tr));

          if str = 'Download Now' then
          begin
            ShellExecute(Handle, nil, 'http://www.SomeSite.com/download', nil, nil, SW_SHOWDEFAULT);
          end
          else if str = 'Another Link' then
          begin
            // do something else
          end;
        end;
      end;
    end;

    CM_RECREATEWND: begin
      SetRichEditMasks;
    end;
  end;
end;

end.

Zitat:

Update: Per MSDN:

RichEdit Friendly Name Hyperlinks
In RichEdit, the hyperlink field entity is represented by character formatting effects, as contrasted to delimiters which are used to structure math objects. As such, these hyperlinks cannot be nested, although in RichEdit 5.0 and later they can be adjacent to one another. The whole hyperlink has the character formatting effects of CFE_LINK and CFE_LINKPROTECTED, while autoURLs only have the CFE_LINK attribute. The CFE_LINKPROTECTED is included for the former so that the autoURL scanner skips over friendly name links. The instruction part, i.e., the URL, has the CFE_HIDDEN attribute as well, since it’s not supposed to be displayed. The URL itself is enclosed in ASCII double quotes and preceded by the string “HYPERLINK “. Since CFE_HIDDEN plays an integral role in friendly name hyperlinks, it cannot be used in the name.

For example, in WordPad, which uses RichEdit, a hyperlink with the name MSN would have the plain text

HYPERLINK “http://www.msn.com”MSN The whole link would have CFE_LINK and CFE_LINKPROTECTED character formatting attributes and all but the MSN would have the CFE_HIDDEN attribute.

This can be simulated easily in code:

Delphi-Quellcode:

procedure TForm1.FormCreate(Sender: TObject);
begin
  ...
  RichEdit1.Text := 'Would you like to Download Now?';

  RichEdit1.SelStart := 18;
  RichEdit1.SelLength := 12;    
  InsertHyperLink('Download Now', 'http://www.SomeSite.com/downloads');
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  InsertHyperLink('A Text Link');
end;

procedure TForm1.InsertHyperLink(const HyperlinkText: string; const HyperlinkURL: string = '');
var
  HyperlinkPrefix, FullHyperlink: string;
  Fmt: CHARFORMAT2;
  StartPos: Integer;
begin
  if HyperlinkURL <> '' then
  begin
    HyperlinkPrefix := Format('HYPERLINK "%s"', [HyperlinkURL]);
    FullHyperlink := HyperlinkPrefix + HyperlinkText;
  end else begin
    FullHyperlink := HyperlinkText;
  end;

  StartPos := RichEdit1.SelStart;
  RichEdit1.SelText := FullHyperlink;

  RichEdit1.SelStart := StartPos;
  RichEdit1.SelLength := Length(FullHyperlink);

  FillChar(Fmt, SizeOf(Fmt), 0);
  Fmt.cbSize := SizeOf(Fmt);
  Fmt.dwMask := CFM_LINK;
  Fmt.dwEffects := CFE_LINK;
  if HyperlinkURL <> '' then
  begin
    // per MSDN: "RichEdit doesn’t allow the CFE_LINKPROTECTED attribute to be
    // set directly by programs. Maybe it will allow it someday after enough
    // testing is completed to ensure that things cannot go awry"...
    //
    {
    Fmt.dwMask := Fmt.dwMask or CFM_LINKPROTECTED;
    Fmt.dwEffects := Fmt.dwEffects or CFE_LINKPROTECTED;
    }
  end;

  SendMessage(RichEdit1.Handle, EM_SETCHARFORMAT, SCF_SELECTION, LPARAM(@Fmt));

  if HyperlinkURL <> '' then
  begin
    RichEdit1.SelStart := StartPos;
    RichEdit1.SelLength := Length(HyperlinkPrefix);

    FillChar(Fmt, SizeOf(Fmt), 0);
    Fmt.cbSize := SizeOf(Fmt);
    Fmt.dwMask := CFM_HIDDEN;
    Fmt.dwEffects := CFE_HIDDEN;

    SendMessage(RichEdit1.Handle, EM_SETCHARFORMAT, SCF_SELECTION, LPARAM(@Fmt));
  end;

  RichEdit1.SelStart := StartPos + Length(FullHyperlink);
  RichEdit1.SelLength := 0;
end;

And then handled in the EN_LINK notification by parsing the clicked hyperlink text:

Delphi-Quellcode:

uses
  ..., System.StrUtils;

...

SendMessage(RichEdit1.Handle, EM_GETTEXTRANGE, 0, LPARAM(@tr));

// Per MSDN: "The ENLINK notification structure contains a CHARRANGE with
// the start and end character positions of the actual URL (IRI, file path
// name, email address, etc.) that typically appears in a browser URL
// window. This doesn’t include the “HYPERLINK ” string nor the quotes in
// the hidden part. For the MSN link above, it identifies only the
// http://www.msn.com characters in the backing store."
//
// However, without the CFM_LINKPROTECTED flag, the CHARRANGE will report
// the positions of the entire "HYPERLINK ..." string instead, so just strip
// off what is not needed...
//
if StartsText('HYPERLINK "', str) then
begin
  Delete(str, 1, 11);
  Delete(str, Pos('"', str), MaxInt);
end;

if (str is a URL) then begin
  ShellExecute(Handle, nil, PChar(str), nil, nil, SW_SHOWDEFAULT);
end
else begin
  // do something else
end;

[Sigi Sandl]

Danke euch,

ich hab' Variante 1 umgesetzt, funktioniert prima.

Grüße
Sigi