做人不可以懒成这样的。。。

这里有个记事本的小例子.源码如下:

unit EditFM;

interface

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

type
TEditForm = class(TForm)
MainMenu1: TMainMenu;
MIFile: TMenuItem;
MIEdit: TMenuItem;
MICharacter: TMenuItem;
MIHelp: TMenuItem;
MINew: TMenuItem;
MIOpen: TMenuItem;
MISave: TMenuItem;
MISaveAs: TMenuItem;
MIPrint: TMenuItem;
MIPrinterSetup: TMenuItem;
U1: TMenuItem;
R1: TMenuItem;
N3: TMenuItem;
T1: TMenuItem;
C2: TMenuItem;
P2: TMenuItem;
D1: TMenuItem;
N4: TMenuItem;
N5: TMenuItem;
F1: TMenuItem;
L1: TMenuItem;
MILeft: TMenuItem;
MICenter: TMenuItem;
MIRight: TMenuItem;
N6: TMenuItem;
W1: TMenuItem;
F2: TMenuItem;
N7: TMenuItem;
N8: TMenuItem;
Editor: TRichEdit;
PopupMenu1: TPopupMenu;
U2: TMenuItem;
R3: TMenuItem;
N9: TMenuItem;
T2: TMenuItem;
C4: TMenuItem;
P3: TMenuItem;
D2: TMenuItem;
A2: TMenuItem;
N10: TMenuItem;
F3: TMenuItem;
L3: TMenuItem;
DgOpen: TOpenDialog;
DgPrint: TPrintDialog;
DgPrinterSetup: TPrinterSetupDialog;
DgFont: TFontDialog;
DgFind: TFindDialog;
DgReplace: TReplaceDialog;
N2: TMenuItem;
MIExit: TMenuItem;
DgSave: TSaveDialog;
ToolBar: TToolBar;
ImageList1: TImageList;
ToolButton1: TToolButton;
ToolButton2: TToolButton;
ToolButton3: TToolButton;
ToolButton4: TToolButton;
ToolButton5: TToolButton;
ToolButton6: TToolButton;
StatusBar: TStatusBar;
procedure MIExitClick(Sender: TObject);
procedure MINewClick(Sender: TObject);
procedure MISaveAsClick(Sender: TObject);
procedure MISaveClick(Sender: TObject);
procedure F2Click(Sender: TObject);
procedure MIPrintClick(Sender: TObject);
procedure F1Click(Sender: TObject);
procedure L1Click(Sender: TObject);
procedure MIOpenClick(Sender: TObject);
procedure MIPrinterSetupClick(Sender: TObject);
procedure T1Click(Sender: TObject);
procedure C2Click(Sender: TObject);
procedure P2Click(Sender: TObject);
procedure D1Click(Sender: TObject);
procedure N4Click(Sender: TObject);
procedure U1Click(Sender: TObject);
procedure R1Click(Sender: TObject);
procedure DgFindFind(Sender: TObject);
procedure DgReplaceReplace(Sender: TObject);
procedure W1Click(Sender: TObject);
procedure MILeftClick(Sender: TObject);
procedure MICenterClick(Sender: TObject);
procedure MIRightClick(Sender: TObject);
procedure N8Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure EditorChange(Sender: TObject);
private
{ Private declarations }
PathName: string;
HasUndo:Boolean;
public
{ Public declarations }
procedure CheckTextModified;
end;

var
EditForm: TEditForm;

const
DefaultFileName = '无标题';

implementation

{$R *.dfm}

procedure TEditForm.CheckTextModified;
begin
if Editor.Modified then //修改过
begin
case Application.MessageBox('文件没有保存！要保存吗？',
'提示',MB_YESNO+MB_ICONQUESTION) of
IDYES: //保存文件
MISaveClick(Self); //保存文件
end;
end;
end;

procedure TEditForm.MIExitClick(Sender: TObject);
begin
Close;
end;

procedure TEditForm.MINewClick(Sender: TObject);
begin
CheckTextModified; //检测是否做了修改
Editor.Lines.Clear; //清除所有文本
Editor.Modified:=False; //把Modified属性设为False
PathName:=DefaultFileName;
Self.Caption:=DefaultFileName; //把窗口标题设为'无标题'
end;

procedure TEditForm.MISaveAsClick(Sender: TObject);
begin
DgSave.FileName := DefaultFileName;
if DgSave.Execute then
begin
PathName := DgSave.FileName; //获取路径名
if DgSave.FilterIndex=1 then //txt文件
begin
Editor.PlainText:=True;
PathName:=PathName+'.txt';
end;
if DgSave.FilterIndex=2 then //rtf文件
begin
Editor.PlainText:=False;
PathName:=PathName+'.rtf';
end;
if DgSave.FilterIndex=3 then //所有文件
begin
Editor.PlainText:=False;
end;
Editor.Lines.SaveToFile(PathName); //保存文件
Editor.Modified := False; //设置Editor为未改变
Caption := ExtractFileName(PathName); //取出文件名，设为窗口标题
StatusBar.Panels[1].Text:='';
end;
end;

procedure TEditForm.MISaveClick(Sender: TObject);
begin
if PathName = DefaultFileName then //第一次保存
MISaveAsClick(Sender)
else
begin
Editor.Lines.SaveToFile(PathName); //已经保存过
Editor.Modified := False;
StatusBar.Panels[1].Text:='';
end;
end;

procedure TEditForm.F2Click(Sender: TObject);
begin
DgFont.Font.Assign(Editor.Font); //DgFont的初始字体设成Editor的字体
if DgFont.Execute then
Editor.SelAttributes.Assign(DgFont.Font);
end;

procedure TEditForm.MIPrintClick(Sender: TObject);
begin
if DgPrint.Execute then
Editor.Print(PathName);
end;

