unit1.pas

delphi课程设计的内容,包括源代码,文本的设计,菜单的设计等.

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ComCtrls, Menus, ActnList,clipbrd, ImgList, ToolWin, ExtCtrls;

type
  TForm1 = class(TForm)
    MainMenu1: TMainMenu;
    F1: TMenuItem;
    N1: TMenuItem;
    O1: TMenuItem;
    S1: TMenuItem;
    A1: TMenuItem;
    N2: TMenuItem;
    X1: TMenuItem;
    E1: TMenuItem;
    T1: TMenuItem;
    C1: TMenuItem;
    P1: TMenuItem;
    N3: TMenuItem;
    F2: TMenuItem;
    R1: TMenuItem;
    S2: TMenuItem;
    F3: TMenuItem;
    N4: TMenuItem;
    N5: TMenuItem;
    h1: TMenuItem;
    A2: TMenuItem;
    richedit1: TRichEdit;
    ActionList1: TActionList;
    OpenDialog1: TOpenDialog;
    SaveDialog1: TSaveDialog;
    FontDialog1: TFontDialog;
    ColorDialog1: TColorDialog;
    FindDialog1: TFindDialog;
    ReplaceDialog1: TReplaceDialog;
    N6: TMenuItem;
    Action_Cut: TAction;
    Action_Copy: TAction;
    Action_Paste: TAction;
    Action_Find: TAction;
    Action_Replace: TAction;
    Action_filenew: TAction;
    ToolBar1: TToolBar;
    ToolButton1: TToolButton;
    ToolButton2: TToolButton;
    ToolButton3: TToolButton;
    ToolButton4: TToolButton;
    ToolButton5: TToolButton;
    ToolButton6: TToolButton;
    ToolButton7: TToolButton;
    ToolButton8: TToolButton;
    ToolButton9: TToolButton;
    ToolButton10: TToolButton;
    ToolButton11: TToolButton;
    ImageList1: TImageList;
    StatusBar1: TStatusBar;
    Timer1: TTimer;
    N7: TMenuItem;
    procedure F3Click(Sender: TObject);
    procedure O1Click(Sender: TObject);
    procedure N6Click(Sender: TObject);
    procedure A2Click(Sender: TObject);
    procedure S1Click(Sender: TObject);
    procedure A1Click(Sender: TObject);
    procedure X1Click(Sender: TObject);
    procedure Action_CutExecute(Sender: TObject);
    procedure Action_PasteExecute(Sender: TObject);
    procedure Action_CopyExecute(Sender: TObject);
    procedure Action_FindExecute(Sender: TObject);
    procedure FindDialog1Find(Sender: TObject);
    procedure Action_FindUpdate(Sender: TObject);
    procedure Action_ReplaceExecute(Sender: TObject);
    procedure ReplaceDialog1Find(Sender: TObject);
    procedure ReplaceDialog1Replace(Sender: TObject);
    procedure N5Click(Sender: TObject);
    procedure ToolButton2Click(Sender: TObject);
    procedure ToolButton3Click(Sender: TObject);
    procedure ToolButton4Click(Sender: TObject);
    procedure ToolButton5Click(Sender: TObject);
    procedure ToolButton6Click(Sender: TObject);
    procedure ToolButton9Click(Sender: TObject);
    procedure ToolButton10Click(Sender: TObject);
    procedure ToolButton11Click(Sender: TObject);
    procedure ToolButton1Click(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure richedit1Change(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure N1Click(Sender: TObject);
    procedure N7Click(Sender: TObject);
    

  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

uses Unit2;



{$R *.DFM}

procedure TForm1.F3Click(Sender: TObject);
begin
    if fontdialog1.Execute then
       richedit1.SelAttributes.name:=fontdialog1.font.name;
       richedit1.SelAttributes.size:=fontdialog1.font.size;
       richedit1.SelAttributes.color:=fontdialog1.font.color;
       richedit1.SelAttributes.style:=fontdialog1.font.style;
end;

procedure TForm1.O1Click(Sender: TObject);
begin
    with opendialog1 do
    begin
    defaultext:='txt';//设置默认的扩展名
    title:='打开文件';//设置对话框标题
    initialdir:='c:\';//设置默认路径
    //设置过滤条件
    filter:='(*.rtf)|*.rtf|文本文件(*.txt)|*.txt';
     if (execute) then
     richedit1.Lines.LoadFromFile(opendialog1.filename);

    end;
     
end;

procedure TForm1.N6Click(Sender: TObject);
begin
    if colordialog1.Execute then
       richedit1.Color:=colordialog1.Color;
end;

procedure TForm1.A2Click(Sender: TObject);
begin
    form2.show;
end;

procedure TForm1.S1Click(Sender: TObject);
begin
    with savedialog1 do
    begin
    defaultext:='rtf';
    title:='保存'+form1.Caption;
    initialdir:='我的文档';
    filter:='(*.rtf)|*.rtf|文本文件(*.txt)*.txt';
    if (Execute) then
    richedit1.lines.SaveToFile(savedialog1.filename);
    end;
end;

procedure TForm1.A1Click(Sender: TObject);
begin
   with savedialog1 do
   begin
     defaultext:='rtf';
     title:='保存'+form1.caption;
     initialdir:='d:\';
     filter:='(*.rtf)|*.rtf|文本文件(*.txt)*.txt';
     if (execute) then
     richedit1.Lines.SaveToFile(filename);
   end;
end;

procedure TForm1.X1Click(Sender: TObject);
begin
   close;
end;

procedure TForm1.Action_CutExecute(Sender: TObject);
begin
    richedit1.CutToClipboard ;
end;

procedure TForm1.Action_PasteExecute(Sender: TObject);
begin
    richedit1.PasteFromClipboard ;
end;

procedure TForm1.Action_CopyExecute(Sender: TObject);
begin
    richedit1.CopyToClipboard ;
end;

procedure TForm1.Action_FindExecute(Sender: TObject);
begin
   finddialog1.findtext:=richedit1.SelText ;
   finddialog1.options:=[frDown,frDisableMatchCase,frdisableUpDown,
   frdisableWholeWord]; finddialog1.Execute ;




end;

procedure TForm1.FindDialog1Find(Sender: TObject);
var
lFountAt:integer;
lStartPos,lFindLength:integer;


begin
with  form1.RichEdit1 do
begin
  if SelLength<>0 then
  lstartPos:=SelStart+SelLength
  else
   lStartPos:=0;
   lFindLength:=Length(Text)-lStartPos;
   lFountAt:=findText(FindDialog1.FindText,lStartPos,lFindLength,[stMatchCase]);
  if lFountAt<>-1 then
  begin
   setfocus;
   SelStart:=lFountAt;
   SelLength:=Length(finddialog1.findtext);
  end
  else   showmessage('搜索完毕！');
end;
end;

procedure TForm1.Action_FindUpdate(Sender: TObject);
begin
    (sender as TAction).enabled:=(richedit1<>nil);
end;

procedure TForm1.Action_ReplaceExecute(Sender: TObject);
begin
   replacedialog1.findtext:=richedit1.SelText ;
   replacedialog1.options:=[frDown,frDisableMatchCase,frdisableUpDown,
   frdisableWholeWord]; replacedialog1.Execute ;
end;

procedure TForm1.ReplaceDialog1Find(Sender: TObject);
 var
lFountAt:integer;
lStartPos,lFindLength:integer;


begin
with  form1.RichEdit1 do
begin
  if SelLength<>0 then
  lstartPos:=SelStart+SelLength
  else
   lStartPos:=0;
   lFindLength:=Length(Text)-lStartPos;
   lFountAt:=findText(replaceDialog1.FindText,lStartPos,lFindLength,[stMatchCase]);
  if lFountAt<>-1 then
  begin
   setfocus;
   SelStart:=lFountAt;
   SelLength:=Length(replacedialog1.findtext);
  end
  else   showmessage('搜索完毕！');
end;

end;

procedure TForm1.ReplaceDialog1Replace(Sender: TObject);
var
lFountAt:integer;
lStartPos,lFindLength:integer;


begin
with  form1.RichEdit1 do
begin
  if SelLength<>0 then
  lstartPos:=SelStart+SelLength
  else
   lStartPos:=0;
   lFindLength:=Length(Text)-lStartPos;
   lFountAt:=findText(replaceDialog1.FindText,lStartPos,lFindLength,[stMatchCase]);
  if lFountAt<>-1 then
  begin
   setfocus;
   SelStart:=lFountAt;
   SelLength:=Length(replacedialog1.findtext);
   SelText:=Replacedialog1.ReplaceText;
  end
  else   showmessage('搜索完毕！');
  while ((frReplaceall in ReplaceDialog1.Options) and (lFountAt<>-1)) do
   begin
  if SelLength<>0 then
  lstartPos:=SelStart+SelLength
  else
   lStartPos:=0;
   lFindLength:=Length(Text)-lStartPos;
   lFountAt:=findText(replaceDialog1.FindText,lStartPos,lFindLength,[stMatchCase]);
  if lFountAt<>-1 then
  begin
   setfocus;
   SelStart:=lFountAt;
   SelLength:=Length(replacedialog1.findtext);
   SelText:=Replacedialog1.ReplaceText;
  end
  else   showmessage('完成搜索！');
end;
end;

end;


procedure TForm1.N5Click(Sender: TObject);
begin
   richedit1.SelectAll;
end;

procedure TForm1.ToolButton2Click(Sender: TObject);
begin
   with savedialog1 do
    begin
    defaultext:='rtf';
    title:='保存'+form1.Caption;
    initialdir:='我的文档';
    filter:='(*.rtf)|*.rtf|文本文件(*.txt)*.txt';
    if (Execute) then
    richedit1.lines.SaveToFile(savedialog1.filename);
    end;
end;

procedure TForm1.ToolButton3Click(Sender: TObject);
begin
     with opendialog1 do
    begin
    defaultext:='txt';//设置默认的扩展名
    title:='打开文件';//设置对话框标题
    initialdir:='c:\';//设置默认路径
    //设置过滤条件
    filter:='(*.rtf)|*.rtf|文本文件(*.txt)|*.txt';
     if (execute) then
     richedit1.Lines.LoadFromFile(opendialog1.filename);

    end;
end;

procedure TForm1.ToolButton4Click(Sender: TObject);
begin
    richedit1.PasteFromClipboard ;
end;

procedure TForm1.ToolButton5Click(Sender: TObject);
begin
    richedit1.CopyToClipboard;
end;

procedure TForm1.ToolButton6Click(Sender: TObject);
begin
   richedit1.CutToClipboard;
end;

procedure TForm1.ToolButton9Click(Sender: TObject);
begin
    if fontdialog1.Execute then
       richedit1.SelAttributes.name:=fontdialog1.font.name;
       richedit1.SelAttributes.size:=fontdialog1.font.size;
       richedit1.SelAttributes.color:=fontdialog1.font.color;
       richedit1.SelAttributes.style:=fontdialog1.font.style;
end;

procedure TForm1.ToolButton10Click(Sender: TObject);
begin
    if colordialog1.Execute then
       richedit1.Color:=colordialog1.Color;
end;

procedure TForm1.ToolButton11Click(Sender: TObject);
begin
form2.show;
end;

procedure TForm1.ToolButton1Click(Sender: TObject);
 const
   swarningtext='文档正文已修改，是否保存？';


begin
   if richedit1.Modified then
   begin
   case messagedlg(swarningtext,mtwarning,[mbYes,mbNo,mbCancel],0) of
   idYes: with savedialog1 do
   begin
     defaultext:='rtf';
     title:='保存'+form1.caption;
     initialdir:='d:\';
     filter:='(*.rtf)|*.rtf|文本文件(*.txt)*.txt';
     if (execute) then
     richedit1.Lines.SaveToFile(filename);
     richedit1.Clear;

   end;


   idNo:richedit1.Clear;

   end;
   end;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
   statusbar1.Panels[2].text:=timetostr(time);
end;

procedure TForm1.richedit1Change(Sender: TObject);
begin
     statusbar1.Panels[0].text:='Modified';
end;

procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);

const
   swarningtext='文档正文已修改，是否保存？';


begin
   
   if richedit1.Modified then
   begin
   case messagedlg(swarningtext,mtwarning,[mbYes,mbNo,mbCancel],0) of
   idYes:  with savedialog1 do
   begin
     defaultext:='rtf';
     title:='保存'+form1.caption;
     initialdir:='d:\';
     filter:='(*.rtf)|*.rtf|文本文件(*.txt)*.txt';
     if (execute) then
     richedit1.Lines.SaveToFile(filename);


   end;

   idCancel:CanClose:=False;
   end;
   end;
end;

procedure TForm1.N1Click(Sender: TObject);

const
   swarningtext='文档正文已修改，是否保存？';


begin
   if richedit1.Modified then
   begin
   case messagedlg(swarningtext,mtwarning,[mbYes,mbNo,mbCancel],0) of
   idYes: with savedialog1 do
   begin
     defaultext:='rtf';
     title:='保存'+form1.caption;
     initialdir:='d:\';
     filter:='(*.rtf)|*.rtf|文本文件(*.txt)*.txt';
     if (execute) then
     richedit1.Lines.SaveToFile(filename);
     richedit1.Clear;

   end;


   idNo:richedit1.Clear;

   end;
   end;
end;

procedure TForm1.N7Click(Sender: TObject);
begin
   richedit1.text:=timetostr(time)+'   '+datetostr(date);
end;

end.