unit1.pas

这是我用Delphi仿造windows中自带记事本的功能设计的一个记事本小程序

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Memo1: TMemo;
    MainMenu1: TMainMenu;
    PopupMenu1: TPopupMenu;
    N1: TMenuItem;
    N2: TMenuItem;
    N3: TMenuItem;
    N4: TMenuItem;
    N5: TMenuItem;
    N6: TMenuItem;
    N7: TMenuItem;
    N8: TMenuItem;
    N9: TMenuItem;
    N10: TMenuItem;
    N11: TMenuItem;
    N12: TMenuItem;
    N13: TMenuItem;
    N14: TMenuItem;
    N15: TMenuItem;
    N16: TMenuItem;
    N17: TMenuItem;
    N18: TMenuItem;
    N19: TMenuItem;
    N20: TMenuItem;
    N21: TMenuItem;
    N22: TMenuItem;
    OpenDialog1: TOpenDialog;
    SaveDialog1: TSaveDialog;
    ColorDialog1: TColorDialog;
    FindDialog1: TFindDialog;
    ReplaceDialog1: TReplaceDialog;
    Selectall1: TMenuItem;
    N23: TMenuItem;
    Undo1: TMenuItem;
    N24: TMenuItem;
    FontDialog1: TFontDialog;
    BgColor1: TMenuItem;
    N25: TMenuItem;
    procedure N22Click(Sender: TObject);
    procedure N3Click(Sender: TObject);
    procedure N2Click(Sender: TObject);
    procedure N4Click(Sender: TObject);
    procedure N5Click(Sender: TObject);
    procedure N6Click(Sender: TObject);
    procedure N12Click(Sender: TObject);
    procedure N15Click(Sender: TObject);
    procedure findevent(Sender: TObject);
    procedure replacefind(Sender: TObject);
    procedure replaceevent(Sender: TObject);
    procedure N9Click(Sender: TObject);
    procedure N13Click(Sender: TObject);
    procedure N10Click(Sender: TObject);
    procedure N11Click(Sender: TObject);
    procedure Undo1Click(Sender: TObject);
    procedure Selectall1Click(Sender: TObject);
    procedure N17Click(Sender: TObject);
    procedure N24Click(Sender: TObject);
    procedure N19Click(Sender: TObject);
    procedure N20Click(Sender: TObject);
    procedure BgColor1Click(Sender: TObject);
    procedure N25Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  f:textfile;
  wfilename:string;
  flag:boolean;
  hsaved:boolean;
implementation
uses unit2;
{$R *.dfm}

procedure TForm1.N22Click(Sender: TObject);
begin
aboutbox:=taboutbox.create(nil);
aboutbox.show;
end;

procedure TForm1.N3Click(Sender: TObject);
var line:string;
begin
if opendialog1.Execute then
    begin
       assignfile(f,opendialog1.FileName);
       reset(f);
       form1.Caption:=opendialog1.FileName;
       flag:=true;
       hsaved:=false;
       while not eof(f) do begin
          readln(f,line);
          memo1.Lines.add(line);
          end;
    closefile(f);
    end;
end;

procedure TForm1.N2Click(Sender: TObject);
begin
form1.Tag:=form1.Tag+1;;
with tform1.Create(nil) do
begin
Caption:='新建记事本'+inttostr(form1.tag);
name:='form'+inttostr(form1.tag);
show;
end;
end;

procedure TForm1.N4Click(Sender: TObject);
var i,lastline:integer;
begin
  if hsaved then
    begin
     lastline:=memo1.Lines.Add('')-1;
      assignfile(f,wfilename);
      rewrite(f);
      for i:=0 to lastline do
         begin
           writeln(f,memo1.lines[i]);
          end;
      closefile(f);
    end
  else
    N5click(sender);

end;

procedure TForm1.N5Click(Sender: TObject);
var i,lastline:integer;
    writefile:textfile;
begin
if savedialog1.Execute then
   begin
     hsaved:=true;
     wfilename:=savedialog1.FileName;
     assignfile(writefile,savedialog1.FileName);
     rewrite(writefile);
     form1.Caption:=wfilename;
     lastline:=memo1.Lines.Add('')-1;
     for i:=0 to lastline do
        begin
        writeln(writefile,memo1.lines[i]);
        end;
        closefile(writefile);
   end;
