📄 新建文本文档.txt

📁 超强功能文本编辑器
💻 TXT
字号:
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Menus, StdCtrls, ImgList, ComCtrls, ToolWin,Winprocs;

type
  Ttxtform = class(TForm)
    OpenDialog1: TOpenDialog;
    SaveDialog1: TSaveDialog;
    MainMenu1: TMainMenu;
    menufile: TMenuItem;
    menunew: TMenuItem;
    menuopen: TMenuItem;
    menusave: TMenuItem;
    menusaves: TMenuItem;
    N1: TMenuItem;
    menuymsz: TMenuItem;
    menuprint: TMenuItem;
    N2: TMenuItem;
    menuend: TMenuItem;
    menuedit: TMenuItem;
    menucx: TMenuItem;
    N3: TMenuItem;
    menucut: TMenuItem;
    menucopy: TMenuItem;
    menupaste: TMenuItem;
    menudel: TMenuItem;
    N4: TMenuItem;
    menufind: TMenuItem;
    menufinds: TMenuItem;
    menuchange: TMenuItem;
    menuleap: TMenuItem;
    N5: TMenuItem;
    menusel: TMenuItem;
    menttimedate: TMenuItem;
    menugs: TMenuItem;
    menuauto: TMenuItem;
    menufond: TMenuItem;
    H1: TMenuItem;
    menuhelp: TMenuItem;
    menuabout: TMenuItem;
    PopupMenu1: TPopupMenu;
    pupcx: TMenuItem;
    pupcut: TMenuItem;
    pupcopy: TMenuItem;
    puppaste: TMenuItem;
    pupdel: TMenuItem;
    N6: TMenuItem;
    N7: TMenuItem;
    pupsel: TMenuItem;
    FontDialog1: TFontDialog;
    ImageList1: TImageList;
    ToolBar1: TToolBar;
    ToolButton1: TToolButton;
    ToolButton2: TToolButton;
    ToolButton5: TToolButton;
    toolcx: TToolButton;
    toolcut: TToolButton;
    toolcopy: TToolButton;
    ToolButton9: TToolButton;
    tooldel: TToolButton;
    toolleft: TToolButton;
    toolmiddle: TToolButton;
    toolright: TToolButton;
    toolbold: TToolButton;
    toolitalic: TToolButton;
    toolunderline: TToolButton;
    N8: TMenuItem;
    N9: TMenuItem;
    subbold: TMenuItem;
    subitalic: TMenuItem;
    subunderline: TMenuItem;
    N11: TMenuItem;
    L1: TMenuItem;
    submiddle: TMenuItem;
    R1: TMenuItem;
    FindDialog1: TFindDialog;
    memotxt: TRichEdit;
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure menuopenClick(Sender: TObject);
    procedure menusaveClick(Sender: TObject);
    procedure menunewClick(Sender: TObject);
    procedure menusavesClick(Sender: TObject);
    procedure menueditClick(Sender: TObject);
    procedure menucutClick(Sender: TObject);
    procedure menucopyClick(Sender: TObject);
    procedure menupasteClick(Sender: TObject);
    procedure menucxClick(Sender: TObject);
    procedure menudelClick(Sender: TObject);
    procedure menuselClick(Sender: TObject);
    procedure menuendClick(Sender: TObject);
    procedure PopupMenu1Popup(Sender: TObject);
    procedure menuautoClick(Sender: TObject);
    procedure menufondClick(Sender: TObject);
    procedure subboldClick(Sender: TObject);
    procedure subitalicClick(Sender: TObject);
    procedure subunderlineClick(Sender: TObject);
    procedure toolleftClick(Sender: TObject);
    procedure toolmiddleClick(Sender: TObject);
    procedure toolrightClick(Sender: TObject);
    procedure menufindClick(Sender: TObject);
    procedure memotxt1MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure memotxt1KeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure FindDialog1Find(Sender: TObject);
    procedure memotxtMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure memotxtKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure memotxtChange(Sender: TObject);
  private
    filename:string;
    function savedatas():boolean; //保存函数
    function ismodify():boolean;  //文本是否改变函数
    { Private declarations }
  public
   //function SearchMemo(Memo:TCustomEdit;const searchstring:string;options:TfindOptions):boolean;
   // function SearchBuf(Buf: PChar;BufLen:Integer;selstart,sellength:integer;searchistring:string;options:TFindOptions):Pchar;
    { Public declarations }
  end;

