unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ExtCtrls, SclRView, CRVData, CRVFData, StdCtrls;

type
  TMEvent = (meMouseMove, meMouseDown, meMouseUp);

  TForm1 = class(TForm)
    SRV: TSRichViewEdit;
    Panel1: TPanel;
    procedure SRVDrawHyperlink(Sender: TSRichViewEdit;
      Canvas: TCanvas; RVData: TCustomRVData; PageNo, ItemNo: Integer;
      RepaintRect, R: TRect);
    procedure FormCreate(Sender: TObject);
    procedure SRVMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure SRVMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure SRVMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  MEvent : TMEvent;

implementation

{$R *.DFM}

procedure TForm1.FormCreate(Sender: TObject);
begin
  MEvent := meMouseMove;
  SRV.LoadRVF(ExtractFilePath(Application.ExeName) + 'hlink.rvf');
end;

procedure TForm1.SRVDrawHyperlink(Sender: TSRichViewEdit;
  Canvas: TCanvas; RVData: TCustomRVData; PageNo, ItemNo: Integer;
  RepaintRect, R: TRect);
var
     MRVData : TCustomRVFormattedData;
     MItemNo, MOffsetInItem : Integer;
     p : TPoint;
     InArea, bInLeft : Boolean;
begin
  p := SRV.ScreenToClient(Mouse.CursorPos);
  p := SRV.convertSRVtoRV(p, InArea, bInLeft);
  p.X := p.X + SRV.RichViewEdit.HScrollPos;
  p.Y := p.Y + SRV.RichViewEdit.VScrollPos * SRV.RichViewEdit.VSmallStep;
  SRV.RichViewEdit.GetItemAt(p.x, p.y, MRVData, MItemNo, MOffsetInItem, True);

  if (MRVData = nil) or (MRVData <> RVData) or (MItemNo <> ItemNo) then
    exit;

  Canvas.Pen.Style := psSolid;
  Canvas.Brush.Style := bsSolid;
  Canvas.Pen.Width := 2;
  Canvas.Pen.Color := clRed;

  case MEvent of
    meMouseMove :
      begin
        Canvas.Brush.Color := clLime;
        Panel1.Caption := 'Move URL: ' + PChar(RVData.GetItemTag(ItemNo));
      end;
    meMouseDown :
      begin
        Canvas.Brush.Color := clYellow;
        Panel1.Caption := 'Down URL: ' + PChar(RVData.GetItemTag(ItemNo));
      end;
    meMouseUp :
      begin
        Canvas.Brush.Color := clSilver;
        Panel1.Caption := 'Up URL: ' + PChar(RVData.GetItemTag(ItemNo));
      end;
  end;

  Canvas.RoundRect(R.Left, R.Top, R.Right, R.Bottom, 3, 3);
end;

procedure TForm1.SRVMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  Panel1.Caption := '<None URL>';
  MEvent := meMouseMove;
  SRV.Update;
end;

procedure TForm1.SRVMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  MEvent := meMouseDown;
  SRV.Update;
end;

procedure TForm1.SRVMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  //MEvent := meMouseUp;
  //SRV.Update;
end;

end.
