修改版鱼C记事本

lgd0722

根据小甲鱼老师的鱼C记事本视频练习实践。其中修改了查找部分，使程序能够支持多行查找，同一个字符支持多次查找。但目前存在缺陷，只能正常查找中文，无法正常查找英文，求大神指点程序。
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Menus, StdCtrls, ShellAPI;

type
  TForm1 = class(TForm)
    mmo1: TMemo;
    mm1: TMainMenu;
    F1: TMenuItem;
    create: TMenuItem;
    open: TMenuItem;
    save: TMenuItem;
    N1: TMenuItem;
    quit: TMenuItem;
    dlgOpen1: TOpenDialog;
    dlgSave1: TSaveDialog;
    E1: TMenuItem;
    O1: TMenuItem;
    font: TMenuItem;
    background: TMenuItem;
    dlgFont1: TFontDialog;
    dlgColor1: TColorDialog;
    dlgFind1: TFindDialog;
    dlgReplace1: TReplaceDialog;
    undo: TMenuItem;
    N2: TMenuItem;
    cut: TMenuItem;
    copy: TMenuItem;
    paste: TMenuItem;
    del: TMenuItem;
    N3: TMenuItem;
    find: TMenuItem;
    replace: TMenuItem;
    N4: TMenuItem;
    all: TMenuItem;
    N5: TMenuItem;
    time: TMenuItem;
    help: TMenuItem;
    about: TMenuItem;
    procedure openClick(Sender: TObject);
    procedure fontClick(Sender: TObject);
    procedure backgroundClick(Sender: TObject);
    procedure quitClick(Sender: TObject);
    procedure saveClick(Sender: TObject);
    procedure createClick(Sender: TObject);
    procedure undoClick(Sender: TObject);
    procedure cutClick(Sender: TObject);
    procedure copyClick(Sender: TObject);
    procedure pasteClick(Sender: TObject);
    procedure delClick(Sender: TObject);
    procedure allClick(Sender: TObject);
    procedure timeClick(Sender: TObject);
    procedure aboutClick(Sender: TObject);
    procedure findClick(Sender: TObject);
    procedure replaceClick(Sender: TObject);
    procedure dlgFind1Find(Sender: TObject);
    procedure dlgReplace1Replace(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation
var
  Filename: string = '';
  Line_num: Integer = 0;
  Posreturn: Integer = 0;
  lastpos: Integer = 0;
  count: Integer = 0; //每行的查找值个数

{$R *.dfm}

procedure TForm1.openClick(Sender: TObject);
begin
  dlgOpen1.Filter:= '文本文档(*.txt;*.log)|*.txt;*.log';

  if dlgOpen1.Execute then
    begin
      Filename:= dlgOpen1.FileName;
      mmo1.Lines.LoadFromFile(Filename);
      Form1.Caption:= Filename;
    end
  else
    Exit;

end;

procedure TForm1.fontClick(Sender: TObject);
begin
  if dlgFont1.Execute then
    mmo1.Font:= dlgFont1.Font
  else
    Exit;
end;

procedure TForm1.backgroundClick(Sender: TObject);
begin
  if dlgColor1.Execute then
    mmo1.Color:= dlgColor1.Color
  else
    Exit;

end;

procedure TForm1.quitClick(Sender: TObject);
begin
  dlgSave1.Filter:= '文本文档(*.txt;*.log)|*.txt;*.log';

  if mmo1.Modified = True then
    begin
      if MessageBox(Handle, '文本已发生变化，是否需要保存？', '提示', MB_OKCANCEL) = IDOK then
        if dlgsave1.execute = true then
          begin
            Filename:= dlgsave1.FileName + '.txt';
            mmo1.Lines.SaveToFile(Filename);
            Close;
          end
        else
          exit
      else
        Close;
    end
  else
    Close;

end;

procedure TForm1.saveClick(Sender: TObject);
begin
  dlgSave1.Filter:= '文本文档(*.txt;*.log)|*.txt;*.log';

  if dlgSave1.Execute then
    begin
      Filename:= dlgSave1.FileName + '.txt';
      mmo1.Lines.SaveToFile(Filename);
    end
  else
    Exit;
end;

procedure TForm1.createClick(Sender: TObject);
begin
  dlgSave1.Filter:= '文本文档(*.txt;*.log)|*.txt;*.log';

  if mmo1.Modified = True then
    begin
      if MessageBox(Handle, '文本已发生变化，是否需要保存？', '提示', MB_OKCANCEL) = IDOK then
        if dlgsave1.execute = true then
          begin
            Filename:= dlgsave1.FileName + '.txt';
            mmo1.Lines.SaveToFile(Filename);
            mmo1.Lines.Clear;
          end
        else
          exit
      else
        mmo1.Lines.Clear;
    end
  else
    mmo1.Lines.Clear;
end;

procedure TForm1.undoClick(Sender: TObject);
begin
  mmo1.Undo;
end;

procedure TForm1.cutClick(Sender: TObject);
begin
  mmo1.CutToClipboard;
end;

procedure TForm1.copyClick(Sender: TObject);
begin
  mmo1.CopyToClipboard;
end;

procedure TForm1.pasteClick(Sender: TObject);
begin
  mmo1.PasteFromClipboard;
end;

procedure TForm1.delClick(Sender: TObject);
begin
  mmo1.ClearSelection;
end;

procedure TForm1.allClick(Sender: TObject);
begin
  mmo1.SelectAll;
end;

procedure TForm1.timeClick(Sender: TObject);
begin
  mmo1.SelText:= DateTimeToStr(Now);
  //mmo1.SelText:= IntToStr(Pos('a', mmo1.Lines[0]));
end;

procedure TForm1.aboutClick(Sender: TObject);
begin
  ShellAboutA(Self.Handle, PChar('鱼C记事本'), PChar('鱼C记事本 -- MIKA'), hicon(nil));
end;

procedure TForm1.findClick(Sender: TObject);
begin
  dlgFind1.FindText:= mmo1.SelText;
  dlgFind1.Execute;
end;

procedure TForm1.replaceClick(Sender: TObject);
begin
  dlgReplace1.ReplaceText:= mmo1.SelText;
  dlgReplace1.Execute;
end;
//相当于一个全局循环删除式查找
procedure TForm1.dlgFind1Find(Sender: TObject);
var
  tmpstr: string;
  startpos, j: Integer;
begin
  if Line_num < mmo1.Lines.Count then
    begin
      tmpstr:= mmo1.Lines[Line_num];
      if Posreturn = 0 then
        Delete(tmpstr, Posreturn, Posreturn)
      else
        Delete(tmpstr, 1, lastpos + Posreturn + count*Length(dlgFind1.FindText));
      lastpos:= lastpos + Posreturn;//保留上一次的值
      Posreturn:= Pos(dlgFind1.FindText, tmpstr);
      if Posreturn <> 0 then
        begin
          mmo1.SetFocus;
          if Line_num > 0 then
            for j:= 0 to (Line_num - 1) do
              startpos:= lastpos + Posreturn + count*Length(dlgFind1.FindText) + Length(mmo1.Lines[j]) + Line_num*2
          else
              startpos:= lastpos + Posreturn + count*Length(dlgFind1.FindText);
          mmo1.SelStart:= startpos;
          mmo1.SelLength:= Length(dlgFind1.FindText);
          count:= count + 1;
        end
      else
        begin
          Line_num:= Line_num + 1;
          lastpos:= 0;
          count:= 0;
        end;
    end
  else
    begin
      Line_num:= 0;
      Posreturn:= 0;
      lastpos:= 0;
      count:= 0;
    end;

end;

procedure TForm1.dlgReplace1Replace(Sender: TObject);
var
  selpos: Integer;
begin
  with TReplaceDialog(Sender) do
  begin
    selpos:= Pos(FindText, mmo1.Lines.Text);
    if selpos > 0 then
    begin
      mmo1.SelStart:= selpos - 1;
      mmo1.SelLength:= Length(FindText);
      mmo1.SelText:= ReplaceText;
    end
    else
      MessageBox(0, '抱歉，找不到需要替换的字符串', '出错', MB_ICONERROR or MB_OK);
  end;
end;

end.

阁龙1427

点个赞，代码多些注释会完美更多。
感谢楼主分享