home *** CD-ROM | disk | FTP | other *** search
/ Delphi 4 Bible / Delphi_4_Bible_Tom_Swan_IDG_Books_1998.iso / source / MDIDEMO / MAIN.PAS < prev    next >
Pascal/Delphi Source File  |  1998-04-13  |  4KB  |  180 lines
  1. unit Main;
  2.  
  3. interface
  4.  
  5. uses
  6.   Windows, Messages, SysUtils, Classes, Graphics, Controls,
  7.   Forms, Dialogs, Menus, Child;
  8.  
  9. type
  10.   TMainForm = class(TForm)
  11.     MainMenu1: TMainMenu;
  12.     FileMenu: TMenuItem;
  13.     FileOpen: TMenuItem;
  14.     FileSave: TMenuItem;
  15.     FileSaveAs: TMenuItem;
  16.     FileNew: TMenuItem;
  17.     N1: TMenuItem;
  18.     FileExit: TMenuItem;
  19.     WindowMenu: TMenuItem;
  20.     WindowCascade: TMenuItem;
  21.     WindowTile: TMenuItem;
  22.     WindowArrangeIcons: TMenuItem;
  23.     N2: TMenuItem;
  24.     WindowCloseAll: TMenuItem;
  25.     WindowMinimizeAll: TMenuItem;
  26.     HelpMenu: TMenuItem;
  27.     HelpAbout: TMenuItem;
  28.     OpenDialog: TOpenDialog;
  29.     FileClose: TMenuItem;
  30.     N3: TMenuItem;
  31.     SaveDialog: TSaveDialog;
  32.     procedure FileNewClick(Sender: TObject);
  33.     procedure FileOpenClick(Sender: TObject);
  34.     procedure FileCloseClick(Sender: TObject);
  35.     procedure FileSaveClick(Sender: TObject);
  36.     procedure FileSaveAsClick(Sender: TObject);
  37.     procedure FileExitClick(Sender: TObject);
  38.     procedure WindowCascadeClick(Sender: TObject);
  39.     procedure WindowTileClick(Sender: TObject);
  40.     procedure WindowArrangeIconsClick(Sender: TObject);
  41.     procedure WindowMinimizeAllClick(Sender: TObject);
  42.     procedure WindowCloseAllClick(Sender: TObject);
  43.     procedure HelpAboutClick(Sender: TObject);
  44.     procedure FileMenuClick(Sender: TObject);
  45.     procedure WindowMenuClick(Sender: TObject);
  46.   private
  47.   {- Private declarations }
  48.     procedure CreateChild(const Name: string);
  49.   public
  50.   {- Public declarations }
  51.   end;
  52.  
  53. var
  54.   MainForm: TMainForm;
  55.  
  56. implementation
  57.  
  58. uses About;
  59.  
  60. {$R *.DFM}
  61.  
  62. const
  63.   maxChildren = 10;  { Optional: No maximum required }
  64.  
  65. procedure TMainForm.CreateChild(const Name: String);
  66. var
  67.   Child: TChildForm;
  68. begin
  69.   Child := TChildForm.Create(Application);
  70.   Child.Caption := Name;
  71. end;
  72.  
  73. procedure TMainForm.FileNewClick(Sender: TObject);
  74. begin
  75.   CreateChild('Untitled' + IntToStr(MDIChildCount + 1));
  76. end;
  77.  
  78. procedure TMainForm.FileOpenClick(Sender: TObject);
  79. begin
  80.   if OpenDialog.Execute then
  81.   begin
  82.     CreateChild(Lowercase(OpenDialog.FileName));
  83.     with ActiveMDIChild as TChildForm do
  84.       LoadData(OpenDialog.FileName);
  85.   end;
  86. end;
  87.  
  88. procedure TMainForm.FileCloseClick(Sender: TObject);
  89. begin
  90.   if ActiveMDIChild <> nil then
  91.     ActiveMDIChild.Close;
  92. end;
  93.  
  94. procedure TMainForm.FileSaveClick(Sender: TObject);
  95. begin
  96.   if Pos('Untitled', ActiveMDIChild.Caption) = 1 then
  97.     FileSaveAsClick(Sender)
  98.   else with ActiveMDIChild as TChildForm do
  99.     SaveData(Caption);
  100. end;
  101.  
  102. procedure TMainForm.FileSaveAsClick(Sender: TObject);
  103. var
  104.   FExt: String;
  105. begin
  106.   with SaveDialog do
  107.   begin
  108.     FileName := ActiveMDIChild.Caption;
  109.     FExt := ExtractFileExt(FileName);
  110.     if Length(FExt) = 0 then
  111.       FExt := '.*';
  112.     Filter := 'Files (*' + FExt + ')|*' + FExt;
  113.     if Execute then
  114.     with ActiveMDIChild as TChildForm do
  115.       SaveData(FileName);
  116.   end;
  117. end;
  118.  
  119. procedure TMainForm.FileExitClick(Sender: TObject);
  120. begin
  121.   Close;
  122. end;
  123.  
  124. procedure TMainForm.WindowCascadeClick(Sender: TObject);
  125. begin
  126.   Cascade;
  127. end;
  128.  
  129. procedure TMainForm.WindowTileClick(Sender: TObject);
  130. begin
  131.   Tile;
  132. end;
  133.  
  134. procedure TMainForm.WindowArrangeIconsClick(Sender: TObject);
  135. begin
  136.   ArrangeIcons;
  137. end;
  138.  
  139. procedure TMainForm.WindowMinimizeAllClick(Sender: TObject);
  140. var
  141.   I: Integer;
  142. begin
  143.   for I := MDIChildCount - 1 downto 0 do
  144.     MDIChildren[I].WindowState := wsMinimized;
  145. end;
  146.  
  147. procedure TMainForm.WindowCloseAllClick(Sender: TObject);
  148. var
  149.   I: Integer;
  150. begin
  151.   for I := MDIChildCount - 1 downto 0 do
  152.     MDIChildren[I].Close;
  153. end;
  154.  
  155. procedure TMainForm.HelpAboutClick(Sender: TObject);
  156. begin
  157.   AboutForm.ShowModal;
  158. end;
  159.  
  160. procedure TMainForm.FileMenuClick(Sender: TObject);
  161. begin
  162.   FileNew.Enabled := MDIChildCount < maxChildren;
  163.   FileOpen.Enabled := FileNew.Enabled;
  164.   FileClose.Enabled := MDIChildCount > 0;
  165.   FileSave.Enabled := FileClose.Enabled;
  166.   FileSaveAs.Enabled := FileClose.Enabled;
  167. end;
  168.  
  169. procedure TMainForm.WindowMenuClick(Sender: TObject);
  170. var
  171.   I: Integer;
  172. begin
  173.   with WindowMenu do
  174.   for I := 0 to Count - 1 do
  175.     with Items[I] as TMenuItem do
  176.       Enabled := MDIChildCount > 0;
  177. end;
  178.  
  179. end.
  180.