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
  FileName:='无标题';
  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;

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

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

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