napad.pas

Delphi 7基础编程的源代码

unit Napad;

interface

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

type
  TMainForm = class(TForm)
    RichEdit1: TRichEdit;
    OpenDialog1: TOpenDialog;
    SaveDialog1: TSaveDialog;
    MainMenu1: TMainMenu;
    StatusBar1: TStatusBar;
    ToolBar1: TToolBar;
    m1: TMenuItem;
    m11: TMenuItem;
    m12: TMenuItem;
    m14: TMenuItem;
    m15: TMenuItem;
    m16: TMenuItem;
    ImageList1: TImageList;
    TBCut: TToolButton;
    TBPaste: TToolButton;
    TBUndo: TToolButton;
    TBCopy: TToolButton;
    ToolButton5: TToolButton;
    ColorBox1: TColorBox;
    FindDialog1: TFindDialog;
    ReplaceDialog1: TReplaceDialog;
    ComboBox1: TComboBox;
    ToolButton6: TToolButton;
    TBbold: TToolButton;
    TBI: TToolButton;
    TBsize: TToolButton;
    ToolButton4: TToolButton;
    PopupSize: TPopupMenu;
    Mlarge: TMenuItem;
    Pmid: TMenuItem;
    Psmall: TMenuItem;
    PMenu: TPopupMenu;
    PFind: TMenuItem;
    PReplace: TMenuItem;
    procedure FormCreate(Sender: TObject);
    procedure m12Click(Sender: TObject);
    procedure m16Click(Sender: TObject);
    procedure m14Click(Sender: TObject);
    procedure m11Click(Sender: TObject);
    procedure FormResize(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure ColorBox1Change(Sender: TObject);
    procedure ComboBox1Click(Sender: TObject);
    procedure TBCutClick(Sender: TObject);
    procedure RichEdit1SelectionChange(Sender: TObject);
    procedure TBPasteClick(Sender: TObject);
    procedure TBUndoClick(Sender: TObject);
    procedure RichEdit1Change(Sender: TObject);
    procedure TBboldClick(Sender: TObject);
    procedure TBIClick(Sender: TObject);
    procedure MlargeClick(Sender: TObject);
    procedure PmidClick(Sender: TObject);
    procedure PsmallClick(Sender: TObject);
    procedure PFindClick(Sender: TObject);
    procedure FindDialog1Find(Sender: TObject);
    procedure PReplaceClick(Sender: TObject);
    procedure ReplaceDialog1Replace(Sender: TObject);
    procedure ReplaceDialog1Find(Sender: TObject);
    procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure TBsizeMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure ColorBox1Click(Sender: TObject);
    procedure TBCutMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure TBPasteMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure TBCopyMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure TBUndoMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure TBboldMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure TBIMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure ToolBar1MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure StatusBar1MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  MainForm: TMainForm;

implementation

{$R *.dfm}
 //初始化设置
procedure TMainForm.FormCreate(Sender: TObject);
begin
  MainForm.Caption:='VCL综合应用示例';
  TBCut.Enabled:=false;
  TBUndo.Enabled:=false;
  TBCopy.Enabled:=false;
  Combobox1.Items := Screen.Fonts;
  Combobox1.ItemIndex := Combobox1.Items.IndexOf ( RichEdit1.Font.Name);
  richedit1.Clear;
  richedit1.ScrollBars:=ssBoth; //允许编辑控件有水平和垂直滚动条
  Richedit1.Font.Size:=26;
  richedit1.HideSelection:=false;//焦点移走后还保持选择。
  opendialog1.Filter:='Text  files (*.txt)|*.TXT';
  savedialog1.Filter:='Text  files (*.txt)|*.TXT';
     //设置两个对话框的过滤器
  tbcut.Hint:='剪切';
  tbcopy.Hint:='拷贝';
  tbundo.Hint:='撤销';
  tbpaste.Hint:='粘贴';
  m1.Hint:='文件';
  m11.Hint:='新建一个文件';
  m12.Hint:='打开一个文件';
  m14.Hint:='保存文件';
  m15.Hint:='退出编辑器';
  colorbox1.Hint:='设置字体颜色';
  combobox1.Hint:='设置字体风格';
  richedit1.ShowHint:=false;
  richedit1.Hint:='编辑框';
  statusbar1.SimplePanel:=false;
  statusbar1.Hint:='状态栏';
  tbbold.Hint:='设置字为粗体';
  tbi.hint:='设置字为斜体';
  tbsize.Hint:='设置字体大小';
end;

procedure TMainForm.m12Click(Sender: TObject);
var
filename:String;
begin
    if(True=opendialog1.Execute())then
    begin       //打开指定文件
       filename:=opendialog1.FileName;
       richedit1.Lines.LoadFromFile(filename);
    end;
end;

procedure TMainForm.m16Click(Sender: TObject);
begin
    close; //退出系统
end;

procedure TMainForm.m14Click(Sender: TObject);
var
filename:String;
begin
    if(True=savedialog1.Execute())then
      begin    //将编辑框中的内容保存为文件
         filename:=savedialog1.FileName;
         richedit1.Lines.SaveToFile(filename);
      end;
   end;
procedure TMainForm.m11Click(Sender: TObject);
begin   //新建文件时根据编辑内容是否变化而给出提示
  if(True=richedit1.Modified) then
    case MessageDlg (
    '文件'  + ' 已经改变' +
    #13#13 + '要保存改变么',
    mtConfirmation, mbYesNoCancel, 0) of
  idYes:
   begin
     m14.Click   ;
     richedit1.clear;
     end;
  idNo:
     richedit1.Clear;
  else
     ;
  end;
end;

procedure TMainForm.FormResize(Sender: TObject);
begin  //调整窗口尺寸时对richedit控件进行相应调整。
  richedit1.Top:=ToolBar1.Height;
  richedit1.Left:=5;
  richedit1.Width:=Mainform.ClientWidth-10;
  richedit1.Height:=MainForm.ClientHeight-
  ToolBar1.Height-statusbar1.Height;
  statusbar1.Panels[0].Width:=Mainform.ClientWidth div 2;
end;

procedure TMainForm.FormClose(Sender: TObject; var Action: TCloseAction);
begin  //关闭文件时提示是否保存
 if(True=richedit1.Modified) then
    case MessageDlg (
    '文件'  + ' 已经改变' +
    #13#13 + '要保存改变么',
    mtConfirmation, mbYesNoCancel, 0) of
  idYes:
   begin
     m14.Click   ;
   end;
  idNo:
  else
    abort ;  //按取消则不关闭
  end;
end;

procedure TMainForm.ColorBox1Change(Sender: TObject);
begin     //设置字体颜色
  richedit1.SelAttributes.Color:=colorbox1.Selected;
end;

procedure TMainForm.ComboBox1Click(Sender: TObject);
begin //设置字体风格
   RichEdit1.SelAttributes.Name := Combobox1.Text;
   statusbar1.Panels[0].Text:=combobox1.hint;
end;

procedure TMainForm.TBCutClick(Sender: TObject);
begin  //剪切所选文本
   richedit1.CutToClipboard;
   TBCut.Enabled:=false;
end;

procedure TMainForm.RichEdit1SelectionChange(Sender: TObject);
var
line,column:integer;
begin      //当编辑器中光标移动时，设置状态栏的变化。
     statusbar1.Panels[0].Text:=richedit1.hint;
     if (richedit1.Focused=True) then
     begin
         line:=RichEdit1.CaretPos.Y + 1;
         column:=RichEdit1.CaretPos.X + 1;
          statusbar1.Panels[1].Text:='行：'+inttostr(line)+' '
            +'列：'+inttostr(column);
     end;
   if richedit1.SelLength>0 then
   begin     //如果选中了文本，则工具栏按钮变化
        TBcut.Enabled:=True;
        TBcopy.Enabled:=True;
   end
   else
   begin
        TBcut.Enabled:=false;
        TBCopy.Enabled:=False;
   end;
end;

procedure TMainForm.TBPasteClick(Sender: TObject);
begin   //粘贴文本
   richedit1.PasteFromClipboard;
end;

procedure TMainForm.TBUndoClick(Sender: TObject);
begin      //取消文本
    richedit1.Undo;
end;

procedure TMainForm.RichEdit1Change(Sender: TObject);
begin
  TBUndo.Enabled:=true;
end;

procedure TMainForm.TBboldClick(Sender: TObject);
begin      //通过工具栏按钮设置字体粗细
    with RichEdit1.SelAttributes do
    if fsBold in Style then
      Style := Style - [fsBold]
    else
    begin
      Style := Style + [fsBold];
       TBbold.Down:=true;
    end;
end;

procedure TMainForm.TBIClick(Sender: TObject);
begin  //设置字体是否为斜体
   with RichEdit1.SelAttributes do
   if fsItalic in Style then
      Style := Style - [fsItalic]
    else
    begin
      Style := Style + [fsItalic];
       TBI.Down:=true; //设置按钮为下压。
    end;
end;

procedure TMainForm.MlargeClick(Sender: TObject);
begin   //设置大字体
   richedit1.SelAttributes.Size:=36;
end;

procedure TMainForm.PmidClick(Sender: TObject);
begin        //设置中号字体
    richedit1.SelAttributes.Size:=26;
end;

procedure TMainForm.PsmallClick(Sender: TObject);
begin        //设置小号字体
        richedit1.SelAttributes.Size:=16;
end;

procedure TMainForm.PFindClick(Sender: TObject);
begin      //代开”查找“对话框
   finddialog1.Execute();
end;

//执行查找操作
procedure TMainForm.FindDialog1Find(Sender: TObject);
var
  FoundAt: LongInt;
  StartPos, ToEnd: Integer;
begin
  with RichEdit1 do
  begin
     //得到当前光标的位置
    if SelLength <> 0 then
      StartPos := SelStart + SelLength
    else
      StartPos := richedit1.SelStart;
      ToEnd := Length(Text) - StartPos;
      //找到对应文本，并返回位置
      FoundAt := FindText(FindDialog1.FindText, StartPos, ToEnd, [stMatchCase]);
    if FoundAt <> -1 then
    begin
      SetFocus;
      SelStart := FoundAt;
      SelLength := Length(FindDialog1.FindText);
    end //如果未找到则给出提示
    else MessageDlg(Concat('在编辑器中不能找到 "', replacedialog1.FindText,'"'), mtError, [mbOk], 0);
  end;
end;

procedure TMainForm.PReplaceClick(Sender: TObject);
begin       //打开”替换为 “对话框
    replacedialog1.Execute;
end;

procedure TMainForm.ReplaceDialog1Replace(Sender: TObject);
var
  SelPos: Integer;
begin
  with TReplaceDialog(Sender) do
  begin    //找到位置
    SelPos := Pos(FindText, richedit1.Lines.Text);
    if SelPos > 0 then
    begin       //执行替换操作
      richedit1.SelStart := SelPos - 1;
      richedit1.SelLength := Length(FindText);
      richedit1.SelText := ReplaceText;
    end          //如失败，给出提示
   else MessageDlg(Concat('在编辑器中不能找到 "', replacedialog1.FindText,'"'), mtError, [mbOk], 0);
  end;
end;

procedure TMainForm.ReplaceDialog1Find(Sender: TObject);
var
  FoundAt: LongInt;
  StartPos, ToEnd: Integer;
begin
  //执行”替换“对话框中的查找操作
  with RichEdit1 do
  begin
    if SelLength <> 0 then
      StartPos := SelStart + SelLength
    else
      StartPos := richedit1.SelStart;
    ToEnd := Length(Text) - StartPos;
    FoundAt := FindText(replacedialog1.FindText, StartPos, ToEnd, [stMatchCase]);
    if FoundAt <> -1 then
    begin
      SetFocus;
      SelStart := FoundAt;
      SelLength := Length(replaceDialog1.FindText);
    end
     else MessageDlg(Concat('在编辑器中不能找到 "', replacedialog1.FindText,'"'), mtError, [mbOk], 0);
  end;
end;

//下面为状态栏的设置
procedure TMainForm.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
    statusbar1.Panels[0].text:='';
end;

procedure TMainForm.TBsizeMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);

