Delphi5实现鱼C记事本程序（TRichEdit版）

c4fx

已于 2024-08-05 11:01:55 修改

阅读量826

点赞数 11

分类专栏： Delphi5 文章标签：开发语言 Delphi

于 2024-08-05 10:55:58 首次发布

本文链接：https://blog.csdn.net/weixin_52116519/article/details/140814514

版权

Delphi5 专栏收录该内容

20 篇文章 0 订阅

订阅专栏

效果图

鱼C记事本程序

程序图标

Delphi5的程序图标需要ICO后缀名的文件，已经上传到CSDN，可以用一下。

在这里插入图片描述

有什么快捷生成ICO文件的方法，可以在评论区分享一下噢，谢谢！！

MainMenu菜单组件

在这里插入图片描述

TRichEdit 组件

在 Delphi 5 中，TRichEdit 组件是一个用于显示和编辑格式化文本的组件。它提供了比标准的多行文本编辑控件（如 TMemo）更丰富的文本处理能力，包括字体样式（如粗体、斜体、下划线）、颜色、段落格式等。TRichEdit 组件基于 Windows 的 Rich Edit 控件，因此它支持 Windows Rich Text Format (RTF) 格式的文本。

TOpenDialog组件

显示一个标准的“打开文件”对话框，让用户选择一个或多个文件。

TSaveDialog组件

在Delphi 5中，TSaveDialog组件是一个标准的文件保存对话框，它允许用户选择一个文件位置并输入文件名以保存文件。这个组件是基于Windows的通用文件对话框API构建的，提供了丰富的配置选项，如文件过滤器、默认扩展名、初始目录等。

Filter属性：定义对话框中显示的文件类型过滤器。你可以指定多个过滤器，每个过滤器由描述和对应的文件扩展名组成，例如文本文件(*.txt)|*.txt。

在这里插入图片描述

功能-文件

注意一下TOpenDialog、TSaveDialog组件的Filter即可。

鱼C记事本——文件

{实现 文件 功能}
{文件-新建}
procedure TForm1.N2Click(Sender: TObject);
//清除当前文本框的内容即可，后续就是打开和保存操作了
begin
  mmo1.clear;
end;

{文件-打开}
procedure TForm1.O3Click(Sender: TObject);
//打开文件对话框
//选择文件
//加载文件,显示文件
begin
  dlgOpen1.Filter:='文本文档(*.txt)|*.TXT';
  if dlgOpen1.Execute then  设置文件过滤器
  begin
    filename:= dlgOpen1.FileName;
    mmo1.Lines.LoadFromFile(filename);
  end
  else
    Exit;
end;

{文件-保存}
procedure TForm1.O2Click(Sender: TObject);
//打开文本保存对话框
//自定义文件名
//将文本输入框的文本保存到文件名
begin
  dlgSave1.Filter:='文本文档(*.txt)|*.TXT';
  if dlgSave1.Execute then
  begin
    filename:=dlgSave1.FileName+'.txt';
    mmo1.Lines.SaveToFile(filename);
  end
  else
    Exit;
end;

{文件-退出}
procedure TForm1.E2Click(Sender: TObject);
begin
  close;
end;

功能-编辑

功能都是用Delphi5的内部函数实现，一句话代码。

鱼C记事本——编辑

var
  Form1: TForm1;
  filename:string;
  
  {编辑-查找}
  Alltext: string;    //文本框内容
  startPos: Integer; // 上次查找的结束位置
  selecttext:string;   //查找内容

{实现 编辑 功能}
{编辑-撤销}
procedure TForm1.U1Click(Sender: TObject);
begin
  mmo1.Undo;
end;

{编辑-剪切}
procedure TForm1.T1Click(Sender: TObject);
begin
  mmo1.CutToClipboard;
end;

{编辑-复制}
procedure TForm1.C1Click(Sender: TObject);
begin
  mmo1.CopyToClipboard;
end;

{编辑-粘贴}
procedure TForm1.P1Click(Sender: TObject);
begin
  mmo1.PasteFromClipboard;
end;

{编辑-删除}
procedure TForm1.D1Click(Sender: TObject);
//删除选中的文本
begin
  mmo1.ClearSelection;
end;

{编辑-全选}
procedure TForm1.A1Click(Sender: TObject);
begin
  mmo1.SelectAll;
end;

{编辑-插入日期}
procedure TForm1.N7Click(Sender: TObject);
begin
  mmo1.SelText:=DateTimeToStr(Now());
