unit Demo5Frm;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  RVStyle, RVScroll, RichView, StdCtrls, ExtCtrls, Menus, RVFuncs, ShellApi;

type
  TfrmDemo5 = class(TForm)
    pan: TPanel;
    edit: TEdit;
    rv: TRichView;
    rvs: TRVStyle;
    pm: TPopupMenu;
    mitFreezescrolling: TMenuItem;
    procedure FormCreate(Sender: TObject);
    procedure FormResize(Sender: TObject);
    procedure editKeyPress(Sender: TObject; var Key: Char);
    procedure rvSelect(Sender: TObject);
    procedure pmPopup(Sender: TObject);
    procedure mitFreezescrollingClick(Sender: TObject);
    procedure rvJump(Sender: TObject; id: Integer);
    procedure FormKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  frmDemo5: TfrmDemo5;

implementation

{$R *.DFM}
{--------------------------------------------------------------}
procedure AddWithURLs(s: String; rv: TRichView; DefStyle, UrlStyle: Integer);
var Before, CurrentWord, Space: String;
    p: Integer;
    ParaNo: Integer;
begin
   ParaNo := 0;
   Before := '';
   if s = '' then begin
     rv.AddNL('', DefStyle, ParaNo);
     exit;
   end;
   while s<>'' do begin
     p := Pos(' ', s);
     if p=0 then p := Length(s)+1;
     CurrentWord := Copy(s, 1, p-1);
     Space := Copy(s, p, 1);
     s := Copy(s, p+1, Length(s));
     if RVIsURL(CurrentWord) or RVIsEmail(CurrentWord) then begin
        if Before<>'' then begin
          rv.AddNL(Before, DefStyle, ParaNo);
          ParaNo := -1;
          Before := '';
        end;
        rv.AddNL(CurrentWord, UrlStyle, ParaNo);
        ParaNo := -1;
        if Space<>'' then rv.Add(Space, DefStyle);
        end
     else
       Before := Before + CurrentWord+Space;
   end;
   if Before<>'' then
     rv.AddNL(Before, DefStyle, ParaNo);
end;
{--------------------------------------------------------------}
procedure TfrmDemo5.FormCreate(Sender: TObject);
begin
  pan.ClientHeight := edit.Height;
  edit.SetBounds(0,0,pan.ClientWidth,pan.ClientHeight);
  rv.AddNL('Use right-click menu to freeze scrolling when appending text',
    2, 0);
  rv.AddNL('Try quick-copy: selection is copied automatically when done',
    2, 0);
  AddWithURLs('You can use URLs and e-mail ( like www.trichview.com )',
    rv, 2, 1);
  rv.Format;
end;
{--------------------------------------------------------------}
procedure TfrmDemo5.FormResize(Sender: TObject);
begin
 edit.Width := pan.ClientWidth;
end;
{--------------------------------------------------------------}
procedure TfrmDemo5.editKeyPress(Sender: TObject; var Key: Char);
begin
  if Key=#13 then begin
    AddWithURLS(edit.Text,rv,0,1);
    rv.FormatTail;
    Key := #0;
    edit.Text := '';
  end;
end;
{--------------------------------------------------------------}
procedure TfrmDemo5.rvSelect(Sender: TObject);
begin
  // Quick-copy
  if rv.SelectionExists then begin
    rv.CopyDef;
    rv.Deselect;
    rv.Invalidate;
  end;
end;
{--------------------------------------------------------------}
procedure TfrmDemo5.pmPopup(Sender: TObject);
begin
  mitFreezeScrolling.Checked := not (rvoScrollToEnd in rv.Options);
end;
{--------------------------------------------------------------}
procedure TfrmDemo5.mitFreezescrollingClick(Sender: TObject);
begin
  if (rvoScrollToEnd in rv.Options) then
    rv.Options := rv.Options-[rvoScrollToEnd]
  else
    rv.Options := rv.Options+[rvoScrollToEnd];
end;
{--------------------------------------------------------------}
procedure TfrmDemo5.rvJump(Sender: TObject; id: Integer);
var ItemNo: Integer;
    s: String;
begin
  ItemNo := rv.GetJumpPointItemNo(id);
  s := rv.GetItemText(ItemNo);
  if not RVIsURL(s) and RVIsEmail(s) then
    s := 'mailto:'+s;
  ShellExecute(Application.Handle, 'open', PChar(s), nil, nil, SW_NORMAL);
end;
{--------------------------------------------------------------}
procedure TfrmDemo5.FormKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if Key=VK_ESCAPE then Close;
end;



end.