var
  txtform: Ttxtform;
implementation

{$R *.dfm}

{ Ttxtform }

procedure Ttxtform.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  if ismodify then
    action:=caFree;
end;

procedure Ttxtform.menuopenClick(Sender: TObject);
begin
  if ismodify then
    begin
      if OpenDialog1.Execute then
      begin
        if FileExists(OpenDialog1.FileName) then
        begin
          memotxt.Lines.LoadFromFile(OpenDialog1.FileName);
          txtform.Caption:=Extractfilename(opendialog1.FileName)+'-记事本'; //extractfilename函数取文件名
          filename:=opendialog1.FileName;
        end
        else
         showmessage(opendialog1.FileName+'不存在');
      end;
  end;
  //else
   // opendialog1.Execute;
end;
function Ttxtform.savedatas: boolean;
var
  wil:boolean;
begin
 wil:=true;
  if fileexists(filename) then  //判断文件名是否存在
  begin
    memotxt.Lines.SaveToFile(filename);
    memotxt.Modified:=false;
  end
  else
   while wil=true do  //使弹出对话框循环
   begin
     if savedialog1.Execute then
     begin
       if fileexists(savedialog1.FileName) then
       begin
          if application.MessageBox('文件名已经存在,是否保存?','保存',MB_yesno)=idyes then
          begin
             memotxt.Lines.SaveToFile(savedialog1.FileName);
             filename:=savedialog1.FileName;
             txtform.Caption:=Extractfilename(savedialog1.FileName)+'-记事本';
             memotxt.Modified:=false;
             break;
          end
          else
           savedialog1.Execute;
      end
      else
      begin
       memotxt.Lines.SaveToFile(savedialog1.FileName);
       txtform.Caption:=Extractfilename(savedialog1.FileName)+'-记事本';
       filename:=savedialog1.FileName;
       memotxt.Modified:=false;
       break;
      end;
   end;
   break;
   end; //while end
end;

procedure Ttxtform.menusaveClick(Sender: TObject);
begin
  savedatas; //调用savedatas函数
end;

procedure Ttxtform.menunewClick(Sender: TObject);

begin
  if ismodify then  //调用ismodify函数
  begin
    memotxt.Lines.Clear;
    filename:='';
  end;
end;

function Ttxtform.ismodify: boolean;  //判断是否发生改变的函数
var
  intResult:integer;
begin
  if memotxt.Modified then
  begin
     intResult:=application.MessageBox('数据已经改变,要保存吗?','保存',mb_yesnocancel);
     if intResult=idyes then
       result:=savedatas;
     if intResult=idno then
         result:=true;
     if intResult=idcancel then
        result:=false;
  end
  else
    result:=true
end;

procedure Ttxtform.menusavesClick(Sender: TObject);
begin
   while true do
  begin
  if savedialog1.Execute then
    begin
         if FileExists(savedialog1.FileName) then
             begin
                if application.MessageBox('是否覆盖?','文件保存',MB_YesNo)=idyes then
                  begin
                    memotxt.Lines.SaveToFile(savedialog1.FileName);
                    filename:=savedialog1.FileName;
                    txtform.Caption:=Extractfilename(savedialog1.FileName)+'-记事本';
                    memotxt.Modified:=false;
                     break;
                  end ;
             end
           else
           begin
             memotxt.Lines.SaveToFile(savedialog1.FileName);
             txtform.Caption:=Extractfilename(savedialog1.FileName)+'-记事本';
             filename:=savedialog1.FileName;
             memotxt.Modified:=false;
             break;
           end;
     end
  else
  break;
  end; //while  end
