unitmain.pas

DELPHI编写的一个记事本 用起来和WINODWS的记事本一样 附上源码

unit UnitMain;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ComCtrls, Menus,Registry, ExtCtrls,Printers,ClipBrd,ShellApi;

type
  TFormMain = class(TForm)
    RichEdit1: TRichEdit;
    MainMenu1: TMainMenu;
    MenuFile: TMenuItem;
    ItemNew: TMenuItem;
    ItemOpen: TMenuItem;
    ItemSave: TMenuItem;
    ItemSaveAs: TMenuItem;
    ItemPrint: TMenuItem;
    N4: TMenuItem;
    ItemClose: TMenuItem;
    SaveDialog1: TSaveDialog;
    OpenDialog1: TOpenDialog;
    N1: TMenuItem;
    ItemFont: TMenuItem;
    FontDialog1: TFontDialog;
    PopupMenu1: TPopupMenu;
    ItemUndo: TMenuItem;
    N3: TMenuItem;
    ItemRedo: TMenuItem;
    ItemCut: TMenuItem;
    ItemCopy: TMenuItem;
    ItemPaste: TMenuItem;
    ItemDelete: TMenuItem;
    N5: TMenuItem;
    ItemSelectAll: TMenuItem;
    N6: TMenuItem;
    ItemFindText: TMenuItem;
    FindDialog1: TFindDialog;
    MenuEdit: TMenuItem;
    ItemUndo1: TMenuItem;
    ItemRedo1: TMenuItem;
    N7: TMenuItem;
    ItemCut1: TMenuItem;
    ItemCopy1: TMenuItem;
    ItemPaste1: TMenuItem;
    ItemDelete1: TMenuItem;
    N8: TMenuItem;
    ItemSelectAll1: TMenuItem;
    N9: TMenuItem;
    ItemFind1: TMenuItem;
    ItemAutoWarp1: TMenuItem;
    N11: TMenuItem;
    ItemAutoWarp: TMenuItem;
    H1: TMenuItem;
    N12: TMenuItem;
    N13: TMenuItem;
    procedure ItemNewClick(Sender: TObject);
    procedure ItemOpenClick(Sender: TObject);
    procedure ItemSaveClick(Sender: TObject);
    procedure ItemSaveAsClick(Sender: TObject);
    procedure ItemPrintClick(Sender: TObject);
    procedure ItemCloseClick(Sender: TObject);
    procedure ItemFontClick(Sender: TObject);
    procedure PopupMenu1Popup(Sender: TObject);
    procedure ItemUndoClick(Sender: TObject);
    procedure ItemRedoClick(Sender: TObject);
    procedure ItemCutClick(Sender: TObject);
    procedure ItemCopyClick(Sender: TObject);
    procedure ItemPasteClick(Sender: TObject);
    procedure ItemDeleteClick(Sender: TObject);
    procedure ItemSelectAllClick(Sender: TObject);
    procedure ItemFindTextClick(Sender: TObject);
    procedure FindDialog1Find(Sender: TObject);
    procedure ItemAutoWarp1Click(Sender: TObject);
    procedure ItemFindAndReplaceClick(Sender: TObject);
    procedure ReplaceDialog1Replace(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);


    procedure MenuFileClick(Sender: TObject);

    procedure FormCreate(Sender: TObject);
    procedure N12Click(Sender: TObject);
  private
    sFileName:String;
    Function CheckHasModified:Boolean;
    Function SaveAsFile:Boolean;
    Function SaveFile:Boolean;
    Function MyOpenFile(FileName:String):Boolean;
    procedure WndProc(var Message: TMessage); override;
    { Private declarations }
  public
    { Public declarations }
  end;

var
  FormMain: TFormMain;
  
  s:string;
implementation
Uses RichEdit, Unit1;
{$R *.DFM}

function TFormMain.CheckHasModified: Boolean;
begin
  Result:=not RichEdit1.Modified;
  if not Result then
  begin
    Case Application.MessageBox('文件没有保存！需要保存吗？','提示',MB_YESNO+MB_ICONQUESTION) of
      IDYES:Result:=SaveFile;
      IDNo:Result:=True;
    end;
  end;
end;

procedure TFormMain.ItemNewClick(Sender: TObject);
begin
  if CheckHasModified then
  begin
    RichEdit1.Lines.Clear;
    RichEdit1.Modified:=False;
    sFileName:='';
  end;
