TRichEdit 에 url 링크를 연결하는 것은 여기 저기 소스가 많지만 안정적으로 잘 되는 것은 다음과 같다.
https://stackoverflow.com/questions/37790845/richedit-does-not-process-hyperlinks
TRichEdit 를 TMyRichEdit로 변경했다.
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
TMyRichEdit = 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.
'델파이' 카테고리의 다른 글
TButton Style 종류와 TPopupMenu 연결 (0) | 2017.08.24 |
---|---|
TRichEdit 마우스위의 라인값, 행번호, 열번호 구하기 (0) | 2017.08.14 |
퀵리포트(TQuickReport) TDBGrid 선택된 것만 인쇄 OnNeedData (0) | 2017.07.12 |
스트링그리드(TStringGrid) 현재 행에 색깔 넣기, 교차행에 색깔 넣기, 포커스이동문제해결 (0) | 2017.06.21 |
초단위 반올림하여 분단위표현 SQL Server smalldate 형식과 같이 (0) | 2017.05.19 |