david
fddb8c1dff
NO HAY CÓDIGO FUENTE git-svn-id: https://192.168.0.254/svn/Componentes.Terceros.TRichView@1 b34d35ef-135b-4489-b9d1-9916e9c25524
144 lines
4.1 KiB
ObjectPascal
144 lines
4.1 KiB
ObjectPascal
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.
|