end;

function TFormMain.SaveAsFile: Boolean;
begin
  Result:=False;
  if SaveDialog1.Execute then
  begin
    RichEdit1.Lines.SaveToFile(SaveDialog1.FileName);
    RichEdit1.Modified:=False;
    sFileName:=SaveDialog1.FileName;
    
    Result:=True;
  end;
end;

procedure TFormMain.ItemOpenClick(Sender: TObject);
begin
  if OpenDialog1.Execute then
    MyOpenFile(OpenDialog1.FileName);
    //StatusBar1.Panels[0].Text:=OpenDialog1.FileName;
end;

procedure TFormMain.ItemSaveClick(Sender: TObject);
begin
  SaveFile;
end;

function TFormMain.SaveFile: Boolean;
begin
  if sFileName='' then
    Result:=SaveAsFile
  else
  begin
    RichEdit1.Lines.SaveToFile(sFileName);
    RichEdit1.Modified:=false;
    Result:=True;
  end;
end;

procedure TFormMain.ItemSaveAsClick(Sender: TObject);
begin
  SaveAsFile;
end;

procedure TFormMain.ItemPrintClick(Sender: TObject);
  var p:TPrinter;
begin
  p:=TPrinter.Create;
  if p.Printing then
  RichEdit1.Print(sFileName)
  else
  showmessage('你没有装打印机你就想打印？');
end;

procedure TFormMain.ItemCloseClick(Sender: TObject);
begin
  Close;
end;

procedure TFormMain.ItemFontClick(Sender: TObject);
begin
  FontDialog1.Font :=Richedit1.Font;
  if FontDialog1.Execute then
  Richedit1.SelAttributes.Assign(FontDialog1.Font);
end;

procedure TFormMain.PopupMenu1Popup(Sender: TObject);
begin
  ItemUndo.Enabled:=(RichEdit1.Perform(EM_CANUNDO,0,0)<>0);
  ItemRedo.Enabled:=(RichEdit1.Perform(EM_CANREDO,0,0)<>0);
  ItemCut.Enabled:=(RichEdit1.Perform(EM_SELECTIONTYPE,0,0)<>0);
  ItemCopy.Enabled:=ItemCut.Enabled;
  ItemPaste.Enabled:=(RichEdit1.Perform(EM_CANPASTE,0,0)<>0);
  ItemAutoWarp.Checked:=RichEdit1.WordWrap;
  ItemUndo1.Enabled:=(RichEdit1.Perform(EM_CANUNDO,0,0)<>0);
  ItemRedo1.Enabled:=(RichEdit1.Perform(EM_CANREDO,0,0)<>0);
  ItemCut1.Enabled:=(RichEdit1.Perform(EM_SELECTIONTYPE,0,0)<>0);
  ItemCopy1.Enabled:=ItemCut.Enabled;
  ItemPaste1.Enabled:=(RichEdit1.Perform(EM_CANPASTE,0,0)<>0);
  ItemAutoWarp1.Checked:=RichEdit1.WordWrap;
end;

procedure TFormMain.ItemUndoClick(Sender: TObject);
begin
  RichEdit1.Perform(EM_UNDO,0,0);
end;

procedure TFormMain.ItemRedoClick(Sender: TObject);
begin
  RichEdit1.Perform(EM_REDO,0,0);
end;

procedure TFormMain.ItemCutClick(Sender: TObject);
begin
  RichEdit1.Perform(WM_CUT,0,0);
end;

procedure TFormMain.ItemCopyClick(Sender: TObject);
begin
  RichEdit1.Perform(WM_COPY,0,0);
end;

procedure TFormMain.ItemPasteClick(Sender: TObject);
begin
  RichEdit1.Perform(WM_Paste,0,0);
end;

procedure TFormMain.ItemDeleteClick(Sender: TObject);
begin
  RichEdit1.Perform(WM_CLEAR,0,0);
end;

procedure TFormMain.ItemSelectAllClick(Sender: TObject);
begin
  RichEdit1.SelectAll;
end;

procedure TFormMain.ItemFindTextClick(Sender: TObject);
Var P:TPoint;
begin
  P:=Point(0,0);
  P:=RichEdit1.ClientToScreen(P);
  FindDialog1.Position := P;
  FindDialog1.Execute;
end;

procedure TFormMain.FindDialog1Find(Sender: TObject);
var
  FoundAt: LongInt;
  StartPos, ToEnd: Integer;
  st:TSearchTypes;