end;

procedure TForm1.N6Click(Sender: TObject);
var t:integer;
begin
   if not flag then
    t:=messagedlg('是否保存文件',mtconfirmation,mbyesnocancel,0);
   if t<>2 then
    begin
     if t=6 then  N4Click(sender);
    end;
    close;
end;

procedure TForm1.N12Click(Sender: TObject);
begin
finddialog1.Execute;
end;

procedure TForm1.N15Click(Sender: TObject);
begin
replacedialog1.Execute;
end;

procedure TForm1.findevent(Sender: TObject);
var position:integer;
begin
   if frdown in finddialog1.Options then
   begin
    position:=PosEx(finddialog1.FindText,memo1.Text,memo1.SelStart+memo1.SelLength+1);
    if position=0 then
     begin
       showmessage('找不到'+finddialog1.FindText);
     end
    else
     begin
       memo1.SelStart:=position-1;
       memo1.SelLength:=length(finddialog1.FindText);
       memo1.SetFocus;
     end;
    end
    else
    begin
      position:=PosEx(reversestring(finddialog1.FindText),reversestring(memo1.Text),
      length(memo1.Text)-memo1.SelStart+1);
      if position=0 then
      begin
        showmessage('找不到'+finddialog1.FindText);
      end
      else
      begin
        memo1.SelStart:=length(memo1.Text)-position-
        length(finddialog1.FindText)+1;
        memo1.SelLength:=length(finddialog1.FindText);
        memo1.SetFocus;
      end;
    end;
end;

procedure TForm1.replacefind(Sender: TObject);
var position:integer;
begin
 position:=posex(replacedialog1.FindText,memo1.Text,memo1.SelStart+memo1.SelLength+1);
 if position=0 then
 begin
   showmessage('找不到'+replacedialog1.FindText);
 end
 else
 begin
   memo1.SelStart:=position-1;
   memo1.SelLength:=length(replacedialog1.FindText);
   memo1.SetFocus;
 end;
end;

procedure TForm1.replaceevent(Sender: TObject);
begin
  if frreplaceall in replacedialog1.Options then
  begin
    memo1.Text:=ansireplacetext(memo1.Text,replacedialog1.FindText,replacedialog1.ReplaceText);
    memo1.SetFocus;
  end
  else
  begin
    if memo1.SelText=replacedialog1.FindText then
    begin
     memo1.SelText:=replacedialog1.ReplaceText;
     memo1.SetFocus;
    end
    else
    begin
      findevent(sender);
      if memo1.SelText=replacedialog1.ReplaceText then
      begin
        memo1.SelText:=replacedialog1.ReplaceText;
        memo1.SetFocus;
      end;
    end;
  end;
end;

procedure TForm1.N9Click(Sender: TObject);
begin
memo1.CopyToClipboard;
end;

procedure TForm1.N13Click(Sender: TObject);
begin
memo1.PasteFromClipboard;
end;

procedure TForm1.N10Click(Sender: TObject);
begin
memo1.CutToClipboard;
end;

procedure TForm1.N11Click(Sender: TObject);
begin
memo1.SelText:='';
end;

procedure TForm1.Undo1Click(Sender: TObject);
begin
memo1.Undo;
end;

procedure TForm1.Selectall1Click(Sender: TObject);
begin
memo1.SelectAll;
end;

procedure TForm1.N17Click(Sender: TObject);
begin
memo1.SelText:=timetostr(time);
end;

procedure TForm1.N24Click(Sender: TObject);
begin
memo1.SelText:=datetimetostr(date);
end;

procedure TForm1.N19Click(Sender: TObject);
begin
if fontdialog1.Execute then
memo1.Font:=fontdialog1.Font;
end;

procedure TForm1.N20Click(Sender: TObject);
begin
if colordialog1.Execute then
memo1.Font.Color:=colordialog1.Color;
end;

procedure TForm1.BgColor1Click(Sender: TObject);
begin
if colordialog1.Execute then
memo1.Color:=colordialog1.Color;
end;

procedure TForm1.N25Click(Sender: TObject);
begin
if n25.Checked then
 begin
 n25.Checked:=false;
 memo1.ScrollBars:=ssboth;
 end
else
 begin
 n25.Checked:=true;
 memo1.ScrollBars:=ssVertical;
 end;
end;

end.