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

Delphi控件源码

开发平台:

Delphi

  1. unit Frame;
  2. interface
  3. uses
  4.   Windows, Classes, Graphics, Forms, Controls,
  5.   Child, Menus, SysUtils, StdActns, ActnList, Dialogs, ImgList, ComCtrls,
  6.   ToolWin;
  7. type
  8.   TMainForm = class(TForm)
  9.     MainMenu1: TMainMenu;
  10.     Window1: TMenuItem;
  11.     New1: TMenuItem;
  12.     File1: TMenuItem;
  13.     N1: TMenuItem;
  14.     Exit1: TMenuItem;
  15.     Cascade1: TMenuItem;
  16.     Tile1: TMenuItem;
  17.     ArrangeIcons1: TMenuItem;
  18.     ActionList1: TActionList;
  19.     ActionArrange: TWindowArrange;
  20.     ActionCascade: TWindowCascade;
  21.     ActionClose: TWindowClose;
  22.     ActionMinimizeAll: TWindowMinimizeAll;
  23.     ActionTileHorizontal: TWindowTileHorizontal;
  24.     ActionTileVertical: TWindowTileVertical;
  25.     Tile2: TMenuItem;
  26.     Close1: TMenuItem;
  27.     MinimizeAll1: TMenuItem;
  28.     Edit1: TMenuItem;
  29.     Cut1: TMenuItem;
  30.     Copy1: TMenuItem;
  31.     Paste1: TMenuItem;
  32.     ActionCopy: TEditCopy;
  33.     ActionCut: TEditCut;
  34.     ActionPaste: TEditPaste;
  35.     ActionFont: TAction;
  36.     FontDialog1: TFontDialog;
  37.     N2: TMenuItem;
  38.     Font1: TMenuItem;
  39.     ActionNew: TAction;
  40.     ActionOpen: TAction;
  41.     ActionSaveAs: TAction;
  42.     OpenDialog1: TOpenDialog;
  43.     SaveDialog1: TSaveDialog;
  44.     Open1: TMenuItem;
  45.     Save1: TMenuItem;
  46.     ActionSave: TAction;
  47.     Save2: TMenuItem;
  48.     ImageList1: TImageList;
  49.     ToolBar1: TToolBar;
  50.     ToolButton1: TToolButton;
  51.     ToolButton2: TToolButton;
  52.     ToolButton3: TToolButton;
  53.     ToolButton4: TToolButton;
  54.     ToolButton5: TToolButton;
  55.     ToolButton6: TToolButton;
  56.     ToolButton7: TToolButton;
  57.     ToolButton8: TToolButton;
  58.     procedure Exit1Click(Sender: TObject);
  59.     procedure ActionFontExecute(Sender: TObject);
  60.     procedure ActionFontUpdate(Sender: TObject);
  61.     procedure ActionNewExecute(Sender: TObject);
  62.     procedure ActionOpenExecute(Sender: TObject);
  63.     procedure ActionSaveAsExecute(Sender: TObject);
  64.     procedure ActionSaveAsUpdate(Sender: TObject);
  65.     procedure ActionSaveUpdate(Sender: TObject);
  66.     procedure ActionSaveExecute(Sender: TObject);
  67.   private
  68.     { Private declarations }
  69.     Counter: Integer;
  70.   public
  71.     { Public declarations }
  72.   end;
  73. var
  74.   MainForm: TMainForm;
  75. implementation
  76. {$R *.DFM}
  77. procedure TMainForm.Exit1Click(Sender: TObject);
  78. begin
  79.   // automatically closes each child
  80.   Close;
  81. end;
  82. procedure TMainForm.ActionFontExecute(Sender: TObject);
  83. begin
  84.   if FontDialog1.Execute then
  85.     (ActiveMDIChild as TChildForm).Memo1.Font :=
  86.       FontDialog1.Font;
  87. end;
  88. procedure TMainForm.ActionFontUpdate(Sender: TObject);
  89. begin
  90.   ActionFont.Enabled := MDIChildCount > 0;
  91. end;
  92. procedure TMainForm.ActionNewExecute(Sender: TObject);
  93. var
  94.   ChildForm: TChildForm;
  95. begin
  96.   Inc (Counter);
  97.   ChildForm := TChildForm.Create (Self);
  98.   ChildForm.Caption :=
  99.     LowerCase (ExtractFilePath (Application.Exename)) +
  100.     'text' + IntToStr (Counter) + '.txt';
  101.   ChildForm.Show;
  102. end;
  103. procedure TMainForm.ActionOpenExecute(Sender: TObject);
  104. begin
  105.   if OpenDialog1.Execute then
  106.   begin
  107.     ActionNewExecute (Self);
  108.     (ActiveMDIChild as TChildForm).Load (OpenDialog1.FileName);
  109.   end;
  110. end;
  111. procedure TMainForm.ActionSaveAsExecute(Sender: TObject);
  112. begin
  113.   // suggest the current file name
  114.   SaveDialog1.FileName := ActiveMDIChild.Caption;
  115.   if SaveDialog1.Execute then
  116.   begin
  117.     // modify the file name and save
  118.     ActiveMDIChild.Caption := SaveDialog1.FileName;
  119.     (ActiveMDIChild as TChildForm).Save;
  120.   end;
  121. end;
  122. procedure TMainForm.ActionSaveAsUpdate(Sender: TObject);
  123. begin
  124.   ActionSaveAs.Enabled := MDIChildCount > 0;
  125. end;
  126. procedure TMainForm.ActionSaveUpdate(Sender: TObject);
  127. begin
  128.   ActionSave.Enabled := (MDIChildCount > 0) and
  129.     (ActiveMDIChild as TChildForm).Modified;
  130. end;
  131. procedure TMainForm.ActionSaveExecute(Sender: TObject);
  132. begin
  133.   (ActiveMDIChild as TChildForm).Save;
  134. end;
  135. end.
  136.