unit1.pas.~424~

《Delphi程序员成长攻略》-蒙祖强龚涛的源代码

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ComCtrls, Buttons;

type
  TForm1 = class(TForm)
    GroupBox1: TGroupBox;
    RichEdit1: TRichEdit;
    OpenDialog1: TOpenDialog;
    SaveDialog1: TSaveDialog;
    FontDialog1: TFontDialog;
    ColorDialog1: TColorDialog;
    GroupBox2: TGroupBox;
    OpenFile: TBitBtn;
    SaveFile: TBitBtn;
    SetFont: TBitBtn;
    SetColor: TBitBtn;
    GroupBox3: TGroupBox;
    tofindText: TEdit;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Find: TBitBtn;
    Replace: TBitBtn;
    toreplaceText: TEdit;
    Label4: TLabel;
    IsCase: TCheckBox;
    GroupBox4: TGroupBox;
    downRadio: TRadioButton;
    upRadio: TRadioButton;
    BitBtn1: TBitBtn;
    procedure IsCaseClick(Sender: TObject);
    procedure BitBtn1Click(Sender: TObject);
    procedure RichEdit1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure upRadioClick(Sender: TObject);
    procedure downRadioClick(Sender: TObject);
    procedure ReplaceClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FindClick(Sender: TObject);
    procedure SetColorClick(Sender: TObject);
    procedure SetFontClick(Sender: TObject);
    procedure SaveFileClick(Sender: TObject);
    procedure OpenFileClick(Sender: TObject);


    
  private
    { Private declarations }
  public
    { Public declarations }
   // function findStr():integer;
   //curCursorPos: integer;
  curPos, findedNum,flag,nrflag: integer;
  nr:string;
  procedure upfindStr(startPos:integer; tofind:string);
  procedure downfindStr(startPos:integer; tofind:string);
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.OpenFileClick(Sender: TObject);
begin
     //Edit1.Text :=  IntToStr(RichEdit1.SelStart);
    //RichEdit1.SelStart := 9;
    //RichEdit1.SelLength := 2;
    //RichEdit1.SelText := 'ggggg';
    //RichEdit1.ClearSelection;
    //Edit1.Text :=  IntToStr(RichEdit1.FindText('rr',0,2,0));
    if OpenDialog1.Execute() then
    begin
      RichEdit1.Clear;
      RichEdit1.Lines.LoadFromFile(OpenDialog1.FileName);
    end;

end;

procedure TForm1.SaveFileClick(Sender: TObject);
begin
    SaveDialog1.Filter := 'Word files(*.doc)|*.doc|Txtfile(*.txt)|*.txt';
//用代码设置过滤条件
    SaveDialog1.FilterIndex := 2;   //设置默认显示的文件类型为*.txt文件
    if SaveDialog1.Execute() then
    begin
        RichEdit1.Lines.SaveToFile(SaveDialog1.FileName);
    end;

end;

procedure TForm1.SetFontClick(Sender: TObject);
begin
    if FontDialog1.Execute() then
    begin
        RichEdit1.Font:=FontDialog1.Font;
    end;
end;

procedure TForm1.SetColorClick(Sender: TObject);
begin
    if ColorDialog1.Execute() then
    begin
        RichEdit1.Color := ColorDialog1.Color;   
    end;

end;

procedure  TForm1.downfindStr(startPos:integer; tofind:string); //从startPos开始向下搜索子串tofind
var str,nrstr:string;
    findpos,len,nrpos : integer;
begin
    str := RichEdit1.Text;
    if isCase.Checked = false then str := ansilowercase(str);  //不区分大小写
    len := length(str);   
    str := copy(str, startPos+1);
    findpos := pos(tofind,str);
    nrstr := copy(str,1,findpos+length(tofind)-2);
    if pos(nr,nrstr) = 0 then // -------  匹配行中的字符(从startPos位置起，没有回车换行符) -----------
    begin
      flag := 0;
      if findpos<>0 then
      begin
        RichEdit1.SelStart := (len-length(str)) + findpos - 1;
        RichEdit1.SelLength := length(tofind);
        findedNum := findedNum + 1; //统计找到子串的数量
        flag := 1;
      end
      else
      begin
        if findedNum <> 0 then  showmessage('搜索完成，一共有 '+IntToStr(findedNum)+' 处出现搜索项')
        else showmessage('搜索完毕，未找到搜索项！');
        findedNum  := 0;
      end;
    end
    else  // -------  处理回车、换行符  -------  
    begin
      flag := 0;
      nrpos := pos(nr,nrstr);  //
      delete(nrstr,nrpos,2);   //在nrstr中删回车、换行符
      findpos := pos(tofind,nrstr);
      if findpos<>0 then
      begin
        RichEdit1.SelStart := startPos+findpos-1; //(len-length(nrstr)-2) + findpos - 1;
        RichEdit1.SelLength := length(tofind)+2;
        findedNum := findedNum + 1; //统计找到子串的数量
        flag := 1;
      end
      else
      begin
        RichEdit1.SelStart := RichEdit1.SelStart + 2;
        flag := 0;
        str := RichEdit1.Text;
        len := length(str);
        str := copy(str, RichEdit1.SelStart+1);
        findpos := pos(tofind,str);
        if findpos<>0 then
        begin
          RichEdit1.SelStart := (len-length(str)) + findpos - 1;
          RichEdit1.SelLength := length(tofind);
          findedNum := findedNum + 1; //统计找到子串的数量
          flag := 1;
        end
        else
        begin
          if findedNum <> 0 then  showmessage('搜索完成，一共有 '+IntToStr(findedNum)+' 处出现搜索项')
          else showmessage('搜索完毕，未找到搜索项！');
          findedNum  := 0;
        end;
      end;
    end;