procedure TEditForm.F1Click(Sender: TObject);
begin
DgFind.Execute;
end;

procedure TEditForm.L1Click(Sender: TObject);
begin
DgReplace.Execute;
end;

procedure TEditForm.MIOpenClick(Sender: TObject);
begin
DgOpen.Execute;
end;

procedure TEditForm.MIPrinterSetupClick(Sender: TObject);
begin
DgPrinterSetup.Execute;
end;

procedure TEditForm.T1Click(Sender: TObject);
begin
Editor.CutToClipboard;
end;

procedure TEditForm.C2Click(Sender: TObject);
begin
Editor.CopyToClipboard;
end;

procedure TEditForm.P2Click(Sender: TObject);
begin
Editor.PasteFromClipboard;
end;

procedure TEditForm.D1Click(Sender: TObject);
begin
Editor.ClearSelection;
end;

procedure TEditForm.N4Click(Sender: TObject);
begin
Editor.SelectAll;
end;

procedure TEditForm.U1Click(Sender: TObject);
begin
if not HasUndo then
begin
Editor.Undo;
HasUndo:=True;
end;
end;

procedure TEditForm.R1Click(Sender: TObject);
begin
if HasUndo then
begin
Editor.Undo;
HasUndo:=False;
end;
end;

procedure TEditForm.DgFindFind(Sender: TObject);
var
FoundPos,StartPos,FindLen:integer;
st:TSearchTypes;
begin
if not (frDown in DgFind.Options) then
begin
DgFind.CloseDialog;
ShowMessage('对不起，目前只能处理向下查找。');
exit;
end;
StartPos:=Editor.SelStart+Editor.SelLength; //StartPos代表初始查找位置
FindLen:=Length(Editor.Text)-StartPos; //FindLen代表从StartPos开始到文件末尾的长度
st:=[];
if frMatchCase in DgFind.Options then //匹配大小写
st:=st+[stMatchCase];
if frWholeWord in DgFind.Options then //匹配整个词
st:=st+[stWholeWord];
FoundPos:=Editor.FindText(DgFind.FindText,StartPos,FindLen,st); //开始查找
DgFind.CloseDialog;
if FoundPos <> -1 then //找到
begin
Editor.SelStart:=FoundPos;
Editor.SelLength:=Length(DgFind.FindText);
end
else //未找到
ShowMessage('未找到 '+DgFind.FindText);
end;

procedure TEditForm.DgReplaceReplace(Sender: TObject);
var
FoundPos,StartPos,FindLen:integer;
st:TSearchTypes;
begin
if not (frDown in DgReplace.Options) then
begin
DgReplace.CloseDialog;
ShowMessage('对不起，目前只能处理向下替换。');
exit;
end;
StartPos:=Editor.SelStart+Editor.SelLength; //StartPos代表初始查找位置
FindLen:=Length(Editor.Text)-StartPos; //FindLen代表从StartPos开始到文件末尾的长度
st:=[];
if frMatchCase in DgReplace.Options then //匹配大小写
st:=st+[stMatchCase];
if frWholeWord in DgReplace.Options then //匹配整个词
st:=st+[stWholeWord];
FoundPos:=Editor.FindText(DgReplace.FindText,StartPos,FindLen,st); //开始查找
DgReplace.CloseDialog; //关闭替换对话框
if FoundPos <> -1 then //找到
begin
while FoundPos <> -1 do
begin
Editor.SelStart:=FoundPos;
Editor.SelLength:=Length(DgReplace.FindText);
Editor.SelText:=DgReplace.ReplaceText; //把文本替换掉

if not (frReplaceAll in DgReplace.Options) then //如果不是全部替换
break;

StartPos:=Editor.SelStart+Length(DgReplace.ReplaceText);
FindLen:=Length(Editor.Text)-StartPos; //FindLen代表从StartPos开始到文件末尾的长度
FoundPos:=Editor.FindText(DgReplace.FindText,
StartPos,FindLen,st); //继续查找
end;
ShowMessage('替换完毕！');
end
else //未找到
ShowMessage('未找到 '+DgReplace.FindText);

end;

procedure TEditForm.W1Click(Sender: TObject);
begin
with Editor do
begin
WordWrap := not WordWrap; //让WordWrap取反
if WordWrap then //自动换行
ScrollBars := ssVertical //Editor只有竖直滚动条
else
ScrollBars := ssBoth;
W1.Checked := WordWrap; //设置自动换行菜单项左边的对勾
end;
end;

procedure TEditForm.MILeftClick(Sender: TObject);
begin
MILeft.Checked := True;
MICenter.Checked := False;
MIRight.Checked := False;
Editor.Paragraph.Alignment := taLeftJustify;
end;

procedure TEditForm.MICenterClick(Sender: TObject);
begin
MILeft.Checked := False;
MICenter.Checked := True;
MIRight.Checked := False;
Editor.Paragraph.Alignment := taCenter; //居中
end;

procedure TEditForm.MIRightClick(Sender: TObject);
begin
MILeft.Checked := False;
MICenter.Checked := False;
MIRight.Checked := True;
Editor.Paragraph.Alignment := taRightJustify ;//居右
end;

procedure TEditForm.N8Click(Sender: TObject);
begin
AboutForm.ShowModal;
end;

procedure TEditForm.FormCreate(Sender: TObject);
begin
PathName := DefaultFileName;
HasUndo:=False;
end;

procedure TEditForm.FormClose(Sender: TObject; var Action: TCloseAction);
begin
CheckTextModified;
end;

procedure TEditForm.EditorChange(Sender: TObject);
begin
if Editor.Modified then
StatusBar.Panels[1].Text:='已修改'
else
StatusBar.Panels[1].Text:='';
end;

end.

-----------------------------------------------------------------------------------------------------------