unit1.pas

与Action相结合,可以解决中文件显示乱码

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Panel1: TPanel;
    btnOpen: TButton;
    btnScan: TButton;
    rve: TRichViewEdit;
    RVStyle1: TRVStyle;
    od: TOpenDialog;
    CheckBox1: TCheckBox;
    procedure btnOpenClick(Sender: TObject);
    procedure btnScanClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure rveJump(Sender: TObject; id: Integer);
    procedure rveKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
  private
    { Private declarations }
    procedure URLScanEvent(OldStyleNo: Integer; var NewStyleNo: Integer;
                           ToHypertext: Boolean);
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

{------------------------------------------------------------------------------}
procedure TForm1.FormCreate(Sender: TObject);
begin
  // Uncomment this line to test working with Unicode
  // RVStyle1.TextStyles[0].Unicode := True;
  rve.Clear;
  rve.AddNLATag('This demo shows how to implement URL scanning',0,0,0);
  rve.AddNLATag('Click the button, and URLs (like this - "www.richedit.com/") will be highlighted.',0,0,0);
  rve.AddNLATag('Ctrl+click URL to launch browser or e-mail client',0,0,0);  
  rve.Format;
end;
{------------------------------------------------------------------------------}
procedure TForm1.btnOpenClick(Sender: TObject);
var r: Boolean;
begin
  if not od.Execute then
    exit;
  Screen.Cursor := crHourglass;
  rve.Clear;
  rve.DeleteUnusedStyles(True,True,True);
  case od.FilterIndex of
   1: r := rve.LoadText(od.FileName,0,0,False);
   2: r := rve.LoadRTF(od.FileName);
   else r := False;
  end;
  rve.Format;
  Screen.Cursor := crDefault;
  if not r then
    Application.MessageBox('Error loading file', 'Error', MB_OK or MB_ICONSTOP);
end;
{------------------------------------------------------------------------------}
procedure TForm1.btnScanClick(Sender: TObject);
var r: Boolean;
begin
  Screen.Cursor := crHourglass;
  // Moving caret to the beginning
  rve.SetSelectionBounds(0, rve.GetOffsBeforeItem(0), 0, rve.GetOffsBeforeItem(0));
  // Clearing undo/redo buffers
  rve.ClearUndo;
  // removing old hypertext links
  r := ClearHypertext(rve.RVData, URLScanEvent, True);
  // scanning for URLs
  r := ScanURLs(rve.RVData, URLScanEvent, True) or r;
  if r then
    rve.Format;
  Screen.Cursor := crDefault;
  rve.SetFocus;    
end;
{------------------------------------------------------------------------------}
// Callback procedure
// This procedure should return index of style for converting source style to
procedure TForm1.URLScanEvent(OldStyleNo: Integer; var NewStyleNo: Integer;
  ToHypertext: Boolean);
var Style: TFontInfo;
begin
  // Constructing desired style
  Style := TFontInfo.Create(nil);
  Style.Assign(RVStyle1.TextStyles[OldStyleNo]);
  Style.Jump := ToHypertext;
  if ToHypertext then begin
    // Hypertext links will be blue and underlined
    Style.Style := Style.Style+[fsUnderline];
    Style.Color := clBlue;
    Style.JumpCursor := crJump;
    end
  else begin
    // Plain text will be black and not underlined
    Style.Style := Style.Style-[fsUnderline];
    Style.Color := clWindowText;
  end;
  // May be such style already exists?
  NewStyleNo := RVStyle1.TextStyles.FindSuchStyle(OldStyleNo,Style,RVAllFontInfoProperties);
  if NewStyleNo=-1 then begin
    // Not exists, adding...
    RVStyle1.TextStyles.Add.Assign(Style);
    NewStyleNo := RVStyle1.TextStyles.Count-1;
    RVStyle1.TextStyles[NewStyleNo].Standard := False;
  end;
  Style.Free;
end;
{------------------------------------------------------------------------------}
procedure TForm1.rveJump(Sender: TObject; id: Integer);
var RVData: TCustomRVFormattedData;
    ItemNo: Integer;
    url: String;
begin
   rve.GetJumpPointLocation(id, RVData, ItemNo);
   url := PChar(RVData.GetItemTag(ItemNo));
   ShellExecute(0, 'open', PChar(url), nil, nil, SW_SHOW);
end;
{------------------------------------------------------------------------------}
procedure TForm1.rveKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if Key in [VK_SPACE, VK_RETURN] then begin
    // url detection
    if CheckBox1.Checked then
      DetectURL(rve, URLScanEvent, True);
    // closing url if necessary
    TerminateHyperlink(rve, URLScanEvent); 
  end;
end;

end.