end;

procedure Ttxtform.menueditClick(Sender: TObject);
begin
  if memotxt.SelLength<>0 then
    begin
      menucopy.Enabled:=true;
      menucut.Enabled:=true;
      menudel.Enabled:=true;
    end
  else
    begin
      menucopy.Enabled:=false;
      menucut.Enabled:=false;
      menudel.Enabled:=false;
    end;
  if memotxt.Modified then
    begin
     menucx.Enabled:=true;
    end
  else
     menucx.Enabled:=false;
end;

procedure Ttxtform.menucutClick(Sender: TObject);
begin
  memotxt.CutToClipboard;
end;

procedure Ttxtform.menucopyClick(Sender: TObject);
begin
  memotxt.CopyToClipboard;
end;

procedure Ttxtform.menupasteClick(Sender: TObject);
begin
  memotxt.PasteFromClipboard;
end;

procedure Ttxtform.menucxClick(Sender: TObject);
begin
  memotxt.Undo;
end;

procedure Ttxtform.menudelClick(Sender: TObject);
begin
  memotxt.ClearSelection;
end;

procedure Ttxtform.menuselClick(Sender: TObject);
begin
  memotxt.SelectAll;
end;

procedure Ttxtform.menuendClick(Sender: TObject);
begin
  txtform.Close;//调用memotxt组件中close事件中的语句
end;

procedure Ttxtform.PopupMenu1Popup(Sender: TObject);
begin
if memotxt.SelLength<>0 then
    begin
      pupcopy.Enabled:=true;
      pupcut.Enabled:=true;
      pupdel.Enabled:=true;
    end
  else
    begin
      pupcopy.Enabled:=false;
      pupcut.Enabled:=false;
      pupdel.Enabled:=false;
    end;
  if memotxt.Modified then
    begin
     pupcx.Enabled:=true ;
    end
  else
     pupcx.Enabled:=false;
end;

procedure Ttxtform.menuautoClick(Sender: TObject);
begin
  menuauto.Checked:=not menuauto.Checked;
  if menuauto.Checked then
  begin
    memotxt.WordWrap:=true;
  end
  else
    memotxt.WordWrap:=false;
end;
procedure Ttxtform.menufondClick(Sender: TObject);
begin
  fontdialog1.Font:=memotxt.Font;
  fontdialog1.Execute;
  toolbold.Down:= fsbold in fontdialog1.Font.Style;
  toolitalic.Down:=fsitalic in fontdialog1.font.style;
  toolunderline.Down:= fsunderline in fontdialog1.Font.Style;
  memotxt.Font:=fontdialog1.Font;
end;
procedure Ttxtform.subboldClick(Sender: TObject);
begin
  if subbold.Checked=true then
  begin
   subbold.Checked:=false;
   memotxt.Font.Style:=memotxt.Font.Style-[fsbold];
   toolbold.Down:=false;
  end
  else
  begin
   subbold.Checked:=true;
   memotxt.Font.Style:=memotxt.Font.Style+[fsbold];
   toolbold.Down:=true;
  end;
end;

procedure Ttxtform.subitalicClick(Sender: TObject);
begin
 if subitalic.Checked=true then
  begin
   subitalic.Checked:=false;
   memotxt.Font.Style:=memotxt.Font.Style-[fsitalic];
   toolitalic.Down:=false;
  end
  else
  begin
   subitalic.Checked:=true;
   memotxt.Font.Style:=memotxt.Font.Style+[fsitalic];
   toolitalic.Down:=true;
  end;
end;

procedure Ttxtform.subunderlineClick(Sender: TObject);
begin
 if subunderline.Checked=true then
  begin
   subunderline.Checked:=false;
   memotxt.Font.Style:=memotxt.Font.Style-[fsunderline];
   toolunderline.Down:=false;
  end
  else
  begin
   subunderline.Checked:=true;
   memotxt.Font.Style:=memotxt.Font.Style+[fsunderline];
   toolunderline.Down:=true;
  end;
