修改版鱼C记事本,作品展示区,资源分享,鱼C论坛

lgd0722 发表于 2016-6-19 23:02:38

修改版鱼C记事本

根据小甲鱼老师的鱼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));
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;
   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) + 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 发表于 2016-6-30 21:00:33

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

页: [1]

鱼C论坛's Archiver

修改版鱼C记事本