unit Unit1;

{ Properties:
   rvoTagsArePChars is added in Options
   rvoCtrlJumps is added in EditorOptions
   "Allow adding styles dynamically" in the "Settings" in the context menu
}
{
  This demo shows:
  - how to create document with hyperlinks;
  - how to make hyperlink from the selected text (hyperlink is blue and underlined);
  - how to insert new hyperlinks (when the selection is empty)
  - how to remove hyperlinks from the selected text (if user entered empty hyperlink target);
  - how to close hyperlinks when user presses Space, Tab or Enter key;
  - how to get hypertext style (having all properties of normal style, but
    blue, underlined and hypertext), and vice versa.
}


interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  RVStyle, RVScroll, RichView, RVEdit, Buttons, ExtCtrls, Unit2, CRVFData,
  ShellApi, StdCtrls, SclRView;

type
  TForm1 = class(TForm)
    RVStyle1: TRVStyle;
    Panel1: TPanel;
    SpeedButton1: TSpeedButton;
    CheckBox1: TCheckBox;
    srv: TSRichViewEdit;
    procedure SpeedButton1Click(Sender: TObject);
    procedure RichViewEdit1Jump(Sender: TObject; id: Integer);
    procedure FormCreate(Sender: TObject);
    procedure CheckBox1Click(Sender: TObject);
    procedure RichViewEdit1KeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure srvStyleConversion(Sender: TSRichViewEdit;
      StyleNo, UserData: Integer; AppliedToText: Boolean;
      var NewStyleNo: Integer);
  private
    procedure SetTargetToSelection(const Target: String);
    function GetTargetFromSelection: String;
    procedure ExpandSelectionToHyperlink;
    function GetHypertextStyleNo(StyleNo: Integer): Integer;
    function GetNonHypertextStyleNo(StyleNo: Integer): Integer;
    procedure TerminateHyperlink;
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

{ Constants for calling srv.RichViewEdit.OnStyleConversion }
const CONVERT_TO_HYPERTEXT    = 1;
      CONVERT_TO_NONHYPERTEXT = 2;


procedure TForm1.FormCreate(Sender: TObject);
begin
  srv.RichViewEdit.Clear;
  srv.RichViewEdit.AddNL('Select text and click the button. ',0,0);
  srv.RichViewEdit.AddNLTag('Hyperlink example', GetHypertextStyleNo(0), -1,
    Integer(StrNew('http://www.trichview.com')));
  srv.RichViewEdit.Format;
end;
{------------------------------------------------------------------------------}
{ This function sets tags of all selected items.
  If Target is an empty string, it sets tags = 0, otherwise tags are pointers
  to dynamically allocated copies of Target. }
procedure TForm1.SetTargetToSelection(const Target: String);
var i, StartNo, EndNo, StartOffs, EndOffs: Integer;
    rve: TCustomRichViewEdit;
begin
  { Important: when working with the selection item indices, always use
    TopLevelEditor. }
  rve := srv.RichViewEdit.TopLevelEditor;
  { Receiving the range of selected items }
  rve.GetSelectionBounds(StartNo, StartOffs, EndNo, EndOffs, True);
  { If nothing is selected, exiting }
  if StartNo<0 then
    exit;
  { May be the outermost items are not included in the selection? In this case,
    excluding them }
  if StartOffs >= rve.GetOffsAfterItem(StartNo) then
    inc(StartNo);
  if EndOffs <= rve.GetOffsBeforeItem(EndNo) then
    dec(EndNo);
  { Changing tags of the selected items }
  rve.BeginUndoGroup(rvutTag);
  rve.SetUndoGroupMode(True);
  if Target<>'' then
    for i := StartNo to EndNo do
      rve.SetItemTagEd(i, Integer(StrNew(PChar(Target))))
  else
    for i := StartNo to EndNo do
      rve.SetItemTagEd(i, 0);
  rve.SetUndoGroupMode(False);
end;
{------------------------------------------------------------------------------}
{ Returns the first non-empty tag of the selected items }
function TForm1.GetTargetFromSelection: String;
var i, StartNo, EndNo, StartOffs, EndOffs: Integer;
    rve: TCustomRichViewEdit;