end;
procedure Ttxtform.toolleftClick(Sender: TObject);
begin
  memotxt.Alignment:=taleftJustify ;
  toolleft.Down:=true;
  toolright.Down:=false;
  toolmiddle.Down:=false;
end;

procedure Ttxtform.toolmiddleClick(Sender: TObject);
begin
  memotxt.Alignment:=tacenter ;
  toolleft.Down:=false;
  toolright.Down:=false;
  toolmiddle.Down:=true;
end;

procedure Ttxtform.toolrightClick(Sender: TObject);
begin
  memotxt.Alignment:=tarightJustify ;
  toolleft.Down:=false;
  toolright.Down:=true;
  toolmiddle.Down:=false;
end;

procedure Ttxtform.menufindClick(Sender: TObject);
begin
  finddialog1.Execute;
end;

procedure Ttxtform.memotxt1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
 if memotxt.SelLength<>0 then
    begin
      toolcopy.Enabled:=true;
      toolcut.Enabled:=true;
      tooldel.Enabled:=true;
    end
  else
    begin
      toolcopy.Enabled:=false;
      toolcut.Enabled:=false;
      tooldel.Enabled:=false;
    end;
  if memotxt.Modified then
    begin
     toolcx.Enabled:=true;
    end
  else
     toolcx.Enabled:=false;
end;

procedure Ttxtform.memotxt1KeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
if memotxt.SelLength<>0 then
    begin
      toolcopy.Enabled:=true;
      toolcut.Enabled:=true;
      tooldel.Enabled:=true;
    end
  else
    begin
      toolcopy.Enabled:=false;
      toolcut.Enabled:=false;
      tooldel.Enabled:=false;
    end;
  if memotxt.Modified then
    begin
     toolcx.Enabled:=true;
    end
  else
     toolcx.Enabled:=false;
end;

procedure Ttxtform.FindDialog1Find(Sender: TObject);
var
  FoundAt:longint;
  startpos,toend:integer;
begin
  with memotxt do
  begin
    if sellength<>0 then
      startpos:=selstart+sellength
    else
     startpos:=memotxt.Selstart;
    toend:=length(text)-startpos;
    foundAt:=findtext(finddialog1.findtext,startpos,toend,[stMatchcase]);
   if foundAt<>-1 then
   begin
     setfocus;
     selstart:=foundAt;
     sellength:=length(finddialog1.FindText);
   end
   else
     messagedlg(concat('找不到''',finddialog1.findtext,''''),mterror,[mbok],0);
   end;
end;

procedure Ttxtform.memotxtMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
 if memotxt.SelLength<>0 then
    begin
      toolcopy.Enabled:=true;
      toolcut.Enabled:=true;
      tooldel.Enabled:=true;
    end
  else
    begin
      toolcopy.Enabled:=false;
      toolcut.Enabled:=false;
      tooldel.Enabled:=false;
    end;
  if memotxt.Modified then
    begin
     toolcx.Enabled:=true;
    end
  else
     toolcx.Enabled:=false;
end;

procedure Ttxtform.memotxtKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
 if memotxt.SelLength<>0 then
    begin
      toolcopy.Enabled:=true;
      toolcut.Enabled:=true;
      tooldel.Enabled:=true;
    end
  else
    begin
      toolcopy.Enabled:=false;
      toolcut.Enabled:=false;
      tooldel.Enabled:=false;
    end;
  if memotxt.Modified then
    begin
     toolcx.Enabled:=true;
    end
  else
     toolcx.Enabled:=false;
end;

procedure Ttxtform.memotxtChange(Sender: TObject);
begin
 if memotxt.Modified then
    begin
     menucx.Enabled:=true;
    end
  else
     menucx.Enabled:=false;
end;

end.
💿 文件大小 284 K
👤 上传用户 demonray
📂 所属分类 Delphi控件源码
🏷️ 相关标签

#文本编辑器
⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -
📄 新建 文本文档.txt

⌨️ 快捷键说明

📄 新建文本文档.txt
