home *** CD-ROM | disk | FTP | other *** search
/ PC Format Collection 48 / SENT14D.ISO / tech / delphi / disk15 / textedit.pak / MDIEDIT.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1995-08-24  |  7.9 KB  |  312 lines
  1. unit MDIEdit;
  2.  
  3. interface
  4.  
  5. uses WinTypes, WinProcs, Classes, Graphics, Forms, Controls, Printers,
  6.   Dialogs, Menus, Clipbrd, StdCtrls;
  7.  
  8. type
  9.   TEditForm = class(TForm)
  10.     Memo1: TMemo;
  11.     MainMenu1: TMainMenu;
  12.     MemoPopUp: TPopupMenu;
  13.     FontDialog1: TFontDialog;
  14.     WordWrap1: TMenuItem;
  15.     Left1: TMenuItem;
  16.     Right1: TMenuItem;
  17.     Center1: TMenuItem;
  18.     Cut1: TMenuItem;
  19.     Copy1: TMenuItem;
  20.     Paste1: TMenuItem;
  21.     Delete1: TMenuItem;
  22.     Cut2: TMenuItem;
  23.     Copy2: TMenuItem;
  24.     Paste2: TMenuItem;
  25.     Edit1: TMenuItem;
  26.     SelectAll1: TMenuItem;
  27.     Character1: TMenuItem;
  28.     Font1: TMenuItem;
  29.     File1: TMenuItem;
  30.     New1: TMenuItem;
  31.     Open1: TMenuItem;
  32.     Close1: TMenuItem;
  33.     N1: TMenuItem;
  34.     Save1: TMenuItem;
  35.     SaveAs1: TMenuItem;
  36.     N2: TMenuItem;
  37.     Print1: TMenuItem;
  38.     PrintSetup1: TMenuItem;
  39.     N3: TMenuItem;
  40.     Exit1: TMenuItem;
  41.     PrinterSetupDialog1: TPrinterSetupDialog;
  42.     PrintDialog1: TPrintDialog;
  43.     SaveFileDialog: TSaveDialog;
  44.     procedure SelectAll(Sender: TObject);
  45.     procedure SetFont(Sender: TObject);
  46.     procedure SetWordWrap(Sender: TObject);
  47.     procedure AlignClick(Sender: TObject);
  48.     procedure CopyToClipboard(Sender: TObject);
  49.     procedure CutToClipboard(Sender: TObject);
  50.     procedure PasteFromClipboard(Sender: TObject);
  51.     procedure Delete(Sender: TObject);
  52.     procedure SetPopUpItems(Sender: TObject);
  53.     procedure SetEditItems(Sender: TObject);
  54.     procedure Open(const AFilename: string);
  55.     procedure FormClose(Sender: TObject; var Action: TCloseAction);
  56.     procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
  57.     procedure New1Click(Sender: TObject);
  58.     procedure Open1Click(Sender: TObject);
  59.     procedure Exit1Click(Sender: TObject);
  60.     procedure Close1Click(Sender: TObject);
  61.     procedure Print1Click(Sender: TObject);
  62.     procedure PrintSetup1Click(Sender: TObject);
  63.     procedure SaveAs1Click(Sender: TObject);
  64.     procedure Save1Click(Sender: TObject);
  65.     procedure FormCreate(Sender: TObject);
  66.     procedure FormResize(Sender: TObject);
  67.   private
  68.     Filename: string;
  69.     procedure UpdateMenus;
  70.     procedure SetEditRect;
  71.   end;
  72.  
  73. implementation
  74.  
  75. {$R *.DFM}
  76.  
  77. uses MDIFrame, SysUtils, Messages;
  78.  
  79. const
  80.   BackupExt = '.BAK';
  81.   SWarningText = 'Save Changes to ''%s''?';
  82.   DefaultCaption = 'Untitled';
  83.  
  84. procedure TEditForm.SelectAll(Sender: TObject);
  85. begin
  86.   Memo1.SelectAll;
  87. end;
  88.  
  89. procedure TEditForm.SetFont(Sender: TObject);
  90. begin
  91.   FontDialog1.Font := Memo1.Font;
  92.   if FontDialog1.Execute then
  93.     Memo1.Font := FontDialog1.Font;
  94.   SetEditRect;
  95. end;
  96.  
  97. procedure TEditForm.SetWordWrap(Sender: TObject);
  98. begin
  99.   with Memo1 do
  100.   begin
  101.     WordWrap := not WordWrap;
  102.     if WordWrap then
  103.       ScrollBars := ssVertical else
  104.       ScrollBars := ssBoth;
  105.     WordWrap1.Checked := WordWrap;
  106.   end;
  107.   SetEditRect;
  108. end;
  109.  
  110. procedure TEditForm.AlignClick(Sender: TObject);
  111. begin
  112.   Left1.Checked := False;
  113.   Right1.Checked := False;
  114.   Center1.Checked := False;
  115.   with Sender as TMenuItem do Checked := True;
  116.   with Memo1 do
  117.     if Left1.Checked then
  118.       Alignment := taLeftJustify
  119.     else if Right1.Checked then
  120.       Alignment := taRightJustify
  121.     else if Center1.Checked then
  122.       Alignment := taCenter;
  123. end;
  124.  
  125. procedure TEditForm.CopyToClipboard(Sender: TObject);
  126. begin
  127.   Memo1.CopyToClipboard;
  128. end;
  129.  
  130. procedure TEditForm.CutToClipboard(Sender: TObject);
  131. begin
  132.   Memo1.CutToClipboard;
  133. end;
  134.  
  135. procedure TEditForm.PasteFromClipboard(Sender: TObject);
  136. begin
  137.   Memo1.PasteFromClipboard;
  138. end;
  139.  
  140. procedure TEditForm.Delete(Sender: TObject);
  141. begin
  142.   Memo1.ClearSelection;
  143. end;
  144.  
  145. procedure TEditForm.UpdateMenus;
  146. var
  147.   HasSelection: Boolean;
  148. begin
  149.   Paste1.Enabled := Clipboard.HasFormat(CF_TEXT);
  150.   Paste2.Enabled := Clipboard.HasFormat(CF_TEXT);
  151.   HasSelection := Memo1.SelLength <> 0;
  152.   Cut1.Enabled := HasSelection;
  153.   Copy1.Enabled := HasSelection;
  154.   Delete1.Enabled := HasSelection;
  155.   Cut2.Enabled := HasSelection;
  156.   Copy2.Enabled := HasSelection;
  157. end;
  158.  
  159. procedure TEditForm.SetEditItems(Sender: TObject);
  160. begin
  161.   UpdateMenus;
  162. end;
  163.  
  164. procedure TEditForm.SetPopUpItems(Sender: TObject);
  165. begin
  166.   UpdateMenus;
  167. end;
  168.  
  169. procedure TEditForm.Open(const AFilename: string);
  170. begin
  171.   Filename := AFilename;
  172.   Memo1.Lines.LoadFromFile(FileName);
  173.   Memo1.SelStart := 0;
  174.   Caption := ExtractFileName(FileName);
  175.   Memo1.Modified := False;
  176. end;
  177.  
  178. procedure TEditForm.FormClose(Sender: TObject; var Action: TCloseAction);
  179. begin
  180.   Action := caFree;
  181. end;
  182.  
  183. procedure TEditForm.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
  184. var
  185.   DialogValue: Integer;
  186.   FName: string;
  187. begin
  188.   if Memo1.Modified then
  189.   begin
  190.     FName := Caption;
  191.     DialogValue := MessageDlg(Format(SWarningText, [FName]), mtConfirmation,
  192.       [mbYes, mbNo, mbCancel], 0);
  193.     case DialogValue of
  194.       id_Yes: Save1Click(Self);
  195.       id_Cancel: CanClose := False;
  196.     end;
  197.   end;
  198. end;
  199.  
  200. procedure TEditForm.New1Click(Sender: TObject);
  201. begin
  202.   FrameForm.NewChild(Sender);
  203. end;
  204.  
  205. procedure TEditForm.Open1Click(Sender: TObject);
  206. begin
  207.   FrameForm.OpenChild(Sender);
  208. end;
  209.  
  210. procedure TEditForm.Exit1Click(Sender: TObject);
  211. begin
  212.   FrameForm.Exit1Click(Sender);
  213. end;
  214.  
  215. procedure TEditForm.Close1Click(Sender: TObject);
  216. begin
  217.   Close;
  218. end;
  219.  
  220. { the printing performed in this example either prints the entire buffer,   }
  221. { or...if a section of text is selected, will print the selected text;      }
  222. { in addition, the first line of selected text will be printed left         }
  223. { justified; no attempt is made to make the lines appear as they do on the  }
  224. { monitor.  WYSIWYG printing is beyond the scope of this demo program.      }
  225. { The following features of printing are not demonstrated:                  }
  226. {     Multiple Copies                                                       }
  227. {     Collating Multiple Copies                                             }
  228. {     Page Ranges                                                           }
  229. {     Multiple Fonts, Word Wrapping, etc.                                   }
  230. procedure TEditForm.Print1Click(Sender: TObject);
  231. var
  232.   Line: Integer;
  233.   PrintText: System.Text;
  234. begin
  235.   if PrintDialog1.Execute then
  236.   begin
  237.     AssignPrn(PrintText);
  238.     Rewrite(PrintText);
  239.     Printer.Canvas.Font := Memo1.Font;
  240.     for Line := 0 to Memo1.Lines.Count - 1 do
  241.       Writeln(PrintText, Memo1.Lines[Line]);
  242.     System.Close(PrintText);
  243.   end;
  244. end;
  245.  
  246. procedure TEditForm.PrintSetup1Click(Sender: TObject);
  247. begin
  248.   PrinterSetupDialog1.Execute;
  249. end;
  250.  
  251. procedure TEditForm.SaveAs1Click(Sender: TObject);
  252. begin
  253.   SaveFileDialog.Filename := Filename;
  254.   if SaveFileDialog.Execute then
  255.   begin
  256.     Filename := SaveFileDialog.Filename;
  257.     Caption := ExtractFileName(Filename);
  258.     Save1Click(Sender);
  259.   end;
  260. end;
  261.  
  262. procedure TEditForm.Save1Click(Sender: TObject);
  263.  
  264.   procedure CreateBackup(const Filename: string);
  265.   var
  266.     BackupFilename: string;
  267.   begin
  268.     BackupFilename := ChangeFileExt(Filename, BackupExt);
  269.     DeleteFile(BackupFilename);
  270.     RenameFile(Filename, BackupFilename);
  271.   end;
  272.  
  273.   function IsReadOnly(const Filename: string): Boolean;
  274.   begin
  275.     Result := Boolean(FileGetAttr(Filename) and faReadOnly);
  276.     if Result then MessageDlg(Format('%s is read only.',
  277.       [ExtractFilename(Filename)]), mtWarning, [mbOK], 0);
  278.   end;
  279.  
  280. begin
  281.   if (Filename = '') or IsReadOnly(Filename) then
  282.     SaveAs1Click(Sender)
  283.   else
  284.   begin
  285.     CreateBackup(Filename);
  286.     Memo1.Lines.SaveToFile(Filename);
  287.     Memo1.Modified := False;
  288.   end;
  289. end;
  290.  
  291. procedure TEditForm.SetEditRect;
  292. var
  293.   R: TRect;
  294. begin
  295.   R := Memo1.ClientRect;
  296.   InflateRect(R, -3, -2);
  297.   SendMessage(Memo1.Handle, EM_SETRECT, 0, Longint(@R));
  298. end;
  299.  
  300. procedure TEditForm.FormCreate(Sender: TObject);
  301. begin
  302.   SetEditRect;
  303. end;
  304.  
  305. procedure TEditForm.FormResize(Sender: TObject);
  306. begin
  307.   SetEditRect;
  308. end;
  309.  
  310. end.
  311.  
  312.