RichForm.pas
上传用户:fh681027
上传日期:2022-07-23
资源大小:1959k
文件大小:12k
源码类别:

Delphi控件源码

开发平台:

Delphi

  1. unit RichForm;
  2. interface
  3. uses
  4.   SysUtils, Windows, Messages, Classes, Graphics, Controls, Forms, Dialogs,
  5.   StdCtrls, ComCtrls, ExtCtrls, Menus, ActnList, ToolWin, ImgList, ClipBrd,
  6.   RichEdit, AppEvnts;
  7. type
  8.   TFormRichNote = class(TForm)
  9.     RichEdit: TRichEdit;
  10.     FontDialog: TFontDialog;
  11.     MainMenu: TMainMenu;
  12.     File1: TMenuItem;
  13.     Open1: TMenuItem;
  14.     Saveas1: TMenuItem;
  15.     Exit1: TMenuItem;
  16.     Font1: TMenuItem;
  17.     Bold1: TMenuItem;
  18.     Italic1: TMenuItem;
  19.     Paragraph1: TMenuItem;
  20.     LeftAligned1: TMenuItem;
  21.     Centered1: TMenuItem;
  22.     RightAligned1: TMenuItem;
  23.     Help1: TMenuItem;
  24.     About1: TMenuItem;
  25.     OpenDialog: TOpenDialog;
  26.     SaveDialog: TSaveDialog;
  27.     More1: TMenuItem;
  28.     ColorDialog: TColorDialog;
  29.     ActionList: TActionList;
  30.     ToolBar1: TToolBar;
  31.     ToolButton1: TToolButton;
  32.     ToolButton2: TToolButton;
  33.     ToolButton3: TToolButton;
  34.     ToolButton4: TToolButton;
  35.     ToolButton5: TToolButton;
  36.     ToolButton6: TToolButton;
  37.     ToolButton7: TToolButton;
  38.     ToolButton8: TToolButton;
  39.     ToolButton9: TToolButton;
  40.     ToolButton10: TToolButton;
  41.     ToolButton11: TToolButton;
  42.     ToolButton13: TToolButton;
  43.     ToolButton14: TToolButton;
  44.     ToolButton15: TToolButton;
  45.     ToolButton16: TToolButton;
  46.     ToolButton20: TToolButton;
  47.     ToolButton21: TToolButton;
  48.     acCentered: TAction;
  49.     acUndo: TAction;
  50.     acCut: TAction;
  51.     acPaste: TAction;
  52.     acCopy: TAction;
  53.     acBold: TAction;
  54.     acItalic: TAction;
  55.     acRightAligned: TAction;
  56.     acLeftAligned: TAction;
  57.     acSave: TAction;
  58.     Undo1: TMenuItem;
  59.     acFont: TAction;
  60.     acCountChars: TAction;
  61.     Images: TImageList;
  62.     ToolButton12: TToolButton;
  63.     tbtnSize: TToolButton;
  64.     SizeMenu: TPopupMenu;
  65.     Small1: TMenuItem;
  66.     Medium1: TMenuItem;
  67.     Large1: TMenuItem;
  68.     ComboFont: TComboBox;
  69.     acHintColor: TAction;
  70.     HintColor1: TMenuItem;
  71.     ApplicationEvents1: TApplicationEvents;
  72.     StatusBar: TStatusBar;
  73.     ColorBox1: TColorBox;
  74.     ToolButton18: TToolButton;
  75.     ToolButton19: TToolButton;
  76.     procedure BoldExecute(Sender: TObject);
  77.     procedure ItalicExecute(Sender: TObject);
  78.     procedure ChangeAlignment(Sender: TObject);
  79.     procedure AboutExecute(Sender: TObject);
  80.     procedure ExitExecute(Sender: TObject);
  81.     procedure OpenExecute(Sender: TObject);
  82.     procedure SaveAsExecute(Sender: TObject);
  83.     procedure BackColorExecute(Sender: TObject);
  84.     procedure FontExecute(Sender: TObject);
  85.     procedure CountCharsExecute(Sender: TObject);
  86.     procedure FormCreate(Sender: TObject);
  87.     procedure NewExecute(Sender: TObject);
  88.     procedure SaveExecute(Sender: TObject);
  89.     procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
  90.     procedure PrintExecute(Sender: TObject);
  91.     procedure acSaveUpdate(Sender: TObject);
  92.     procedure acBoldUpdate(Sender: TObject);
  93.     procedure acItalicUpdate(Sender: TObject);
  94.     procedure RichEditChange(Sender: TObject);
  95.     procedure acCountcharsUpdate(Sender: TObject);
  96.     procedure acCutExecute(Sender: TObject);
  97.     procedure acCutUpdate(Sender: TObject);
  98.     procedure acCopyExecute(Sender: TObject);
  99.     procedure acPasteExecute(Sender: TObject);
  100.     procedure acPasteUpdate(Sender: TObject);
  101.     procedure acUndoExecute(Sender: TObject);
  102.     procedure acUndoUpdate(Sender: TObject);
  103.     procedure ActionListUpdate(Action: TBasicAction; var Handled: Boolean);
  104.     procedure tbtnSizeClick(Sender: TObject);
  105.     procedure SetFontSize(Sender: TObject);
  106.     procedure ComboFontClick(Sender: TObject);
  107.     procedure RichEditSelectionChange(Sender: TObject);
  108.     procedure acHintColorExecute(Sender: TObject);
  109.     procedure ApplicationEvents1Hint(Sender: TObject);
  110.     procedure ColorBox1Change(Sender: TObject);
  111.   private
  112.     FileName: string;
  113.     Modified: Boolean;
  114.     procedure CheckCapslock;
  115.   public
  116.     function SaveChanges: Boolean;
  117.     function Save: Boolean;
  118.     function SaveAs: Boolean;
  119.   end;
  120. var
  121.   FormRichNote: TFormRichNote;
  122. implementation
  123. {$R *.DFM}
  124. // status bar panels
  125. const
  126.   sbpMessage = 0;
  127.   sbpCaps = 1;
  128.   sbpPosition = 2;
  129. /////////// Font operations
  130. procedure TFormRichNote.BoldExecute(Sender: TObject);
  131. begin
  132.   with RichEdit.SelAttributes do
  133.     if fsBold in Style then
  134.       Style := Style - [fsBold]
  135.     else
  136.       Style := Style + [fsBold];
  137. end;
  138. procedure TFormRichNote.ItalicExecute(Sender: TObject);
  139. begin
  140.   with RichEdit.SelAttributes do
  141.     if fsItalic in Style then
  142.       Style := Style - [fsItalic]
  143.     else
  144.       Style := Style + [fsItalic];
  145. end;
  146. procedure TFormRichNote.FontExecute(Sender: TObject);
  147. begin
  148.   FontDialog.Font.Assign (RichEdit.SelAttributes);
  149.   if FontDialog.Execute then
  150.   begin
  151.     RichEdit.SelAttributes.Assign (FontDialog.Font);
  152.     RichEditSelectionChange (Self);
  153.   end;
  154. end;
  155. // right + center + left actions
  156. procedure TFormRichNote.ChangeAlignment(Sender: TObject);
  157. begin
  158.   // change paragraph alignment using the TAlignment
  159.   // value saved in the tag of the action
  160.   RichEdit.Paragraph.Alignment := TAlignment (
  161.     (Sender as TAction).Tag);
  162. end;
  163. procedure TFormRichNote.AboutExecute(Sender: TObject);
  164. begin
  165.   MessageDlg (Application.Title + 'Demo' + #13#13
  166.     + 'written for the book "Mastering Delphi" by Marco Cant