我希望RichEdit处理超链接,所以我按照以下说明操作:http://delphi.about.com/od/vclusing/l/aa111803a.htm
以下是我对代码所做的更改:
interface
type
TProgCorner = class(TForm)
RichEdit2: TRichEdit;
RichEdit1: TRichEdit;
RichEdit3: TRichEdit;
RichEdit4: TRichEdit;
procedure FormCreate(Sender: TObject);
private
procedure InitRichEditURLDetection(RE: TRichEdit);
protected
procedure WndProc(var Msg: TMessage); override;
end;
implementation
{$R *.DFM}
uses
ShellAPI, RichEdit;
const
AURL_ENABLEURL = 1;
AURL_ENABLEEAURLS = 8;
procedure TProgCorner.InitRichEditURLDetection(RE: TRichEdit);
var
mask: LResult;
begin
mask := SendMessage(RE.Handle, EM_GETEVENTMASK, 0, 0);
//In the debugger mask is always 1, for all 4 Richedits.
SendMessage(RE.Handle, EM_SETEVENTMASK, 0, mask or ENM_LINK);
//returns 67108865
SendMessage(RE.Handle, EM_AUTOURLDETECT, AURL_ENABLEURL, 0);
//Returns 0 = success (according to MSDN), but no joy.
//SendMessage(RE.Handle, EM_AUTOURLDETECT, AURL_ENABLEEAURLS, 0);
//When uncommented returns -2147024809
//I don't think the registration works, but don't know how to fix this.
end;
procedure TProgCorner.WndProc(var Msg: TMessage);
var
p: TENLink;
sURL: string;
CE: TRichEdit;
begin
//'normal' messages do get through here, but...
if (Msg.Msg = WM_NOTIFY) then begin
//...the following line is never reached.
if (PNMHDR(Msg.lParam).code = EN_LINK) then begin
p:= TENLink(Pointer(TWMNotify(Msg).NMHdr)^);
if (p.Msg = WM_LBUTTONDOWN) then begin
try
CE:= TRichEdit(ProgCorner.ActiveControl);
SendMessage(CE.Handle, EM_EXSETSEL, 0, LPARAM(@(p.chrg)));
sURL:= CE.SelText;
ShellExecute(Handle, 'open', PChar(sURL), 0, 0, SW_SHOWNORMAL);
except
{ignore}
end;
end;
end;
end;
inherited;
end;
procedure TProgCorner.FormCreate(Sender: TObject);
begin
InitRichEditURLDetection(RichEdit1);
InitRichEditURLDetection(RichEdit2);
InitRichEditURLDetection(RichEdit3);
InitRichEditURLDetection(RichEdit4);
//If I set the text here (and not in the object inspector)
//the richedit shows a hyperlink with the 'hand' cursor.
//but still no WM_notify message gets received in WndProc.
RichEdit1.Text:= 'http://www.example.com';
end;
end.
但是,我使用对象检查器嵌入到RichEditx.Lines
中的超链接显示为纯文本(不是链接),单击它们不起作用。
我正在使用在Win32模式下在Windows 7上运行的Delphi Seattle。
我做错了什么?
更新
使用发布已弃用的组合
SendMessage(RE.Handle, EM_AUTOURLDETECT, AURL_ENABLEURL, 0);
并在RichEditx.Text:= 'http://www.example.com'
中手动设置FormCreate
我可以让Richedit显示超链接和手柄。
但是,WndProc仍然没有收到WM_Notify
消息
WndProc确实收到其他消息。
UPDATE2
在我急于简化问题的过程中,我忽略了RichEdit
位于Panel
之上的事实。该面板会播放WM_Notify
消息,因此他们无法访问下面的表单。
答案 0 :(得分:5)
问题是WM_Notify消息永远不会到达主窗体 相反,它被Richedit的父母拦截(我放在那里的面板用于对齐) 我错误地在问题中忽略了这个事实,认为这无关紧要 那说以下对我有用。
然而,我非常赞成Remy在架构上更健全的方法,而在这个问题上苦苦挣扎的人应该首先尝试这种方法。
在VCL.ComCtrls中
TCustomRichEdit = class(TCustomMemo)
private //Why private !?
procedure CNNotify(var Message: TWMNotifyRE); message CN_NOTIFY;
解决方案是插入我们自己的TRichEdit:
uses
...., RichEdit;
type
TRichEdit = class(ComCtrls.TRichEdit)
procedure CNNotify(var Message: TWMNotifyRE); message CN_NOTIFY;
end; //never mind that its ancester is private, it will still work.
TProgCorner = class(TForm)
我将RichRdits存储在一个数组中,因此我可以通过HWnd
查找它们,而不必遍历我的表单的所有子控件。
implementation
function TProgCorner.RichEditByHandle(Handle: HWnd): TRichEdit;
var
i: integer;
begin
//Keep track of the richedits in an array, initialized on creation.
for i:= Low(RichEdits) to High(RichEdits) do begin
if RichEdits[i].Handle = Handle then exit(RichEdits[i]);
end;
Result:= nil;
end;
procedure TRichEdit.CNNotify(var Message: TWMNotifyRE);
var
p: TENLink;
sURL: string;
CE: TRichEdit;
begin
if (Message.NMHdr.code = EN_LINK) then begin
p:= TENLink(Pointer(TWMNotify(Message).NMHdr)^);
if (p.Msg = WM_LBUTTONDOWN) then begin
try
//CE:= TRichEdit(ProgCorner.ActiveControl);
//SendMessage(CE.Handle, EM_EXSETSEL, 0, Longint(@(p.chrg)));
SendMessage(p.nmhdr.hwndFrom, EM_EXSETSEL, 0, Longint(@(p.chrg)));
CE:= ProgCorner.RichEditByHandle(p.nmhdr.hwndFrom);
if assigned(CE) then begin
sURL:= CE.SelText;
ShellExecute(Handle, 'open', PChar(sURL), 0, 0, SW_SHOWNORMAL);
end;
except
{ignore}
end;
end;
end;
inherited;
end;
幸运的是,即使将原始文件声明为私有,也可以插入消息处理程序。
现在它有效。喜欢魅力。
以下是该单元的完整副本以供将来参考:
unit ProgCorn;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ExtCtrls, ComCtrls, Menus, Clipbrd, LifeConst, Tabnotbk, LifeUtil,
MyLinkLabel, RichEdit;
type
TRichEdit = class(ComCtrls.TRichEdit)
procedure CNNotify(var Message: TWMNotifyRE); message CN_NOTIFY;
end;
TProgCorner = class(TForm)
Panel1: TPanel;
Panel2: TPanel;
Label1: TLabel;
TabbedNotebook1: TTabbedNotebook;
PopupMenu1: TPopupMenu;
Copy1: TMenuItem;
Panel3: TPanel;
Button1: TButton;
RichEdit1: TRichEdit;
RichEdit2: TRichEdit;
RichEdit3: TRichEdit;
RichEdit4: TRichEdit;
Button2: TButton;
procedure Copy1Click(Sender: TObject);
procedure PopupMenu1Popup(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
RichEdits: array[1..4] of TRichEdit;
procedure InitRichEditURLDetection(RE: TRichEdit);
function RichEditByHandle(Handle: HWnd): TRichEdit;
public
{ Public declarations }
end;
var
ProgCorner: TProgCorner;
implementation
{$R *.DFM}
uses
ShellAPI;
const
AURL_ENABLEEAURLS = 8;
AURL_ENABLEURL = 1;
procedure TProgCorner.InitRichEditURLDetection(RE: TRichEdit);
var
mask: NativeInt;
begin
mask := SendMessage(RE.Handle, EM_GETEVENTMASK, 0, 0);
SendMessage(RE.Handle, EM_SETEVENTMASK, 0, mask or ENM_LINK);
SendMessage(RE.Handle, EM_AUTOURLDETECT, {AURL_ENABLEEAURLS} AURL_ENABLEURL, 0);
end;
procedure TProgCorner.FormCreate(Sender: TObject);
begin
ProgCorner:= Self;
InitRichEditURLDetection(RichEdit1);
InitRichEditURLDetection(RichEdit2);
InitRichEditURLDetection(RichEdit3);
InitRichEditURLDetection(RichEdit4);
RichEdits[1]:= RichEdit1;
RichEdits[2]:= RichEdit2;
RichEdits[3]:= RichEdit3;
RichEdits[4]:= RichEdit4;
//WordWarp should be set during runtime only, because
//otherwise the text will not warp, but rather be cut off
//before run time.
RichEdit1.Text:= RichEdit1.Text + ' ';
RichEdit2.Text:= RichEdit2.Text + ' ';
RichEdit3.Text:= RichEdit3.Text + ' ';
RichEdit4.Text:= RichEdit4.Text + ' ';
RichEdit1.WordWrap:= true;
RichEdit2.WordWrap:= true;
RichEdit3.WordWrap:= true;
RichEdit4.WordWrap:= true;
end;
procedure TProgCorner.Copy1Click(Sender: TObject);
var
ActiveRichEdit: TRichEdit;
begin
ActiveRichEdit:= TRichEdit(Self.FindComponent('RichEdit'+
IntToStr(TabbedNotebook1.PageIndex+1)));
with ActiveRichEdit do begin
if SelText <> '' then Clipboard.AsText:= SelText
else ClipBoard.AsText:= Lines.Text;
end; {with}
end;
procedure TProgCorner.PopupMenu1Popup(Sender: TObject);
begin
Copy1.Enabled:= true;
end;
procedure TProgCorner.Button2Click(Sender: TObject);
begin
Application.HelpContext(4);
end;
{ TRichEdit }
function TProgCorner.RichEditByHandle(Handle: HWnd): TRichEdit;
var
i: integer;
begin
for i:= Low(RichEdits) to High(RichEdits) do begin
if RichEdits[i].Handle = Handle then exit(RichEdits[i]);
end;
Result:= nil;
end;
procedure TRichEdit.CNNotify(var Message: TWMNotifyRE);
var
p: TENLink;
sURL: string;
CE: TRichEdit;
begin
//if (Message.Msg = WM_NOTIFY) then begin
if (Message.NMHdr.code = EN_LINK) then begin
p:= TENLink(Pointer(TWMNotify(Message).NMHdr)^);
if (p.Msg = WM_LBUTTONDOWN) then begin
try
//CE:= TRichEdit(ProgCorner.ActiveControl);
//SendMessage(CE.Handle, EM_EXSETSEL, 0, Longint(@(p.chrg)));
SendMessage(p.nmhdr.hwndFrom, EM_EXSETSEL, 0, Longint(@(p.chrg)));
CE:= ProgCorner.RichEditByHandle(p.nmhdr.hwndFrom);
if assigned(CE) then begin
sURL:= CE.SelText;
ShellExecute(Handle, 'open', PChar(sURL), 0, 0, SW_SHOWNORMAL);
end;
except
{ignore}
end;
end;
end;
//end;
inherited;
end;
end.
答案 1 :(得分:2)
您问题中显示的代码非常适合我 as-is 。尽管您提出了索赔,但表单WndProc()
确实会收到EN_LINK
次通知,并按预期启动点击后的网址。
但是,如果您将RichEdit放在另一个父控件上,例如TPanel
,则表单将不再收到WM_NOTIFY
消息。父控件将接收它们,因此您必须继承该父控件的子类。
话虽如此,可以对显示的代码进行一些改进:
在EN_LINK
处理中,您可以将其替换为:
CE := TRichEdit(ProgCorner.ActiveControl);
代之以:
CE := TRichEdit(FindControl(TWMNotify(Msg).NMHdr.hwndFrom));
通知会告诉您发送它的RichEdit控件的HWND
,并且VCL知道如何从TWinControl
检索HWND
。
使用EM_GETTEXTRANGE
检索点击的网址,而不是使用EM_EXSETSEL
和SelText
(EM_EXGETSEL
和EM_GETTEXTEX
的组合) 。这样,您使用的邮件就更少,并且根本不必操纵RichEdit的所选文本。该通知会告诉您URL的确切字符范围,因此您可以直接获取这些字符。
您需要处理HWND
娱乐活动。 VCL 可以随时重新创建RichEdit HWND
。每次创建新的HWND
时,您都必须再次发送EM_SETEVENTMASK
和EM_AUTOURLDETECT
条消息,否则您将失去自动检测功能。处理此问题的最佳方法是从TRichEdit
派生一个类并覆盖其CreateWnd()
方法。
由于您无论如何必须派生一个类,您可以让它处理VCL的CN_NOTIFY
消息,而不是直接在父母&#39中处理原始的WM_NOTIFY
消息; s WndProc
。 VCL知道如何将WM_NOTIFY
消息重定向到发送它的VCL控件。这允许VCL控件处理自己的通知。因此,无论RichEdit放置在哪个父级控件上,您的EN_LINK
处理程序都会正常工作,您根本不必子类化/覆盖父级WndProc()
,您可以使用在访问RichEdit成员时处理消息的RichEdit的Self
指针,例如Handle
属性。
总而言之,以下代码适用于我:
unit RichEditUrlTest;
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
TRichEdit = class(Vcl.ComCtrls.TRichEdit)
private
procedure CNNotify(var Message: TWMNotify); message CN_NOTIFY;
protected
procedure CreateWnd; override;
end;
TProgCorner = class(TForm)
RichEdit2: TRichEdit;
RichEdit1: TRichEdit;
RichEdit3: TRichEdit;
RichEdit4: TRichEdit;
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
ProgCorner: TProgCorner;
implementation
{$R *.dfm}
uses
Winapi.ShellAPI, Winapi.RichEdit;
const
AURL_ENABLEURL = 1;
AURL_ENABLEEAURLS = 8;
procedure TRichEdit.CreateWnd;
var
mask: LResult;
begin
inherited;
mask := SendMessage(Handle, EM_GETEVENTMASK, 0, 0);
SendMessage(Handle, EM_SETEVENTMASK, 0, mask or ENM_LINK);
SendMessage(Handle, EM_AUTOURLDETECT, AURL_ENABLEURL, 0);
end;
procedure TRichEdit.CNNotify(var Message: TWMNotify);
type
PENLink = ^TENLink;
var
p: PENLink;
tr: TEXTRANGE;
url: array of Char;
begin
if (Message.NMHdr.code = EN_LINK) then begin
p := PENLink(Message.NMHdr);
if (p.Msg = WM_LBUTTONDOWN) then begin
{ optionally, enable this:
if CheckWin32Version(6, 2) then begin
// on Windows 8+, returning EN_LINK_DO_DEFAULT directs
// the RichEdit to perform the default action...
Message.Result := EN_LINK_DO_DEFAULT;
Exit;
end;
}
try
SetLength(url, p.chrg.cpMax - p.chrg.cpMin + 1);
tr.chrg := p.chrg;
tr.lpstrText := PChar(url);
SendMessage(Handle, EM_GETTEXTRANGE, 0, LPARAM(@tr));
ShellExecute(Handle, nil, PChar(url), 0, 0, SW_SHOWNORMAL);
except
{ignore}
end;
Exit;
end;
end;
inherited;
end;
procedure TProgCorner.FormCreate(Sender: TObject);
begin
RichEdit1.Text:= 'http://www.example.com';
end;
end.