begin
  with RichEdit1 do
  begin
    { begin the search after the current selection if there is one }
    { otherwise, begin at the start of the text }
    StartPos := SelStart + SelLength;
    { ToEnd is the length from StartPos to the end of the text in the rich edit control }
    ToEnd := Length(RichEdit1.Text) - StartPos;
    st:=[];
    if frMatchCase in FindDialog1.Options then
      st:=st+[stMatchCase];
    if frWholeWord in FindDialog1.Options then
      st:=st+[stWholeWord];
    FoundAt := FindText(FindDialog1.FindText, StartPos, ToEnd, st);
    if FoundAt <> -1 then
    begin
      SelStart := FoundAt;
      SelLength := Length(FindDialog1.FindText);
    end else
      ShowMessage('查找完成！')
  end;
end;

procedure TFormMain.ItemAutoWarp1Click(Sender: TObject);
begin
  RichEdit1.WordWrap:=not RichEdit1.WordWrap;
  ItemAutoWarp1.Checked:=RichEdit1.WordWrap;
  ItemAutoWarp.Checked:=RichEdit1.WordWrap;
end;

Function TFormMain.MyOpenFile(FileName:String):Boolean;
begin
  Result:=False;
  if CheckHasModified then
  begin
    try
      RichEdit1.Lines.LoadFromFile(FileName);
      RichEdit1.Modified:=False;
      sFileName:=FileName;
      Result:=True;
    except
      on E:Exception do
        ShowMessage(E.Message);
    end;
  end;
end;

procedure TFormMain.ItemFindAndReplaceClick(Sender: TObject);
Var P:TPoint;
begin
  P:=Point(0,0);
  P:=RichEdit1.ClientToScreen(P);

end;

procedure TFormMain.ReplaceDialog1Replace(Sender: TObject);
var
  FoundAt: LongInt;
  StartPos, ToEnd: Integer;
  st:TSearchTypes;
begin
  with RichEdit1 do
  begin
    { begin the search after the current selection if there is one }
    { otherwise, begin at the start of the text }
    StartPos := SelStart + SelLength;
    { ToEnd is the length from StartPos to the end of the text in the rich edit control }
    ToEnd := Length(RichEdit1.Text) - StartPos;
    st:=[];



    While FoundAt <> -1 do
    begin
      SelStart := FoundAt;


      SelStart := FoundAt;



      StartPos:=SelStart;
      ToEnd := Length(RichEdit1.Text) - StartPos;

    end;

    if FoundAt=-1 then
      ShowMessage('替换完成！');
  end;
end;

procedure TFormMain.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
  CanClose:=not RichEdit1.Modified;
  if not CanClose then
  begin
    Case Application.MessageBox('文件没有保存！需要保存吗？','提示',MB_YESNOCANCEL+MB_ICONQUESTION) of
      IDYES:CanClose:=SaveFile;
      IDNo:CanClose:=True;
    end;
  end;
end;







procedure TFormMain.MenuFileClick(Sender: TObject);
begin
ItemSave.Enabled:=RichEdit1.Modified;
end;



procedure TFormMain.FormCreate(Sender: TObject);
var
 mask: Word;
begin
 mask := SendMessage(RichEdit1.Handle, EM_GETEVENTMASK, 0, 0);
 SendMessage(RichEdit1.Handle, EM_SETEVENTMASK, 0, mask or ENM_LINK);
 SendMessage(RichEdit1.Handle, EM_AUTOURLDETECT, Integer(True), 0);
end;

procedure TFormMain.WndProc(var Message: TMessage);
var
 p: TENLink;
 strURL: string;
begin
 if (Message.Msg = WM_NOTIFY) then
 begin
   if (PNMHDR(Message.LParam).code = EN_LINK) then
   begin
     p := TENLink(Pointer(TWMNotify(Message).NMHdr)^);
     if (p.msg = WM_LBUTTONDOWN) then
     begin
       SendMessage(RichEdit1.Handle, EM_EXSETSEL, 0, LongInt(@(p.chrg)));
       strURL := RichEdit1.SelText;
       ShellExecute(Handle, 'open', PChar(strURL), 0, 0, SW_SHOWNORMAL);
     end
   end
 end;
 inherited;
end;


procedure TFormMain.N12Click(Sender: TObject);
begin
AboutBox.show;
end;

end.