end;

查找

定义一个查找函数，从某个位置开始，在一个长文本中查找一个字符串，最后返回位置。实现“查找下一个”功能的逻辑：每次调用查找函数，将返回的位置作为下一次查找的开始位置。

{查找下一个的函数，自定义}
function FindNextSubstring(const str: string; const sub: string; startPos: Integer): Integer;
var
  foundPos: Integer;
begin
  // 确保startPos在字符串范围内
  if startPos < 1 then
    startPos := 1;
  if startPos > Length(str) then
    Exit; // 如果startPos超出字符串长度，则返回-1表示未找到

  // 使用Pos函数从startPos开始查找
  foundPos := Pos(sub, Copy(str, startPos, MaxInt));
  if foundPos > 0 then
  begin
    // 由于Pos函数是从其输入字符串的开头开始计数的，
    // 我们需要将找到的位置偏移回原始字符串的坐标系中
    Result := startPos + foundPos - 1;
  end
  else
  begin
    // 如果没有找到子字符串，则返回-1
    Result := -1;
  end;
end;

{编辑-查找}
procedure TForm1.F1Click(Sender: TObject);
//选中需要查找的文本
//打开查询对话框
begin
  dlgFind1.FindText:=mmo1.SelText;  //将文本框选中的文本放在对话框-查找内容
  Alltext := mmo1.Text; // 编辑框的文本
  selecttext:= mmo1.SelText;    //选中的文本,要查找的大小
  startPos := 0; // 开始新的查找
  dlgFind1.Execute;
end;

{查找下一个}
procedure TForm1.dlgFind1Find(Sender: TObject);
var
  foundPos:integer;
begin
  foundPos := FindNextSubstring(Alltext, selecttext, startPos);
  if foundPos <> -1 then
  begin
    showmessage('找到了'+selecttext+'在第'+inttostr(foundPos)+'个字符');
    mmo1.SelStart := FoundPos;
    mmo1.SelLength := Length(selecttext);
    // 查找下一个实例（从上一个找到的位置之后开始）
    startPos := foundPos + Length(selecttext); // 假设我们不想查找重叠的实例
  end
  else
  begin
    showmessage('找不到,重新再找一次。');
    startPos := 0;
  end;
end;

替换

主要是调用ReplaceDialog组件完成的。

{编辑-替换}
procedure TForm1.R1Click(Sender: TObject);
//选中需要替换的文本
// 打开替换对话框
begin
  dlgReplace1.FindText:=mmo1.SelText;
  dlgReplace1.Execute;
end;

//当点击对话框中“替换”时，算法逻辑（替换1次）
procedure TForm1.dlgReplace1Replace(Sender: TObject);
var
  selpos:Integer;
begin
  with TReplaceDialog(Sender) do
  begin
    {用于查找子字符串在另一个字符串中首次出现的位置。如果找到了子字符串，
    Pos 函数将返回子字符串首次出现的位置（索引从1开始），
    如果没有找到，则返回0。}
    selpos:=Pos(FindText,mmo1.Lines.Text);
    if selpos>0 then
    begin
      {SelLength、SelStart 和 SelText 是与 文本选择 相关的三个重要属性。}
      mmo1.SelStart:=selpos-1;
      mmo1.SelLength:=Length(FindText);
      mmo1.SelText:=ReplaceText;
      {当你读取 SelText 时，它会返回当前选择区域的文本内容。
      当你向 SelText 写入新文本时，它会替换当前选中的文本（如果 SelLength 大于0）。}
    end
    else
      MessageBox(0,'抱歉，找不到需要替换的文本','提醒！',MB_OK or MB_ICONWARNING);
  end;
end;

功能-格式

鱼C记事本——格式

{格式-字体}
procedure TForm1.F2Click(Sender: TObject);
//打开字体选择对话框
//选择字体
begin
  if dlgFont1.execute then
    mmo1.Font:=dlgFont1.Font
  else
    exit;
end;

{格式-背景}
procedure TForm1.N8Click(Sender: TObject);
begin
  if dlgColor1.execute then
    mmo1.color:=dlgColor1.color
  else
    exit;
end;

功能-帮助

{帮助-关于}
procedure TForm1.A2Click(Sender: TObject);
begin
  ShellAbout(self.handle,
    pchar('鱼C记事本'),
    pchar('CSDN-C4FX'),
    hicon(nil));
end;

鱼C记事本——帮助

总结

