finderunit1.pas

wptools5 pro 完整源代码 Msword界面的文本编辑器源代码

unit FinderUnit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, WPRTEDefs, WPCTRMemo, WPCTRRich;

type
  TWPUseFinder = class(TForm)
    WPRichText1: TWPRichText;
    Panel1: TPanel;
    RedReplace: TButton;
    Button1: TButton;
    ConvHyperlinks: TButton;
    procedure RedReplaceClick(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure ConvHyperlinksClick(Sender: TObject);
  private
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
  end;

var
  WPUseFinder: TWPUseFinder;

implementation

{$R *.dfm}

procedure TWPUseFinder.RedReplaceClick(Sender: TObject);
var Finder: TWPTextFinder;
begin
  Finder := WPRichText1.Finder;  
  Finder.Clear;
  Finder.ToStart;
  Finder.CharAttr.SetColor(clRed);
  Finder.EndAtWord := TRUE;
  //No, this does not work with wildcards: Finder.WholeWord := true;
  Finder.WildCard := '*';
  while Finder.Next('*') do
  begin
    Finder.FoundText := 'Test';
    Finder.FoundAttr.SetColor(clBlack);
  end;
  Finder.CharAttr.Clear;
  WPRichText1.Refresh;
end;

procedure TWPUseFinder.Button1Click(Sender: TObject);
begin
  WPRichText1.HeaderFooter.RTFProps.AttrHelper.Clear;
  WPRichText1.HeaderFooter.RTFProps.AttrHelper.SetStyles([afsBold]);
  WPRichText1.CPPosition := 0;
  repeat
    if WPRichText1.CurrentCharAttr.Contains(
      WPRichText1.HeaderFooter.RTFProps.AttrHelper) then
      WPRichText1.CurrentCharAttr.SetColor(clRed);
  until not WPRichText1.CPMoveNext;
  WPRichText1.Refresh;
end;

procedure TWPUseFinder.ConvHyperlinksClick(Sender: TObject);
begin
  with WPRichText1.Finder do
  begin
    ToStart;
    EndAtSpace := TRUE;
    while Next('http://*') do
    begin
      SelectText;
      WPRichText1.InputHyperlink(FoundText);
    end;
    EndAtSpace := FALSE;
  end;
  WPRichText1.HideSelection;
end;

end.