mainformunit.~pas

用DELPHI做的记事本 类似与WINDOWS中的记事本一样,包括删除,新建

unit MainFormUnit;

interface

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

type
  TMainForm = class(TForm)
    RET: TRichEdit;
    MainMenu1: TMainMenu;
    FileMenu: TMenuItem;
    FileNew: TMenuItem;
    FileOpen: TMenuItem;
    FileSave: TMenuItem;
    FileSaveAs: TMenuItem;
    FEN1: TMenuItem;
    PageSetup: TMenuItem;
    FilePrint: TMenuItem;
    fen2: TMenuItem;
    Exit: TMenuItem;
    EditMenu: TMenuItem;
    FileUndo: TMenuItem;
    fen3: TMenuItem;
    FileCut: TMenuItem;
    FileCopy: TMenuItem;
    FilePaste: TMenuItem;
    FileDel: TMenuItem;
    fen4: TMenuItem;
    FileFind: TMenuItem;
    FileFindNext: TMenuItem;
    FileReplace: TMenuItem;
    FileGoto: TMenuItem;
    fen5: TMenuItem;
    FileSelAll: TMenuItem;
    FileDate: TMenuItem;
    FormatMenu: TMenuItem;
    WordWrap: TMenuItem;
    FileFont: TMenuItem;
    ViewMenu: TMenuItem;
    FileSBAR: TMenuItem;
    SBar: TStatusBar;
    FileWindow: TMenuItem;
    HelpMenu: TMenuItem;
    FileHelp: TMenuItem;
    FileAbout: TMenuItem;
    fen6: TMenuItem;
    Open: TOpenDialog;
    Save: TSaveDialog;
    Font: TFontDialog;
    Find: TFindDialog;
    Replace: TReplaceDialog;
    TBar1: TToolBar;
    ToolButton1: TToolButton;
    TFileNew: TToolButton;
    TFileOpen: TToolButton;
    TFileSave: TToolButton;
    ToolButton5: TToolButton;
    TFilePrint: TToolButton;
    TPrintReview: TToolButton;
    ToolButton8: TToolButton;
    TFileFind: TToolButton;
    ToolButton10: TToolButton;
    TFileCut: TToolButton;
    TFileCopy: TToolButton;
    TFilePaste: TToolButton;
    TFileUndo: TToolButton;
    ToolButton15: TToolButton;
    TFileDate: TToolButton;
    PopupMenu1: TPopupMenu;
    PFileUndo: TMenuItem;
    fen7: TMenuItem;
    PFileCut: TMenuItem;
    PFileCopy: TMenuItem;
    PFilePaste: TMenuItem;
    PFileDel: TMenuItem;
    fen8: TMenuItem;
    PFileSelAll: TMenuItem;
    fen9: TMenuItem;
    Timer1: TTimer;
    ImageList1: TImageList;
    PageSetupD: TPageSetupDialog;
    PrintD: TPrintDialog;
    procedure FormCreate(Sender: TObject);
    procedure FileNewClick(Sender: TObject);
    procedure FileOpenClick(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FileSaveClick(Sender: TObject);
    procedure FileSaveAsClick(Sender: TObject);
    procedure ExitClick(Sender: TObject);
    procedure FileUndoClick(Sender: TObject);
    procedure FileCutClick(Sender: TObject);
    procedure FilePasteClick(Sender: TObject);
    procedure FileCopyClick(Sender: TObject);
    procedure FileDelClick(Sender: TObject);
    procedure FileFindClick(Sender: TObject);
    procedure FindFind(Sender: TObject);
    procedure FileReplaceClick(Sender: TObject);
    procedure ReplaceReplace(Sender: TObject);
    procedure ReplaceFind(Sender: TObject);
    procedure FileGotoClick(Sender: TObject);
    procedure FileSelAllClick(Sender: TObject);
    procedure FileDateClick(Sender: TObject);
    procedure WordWrapClick(Sender: TObject);
    procedure FileFontClick(Sender: TObject);
    procedure FileSBARClick(Sender: TObject);
    procedure FileWindowClick(Sender: TObject);
    procedure FileHelpClick(Sender: TObject);
    procedure FileAboutClick(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure RETKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure PageSetupClick(Sender: TObject);
    procedure FilePrintClick(Sender: TObject);
  private
    { Private declarations }

    FileName:string;                                   //保存文件名

    IfFileChange:boolean;                              //是否打开文件打开对话框

    Function GetFileName(temp:string):String;          //取得文件名

    Procedure BackStart;                               //返回文件初始状态

    Procedure FileSaveASP;                             //文件另存为过程

    Procedure FileSaveP;                              //文件保存过程

    Procedure CheckText;                               //判断文件是否改变的函数

    procedure WMDROPFILES(var Message: TWMDROPFILES);  //文件拖入记事本中的处理过程
      message WM_DROPFILES;

    procedure ButtonDisplay;                           //某些按钮是否激活

    procedure SetCaret(RTF: TRichEdit; var Row, Col:integer); //游标转到指定行过程

  public
    { Public declarations }
  end;

var
  MainForm: TMainForm;

implementation

uses LoginFormUnit, AboutFormUnit;

{$R *.dfm}

//----------自定的过程和函数--------------------------------------------------//

Function TMainForm.GetFileName(temp:string):string;
begin
  FileName:=StringReplace(ExtractFileName(temp),ExtractFileExt(temp), '',
                          [rfReplaceAll	]);
  result:=FileName;
end;

Procedure TMainForm.BackStart;
begin
  MainForm.Caption:='无标题 - 记事本';
  RET.Clear;
end;

Procedure Tmainform.FileSaveAsP;
begin
  if save.Execute then
    begin
      RET.Lines.SaveToFile(save.FileName);
      FileName:=GetFileName(save.FileName);
      mainform.Caption:=Filename+' - 记事本';
    end;
  RET.Modified:=False;
end;

Procedure TmainForm.FileSaveP;
begin

  if (mainform.Caption<>'无标题 - 记事本')then
    begin
      RET.Lines.SaveToFile(FileName+'.txt');
    end
  else
    FileSaveAsP;
  RET.Modified:=False;

end;

Procedure TMainForm.CheckText;
var sel:integer;
begin
  IfFileChange:=true;

  if RET.Modified then
    begin
      sel:=MessageBox(handle,Pchar('文件 '+FileName+' 的文字已经改变。'+#13#13
                      +'想保存文件吗？'),'记事本', MB_YESNOCANCEL+MB_ICONWARNING);

      if sel = IDYES then
          FileSaveAsP
      else if sel = IDCANCEL then
        IfFileChange:=false
      else
        IfFileChange:=true;

    end
end;

procedure Tmainform.WMDROPFILES(var Message: TWMDROPFILES);
var
  DFname : array[0..255] of char;
begin
  CheckText;
  if IfFileChange = true then
    begin
        DragQueryFile(Message.Drop,0, DFname,sizeof(DFname));
        mainform.RET.Lines.LoadFromFile(DFname);
        mainform.Caption:=GetFileName(Dfname)+' - 记事本';
        DragFinish (Message.Drop);
        ret.Modified:=false;
    end
end;

procedure Tmainform.ButtonDisplay;
begin

  if RET.SelText <> '' then
    FileCut.Enabled:=true
  else
    FileCut.Enabled:=false;
  if ret.Lines.Text<> '' then
    TfileFind.Enabled:=true
  else
    TfileFind.Enabled:=false;
  FilePaste.Enabled := SendMessage (RET.Handle, em_CanPaste, 0, 0) <> 0;
  PFilePaste.Enabled:=FilePaste.Enabled;
  TFilePaste.Enabled:=FilePaste.Enabled;
  PFileCut.Enabled:=FileCut.Enabled;
  TfileCut.Enabled:=FileCut.Enabled;
  FileCopy.Enabled:=FileCut.Enabled;
  PfileCopy.Enabled:=FileCut.Enabled;
  TFileCopy.Enabled:=FileCut.Enabled;
  FileDel.Enabled:=FileCut.Enabled;
  PfileDel.Enabled:=FileCut.Enabled;

  FILEUNDO.Enabled:=RET.CanUndo;
  PFileUndo.Enabled:=RET.CanUndo;
  TFileUndo.Enabled:=Ret.CanUndo;
end;

procedure TMainForm.SetCaret(RTF: TRichEdit; var Row, Col:integer);
var i, iStopLine, iSelStart:integer;
begin
  if (RTF = nil) then close;
  if Row = 0 then Row := 1;
  if Col = 0 then Col := 1;

  // 到第 Row 列, Col 行共几个字元
  iStopLine := Row - 1;
  iSelStart := 0;
  for i := 0 to RTF.Lines.Count - 1 do
  begin
    if i = iStopLine then
    begin
      if Length(RTF.Lines[i]) >= Col then
        Inc(iSelStart, Col)
      else
        Inc(iSelStart, Length(RTF.Lines[i]) + 2);
      Break;
    end;
    Inc(iSelStart, Length(RTF.Lines[i]) + 2);
  end;
  if iSelStart > 0 then Dec(iSelStart);

  // 以设定标记的方式指定游标位置
  SendMessage(RTF.Handle, EM_SETSEL, iSelStart, iSelStart);

  // 再次侦测游标位置
  Row := SendMessage(RTF.Handle, EM_LINEFROMCHAR, RTF.SelStart, 0);
  Col := RTF.SelStart - SendMessage(RTF.Handle, EM_LINEINDEX, Row, 0);

  // 卷到游标所在位置
  SendMessage(RTF.Handle, EM_SCROLLCARET, 0, 0);
end;

//----------------------------------------------------------------------------//

//----------------------------------------------------------------------------//

//---------------------------各个按钮事件---------------------------------=---//


procedure TMainForm.FormCreate(Sender: TObject);
begin
  ret.WordWrap:=false;
  FileName:='无标题';
  DragAcceptFiles(Handle,True);
end;

procedure TMainForm.FileNewClick(Sender: TObject);
begin
  CheckText;

  if IfFileChange=true then
    BackStart;

end;


procedure TMainForm.FileOpenClick(Sender: TObject);
begin
  CheckText;

  if IfFileChange=true then
    begin
      if Open.Execute then
        begin
          RET.Lines.LoadFromFile(Open.FileName);
          mainform.Caption:=GetFileName(Open.FileName)+' - 记事本';
          FileName:=GetFileName(Open.FileName);

          RET.Modified:=false;
          Open.FileName:='*.txt';
        end
    end
end;

procedure TMainForm.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
  CheckText;
  CanClose:=IfFileChange;
end;

procedure TMainForm.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  LoginForm.Close;
end;

procedure TMainForm.FileSaveClick(Sender: TObject);
begin
  FileSaveP;
end;

procedure TMainForm.FileSaveAsClick(Sender: TObject);
begin
  FileSaveAsP;
end;

procedure TMainForm.ExitClick(Sender: TObject);
begin
  CheckText;
  if IfFileChange = True then
    close;
end;

procedure TMainForm.FileUndoClick(Sender: TObject);
begin
  RET.Perform(em_undo,0,0);
end;

procedure TMainForm.FileCutClick(Sender: TObject);
begin
  RET.CutToClipboard;
end;

procedure TMainForm.FilePasteClick(Sender: TObject);
begin
  RET.PasteFromClipboard;  
end;

procedure TMainForm.FileCopyClick(Sender: TObject);
begin
  RET.CopyToClipboard;
end;

procedure TMainForm.FileDelClick(Sender: TObject);
begin
  RET.Perform(wm_clear,0,0);
end;

procedure TMainForm.FileFindClick(Sender: TObject);
begin
  Find.Execute;
end;

procedure TMainForm.FindFind(Sender: TObject);
var FoundAt:LongInt;
var StartPos, ToEnd:Integer;
begin
  if RET.SelLength<>0 then
    StartPos:=RET.SelStart + RET.SelLength
  else
    StartPos:=0;
  ToEnd:=Length(Ret.Text) - StartPos;
  FoundAt:=ret.FindText(find.FindText,startpos,toend,[stMatchCase]);
  if FoundAt <> -1 then
  begin
    ret.SetFocus;
    ret.SelStart:=FoundAt;
    ret.SelLength:=Length(find.FindText);
  end
  else
    messagedlg('查找完成',mtWarning,[mbOk],0);
end;



procedure TMainForm.FileReplaceClick(Sender: TObject);
var
  p: tpoint;
begin
  p := point(0,0);
  p := ret.ClientToScreen(p);
  replace.Position := p;
  replace.Execute;
end;



procedure TMainForm.ReplaceReplace(Sender: TObject);
var
  FoundAt: longint;
  StartPos, ToEnd: integer;
  st: TSearchTypes;
begin
  with RET do
  begin
    StartPos := SelStart;  // + SelLength;
    ToEnd := Length(ret.Text) - StartPos;
    st := [];
    if frMatchCase in replace.Options then
      st := st + [stMatchCase];
    if frWholeWord in replace.Options then
      st := st + [stWholeWord];
    FoundAt := FindText(replace.FindText, StartPos, ToEnd, st);
    while FoundAt <> -1 do
    begin
      SelStart := FoundAt;
      SelLength := Length(replace.FindText);
      perform(em_replacesel, 1, integer(pchar(replace.ReplaceText)));
      SelStart := FoundAt;
      SelLength := Length(replace.ReplaceText);
      if not (frReplaceAll in replace.Options) then
        break;
      StartPos := SelStart;
      ToEnd := Length(ret.Text) - StartPos;
      FoundAt := FindText(replace.FindText, StartPos, ToEnd, st);
    end;
    FoundAt := FindText(replace.FindText, StartPos, ToEnd, st);
    if FoundAt = -1 then
      messagedlg('替换完成',mtWarning,[mbOk],0);
  end;
end;

procedure TMainForm.ReplaceFind(Sender: TObject);
var
  FoundAt: longint;
  StartPos, ToEnd: integer;
  st: TSearchTypes;
begin
  with RET do
  begin
    StartPos := SelStart +SelLength;
    ToEnd := Length(ret.Text) - StartPos;
    st := [];
    if frMatchCase in replace.Options then
      st := st + [stMatchCase];
    if frWholeWord in replace.Options then
      st := st + [stWholeWord];
    FoundAt := FindText(replace.FindText, StartPos, ToEnd, st);
    if FoundAt <> -1 then
    begin
      SelStart := FoundAt;
      SelLength := Length(replace.FindText);
    end
    else
      messagedlg('查找完成',mtWarning,[mbOk],0);
  end;
end;

procedure TMainForm.FileGotoClick(Sender: TObject);
var
  gotoln:integer;
  iRow, iCol:integer;
begin
  IROW:=RET.CaretPos.Y+1;
  gotoln:=strtoint(InputBox('转到下列行', '行数(&L)',inttostr(irow)));
  IF (gotoln>RET.Lines.Count) then
    showmessage('行数超过范围')
  else
    begin
      iRow :=gotoln;
      iCol := 0;
      SetCaret(RET, iRow, iCol);
      ret.SetFocus;
    end;
end;

procedure TMainForm.FileSelAllClick(Sender: TObject);
begin
  RET.SelectAll;
end;

procedure TMainForm.FileDateClick(Sender: TObject);
begin 
  RET.SelText := TimeToStr(now) + ' ' + DateToStr(now);
end;

procedure TMainForm.WordWrapClick(Sender: TObject);
begin
  RET.WordWrap:= not ret.WordWrap;
  wordWrap.Checked:= Ret.WordWrap;

  if wordWrap.Checked=true then
    Ret.ScrollBars:=ssVertical
  else
    Ret.ScrollBars:=ssBoth
end;

procedure TMainForm.FileFontClick(Sender: TObject);
begin
  if Font.Execute then
    RET.Font:=font.Font;
end;

procedure TMainForm.FileSBARClick(Sender: TObject);
begin
  FileSbar.Checked:=not FileSbar.Checked;
  
  if FileSbar.Checked=true then
    sbar.Show
  else
    sbar.Hide
end;

procedure TMainForm.FileWindowClick(Sender: TObject);
begin
  TBAr1.Visible:=not TBAr1.Visible;
  FileWindow.Checked:=not FileWindow.Checked;
end;


procedure TMainForm.FileHelpClick(Sender: TObject);
begin
  shellExecute(handle,'open','C:\WINDOWS\Help\notepad.chm', nil, nil, sw_show);
end;

procedure TMainForm.FileAboutClick(Sender: TObject);
begin
  AboutForm.Show;
end;

procedure TMainForm.Timer1Timer(Sender: TObject);
begin
  Sbar.Panels[1].Text:='Ln:'+inttostr(ret.CaretPos.y)+','+' '
                        +'Col:'+inttostr(ret.CaretPos.x);

  if TBAR1.Visible=True then
    Sbar.Panels[0].Text:='正在使用的记事本界面为：写字板格式'
  else
    Sbar.Panels[0].Text:='正在使用的记事本界面为：标准记事本';
  ButtonDisplay;


end;

procedure TMainForm.RETKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  IF (KEY=VK_F1) THEN
    shellExecute(handle,'open','C:\WINDOWS\Help\notepad.chm', nil, nil, sw_show);
end;

procedure TMainForm.PageSetupClick(Sender: TObject);
begin
  PageSetupD.Execute;
end;

procedure TMainForm.FilePrintClick(Sender: TObject);
begin
  PrintD.Execute;
end;

end.