开通博客赚积分
发布资源赚积分
分类

源码开发语言/平台
当前位置：首页 > 源码/资料 > Delphi控件源码 > 查看源码
CdlgTest.pas
资源名称：delphi.rar　[点击查看]
上传用户：fh681027
上传日期：2022-07-23
资源大小：1959k
文件大小：7k
源码类别：

Delphi控件源码

开发平台：

Delphi

CdlgTest.pas：源码内容
  1. unit Cdlgtest;
  3. interface
  5. uses
  6.   Qt, Classes, QGraphics, QForms, QControls,
  7.   QMenus, QStdCtrls, QDialogs, QTypes;
  9. type
  10.   TCommDlgForm = class(TForm)
  11.     OpenDialog1: TOpenDialog;
  12.     SaveDialog1: TSaveDialog;
  13.     FontDialog1: TFontDialog;
  14.     ColorDialog1: TColorDialog;
  15.     MainMenu1: TMainMenu;
  16.     Memo1: TMemo;
  17.     Open1: TMenuItem;
  18.     TextFiles1: TMenuItem;
  19.     Anynewfile1: TMenuItem;
  20.     MultipleSelection1: TMenuItem;
  21.     Save1: TMenuItem;
  22.     TextFile1: TMenuItem;
  23.     AnyFile1: TMenuItem;
  24.     Font1: TMenuItem;
  25.     Standard1: TMenuItem;
  26.     Help1: TMenuItem;
  27.     AboutCommonDialogsTest1: TMenuItem;
  28.     FindDialog1: TFindDialog;
  29.     ReplaceDialog1: TReplaceDialog;
  30.     Search1: TMenuItem;
  31.     Search2: TMenuItem;
  32.     Replace1: TMenuItem;
  33.     Others1: TMenuItem;
  34.     procedure TextFiles1Click(Sender: TObject);
  35.     procedure Anynewfile1Click(Sender: TObject);
  36.     procedure MultipleSelection1Click(Sender: TObject);
  37.     procedure TextFile1Click(Sender: TObject);
  38.     procedure AnyFile1Click(Sender: TObject);
  39.     procedure OnlyTrueType1Click(Sender: TObject);
  40.     procedure NoEffects1Click(Sender: TObject);
  41.     procedure NoStyle1Click(Sender: TObject);
  42.     procedure Standard1Click(Sender: TObject);
  43.     procedure FullOpen1Click(Sender: TObject);
  44.     procedure NoFullOpen1Click(Sender: TObject);
  45.     procedure AboutCommonDialogsTest1Click(Sender: TObject);
  46.     procedure Search2Click(Sender: TObject);
  47.     procedure Replace1Click(Sender: TObject);
  48.     procedure FindDialog1Find(Sender: TObject);
  49.     procedure ReplaceDialog1Replace(Sender: TObject);
  50.     procedure ReplaceDialog1Find(Sender: TObject);
  51.   private
  52.     { Private declarations }
  53.   public
  54.     { Public declarations }
  55.   end;
  57. var
  58.   CommDlgForm: TCommDlgForm;
  60. implementation
  62. {$R *.xfm}
  64. procedure TCommDlgForm.TextFiles1Click(Sender: TObject);
  65. begin
  66.   with OpenDialog1 do
  67.   begin
  68.     Filter := 'Text File (*.txt)|*.txt';
  69.     DefaultExt := 'txt';
  70.     Filename := '';
  71.     Options := [ofFileMustExist,
  72.       ofPathMustExist];
  73.     if Execute then
  74.       if ofExtensionDifferent in Options then
  75.         MessageDlg ('Not a file with the .TXT extension',
  76.           mtError, [mbOK], 0)
  77.       else
  78.         Memo1.Lines.LoadFromFile (FileName);
  79.   end;
  80. end;
  82. procedure TCommDlgForm.Anynewfile1Click(Sender: TObject);
  83. begin
  84.   with OpenDialog1 do
  85.   begin
  86.     Filter := 'Any File (*.*)|*.*';
  87.     FileName := '';
  88.     Options := [];
  89.     if Execute then
  90.       Memo1.Lines.LoadFromFile (FileName);
  91.   end;
  92. end;
  94. procedure TCommDlgForm.MultipleSelection1Click(Sender: TObject);
  95. var
  96.   i: Integer;
  97. begin
  98.   with OpenDialog1 do
  99.   begin
  100.     Filter := 'Text File (*.txt)|*.txt|Any File (*.*)|*.*';
  101.     Filename := '';
  102.     Options := [ofAllowMultiSelect, ofPathMustExist];
  103.     if Execute then
  104.       for i := 0 to Files.Count - 1 do
  105.         if MessageDlg ('Open file ' + Files.Strings [i] + '?',
  106.             mtConfirmation, [mbYes, mbNo], 0) = mrYes then
  107.           Memo1.Lines.LoadFromFile (Files.Strings [i]);
  108.     end;
  109. end;
  111. procedure TCommDlgForm.TextFile1Click(Sender: TObject);
  112. begin
  113.   with SaveDialog1 do
  114.   begin
  115.     Filter := 'Text File (*.txt)|*.txt';
  116.     DefaultExt := 'txt';
  117.     Filename := '';
  118.     Options := [ofPathMustExist];
  119.     if Execute then
  120.       if ofExtensionDifferent in Options then
  121.         MessageDlg ('Not a txt extension', mtError, [mbOK], 0)
  122.       else
  123.         Memo1.Lines.SaveToFile (FileName);
  124.   end;
  125. end;
  127. procedure TCommDlgForm.AnyFile1Click(Sender: TObject);
  128. begin
  129.   with SaveDialog1 do
  130.   begin
  131.     Filter := 'Any File (*.*)|*.*';
  132.     Filename := '';
  133.     Options := [ofPathMustExist];
  134.     if Execute then
  135.       Memo1.Lines.SaveToFile (FileName);
  136.   end;
  137. end;
  139. procedure TCommDlgForm.OnlyTrueType1Click(Sender: TObject);
  140. begin
  141.   with FontDialog1 do
  142.   begin
  143.     if Execute then
  144.       Memo1.Font := Font;
  145.   end;
  146. end;
  148. procedure TCommDlgForm.NoEffects1Click(Sender: TObject);
  149. begin
  150.   with FontDialog1 do
  151.   begin
  152.     if Execute then
  153.       Memo1.Font := Font;
  154.   end;
  155. end;
  157. procedure TCommDlgForm.NoStyle1Click(Sender: TObject);
  158. begin
  159.   with FontDialog1 do
  160.   begin
  161.     if Execute then
  162.       Memo1.Font := Font;
  163.   end;
  164. end;
  166. procedure TCommDlgForm.Standard1Click(Sender: TObject);
  167. begin
  168.   with ColorDialog1 do
  169.   begin
  170.     if Execute then
  171.       Memo1.Color := Color;
  172.   end;
  173. end;
  175. procedure TCommDlgForm.FullOpen1Click(Sender: TObject);
  176. begin
  177.   with ColorDialog1 do
  178.   begin
  179.     if Execute then
  180.       Memo1.Color := Color;
  181.   end;
  182. end;
  184. procedure TCommDlgForm.NoFullOpen1Click(Sender: TObject);
  185. begin
  186.   with ColorDialog1 do
  187.   begin
  188.     if Execute then
  189.       Memo1.Color := Color;
  190.   end;
  191. end;
  193. procedure TCommDlgForm.AboutCommonDialogsTest1Click(Sender: TObject);
  194. begin
  195.   MessageDlg ('The ''Common Dialogs Test'' application has been written' +
  196.     Chr(13) + 'for the book "Mastering Delphi" by Marco Cant