dialogfrm.~pas

关于利用DELPHI来进行企业级方案解决的著作的附书源码

unit DialogFrm;

interface

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

type
  TForm1 = class(TForm)
    OpenDialog1: TOpenDialog;
    SaveDialog1: TSaveDialog;
    FontDialog1: TFontDialog;
    ColorDialog1: TColorDialog;
    PrintDialog1: TPrintDialog;
    FindDialog1: TFindDialog;
    ReplaceDialog1: TReplaceDialog;
    MainMenu1: TMainMenu;
    FileMenu: TMenuItem;
    FileNew: TMenuItem;
    FileOpen: TMenuItem;
    FileSave: TMenuItem;
    N2: TMenuItem;
    FilePrint: TMenuItem;
    N3: TMenuItem;
    FileQuit: TMenuItem;
    EditMenu: TMenuItem;
    EditFont: TMenuItem;
    EditColor: TMenuItem;
    N6: TMenuItem;
    EditFind: TMenuItem;
    EditReplace: TMenuItem;
    HelpMenu: TMenuItem;
    HelpAbout: TMenuItem;
    RichEdit1: TRichEdit;
    N1: TMenuItem;
    procedure FindDialog1Find(Sender: TObject);
    procedure FileOpenClick(Sender: TObject);
    procedure FileSaveClick(Sender: TObject);
    procedure FilePrintClick(Sender: TObject);
    procedure FileQuitClick(Sender: TObject);
    procedure EditFontClick(Sender: TObject);
    procedure EditColorClick(Sender: TObject);
    procedure EditFindClick(Sender: TObject);
    procedure EditReplaceClick(Sender: TObject);
    procedure FileNewClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure FontDialog1Apply(Sender: TObject; Wnd: HWND);
    procedure ReplaceDialog1Replace(Sender: TObject);
  private
    function CheckSave:Bool;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FindDialog1Find(Sender: TObject);
var
  FoundAt: LongInt;
  StartPos, ToEnd: Integer;
begin
  with RichEdit1 do
  begin
    if SelLength <> 0 then
      StartPos := SelStart + SelLength
    else
      StartPos := 0;
    ToEnd := Length(Text) - StartPos;
    FoundAt := FindText(FindDialog1.FindText, StartPos, ToEnd, [stMatchCase]);
    if FoundAt <> -1 then
    begin
      SetFocus;
      SelStart := FoundAt;
      SelLength := Length(FindDialog1.FindText);
    end;
  end;
end;


procedure TForm1.FileOpenClick(Sender: TObject);
begin
  with OpenDialog1 do
   begin
    Options := [ofHideReadOnly,ofFileMustExist];
    OptionsEx := [ofExNoPlacesBar];
    if Execute then
     if ofExtensionDifferent in Options then
       ShowMessage('打开文件类型错误!')
      else
       RichEdit1.Lines.LoadFromFile(Filename);
   end;
end;

procedure TForm1.FileSaveClick(Sender: TObject);
begin
 with SaveDialog1 do
  begin
   Options := [ofOverwritePrompt];
   OptionsEx := [ofExNoPlacesBar];
    if Execute then
     richedit1.Lines.SaveToFile(Filename);
  end;
end;

procedure TForm1.FilePrintClick(Sender: TObject);
var
  i: Integer;
begin
 if PrintDialog1.Execute then
   for i := 1 to PrintDialog1.Copies do
    RichEdit1.Print('默认打印文档');
end;

procedure TForm1.FileQuitClick(Sender: TObject);
begin
 Close;
end;

procedure TForm1.EditFontClick(Sender: TObject);
begin
 if FontDialog1.Execute then
  FontDialog1Apply(Form1,Handle);
end;

procedure TForm1.EditColorClick(Sender: TObject);
begin
 if ColorDialog1.Execute then
   Richedit1.Color := ColorDialog1.Color;
end;

procedure TForm1.EditFindClick(Sender: TObject);
begin
  with FindDialog1 do
  begin
   Options := [frDown,frHideMatchCase,frHideWholeWord];
   Execute;
  end;
end;

procedure TForm1.EditReplaceClick(Sender: TObject);
begin
 with ReplaceDialog1 do
  begin
   Options := [frDown,frHideMatchCase,frHideWholeWord];
   Execute;
  end;
end;

procedure TForm1.FileNewClick(Sender: TObject);
begin
 if CheckSave then
  RichEdit1.lines.Clear;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
 OpenDialog1.Filter:= 'Text Files(*.txt)|*.txt|Rich Type Files(*.rtf)|*.rtf';
 SaveDialog1.Filter:= 'Text Files(*.txt)|*.txt|Rich Type Files(*.rtf)|*.rtf';
end;

function TForm1.CheckSave:Bool;
var Confirm: word;
begin
 CheckSave:=True;
 if RichEdit1.Modified then
  Confirm:=MessageDlg('文件还没有保存！是否保存？',mtWarning,[mbYes,mbNo,mbCancel], 0);
  if Confirm=mrCancel then
   CheckSave:=False;
  if Confirm=mrYes then
   if SaveDialog1.Execute then
    CheckSave:=True
   else
    CheckSave:=False;
end;

procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
 CanClose:= CheckSave;
end;

procedure TForm1.FontDialog1Apply(Sender: TObject; Wnd: HWND);
begin
 if RichEdit1.SelLength>0 then
  begin
   RichEdit1.SelAttributes.Color:=FontDialog1.Font.Color;
   RichEdit1.SelAttributes.Name:=FontDialog1.Font.Name;
   RichEdit1.SelAttributes.Size:=FontDialog1.Font.Size;
   RichEdit1.SelAttributes.Style:=FontDialog1.Font.Style;
  end 
 else
  RichEdit1.Font:=FontDialog1.Font;
end;

procedure TForm1.ReplaceDialog1Replace(Sender: TObject);
var
  SelPos: Integer;
begin
  with TReplaceDialog(Sender) do
  begin
  { 在RichEdit中进行区分大小写的完全查找 }
    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('找不到 "', FindText, '"！ '), mtError, [mbOk], 0);
  end;
end;

end.