home *** CD-ROM | disk | FTP | other *** search
/ Delphi 4 Bible / Delphi_4_Bible_Tom_Swan_IDG_Books_1998.iso / source / TABEDIT / MAIN.PAS < prev    next >
Pascal/Delphi Source File  |  1998-04-10  |  9KB  |  380 lines
  1. unit Main;
  2.  
  3. interface
  4.  
  5. uses
  6.   SysUtils, Windows, Messages, Classes, Graphics, Controls,
  7.   Forms, Dialogs, StdCtrls, ExtCtrls, Tabs, Menus, About,
  8.   Clipbrd;
  9.  
  10. type
  11.   TMainForm = class(TForm)
  12.     MainMenu1: TMainMenu;
  13.     FileMenu: TMenuItem;
  14.     FileExit: TMenuItem;
  15.     N1: TMenuItem;
  16.     FilePrintSetup: TMenuItem;
  17.     FilePrint: TMenuItem;
  18.     N2: TMenuItem;
  19.     FileSaveAs: TMenuItem;
  20.     FileSave: TMenuItem;
  21.     N3: TMenuItem;
  22.     FileClose: TMenuItem;
  23.     FileOpen: TMenuItem;
  24.     FileNew: TMenuItem;
  25.     EditMenu: TMenuItem;
  26.     EditPaste: TMenuItem;
  27.     EditCopy: TMenuItem;
  28.     EditCut: TMenuItem;
  29.     HelpMenu: TMenuItem;
  30.     HelpAbout: TMenuItem;
  31.     TabSet1: TTabSet;
  32.     Memo1: TMemo;
  33.     OptionsMenu: TMenuItem;
  34.     OptionsFont: TMenuItem;
  35.     OptionsBackground: TMenuItem;
  36.     FileOpenDialog: TOpenDialog;
  37.     FileSaveDialog: TSaveDialog;
  38.     FontDialog1: TFontDialog;
  39.     ColorDialog1: TColorDialog;
  40.     FindDialog: TFindDialog;
  41.     procedure FormCreate(Sender: TObject);
  42.     procedure FormDestroy(Sender: TObject);
  43.     procedure FileOpenClick(Sender: TObject);
  44.     procedure FileSaveClick(Sender: TObject);
  45.     procedure FileSaveAsClick(Sender: TObject);
  46.     procedure FileExitClick(Sender: TObject);
  47.     procedure FormCloseQuery(Sender: TObject;
  48.       var CanClose: Boolean);
  49.     procedure FileNewClick(Sender: TObject);
  50.     procedure TabSet1Change(Sender: TObject; NewTab: Integer;
  51.       var AllowChange: Boolean);
  52.     procedure TabSet1Click(Sender: TObject);
  53.     procedure Memo1Change(Sender: TObject);
  54.     procedure FileCloseClick(Sender: TObject);
  55.     procedure EditCutClick(Sender: TObject);
  56.     procedure EditCopyClick(Sender: TObject);
  57.     procedure EditPasteClick(Sender: TObject);
  58.     procedure OptionsFontClick(Sender: TObject);
  59.     procedure OptionsBackgroundClick(Sender: TObject);
  60.     procedure HelpAboutClick(Sender: TObject);
  61.     procedure FileMenuClick(Sender: TObject);
  62.     procedure EditMenuClick(Sender: TObject);
  63.   private
  64.     procedure EnableFileMenu;
  65.     procedure EnableEditMenu;
  66.     procedure SetFilename(const Path: String);
  67.     procedure LoadFile(const Path: String);
  68.     procedure SaveFile(Index: Integer);
  69.     function AllFilesSaved: Boolean;
  70.   public
  71.   end;
  72.  
  73. var
  74.   MainForm: TMainForm;
  75.  
  76. implementation
  77.  
  78. {$R *.DFM}
  79.  
  80. const
  81.   maxPages = 8;
  82.   untitledName = '[untitled]';
  83.  
  84. type
  85.   TPageRec = record
  86.     Filename: String;
  87.     Dirty: Boolean;
  88.     Page: TStringList;
  89.   end;
  90.  
  91. var
  92.   Pages: array[0 .. maxPages - 1] of TPageRec;
  93.  
  94. { Enable / disable File menu commands }
  95. procedure TMainForm.EnableFileMenu;
  96. var
  97.   I: Integer;
  98. begin
  99.   with FileMenu do
  100.     for I := 0 to Count - 1 do     { Enable all File commands }
  101.       Items[I].Enabled := True;
  102.   with TabSet1, Pages[TabIndex] do
  103.     if (not Dirty) or (Filename = untitledName) then
  104.       FileSave.Enabled := False;     { Must use Save as }
  105. end;
  106.  
  107. { Enable / disable Edit menu commands }
  108. procedure TMainForm.EnableEditMenu;
  109. var
  110.   I: Integer;
  111. begin
  112.   with EditMenu do
  113.   begin
  114.     for I := 0 to Count - 1 do     { Enable all Edit commands }
  115.       Items[I].Enabled := True;
  116.     with TabSet1, Pages[TabIndex] do
  117.     begin
  118.       if Memo1.SelLength = 0 then
  119.       begin
  120.         EditCut.Enabled := False;      { No selected text }
  121.         EditCopy.Enabled := False;
  122.       end;
  123.       if not Clipboard.HasFormat(cf_Text) then
  124.         EditPaste.Enabled := False;
  125.     end;
  126.   end;
  127. end;
  128.  
  129. { Save path as current filename and page tab label }
  130. procedure TMainForm.SetFilename(const Path: String);
  131. var
  132.   S: String[12];  { Filename.ext }
  133. begin
  134.   with TabSet1, Pages[TabIndex] do
  135.   begin
  136.     Filename := Lowercase(Path);
  137.     S := ExtractFilename(Filename);
  138.     S[1] := UpCase(S[1]);
  139.     Tabs[TabIndex] := S;
  140.   end;
  141. end;
  142.  
  143. { Read file from disk }
  144. procedure TMainForm.LoadFile(const Path: String);
  145. begin
  146.   with Pages[TabSet1.TabIndex] do
  147.   try
  148.     Memo1.Lines.LoadFromFile(Path);
  149.     Dirty := False;
  150.     Page.Clear;
  151.     SetFilename(Path);
  152.   except on e: EReadError do
  153.     MessageDlg('Error reading file', mtError, [mbOk], 0);
  154.   end;
  155. end;
  156.  
  157. { Write current file to disk }
  158. procedure TMainForm.SaveFile(Index: Integer);
  159. begin
  160.   with TabSet1, Pages[Index] do
  161.   begin
  162.     try
  163.       Memo1.Lines.SaveToFile(Filename);
  164.       Dirty := False;
  165.     except on e:EWriteError do
  166.       MessageDlg('Error writing file', mtError, [mbOk], 0);
  167.     end;
  168.   end;
  169. end;
  170.  
  171. { Return true if all files are saved }
  172. function TMainForm.AllFilesSaved: Boolean;
  173. var
  174.   I: Integer;
  175. begin
  176.   Result := False;
  177.   for I := 0 to maxPages - 1 do with Pages[I] do
  178.     if Dirty then Exit;
  179.   Result := True;
  180. end;
  181.  
  182. { Initialize variables }
  183. procedure TMainForm.FormCreate(Sender: TObject);
  184. var
  185.   I: Integer;
  186. begin
  187.   for I := 0 to maxPages - 1 do with Pages[I] do
  188.   begin
  189.     Filename := '';
  190.     Dirty := False;
  191.     Page := nil;
  192.   end;
  193.   with Pages[0] do
  194.   begin
  195.     Page := TStringList.Create;
  196.     Filename := untitledName;
  197.   end;
  198.   FontDialog1.Font := Memo1.Font;
  199. end;
  200.  
  201. { Last chance to clean up before program ends }
  202. procedure TMainForm.FormDestroy(Sender: TObject);
  203. var
  204.   I: Integer;
  205. begin
  206.   for I := 0 to maxPages - 1 do with Pages[I] do
  207.     if Page <> nil then
  208.       Page.Free;
  209. end;
  210.  
  211. { File|New command }
  212. procedure TMainForm.FileNewClick(Sender: TObject);
  213. var
  214.   I: Integer;
  215. begin
  216.   for I := 0 to maxPages - 1 do with TabSet1, Pages[I] do
  217.   if Page = nil then
  218.   begin
  219.     Page := TStringList.Create;
  220.     Filename := untitledName;
  221.     Dirty := False;
  222.     Tabs.Add(Filename);
  223.     Exit;
  224.   end;
  225. end;
  226.  
  227. { File|Open command }
  228. procedure TMainForm.FileOpenClick(Sender: TObject);
  229. begin
  230.   with Pages[TabSet1.TabIndex] do
  231.   begin
  232.     if Dirty then FileSaveClick(Sender);
  233.     if {still} Dirty then Exit;  { File not saved }
  234.     if FileOpenDialog.Execute then
  235.       LoadFile(FileOpenDialog.Filename);
  236.   end;
  237. end;
  238.  
  239. { File|Close command }
  240. procedure TMainForm.FileCloseClick(Sender: TObject);
  241. var
  242.   W: Word;
  243. begin
  244.   with TabSet1, Pages[TabIndex] do
  245.   begin
  246.     if Dirty then
  247.     begin
  248.       W := MessageDlg('Save changes to ' + Tabs[TabIndex] + '?',
  249.       mtWarning, [mbYes, mbNo, mbCancel], 0);
  250.       case W of
  251.         mrYes: FileSaveClick(Sender);
  252.         mrNo: Dirty := False;
  253.         mrCancel: Exit;
  254.       end;
  255.     end;
  256.     if {still} Dirty then Exit;  { File not saved }
  257.     Page.Clear;
  258.     Memo1.Clear;
  259.     Filename := untitledName;
  260.     Tabs[TabIndex] := Filename;
  261.   end;
  262. end;
  263.  
  264. { File|Save command }
  265. procedure TMainForm.FileSaveClick(Sender: TObject);
  266. begin
  267.   with TabSet1, Pages[TabIndex] do
  268.   if Filename = untitledName then
  269.     FileSaveAsClick(Sender)
  270.   else
  271.     SaveFile(TabIndex);
  272. end;
  273.  
  274. { File|Save As command }
  275. procedure TMainForm.FileSaveAsClick(Sender: TObject);
  276. begin
  277.   with TabSet1, Pages[TabIndex] do                               
  278.   if FileSaveDialog.Execute then
  279.   begin
  280.     SetFilename(FileSaveDialog.Filename);
  281.     SaveFile(TabIndex);
  282.   end;
  283. end;
  284.  
  285. { File|Exit command }
  286. procedure TMainForm.FileExitClick(Sender: TObject);
  287. begin
  288.   Close;
  289. end;
  290.  
  291. { Check for unsaved files and prompt user before program ends }
  292. procedure TMainForm.FormCloseQuery(Sender: TObject;
  293.   var CanClose: Boolean);
  294. var
  295.   I: Integer;
  296.   W: Word;
  297. begin
  298.   CanClose := True;
  299.   for I := 0 to maxPages - 1 do with TabSet1, Pages[I] do
  300.   if Dirty then
  301.   begin
  302.     W := MessageDlg('Save changes to ' + Tabs[I] + '?',
  303.       mtWarning, [mbYes, mbNo, mbCancel], 0);
  304.     case W of
  305.       mrYes: SaveFile(I);
  306.       mrNo: Dirty := False;
  307.       mrCancel: CanClose := False;
  308.     end;
  309.   end;
  310.   if CanClose then
  311.     CanClose := AllFilesSaved;
  312. end;
  313.  
  314. { A tab is changing. Save Memo's text in a TStringList object }
  315. procedure TMainForm.TabSet1Change(Sender: TObject; NewTab: Integer;
  316.   var AllowChange: Boolean);
  317. begin
  318.   with TabSet1, Pages[TabIndex] do
  319.   begin
  320.     Page.Clear;
  321.     Page.Assign(Memo1.Lines);
  322.   end;
  323. end;
  324.  
  325. { A tab has changed. Assign a TStringList object to Memo }
  326. procedure TMainForm.TabSet1Click(Sender: TObject);
  327. begin
  328.   with TabSet1 do
  329.     Memo1.Lines.Assign(Pages[TabIndex].