begin
  Result := '';
  rve := srv.RichViewEdit.TopLevelEditor;
  { Receiving the range of selected items }
  rve.GetSelectionBounds(StartNo, StartOffs, EndNo, EndOffs, True);
  if StartNo<0 then
    exit;
  if StartOffs >= rve.GetOffsAfterItem(StartNo) then
    inc(StartNo);
  if EndOffs <= rve.GetOffsBeforeItem(EndNo) then
    dec(EndNo);
  { Finding the first selected item with non-empty tag }
  for i := StartNo to EndNo do
    if rve.GetItemTag(i)<>0 then begin
      Result := PChar(rve.GetItemTag(i));
      exit;
    end;
end;
{------------------------------------------------------------------------------}
{ Expand the selection: if hyperlink is selected partially, selects it completely }
procedure TForm1.ExpandSelectionToHyperlink;
var StartNo, EndNo, StartOffs, EndOffs: Integer;
    rve: TCustomRichViewEdit;
begin
  rve := srv.RichViewEdit.TopLevelEditor;
  { Receiving a range of selected items }
  rve.GetSelectionBounds(StartNo, StartOffs, EndNo, EndOffs, True);
  { If no selection exists, using caret position }
  if StartNo<0 then begin
    StartNo := rve.CurItemNo;
    StartOffs := rve.OffsetInCurItem;
    EndNo := StartNo;
    EndOffs := StartOffs;
  end;
  if StartOffs >= rve.GetOffsAfterItem(StartNo) then begin
    inc(StartNo);
    if StartNo=rve.ItemCount then
      exit;
  end;
  if EndOffs <= rve.GetOffsBeforeItem(EndNo) then begin
    dec(EndNo);
    if EndNo<0 then
      exit;
  end;
  { Expanding the selection to the whole items, if necessary }
  if (rve.GetItemStyle(StartNo)>=0) and RVStyle1.TextStyles[rve.GetItemStyle(StartNo)].Jump then
    StartOffs := rve.GetOffsBeforeItem(StartNo);
  if (rve.GetItemStyle(EndNo)>=0) and RVStyle1.TextStyles[rve.GetItemStyle(EndNo)].Jump then
    EndOffs := rve.GetOffsAfterItem(EndNo);
  rve.SetSelectionBounds(StartNo, StartOffs, EndNo, EndOffs);
  rve.Invalidate;
end;
{------------------------------------------------------------------------------}
{ Clicking "Create Hyperlink" button. If user enters non-empty Target, making
  the selection hypertext. If user enters empty Target, making the selection
  non-hypertext. Then assigning Target to tags of the selected items. }
procedure TForm1.SpeedButton1Click(Sender: TObject);
var Target: String;
begin
  ExpandSelectionToHyperlink;
  Target := GetTargetFromSelection;
  Form2.Edit1.Text := Target;
  if Form2.ShowModal=mrOk then begin
    Target := Form2.Edit1.Text;
    if srv.RichViewEdit.SelectionExists then begin
      if Target='' then
        srv.RichViewEdit.ApplyStyleConversion(CONVERT_TO_NONHYPERTEXT)
      else
        srv.RichViewEdit.ApplyStyleConversion(CONVERT_TO_HYPERTEXT);
      SetTargetToSelection(Target);
      end
    else
      if Target='' then
        Beep
      else begin
        srv.RichViewEdit.CurTextStyleNo := GetHypertextStyleNo(srv.RichViewEdit.CurTextStyleNo);
        srv.RichViewEdit.InsertStringTag('New link', Integer(StrNew(PChar(Target))));
      end;
  end;
end;
{------------------------------------------------------------------------------}
{ Clicking hyperlink. }
procedure TForm1.RichViewEdit1Jump(Sender: TObject; id: Integer);
var URL: String;
    RVData: TCustomRVFormattedData;
    ItemNo: Integer;
begin
  srv.RichViewEdit.GetJumpPointLocation(id, RVData, ItemNo);
  URL := PChar(RVData.GetItemTag(ItemNo));
  ShellExecute(0, 'open', PChar(URL), nil, nil, SW_SHOW);