只是简单地实现了记事本的功能，运行效果还不错，该有的差不多都有了。在“文件-替换”处有小小bug，还有很多可以完善的地方，有机会再改吧。

在线视频拼接

为了不剪辑，录制的流畅性，把各个功能模块分块录制，然后拼接一起的，所以用了一个在线视频拼接工具。

在这里插入图片描述

完整代码

unit book;

interface

uses
  SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  Dialogs, Forms,Form, Formprpt, Menus, StdCtrls, shellapi, ComCtrls;

type
  TForm1 = class(MForm)
    mainmenu1: TMainMenu;
    N1: TMenuItem;
    E1: TMenuItem;
    O1: TMenuItem;
    H1: TMenuItem;
    N2: TMenuItem;
    O2: TMenuItem;
    O3: TMenuItem;
    N3: TMenuItem;
    E2: TMenuItem;
    U1: TMenuItem;
    T1: TMenuItem;
    C1: TMenuItem;
    P1: TMenuItem;
    D1: TMenuItem;
    N4: TMenuItem;
    A1: TMenuItem;
    N5: TMenuItem;
    F1: TMenuItem;
    R1: TMenuItem;
    N6: TMenuItem;
    N7: TMenuItem;
    F2: TMenuItem;
    N8: TMenuItem;
    A2: TMenuItem;
    dlgOpen1: TOpenDialog;
    dlgSave1: TSaveDialog;
    dlgFind1: TFindDialog;
    dlgReplace1: TReplaceDialog;
    dlgColor1: TColorDialog;
    dlgFont1: TFontDialog;
    mmo1: TRichEdit;
    procedure O3Click(Sender: TObject);
    procedure O2Click(Sender: TObject);
    procedure N2Click(Sender: TObject);
    procedure E2Click(Sender: TObject);
    procedure U1Click(Sender: TObject);
    procedure T1Click(Sender: TObject);
    procedure C1Click(Sender: TObject);
    procedure P1Click(Sender: TObject);
    procedure D1Click(Sender: TObject);
    procedure A1Click(Sender: TObject);
    procedure F1Click(Sender: TObject);
    procedure R1Click(Sender: TObject);
    procedure N7Click(Sender: TObject);
    procedure F2Click(Sender: TObject);
    procedure N8Click(Sender: TObject);
    procedure A2Click(Sender: TObject);
    procedure dlgReplace1Replace(Sender: TObject);
    procedure dlgFind1Find(Sender: TObject);
//    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  filename:string;

  {编辑-查找}
  Alltext: string;    //文本框内容
  startPos: Integer; // 上次查找的结束位置
  selecttext:string;   //查找内容


implementation

{$R *.DFM}

{实现 文件 功能}

{文件-新建}
procedure TForm1.N2Click(Sender: TObject);
//清除当前文本框的内容即可，后续就是打开和保存操作了
begin
  mmo1.clear;
end;

{文件-打开}
procedure TForm1.O3Click(Sender: TObject);
//打开文件对话框
//选择文件
//加载文件,显示文件
begin
  dlgOpen1.Filter:='文本文档(*.txt)|*.TXT';
  if dlgOpen1.Execute then  设置文件过滤器
  begin
    filename:= dlgOpen1.FileName;
    mmo1.Lines.LoadFromFile(filename);
  end
  else
    Exit;
end;

{文件-保存}
procedure TForm1.O2Click(Sender: TObject);
//打开文本保存对话框
//自定义文件名
//将文本输入框的文本保存到文件名
begin
  dlgSave1.Filter:='文本文档(*.txt)|*.TXT';
  if dlgSave1.Execute then
  begin
    filename:=dlgSave1.FileName+'.txt';
    mmo1.Lines.SaveToFile(filename);
  end
  else
    Exit;
end;

{文件-退出}
procedure TForm1.E2Click(Sender: TObject);
begin
  close;
end;

{实现 编辑 功能}
{编辑-撤销}
procedure TForm1.U1Click(Sender: TObject);
begin
  mmo1.Undo;
end;

{编辑-剪切}
procedure TForm1.T1Click(Sender: TObject);
begin
  mmo1.CutToClipboard;
end;

{编辑-复制}
procedure TForm1.C1Click(Sender: TObject);
begin
  mmo1.CopyToClipboard;
end;

{编辑-粘贴}
procedure TForm1.P1Click(Sender: TObject);
begin
  mmo1.PasteFromClipboard;
end;

