dialogfrm.~pas

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

unit DialogFrm;

interface

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

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;
    CoolBar1: TCoolBar;
    ToolBar1: TToolBar;
    ToolBar2: TToolBar;
    NewToolButton: TToolButton;
    OpenToolButton: TToolButton;
    SaveToolButton: TToolButton;
    ToolButton4: TToolButton;
    FindToolButton: TToolButton;
    ReplaceToolButton: TToolButton;
    NameComboBox: TComboBox;
    SizeComboBox: TComboBox;
    ToolButton7: TToolButton;
    CutToolButton: TToolButton;
    CopyToolButton: TToolButton;
    PasteToolButton: TToolButton;
    UndoToolButton: TToolButton;
    ToolButton12: TToolButton;
    BoldToolButton: TToolButton;
    ItalicToolButton: TToolButton;
    UnderlineToolButton: TToolButton;
    LeftToolButton: TToolButton;
    ImageList1: TImageList;
    CenterToolButton: TToolButton;
    RightToolButton: TToolButton;
    ToolButton23: TToolButton;
    HelpToolButton: TToolButton;
    ToolButton14: TToolButton;
    FontToolButton: TToolButton;
    ColorToolButton: TToolButton;
    WrapToolButton: TToolButton;
    StatusBar1: TStatusBar;
    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);
    procedure CutToolButtonClick(Sender: TObject);
    procedure NameComboBoxSelect(Sender: TObject);
    procedure SizeComboBoxSelect(Sender: TObject);
    procedure RichEdit1SelectionChange(Sender: TObject);
    procedure BoldToolButtonClick(Sender: TObject);
    procedure ItalicToolButtonClick(Sender: TObject);
    procedure UnderlineToolButtonClick(Sender: TObject);
    procedure LeftToolButtonClick(Sender: TObject);
    procedure UndoToolButtonClick(Sender: TObject);
    procedure WrapToolButtonClick(Sender: TObject);
    procedure CopyToolButtonClick(Sender: TObject);
    procedure PasteToolButtonClick(Sender: TObject);
    procedure CoolBar1EndDock(Sender, Target: TObject; X, Y: Integer);
    procedure StatusBar1DrawPanel(StatusBar: TStatusBar;
      Panel: TStatusPanel; const Rect: TRect);
    procedure FormActivate(Sender: TObject);
    procedure RichEdit1KeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
  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
 if CheckSave then
  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';
 NameComboBox.Items.AddStrings(Screen.Fonts);
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
   RichEdit1.SelAttributes.Assign(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;

procedure TForm1.CutToolButtonClick(Sender: TObject);
begin
 RichEdit1.CutToClipboard;
end;

procedure TForm1.NameComboBoxSelect(Sender: TObject);
begin
 if RichEdit1.SelLength>0 then
  RichEdit1.SelAttributes.Name:=NameComboBox.Items.Strings[NameComboBox.ItemIndex];
end;

procedure TForm1.SizeComboBoxSelect(Sender: TObject);
begin
 if RichEdit1.SelLength>0 then
  RichEdit1.SelAttributes.Size:=StrToInt(SizeComboBox.Items.Strings[SizeComboBox.ItemIndex]);
end;

procedure TForm1.RichEdit1SelectionChange(Sender: TObject);
var
 Row,Col:Integer;
begin
 BoldToolButton.Down:=(fsBold in RichEdit1.SelAttributes.Style);
 ItalicToolButton.Down:=(fsItalic in RichEdit1.SelAttributes.Style);
 UnderlineToolButton.Down:=(fsUnderline in RichEdit1.SelAttributes.Style);
 case RichEdit1.Paragraph.Alignment of
  taLeftJustify: LeftToolButton.Down:=True;
  taCenter: CenterToolButton.Down:=True;
  taRightJustify: RightToolButton.Down:=True;
 end;
 with RichEdit1 do
  begin
   Row:=SendMessage(Handle,EM_LINEFROMCHAR,SelStart,0);
   Col:=SelStart- SendMessage(Handle,EM_LINEINDEX,Row,0);
  end;
 StatusBar1.Panels[0].Text:=Format('%d 行   %d 列',[Row,Col]); 
end;

procedure TForm1.BoldToolButtonClick(Sender: TObject);
begin
 if BoldToolButton.Down then
  RichEdit1.SelAttributes.Style:=RichEdit1.SelAttributes.Style+[fsBold]
 else
  RichEdit1.SelAttributes.Style:=RichEdit1.SelAttributes.Style-[fsBold];
end;

procedure TForm1.ItalicToolButtonClick(Sender: TObject);
begin
 if ItalicToolButton.Down then
  RichEdit1.SelAttributes.Style:=RichEdit1.SelAttributes.Style+[fsItalic]
 else
  RichEdit1.SelAttributes.Style:=RichEdit1.SelAttributes.Style-[fsItalic];
end;

procedure TForm1.UnderlineToolButtonClick(Sender: TObject);
begin
 if UnderlineToolButton.Down then
  RichEdit1.SelAttributes.Style:=RichEdit1.SelAttributes.Style+[fsUnderline]
 else
  RichEdit1.SelAttributes.Style:=RichEdit1.SelAttributes.Style-[fsUnderline];
end;

procedure TForm1.LeftToolButtonClick(Sender: TObject);
begin
 if Sender=LeftToolButton then
  RichEdit1.Paragraph.Alignment:=taLeftJustify
 else if Sender=CenterToolButton then
  RichEdit1.Paragraph.Alignment:= taCenter
 else
  RichEdit1.Paragraph.Alignment:= taRightJustify;
end;

procedure TForm1.UndoToolButtonClick(Sender: TObject);
begin
 RichEdit1.Undo;
end;

procedure TForm1.WrapToolButtonClick(Sender: TObject);
begin
 RichEdit1.WordWrap:= WrapToolButton.Down;
end;

procedure TForm1.CopyToolButtonClick(Sender: TObject);
begin
 RichEdit1.CopyToClipboard;
end;

procedure TForm1.PasteToolButtonClick(Sender: TObject);
begin
 RichEdit1.PasteFromClipboard;
end;

procedure TForm1.CoolBar1EndDock(Sender, Target: TObject; X, Y: Integer);
begin
  CoolBar1.Left:=0;
  CoolBar1.Top:=0;
end;

procedure TForm1.StatusBar1DrawPanel(StatusBar: TStatusBar;
  Panel: TStatusPanel; const Rect: TRect);
begin
  with StatusBar.Canvas do
   begin
    if (GetKeyState(VK_INSERT) and 1=1) then
     Font.Color:=clBlack
    else
     Font.Color:=clGray;
     TextOut(Rect.Left+10,Rect.Top+1,'修改');
   end;  
end;

procedure TForm1.FormActivate(Sender: TObject);
begin
 StatusBar1.Repaint;
end;

procedure TForm1.RichEdit1KeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
 StatusBar1.Repaint;
end;

end.