end;
{------------------------------------------------------------------------------}
{ Switching readonly/editing mode. In editing mode, hypertext works only
  if holding Ctrl key. }
procedure TForm1.CheckBox1Click(Sender: TObject);
begin
  srv.RichViewEdit.ReadOnly := CheckBox1.Checked;
  if CheckBox1.Checked then
    srv.RichViewEdit.Color := clBtnFace
  else
    srv.RichViewEdit.Color := clWindow;
  SpeedButton1.Enabled := not CheckBox1.Checked;
  srv.RichViewEdit.SetFocus;
end;
{------------------------------------------------------------------------------}
{ Returns the index of text style having the same properties as
  RVStyle1.TextStyles[StyleNo], but blue, underlined and hypertext.
  If such text style does not exist, creates it and returns its index. }
function TForm1.GetHypertextStyleNo(StyleNo: Integer): Integer;
var fi: TFontInfo;
begin
  fi := TFontInfo.Create(nil);
  fi.Assign(RVStyle1.TextStyles[StyleNo]);
  fi.Color := clBlue;
  fi.Style := fi.Style + [fsUnderline];
  fi.Jump  := True;
  Result := RVStyle1.TextStyles.FindSuchStyle(StyleNo, fi, RVAllFontInfoProperties);
  if Result<0 then begin
    RVStyle1.TextStyles.Add;
    Result := RVStyle1.TextStyles.Count-1;
    RVStyle1.TextStyles[Result].Assign(fi);
    RVStyle1.TextStyles[Result].Standard := False;
  end;
end;
{------------------------------------------------------------------------------}
{ Returns the index of text style having the same properties as
  RVStyle1.TextStyles[StyleNo], but with normal color, not underlined and
  not hypertext.
  If such text style does not exist, creates it and returns its index. }
function TForm1.GetNonHypertextStyleNo(StyleNo: Integer): Integer;
var fi: TFontInfo;
begin
  fi := TFontInfo.Create(nil);
  fi.Assign(RVStyle1.TextStyles[StyleNo]);
  fi.Color := clWindowText;
  fi.Style := fi.Style - [fsUnderline];
  fi.Jump  := False;
  Result := RVStyle1.TextStyles.FindSuchStyle(StyleNo, fi, RVAllFontInfoProperties);
  if Result<0 then begin
    RVStyle1.TextStyles.Add;
    Result := RVStyle1.TextStyles.Count-1;
    RVStyle1.TextStyles[Result].Assign(fi);
    RVStyle1.TextStyles[Result].Standard := False;
  end;
end;
{------------------------------------------------------------------------------}
{ If the caret is at the end of hyperlink, and there is no selection,
  switching the current text style to non-hypertext }
procedure TForm1.TerminateHyperlink;
var rve: TCustomRichViewEdit;
begin
  rve := srv.RichViewEdit.TopLevelEditor;
  if (rve.CurTextStyleNo=rve.CurItemStyle) and
     RVStyle1.TextStyles[rve.CurTextStyleNo].Jump and
     not rve.SelectionExists and
     (rve.OffsetInCurItem>=rve.GetOffsAfterItem(rve.CurItemNo)) then
    rve.CurTextStyleNo := GetNonHypertextStyleNo(rve.CurTextStyleNo);
end;
{------------------------------------------------------------------------------}
{ Closing hypelinks when user presses Space, Tab, or Enter }
procedure TForm1.RichViewEdit1KeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if (Key in [VK_SPACE, VK_TAB, VK_RETURN]) and not srv.RichViewEdit.ReadOnly then
    TerminateHyperlink;
end;
{------------------------------------------------------------------------------}
{ This event is called for all selected text items when you call
  ApplyStyleConversion, see SpeedButton1Click }
procedure TForm1.srvStyleConversion(Sender: TSRichViewEdit;
  StyleNo, UserData: Integer; AppliedToText: Boolean;
  var NewStyleNo: Integer);
begin
  case UserData of
    CONVERT_TO_HYPERTEXT:
      NewStyleNo := GetHypertextStyleNo(StyleNo);
    CONVERT_TO_NONHYPERTEXT:
      NewStyleNo := GetNonHypertextStyleNo(StyleNo);
  end;
end;

end.
