unit1.pas

模仿Windows记事本写的delphi语言程序

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Menus, StdCtrls, ComCtrls, ColorGrd, ExtCtrls, ImgList,
  StdActns, ActnList;

const
  NewLine=#13#10;
  DefaultFilter='文本文件(*.txt)|*.txt|超文本文件(*.htm,*.html)|*.htm;*.html|'+
                'RTF文件(*.rtf)|*.rtf|Gb码文件(*.gb)|*.gb|批处理文件(*.bat)|'+
                '*.bat|配置文件(*.ini)|*.ini|C源程序(*.h,*.c,*.cpp)|*.h;*.c;'+
                '*.cpp|其它源程序(*.asm,*.bas……)|*.asm;;*.bas;*.prg;*.jav|所有文件(*.*)|*.*';

type
  TForm1 = class(TForm)
    MainMenu1: TMainMenu;
    N1: TMenuItem;
    N2: TMenuItem;
    N3: TMenuItem;
    N4: TMenuItem;
    N5: TMenuItem;
    N6: TMenuItem;
    N7: TMenuItem;
    P1: 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;
    N23: TMenuItem;
    N24: TMenuItem;
    N25: TMenuItem;
    W1: TMenuItem;
    F1: TMenuItem;
    N26: TMenuItem;
    N27: TMenuItem;
    N28: TMenuItem;
    N29: TMenuItem;
    N30: TMenuItem;
    PopupMenu1: TPopupMenu;
    N31: TMenuItem;
    N32: TMenuItem;
    N33: TMenuItem;
    N34: TMenuItem;
    N35: TMenuItem;
    N36: TMenuItem;
    N37: TMenuItem;
    N38: TMenuItem;
    N39: TMenuItem;
    N40: TMenuItem;
    Unicode1: TMenuItem;
    Unicode2: TMenuItem;
    N41: TMenuItem;
    IME1: TMenuItem;
    N42: TMenuItem;
    RichEdit1: TRichEdit;
    OpenDialog1: TOpenDialog;
    SaveDialog1: TSaveDialog;
    FontDialog1: TFontDialog;
    ReplaceDialog1: TReplaceDialog;
    FindDialog1: TFindDialog;
    PrintDialog1: TPrintDialog;
    PrinterSetupDialog1: TPrinterSetupDialog;
    Timer1: TTimer;
    StatusBar1: TStatusBar;
    ColorDialog1: TColorDialog;
    N43: TMenuItem;
    procedure N30Click(Sender: TObject);
    procedure N2Click(Sender: TObject);
    procedure N24Click(Sender: TObject);
    procedure N11Click(Sender: TObject);
    procedure W1Click(Sender: TObject);
    procedure F1Click(Sender: TObject);
    procedure N13Click(Sender: TObject);
    procedure N14Click(Sender: TObject);
    procedure N15Click(Sender: TObject);
    procedure N16Click(Sender: TObject);
    procedure N23Click(Sender: TObject);
    procedure N18Click(Sender: TObject);
    procedure N19Click(Sender: TObject);
    procedure N9Click(Sender: TObject);
    procedure N7Click(Sender: TObject);
    procedure P1Click(Sender: TObject);
    procedure N5Click(Sender: TObject);
    procedure N3Click(Sender: TObject);
    procedure N33Click(Sender: TObject);
    procedure N34Click(Sender: TObject);
    procedure N35Click(Sender: TObject);
    procedure N36Click(Sender: TObject);
    procedure N38Click(Sender: TObject);
    procedure N4Click(Sender: TObject);
    procedure FindDialogFind(Sender: TObject);
    procedure ReplaceDialogReplace(Sender: TObject);
    procedure ReplaceDialogFind(Sender: TObject);
    procedure N20Click(Sender: TObject);
    procedure N40Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure N27Click(Sender: TObject);
    procedure N43Click(Sender: TObject);
    private
    { Private declarations }
   function PerformFind(Sender: TObject; FindString: String; SearchType: TSearchTypes):Boolean;//查找下一个
  public
    { Public declarations }
    FindTextOld:string;
  end;

var
  Form1: TForm1;
  Filename:String;

implementation

uses Unit2;

{$R *.dfm}

//{{{{{{{{{{{{{{{{{{{{{{{{查找下一个{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{//
function TForm1.PerformFind(Sender: TObject; FindString: String; SearchType: TSearchTypes):Boolean;
var
  FoundAt, StartPos, ToEnd: Integer;
  str:string;
  label Start;
