Unit1.pas
上传用户:daoqigc
上传日期:2021-04-20
资源大小:2795k
文件大小:5k
- 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.