unit4.pas

全文检索 快速搜寻一般文字档

unit Unit4;

interface

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

type
  TForm4 = class(TForm)
    Panel5: TPanel;
    Label12: TLabel;
    Edit4: TEdit;
    Edit2: TEdit;
    Button3: TButton;
    Button4: TButton;
    Button5: TButton;
    Button7: TButton;
    CheckBox2: TCheckBox;
    RichEdit2: TRichEdit;
    procedure Button3Click(Sender: TObject);
    procedure Button7Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure Button5Click(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure CheckBox2Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form4: TForm4;

implementation

uses Unit1;

{$R *.dfm}

procedure TForm4.Button3Click(Sender: TObject);
begin
  Close;
end;

procedure TForm4.Button4Click(Sender: TObject);
var
  FoundAt: LongInt;
  StartPos, ToEnd: Integer;
begin
  with RichEdit2 do
  begin
    if SelLength <> 0 then
      StartPos := SelStart + SelLength
    else
      StartPos := 0;
    ToEnd := Length(Text) - StartPos;
    FoundAt := FindText(Edit4.text, StartPos, ToEnd, [stMatchCase]);
    if FoundAt <> -1 then
    begin
      SetFocus;
      SelStart := FoundAt;
      SelLength := Length(Edit4.text);
    end
    else ShowMessage('找不到相符的文字');
  end;


end;

procedure TForm4.Button5Click(Sender: TObject);
var
  FoundAt: LongInt;
  StartPos, ToEnd, LastPos: Integer;
begin
  LastPos := RichEdit2.SelStart;
  StartPos := 0;
  ToEnd := LastPos;
  FoundAt := 0;
  While FoundAt <> -1 do
  begin
    FoundAt := RichEdit2.FindText(Edit4.text, StartPos, ToEnd, [stMatchCase]);
    if FoundAt <> -1 then
    begin
      RichEdit2.SelStart := FoundAt;
      StartPos := FoundAt + Length(Edit4.text);
      ToEnd := LastPos - StartPos;
    end;
  end;
  if StartPos > 0 then
  begin
    RichEdit2.SetFocus;
    RichEdit2.SelLength := Length(Edit4.text);
  end
  else ShowMessage('找不到相符的文字');


end;

procedure TForm4.Button7Click(Sender: TObject);
var
//   SL:   TStringList;
          MM:   TMemoryStream;
//          AnStr:   String;
          WS:   WideString;
          P:   PByteArray;
  begin
    //      SL:=   TStringList.Create;
      MM:=   TMemoryStream.Create;
      try
//          SL.LoadFromFile('test.txt');
//          AnStr:=   RichEdit2.Lines;

          WS:=WideChar(65279);
          ws:=ws+   RichEdit2.text;                 //转为Unicode


          //文本开头写进Unicode的标识
{          GetMem(P,   2   *   Sizeof(Char));
          P[0]:=   $FF;
          P[1]:=   $FE;
          MM.Write(P^,   2   *   Sizeof(Char));

          P[0]:=   $FF;
          P[1]:=   $FE;
}
          //将Unicode文本写进流中保存。
          MM.Write(PWideChar(WS)^,   Length(WS)   *   Sizeof(WideChar));
          MM.SaveToFile(EDit2.text);

          FreeMem(P);
      finally
//          SL.Free;
          MM.Free;
      end;


//   RichEdit2.Lines.SavetoFile(EDit2.text);

end;

procedure TForm4.CheckBox2Click(Sender: TObject);
begin
    if CheckBox2.Checked
    then RichEdit2.ReadOnly:=False
    else  RichEdit2.ReadOnly:=True;

end;

procedure TForm4.FormShow(Sender: TObject);
var CurrentLine:Integer;
  pathdir, temp: string;
  f: tSearchrec;
  i, count, posre: integer;
  stlist: tstringlist;
  FoundAt: LongInt;
  StartPos, ToEnd: Integer;
begin
  Edit2.Text:=main.ListBox1.Items[main.ListBox1.itemindex];
  Edit4.Text:=Trim(main.Combobox1.Text);
  RichEdit2.Lines.LoadFromFile(Edit2.text);
  CheckBox2.Checked:=False; // 不可修改
//  stlist := tstringlist.Create;
//  application.ProcessMessages;

//        Main.richedit1.SelAttributes.Color := clBlack;
//        stlist.LoadFromFile(Edit2.text);       // 讀取檔案
        COUNT := 0;
//        SelLength := 0;
//      將關鍵字全部標出來
        RichEdit2.Visible:=False;
        RichEdit2.SelLength:=0;

        while true do
        begin
          with RichEdit2 do
          begin
            if SelLength=0
            then StartPos :=0
            else StartPos := SelStart + SelLength;

            ToEnd := Length(Text) - StartPos;                //[stWholeWord]
            FoundAt := FindText(Edit4.Text, StartPos, ToEnd, [stMatchCase]);
            if FoundAt <> -1 then
            begin
                //找到的字串換色
//              SetFocus;
              SelStart := FoundAt;
              SelLength := Length(Edit4.Text);
              SelAttributes.Color := CLRed;
              COUNT := COUNT + 1;

            end
            else
            begin
//               SetFocus;
               SelStart := 0;
               SelLength := 0;
               break; // ShowMessage('找不到相符的文字');
            end;
          end;
        end;
//  stlist.Free;
    RichEdit2.Visible:=True;
    RichEdit2.SetFocus;

    Label12.Caption:=inttostr(count);

    Button4.click;
end;

end.