end;


procedure TForm1.upfindStr(startPos:integer; tofind:string);//从startPos开始向上搜索子串tofind
var str,curStr:string;
    findpos,len,i: integer;
begin
   i := startPos-length(tofind)+1;
   str := RichEdit1.Text;
   if isCase.Checked = false then str := ansilowercase(str);  //不区分大小写
   str := copy(str,1,startPos);
   while i>=1 do
   begin

     if nrflag=0 then
     begin
       curStr := copy(str,i,length(tofind));
       nrflag := pos(nr,curStr);
       if nrflag<>0 then  //delete(curStr,pos(nr,curStr),2);  //删除回车符和换行符
       begin
         i:=i-1;
         continue;
       end;
     end
     else  //if nrflag<>0 then
     begin
       curStr := copy(str,i,length(tofind)+2);
       nrflag := pos(nr,copy(curStr,1,length(tofind)));
       delete(curStr,pos(nr,curStr),2);  //删除回车符和换行符
     end;
     if ansicomparestr(curStr,tofind) = 0 then
     begin
       RichEdit1.SelStart := i-1;
       if nrflag<>0 then RichEdit1.SelLength := length(tofind)+2
       else RichEdit1.SelLength := length(tofind);
       findedNum  := findedNum + 1;
       if nrflag=0 then curPos := RichEdit1.SelStart+length(tofind)-1
       else curPos := RichEdit1.SelStart+length(tofind)-1+2;
       //if nrflag=0 then curPos := RichEdit1.SelStart+length(tofind)-1
       //else curPos := RichEdit1.SelStart+length(tofind);
       exit;
     end;
     i := i - 1;
   end;  //end  while i>=1 do


   if i<1 then
   begin
      if findedNum <> 0 then  showmessage('搜索完成，一共有 '+IntToStr(findedNum)+' 处出现搜索项')
      else showmessage('搜索完毕，未找到搜索项！');
      findedNum  := 0;
   end;

end;

procedure TForm1.FindClick(Sender: TObject);
var   i,curCursorPos: integer;
    tofind : string;  
begin
  tofind := tofindText.Text;
  if isCase.Checked = false then tofind := ansilowercase(tofind);  //不区分大小写
  if downRadio.Checked then
  begin
    if flag=1 then RichEdit1.SelStart := RichEdit1.SelStart + 1;  //向下搜索时
    curCursorPos := RichEdit1.SelStart;
    downfindStr(curCursorPos,tofind);
  end;
  if upRadio.Checked then
  begin
    if curPos=0 then
    begin
      curPos := RichEdit1.SelStart;  //向上搜索时   ???
    end;
    //else curPos := curPos-1;
    //showmessage(IntToStr(curPos));

    curCursorPos := curPos;
    upfindStr(curCursorPos,tofind);
  end;
end;



procedure TForm1.FormCreate(Sender: TObject);
begin
    RichEdit1.SelStart := 0;
    flag := 0;
    curPos := 0;
    findedNum := 0;
    downRadio.Checked := true;
    nr := chr(13); //chr(13)+chr(10);
    nrflag := 0;
    IsCase.Checked := true;
end;

procedure TForm1.ReplaceClick(Sender: TObject);
var tofind:string;
    curCursorPos: integer;
begin
  tofind := tofindText.Text;
  if isCase.Checked = false then tofind := ansilowercase(tofind);  //不区分大小写
  if downRadio.Checked then
  begin
    if flag=1 then RichEdit1.SelStart := RichEdit1.SelStart + 1;  //向下替换时
    curCursorPos := RichEdit1.SelStart;
    downfindStr(curCursorPos,tofind);

    if RichEdit1.SelLength <> 0 then  //找到子串
    begin
      if MessageDlg('要替换当前子串吗？',mtConfirmation,[mbYes,mbNo],0)=mrYes then
      begin
        RichEdit1.SelText := toreplaceText.Text;
      end;
    end;
  end;


  if upRadio.Checked then
  begin
    if curPos=0 then
    begin
      curPos := RichEdit1.SelStart;  //向上搜索时
    end;
    curCursorPos := curPos;
    upfindStr(curCursorPos,tofind);

    if RichEdit1.SelLength <> 0 then  //找到子串
    begin
      if MessageDlg('要替换当前子串吗？',mtConfirmation,[mbYes,mbNo],0)=mrYes then
      begin
        RichEdit1.SelText := toreplaceText.Text;
      end;
    end;
  end;



  
  
  
end;

procedure TForm1.downRadioClick(Sender: TObject);
begin
    RichEdit1.SelStart := 0;
    flag := 0;
    curPos := 0;
    findedNum := 0;
end;

procedure TForm1.upRadioClick(Sender: TObject);
begin
    RichEdit1.SelStart := length(RichEdit1.Text);
    flag := 0;
    curPos := 0;
    findedNum := 0;
end;

procedure TForm1.RichEdit1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
    flag := 0;
    curPos := RichEdit1.SelStart;
    findedNum := 0;
end;

procedure TForm1.BitBtn1Click(Sender: TObject);
begin
  //RichEdit1.SelText := '中华人民共和国';
 // toreplaceText.Text := ansilowercase(toreplaceText.Text);
 if MessageDlg('ssssssssssss',mtConfirmation,[mbYes,mbNo],0)=mrYes then toreplaceText.Text := '88';
end;

procedure TForm1.IsCaseClick(Sender: TObject);
begin
  flag := 0;
  curPos := 0;
  findedNum := 0;
end;

end.