{编辑-删除}
procedure TForm1.D1Click(Sender: TObject);
//删除选中的文本
begin
  mmo1.ClearSelection;
end;

{编辑-全选}
procedure TForm1.A1Click(Sender: TObject);
begin
  mmo1.SelectAll;
end;

{查找下一个的函数，自定义}
function FindNextSubstring(const str: string; const sub: string; startPos: Integer): Integer;
var
  foundPos: Integer;
begin
  // 确保startPos在字符串范围内
  if startPos < 1 then
    startPos := 1;
  if startPos > Length(str) then
    Exit; // 如果startPos超出字符串长度，则返回-1表示未找到

  // 使用Pos函数从startPos开始查找
  foundPos := Pos(sub, Copy(str, startPos, MaxInt));
  if foundPos > 0 then
  begin
    // 由于Pos函数是从其输入字符串的开头开始计数的，
    // 我们需要将找到的位置偏移回原始字符串的坐标系中
    Result := startPos + foundPos - 1;
  end
  else
  begin
    // 如果没有找到子字符串，则返回-1
    Result := -1;
  end;
end;

{编辑-查找}
procedure TForm1.F1Click(Sender: TObject);
//选中需要查找的文本
//打开查询对话框
begin
  dlgFind1.FindText:=mmo1.SelText;  //将文本框选中的文本放在对话框-查找内容
  Alltext := mmo1.Text; // 编辑框的文本
  selecttext:= mmo1.SelText;    //选中的文本,要查找的大小
  startPos := 0; // 开始新的查找
  dlgFind1.Execute;
end;

{查找下一个}
procedure TForm1.dlgFind1Find(Sender: TObject);
var
  foundPos:integer;
begin
  foundPos := FindNextSubstring(Alltext, selecttext, startPos);
  if foundPos <> -1 then
  begin
    showmessage('找到了'+selecttext+'在第'+inttostr(foundPos)+'个字符');
    mmo1.SelStart := FoundPos;
    mmo1.SelLength := Length(selecttext);
    // 查找下一个实例（从上一个找到的位置之后开始）
    startPos := foundPos + Length(selecttext); // 假设我们不想查找重叠的实例
  end
  else
  begin
    showmessage('找不到,重新再找一次。');
    startPos := 0;
  end;
end;

{编辑-替换}
procedure TForm1.R1Click(Sender: TObject);
//选中需要替换的文本
// 打开替换对话框
begin
  dlgReplace1.FindText:=mmo1.SelText;
  dlgReplace1.Execute;
end;

//当点击对话框中“替换”时，算法逻辑（替换1次）
procedure TForm1.dlgReplace1Replace(Sender: TObject);
var
  selpos:Integer;
begin
  with TReplaceDialog(Sender) do
  begin
    {用于查找子字符串在另一个字符串中首次出现的位置。如果找到了子字符串，
    Pos 函数将返回子字符串首次出现的位置（索引从1开始），
    如果没有找到，则返回0。}
    selpos:=Pos(FindText,mmo1.Lines.Text);
    if selpos>0 then
    begin
      {SelLength、SelStart 和 SelText 是与 文本选择 相关的三个重要属性。}
      mmo1.SelStart:=selpos-1;
      mmo1.SelLength:=Length(FindText);
      mmo1.SelText:=ReplaceText;
      {当你读取 SelText 时，它会返回当前选择区域的文本内容。
      当你向 SelText 写入新文本时，它会替换当前选中的文本（如果 SelLength 大于0）。}
    end
    else
      MessageBox(0,'抱歉，找不到需要替换的文本','提醒！',MB_OK or MB_ICONWARNING);
  end;
end;

{编辑-插入日期}
procedure TForm1.N7Click(Sender: TObject);
begin
  mmo1.SelText:=DateTimeToStr(Now());
end;

{格式-字体}
procedure TForm1.F2Click(Sender: TObject);
//打开字体选择对话框
//选择字体
begin
  if dlgFont1.execute then
    mmo1.Font:=dlgFont1.Font
  else
    exit;
end;

{格式-背景}
procedure TForm1.N8Click(Sender: TObject);
begin
  if dlgColor1.execute then
    mmo1.color:=dlgColor1.color
  else
    exit;
end;

{帮助-关于}
procedure TForm1.A2Click(Sender: TObject);
begin
  ShellAbout(self.handle,
    pchar('鱼C记事本'),
    pchar('CSDN-C4FX'),
    hicon(nil));
end;

end.