begin
    statusbar1.Panels[0].Text:=TBsize.hint;
end;

procedure TMainForm.ColorBox1Click(Sender: TObject);
begin
    statusbar1.Panels[0].Text:=colorbox1.hint+colorbox1.SelText;
end;

procedure TMainForm.TBCutMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
   statusbar1.Panels[0].Text:=Tbcut.hint+'所选文本';
end;

procedure TMainForm.TBPasteMouseMove(Sender: TObject; Shift: TShiftState;
  X, Y: Integer);
begin
    statusbar1.Panels[0].Text:=TBpaste.hint+'到光标处';
end;

procedure TMainForm.TBCopyMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
    statusbar1.Panels[0].Text:=TBcopy.hint+'所选文本';
end;

procedure TMainForm.TBUndoMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
       statusbar1.Panels[0].Text:=TBundo.hint+'刚才的操作';
end;

procedure TMainForm.TBboldMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  statusbar1.Panels[0].Text:=TBbold.hint;
end;

procedure TMainForm.TBIMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
    statusbar1.Panels[0].Text:=TBi.hint;
end;

procedure TMainForm.ToolBar1MouseMove(Sender: TObject; Shift: TShiftState;
  X, Y: Integer);
begin
      statusbar1.Panels[0].Text:=' ';
end;

procedure TMainForm.StatusBar1MouseMove(Sender: TObject;
  Shift: TShiftState; X, Y: Integer);
begin
  statusbar1.Panels[0].Text:=statusbar1.hint;
end;
end.