TRichEdit 에서 URL 클릭하기 & 스크롤 락 기능 추가

소스: http://goo.gl/KJl4Ee

소스의 링크를 클릭하시면 아시겠지만, 정말 간단합니다!

사용 방법은 아래와 같습니다.

unit _fmMain;

interface

uses
  RichEditPlus, ShellAPI,
  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 (TRichEditPlus);

  TForm1 = class(TForm)
    RichEdit1: TRichEdit;
    procedure FormCreate(Sender: TObject);
  private
    procedure on_TURLClick(Sender:TObject; const AURL:string);
  public
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
  RichEdit1.OnURLClick := on_TURLClick;

  RichEdit1.Lines.Add( 'http://www.himytv.com/' );
end;

procedure TForm1.on_TURLClick(Sender: TObject; const AURL: string);
begin
  ShellExecute(Handle, 'open', PChar(AURL), 0, 0, SW_SHOWNORMAL);
end;

end.

6: 라인에서 보듯이 uses에 RichEditPlus, ShellAPI 를 추가 합니다.

11: 라인에서 앞으로 사용 할 TRichEdit 클래스는 모두 TRichEditPlus 으로 치환해서 사용 할 것을 선언합니다.  이제 폼 위에 TRichEdit  콤포넌트를 올려 놓아도 실제로는 TRichEditPlus 클래스의 객체가 생성 됩니다.

17: URL 링크가 클릭 되었을 때 처리 할 이벤트 핸들러를 작성 합니다.

37: 실제 이벤트 핸들러에서는 해당 URL을 ShellExecute 함수를 이용해서 실행합니다.  결과적으로 웹 브로우져가 실행 됩니다.

30: 리치 에디터의 이벤트 핸들러를 지정합니다.

32: 테스트 할 URL 링크를 삽입 합니다.

TRichEditPlus 에는 스크롤 이벤트도 추가하였습니다.  채팅 창에서 이용 할 때 스크롤 업이 되면 채팅 내용이 추가로 입력 되어도 스크롤이 되지 않는 락 기능을 만들기 위해서 추가한 것인데, 다른 용도로도 사용 할 수 있을 듯 합니다.

아래는 채팅 창의 스크롤 락을 구현한 예제의 일부입니다.

const
  WM_Lock = WM_USER + 1;
  WM_Unlock = WM_USER + 2;

...

procedure TfrChat.on_Scroll(Sender: TObject);
const
  SCROOL_MARGIN = 10;
var
  iPos, iMin, iMax : integer;
begin
  iPos := GetScrollPos(moChat.Handle, SB_VERT);
  GetScrollRange(moChat.Handle, SB_VERT, iMin, iMax);

  if (iPos + moChat.Height + SCROOL_MARGIN) > iMax then PostMessage(Handle, WM_Unlock, 0, 0)
  else PostMessage(Handle, WM_Lock, 0, 0);
end;

procedure TfrChat.WMLock(var Message: TWMVScroll);
begin
  plChatLocked.Visible := true;  // 자물쇠 이미지를 보여서 락이 걸린 상태임을 알린다.
  moChat.HideSelection := true; // 리치 에디터에 새로운 입력이 생겨도 자동으로 마지막 라인으로 스크롤 되지 않는다.
end;

procedure TfrChat.WMUnlock(var Message: TWMVScroll);
begin
  plChatLocked.Visible := false;
  moChat.HideSelection := false;
end;

[그림 1] 깨알 같은 자물쇠 이미지 ^^;