begin
  if FindTextOld = FindString then
    with RichEdit1 do
    begin
      Start: StartPos:=SelStart+SelLength;
      ToEnd:=GetTextLen-StartPos;
      FoundAt:=FindText(FindString,StartPos,ToEnd,SearchType);
      if FoundAt<>-1 then
      begin
        SelStart:=FoundAt;
        SelLength:=Length(FindString);
        if Seltext='' then
        begin
          Selstart:=Selstart+2;
          goto Start;
        end;
        Result:=True;
      end
      else
      begin
        str:= '找不到 '''''+PChar(FindString)+'''''';
        Application.MessageBox(PChar(str),'记事本',MB_ICONINFORMATION);
        FindDialog1.CloseDialog;
        Result:=False;
      end;
    end
  else
  begin
    FindTextOld:= FindString; 
    Result:=True;
  end;
end;
//}}}}}}}}}}}}}}}}}}}}}}}}}}}}}end}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}//



// 新建
procedure TForm1.N2Click(Sender: TObject);
begin
  if(True=Richedit1.Modified) then
  case MessageDlg('文件'+'已经改变'+#13#13+'是否保存文件？',mtConfirmation,mbYesNoCancel,0) of
  idYes:
  begin
    N5.Click;
    Richedit1.clear;
  end;
  idNo:
     Richedit1.clear
  else
    ;
  end;
end;

//打开
procedure TForm1.N3Click(Sender: TObject);
begin
  OpenDialog1.Filter:=DefaultFilter;
  if OpenDialog1.Execute then
  begin
    Richedit1.Clear;
    Richedit1.SetFocus;
    Richedit1.Lines.LoadFromFile(OpenDialog1.filename);
    end;
end;

//保存
procedure TForm1.N4Click(Sender: TObject);
begin
  SaveDialog1.Filter:=DefaultFilter;
  if SaveDialog1.Execute then
    Richedit1.Lines.SaveToFile(SaveDialog1.FileName);
end;

//另存为
procedure TForm1.N5Click(Sender: TObject);
begin
  SaveDialog1.Filter:=DefaultFilter;
  if(SaveDialog1.Execute()) then
  begin
     filename:=SaveDialog1.Filename;
     Richedit1.Lines.SaveToFile(filename);
  end;
end;

// 页面设置
procedure TForm1.N7Click(Sender: TObject);
begin
 try
    PrinterSetupDialog1.Execute
  except
    Application.MessageBox(Pchar('无法找到默认的打印机'+NewLine+'请确认打印机已安装正确。'),Pchar(Application.Title),MB_ICONINFORMATION);
  end;
end;

//打印
procedure TForm1.P1Click(Sender: TObject);
begin
 try
    RichEdit1.Print(FileName);
  except
    Application.MessageBox(Pchar('无法找到默认的打印机'+NewLine+'请确认打印机已安装正确。'),Pchar(Application.Title),MB_ICONINFORMATION);
  end;
end;

//退出
procedure TForm1.N9Click(Sender: TObject);
begin
   if(True=Richedit1.Modified) then
  case MessageDlg('文件'+'已经改变'+#13#13+'是否保存文件？',mtConfirmation,mbYesNoCancel,0) of
  idYes:
  begin
    N5.Click;
    Richedit1.clear;
  end;
  idNo:
     Richedit1.clear
  else
    ;
  end;
 Close;
end;

//时间/日期
procedure TForm1.N24Click(Sender: TObject);
begin
     RichEdit1.SelText:=DatetimeToStr(now());
end;

//撤销
procedure TForm1.N11Click(Sender: TObject);
begin
  RichEdit1.Undo;
end;

//剪切
procedure TForm1.N13Click(Sender: TObject);
begin
   RichEdit1.CutToClipboard;
end;

//复制
procedure TForm1.N14Click(Sender: TObject);
begin
  RichEdit1.CopyToClipboard;
end;

//粘帖
procedure TForm1.N15Click(Sender: TObject);
begin
   RichEdit1.PasteFromClipboard;
end;

//删除
procedure TForm1.N16Click(Sender: TObject);
begin
   RichEdit1.ClearSelection;
end;

//全选
procedure TForm1.N23Click(Sender: TObject);
begin
  RichEdit1.SelectAll;
end;

//查找窗体
procedure TForm1.N18Click(Sender: TObject);
begin
  with FindDialog1 do
  begin
    Position:=Point(Self.Left + Self.Width div 4,Self.Top + Self.Height div 4);
    FindText:=RichEdit1.SelText;
    Execute;
  end;
end;

//查找窗体中的查找功能
procedure TForm1.FindDialogFind(Sender: TObject);
var
  SearchType:TSearchTypes;
begin
  with FindDialog1 do
  begin
    if frMatchCase in Options then
      SearchType:=SearchType+[stMatchCase];
    if frWholeWord in Options then
      SearchType:=SearchType+[stWholeWord];
    PerformFind(Sender,FindText,SearchType);
  end;
  RichEdit1.SetFocus;
  SendMessage(RichEdit1.Handle,EM_SCROLLCARET,0,0);
end;

//查找下一个
procedure TForm1.N19Click(Sender: TObject);
begin
  if Length(FindDialog1.FindText)>0 then
    FindDialogFind(Sender)
  else
    with FindDialog1 do
    begin
      Position:=Point(Self.Left + Self.Width div 4,Self.Top + Self.Height div 4);
      FindText:=RichEdit1.SelText;
      Execute;
    end;
end;

//替换窗体

procedure TForm1.N20Click(Sender: TObject);
begin
 with ReplaceDialog1 do
  begin
    Position:= Point(Self.Left + Self.Width div 4,Self.Top + Self.Height div 4);
    if RichEdit1.SelLength>0 then
    begin
      FindText:=RichEdit1.SelText;
      FindDialog1.FindText:=RichEdit1.SelText;
    end
    else
      if Length(FindDialog1.FindText)>0 then
         FindText:= FindDialog1.FindText;
    Execute;
  end;
end;


//替换中的查找功能
procedure TForm1.ReplaceDialogFind(Sender: TObject);
var
  SearchType:TSearchTypes;
begin
  with ReplaceDialog1 do
  begin
    if frMatchCase in Options then
      SearchType:=SearchType+[stMatchCase];
    if frWholeWord in Options then
      SearchType:=SearchType+[stWholeWord];
    PerformFind(Sender,FindText,SearchType);
  end;
  RichEdit1.SetFocus;
  SendMessage(RichEdit1.Handle,EM_SCROLLCARET,0,0);
end;

//替换中的替换 替换全部功能
procedure TForm1.ReplaceDialogReplace(Sender: TObject);
var
  SearchType:TSearchTypes;
  FoundAt, StartPos, ToEnd: Integer;
  str:string;
  label Start, Start1, Start2;
begin
  with ReplaceDialog1 do
  begin //1
  
    if frReplace in Options then
    begin//2
      if frMatchCase in Options then
        SearchType:=SearchType+[stMatchCase];
      if frWholeWord in Options then
        SearchType:=SearchType+[stWholeWord];

      if RichEdit1.Seltext = ReplaceDialog1.FindText then
      begin
        RichEdit1.SelText:= ReplaceDialog1.ReplaceText;
        Start1: StartPos:=RichEdit1.SelStart+RichEdit1.SelLength;
        ToEnd:= RichEdit1.GetTextLen-StartPos;
        FoundAt := RichEdit1.FindText(ReplaceDialog1.FindText,StartPos,ToEnd,SearchType);

        if FoundAt<>-1 then
        begin
          RichEdit1.SelStart:=FoundAt;
          RichEdit1.SelLength:=Length(ReplaceDialog1.FindText);
          if RichEdit1.Seltext='' then
          begin
            RichEdit1.Selstart:=RichEdit1.Selstart+2;
            goto Start1;
          end;
          SendMessage(RichEdit1.Handle, EM_SCROLLCARET, 0, 0);
        end
        else
        begin
          Str:= '找不到 '''''+ReplaceDialog1.FindText+'''''';
          Application.MessageBox(PChar(Str),'记事本',MB_ICONINFORMATION);
        end;

      end
      else
      begin
        Start2: StartPos:=RichEdit1.SelStart+RichEdit1.SelLength;
        ToEnd:= RichEdit1.GetTextLen-StartPos;
        FoundAt := RichEdit1.FindText(ReplaceDialog1.FindText,StartPos,ToEnd,SearchType);

        if FoundAt<>-1 then
        begin
          RichEdit1.SelStart:=FoundAt;
          if RichEdit1.Seltext='' then
          RichEdit1.SelLength:=Length(ReplaceDialog1.FindText);
          begin
            RichEdit1.Selstart:=RichEdit1.Selstart+2;  
            goto Start2;
          end;
          SendMessage(RichEdit1.Handle, EM_SCROLLCARET, 0, 0);
        end
        else
        begin
          Str:= '找不到 '''''+ReplaceDialog1.FindText+'''''';
          Application.MessageBox(PChar(Str),'记事本',MB_ICONINFORMATION);
        end;
      end;
    end;

    if frReplaceAll in Options then
    begin
      if frMatchCase in Options then
        SearchType:=SearchType+[stMatchCase];
      if frWholeWord in Options then
        SearchType:=SearchType+[stWholeWord];
      if RichEdit1.Seltext = ReplaceDialog1.FindText then
         RichEdit1.SelText:= ReplaceDialog1.ReplaceText;
      FindTextOld:='';
      PerformFind(Sender,FindText,SearchType);

      while PerformFind(Sender,FindText,SearchType) do
      begin
        RichEdit1.SelText:= ReplaceDialog1.ReplaceText;
      end;
    end;

  end;//1
  RichEdit1.SetFocus;
  SendMessage(RichEdit1.Handle,EM_SCROLLCARET,0,0);
end;


//自动换行
procedure TForm1.W1Click(Sender: TObject);
var
  Pos:Integer;
begin
  with RichEdit1,W1 do
  begin
    Pos:=SelStart;
    Checked:=Not Checked;
    WordWrap:=Checked;
    if WordWrap then
      ScrollBars:=ssVertical
    else
      ScrollBars:=ssBoth;
    SelStart:=Pos;
  end;
end;

//字体
procedure TForm1.F1Click(Sender: TObject);
begin
  if FontDialog1.Execute then
  begin
    RichEdit1.Font:= FontDialog1.Font;
  end;
end;

//关于记事本
procedure TForm1.N30Click(Sender: TObject);
begin
   Form2.Show;
end;


//----------------右键设置------------------------
procedure TForm1.N33Click(Sender: TObject);
begin
   RichEdit1.CutToClipboard;
end;

procedure TForm1.N34Click(Sender: TObject);
begin
  RichEdit1.CopyToClipboard;
end;

procedure TForm1.N35Click(Sender: TObject);
begin
   RichEdit1.PasteFromClipboard;
end;

procedure TForm1.N36Click(Sender: TObject);
begin
   RichEdit1.ClearSelection;
end;

procedure TForm1.N38Click(Sender: TObject);
begin
    RichEdit1.SelectAll;
end;

procedure TForm1.N40Click(Sender: TObject);
begin
  if  N40.Checked=False then
  begin
  (sender as TMenuItem).Checked:=True;
   if N40.Checked then
      RichEdit1.Paragraph.Alignment:=taRightJustify;
     //右对齐
   end
   else
   begin
     RichEdit1.Paragraph.Alignment:=taLeftJustify;
     N40.Checked:=False;
   end;

end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
 if(True=Richedit1.Modified) then
  case MessageDlg('文件'+'已经改变'+#13#13+'是否保存文件？',mtConfirmation,mbYesNoCancel,0) of
  idYes:
  begin
    N5.Click;
    Richedit1.clear;
  end;
  idNo:
     Richedit1.clear
  else
    ;
  end;
end;

procedure TForm1.N27Click(Sender: TObject);
begin
  statusbar1.panels[0].text:=Datetostr(date);
  statusbar1.panels[1].text:=timetostr(time);
  statusbar1.Panels[2].Text:='statusbar:ON';

if N27.Checked=false then
 begin
  N27.Checked:=true;
  statusbar1.Visible:=true;
  statusbar1.panels[0].text:=Datetostr(date);
  statusbar1.panels[1].text:=timetostr(time);
  statusbar1.Panels[2].Text:='statusbar:ON';
  end
  else
  begin
  N27.Checked:=false;
  statusbar1.Visible:=false;
  end;
end;

procedure TForm1.N43Click(Sender: TObject);
begin
  with ColorDialog1 do
  begin
    Color:=RichEdit1.Color;
    if Execute then
      RichEdit1.Color:=Color;
  end;
end;

end.