Project Structure

• QCommDlg.dpr
• CdlgTest.pas
• CdlgTest.dfm

program QCommDlg;

uses
  QForms,
  CdlgTest in 'CdlgTest.pas' {CommDlgForm};

{$R *.res}

begin
  Application.CreateForm(TCommDlgForm, CommDlgForm);
  Application.Run;
end.

unit Cdlgtest;

interface

uses
  Qt, Classes, QGraphics, QForms, QControls,
  QMenus, QStdCtrls, QDialogs, QTypes;

type
  TCommDlgForm = class(TForm)
    OpenDialog1: TOpenDialog;
    SaveDialog1: TSaveDialog;
    FontDialog1: TFontDialog;
    ColorDialog1: TColorDialog;
    MainMenu1: TMainMenu;
    Memo1: TMemo;
    Open1: TMenuItem;
    TextFiles1: TMenuItem;
    Anynewfile1: TMenuItem;
    MultipleSelection1: TMenuItem;
    Save1: TMenuItem;
    TextFile1: TMenuItem;
    AnyFile1: TMenuItem;
    Font1: TMenuItem;
    Standard1: TMenuItem;
    Help1: TMenuItem;
    AboutCommonDialogsTest1: TMenuItem;
    FindDialog1: TFindDialog;
    ReplaceDialog1: TReplaceDialog;
    Search1: TMenuItem;
    Search2: TMenuItem;
    Replace1: TMenuItem;
    Others1: TMenuItem;
    procedure TextFiles1Click(Sender: TObject);
    procedure Anynewfile1Click(Sender: TObject);
    procedure MultipleSelection1Click(Sender: TObject);
    procedure TextFile1Click(Sender: TObject);
    procedure AnyFile1Click(Sender: TObject);
    procedure OnlyTrueType1Click(Sender: TObject);
    procedure NoEffects1Click(Sender: TObject);
    procedure NoStyle1Click(Sender: TObject);
    procedure Standard1Click(Sender: TObject);
    procedure FullOpen1Click(Sender: TObject);
    procedure NoFullOpen1Click(Sender: TObject);
    procedure AboutCommonDialogsTest1Click(Sender: TObject);
    procedure Search2Click(Sender: TObject);
    procedure Replace1Click(Sender: TObject);
    procedure FindDialog1Find(Sender: TObject);
    procedure ReplaceDialog1Replace(Sender: TObject);
    procedure ReplaceDialog1Find(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  CommDlgForm: TCommDlgForm;

implementation

{$R *.xfm}

procedure TCommDlgForm.TextFiles1Click(Sender: TObject);
begin
  with OpenDialog1 do
  begin
    Filter := 'Text File (*.txt)|*.txt';
    DefaultExt := 'txt';
    Filename := '';
    Options := [ofFileMustExist,
      ofPathMustExist];
    if Execute then
      if ofExtensionDifferent in Options then
        MessageDlg ('Not a file with the .TXT extension',
          mtError, [mbOK], 0)
      else
        Memo1.Lines.LoadFromFile (FileName);
  end;
end;

procedure TCommDlgForm.Anynewfile1Click(Sender: TObject);
begin
  with OpenDialog1 do
  begin
    Filter := 'Any File (*.*)|*.*';
    FileName := '';
    Options := [];
    if Execute then
      Memo1.Lines.LoadFromFile (FileName);
  end;
end;

procedure TCommDlgForm.MultipleSelection1Click(Sender: TObject);
var
  i: Integer;
begin
  with OpenDialog1 do
  begin
    Filter := 'Text File (*.txt)|*.txt|Any File (*.*)|*.*';
    Filename := '';
    Options := [ofAllowMultiSelect, ofPathMustExist];
    if Execute then
      for i := 0 to Files.Count - 1 do
        if MessageDlg ('Open file ' + Files.Strings [i] + '?',
            mtConfirmation, [mbYes, mbNo], 0) = mrYes then
          Memo1.Lines.LoadFromFile (Files.Strings [i]);
    end;
end;

procedure TCommDlgForm.TextFile1Click(Sender: TObject);
begin
  with SaveDialog1 do
  begin
    Filter := 'Text File (*.txt)|*.txt';
    DefaultExt := 'txt';
    Filename := '';
    Options := [ofPathMustExist];
    if Execute then
      if ofExtensionDifferent in Options then
        MessageDlg ('Not a txt extension', mtError, [mbOK], 0)
      else
        Memo1.Lines.SaveToFile (FileName);
  end;
end;

procedure TCommDlgForm.AnyFile1Click(Sender: TObject);
begin
  with SaveDialog1 do
  begin
    Filter := 'Any File (*.*)|*.*';
    Filename := '';
    Options := [ofPathMustExist];
    if Execute then
      Memo1.Lines.SaveToFile (FileName);
  end;
end;

procedure TCommDlgForm.OnlyTrueType1Click(Sender: TObject);
begin
  with FontDialog1 do
  begin
    if Execute then
      Memo1.Font := Font;
  end;
end;

procedure TCommDlgForm.NoEffects1Click(Sender: TObject);
begin
  with FontDialog1 do
  begin
    if Execute then
      Memo1.Font := Font;
  end;
end;

procedure TCommDlgForm.NoStyle1Click(Sender: TObject);
begin
  with FontDialog1 do
  begin
    if Execute then
      Memo1.Font := Font;
  end;
end;

procedure TCommDlgForm.Standard1Click(Sender: TObject);
begin
  with ColorDialog1 do
  begin
    if Execute then
      Memo1.Color := Color;
  end;
end;

procedure TCommDlgForm.FullOpen1Click(Sender: TObject);
begin
  with ColorDialog1 do
  begin
    if Execute then
      Memo1.Color := Color;
  end;
end;

procedure TCommDlgForm.NoFullOpen1Click(Sender: TObject);
begin
  with ColorDialog1 do
  begin
    if Execute then
      Memo1.Color := Color;
  end;
end;

procedure TCommDlgForm.AboutCommonDialogsTest1Click(Sender: TObject);
begin
  MessageDlg ('The ''Common Dialogs Test'' application has been written' +
    Chr(13) + 'for the book "Mastering Delphi" by Marco Cantù',
    mtInformation, [mbOk], 0);
end;

procedure TCommDlgForm.Search2Click(Sender: TObject);
begin
  FindDialog1.Execute;
end;

procedure TCommDlgForm.Replace1Click(Sender: TObject);
begin
  ReplaceDialog1.Execute;
end;

procedure TCommDlgForm.FindDialog1Find(Sender: TObject);
var
  FoundPos, InitPos: Integer;
begin
  {search in the text after the current selection}
  InitPos := Memo1.SelStart + Memo1.SelLength;
  FoundPos := Pos (FindDialog1.FindText,
    Copy (Memo1.Text, InitPos + 1,
      Length (Memo1.Text) - InitPos));
  if FoundPos > 0 then
  begin
    {activate the component, and select the text}
    Memo1.SetFocus;
    Memo1.SelStart := InitPos + FoundPos - 1;
    Memo1.SelLength := Length(FindDialog1.FindText);
  end
  else
  begin
    MessageDlg ('Text not found', mtInformation, [mbOK], 0);
  end;
end;

procedure TCommDlgForm.ReplaceDialog1Replace(Sender: TObject);
var
  FoundPos, InitPos: Integer;
begin
  {search in the text after the current selection}
  InitPos := Memo1.SelStart + Memo1.SelLength;
  FoundPos := Pos (ReplaceDialog1.FindText,
    Copy (Memo1.Text, InitPos + 1,
      Length (Memo1.Text) - InitPos));
  if FoundPos > 0 then
  begin
    {activate the component, and select the text}
    Memo1.SetFocus;
    Memo1.SelStart := InitPos + FoundPos - 1;
    Memo1.SelLength := Length (ReplaceDialog1.FindText);
    Memo1.SelText := ReplaceDialog1.ReplaceText;
  end
  else
  begin
    MessageDlg ('Text not found', mtInformation, [mbOK], 0);
  end;
end;

procedure TCommDlgForm.ReplaceDialog1Find(Sender: TObject);
begin
  FindDialog1.FindText := ReplaceDialog1.FindText;
  FindDialog1Find (ReplaceDialog1);
end;

end.

object CommDlgForm: TCommDlgForm
  Left = 119
  Top = 153
  Width = 532
  Height = 355
  ActiveControl = Memo1
  Caption = 'Common Dialogs Test'
  Color = clButton
  Font.Color = clBlack
  Font.Height = 11
  Font.Name = 'MS Sans Serif'
  Font.Pitch = fpVariable
  Font.Style = []
  Font.Weight = 40
  Menu = MainMenu1
  ParentFont = False
  PixelsPerInch = 96
  TextHeight = 13
  TextWidth = 6
  object Memo1: TMemo
    Left = 0
    Top = 0
    Width = 532
    Height = 332
    Align = alClient
    Font.Color = clBlack
    Font.Height = 13
    Font.Name = 'Times New Roman'
    Font.Pitch = fpVariable
    Font.Style = []
    Font.Weight = 40
    ParentFont = False
    ScrollBars = ssBoth
    TabOrder = 0
  end
  object OpenDialog1: TOpenDialog
    Title = 'Open'
    Left = 96
    Top = 16
  end
  object SaveDialog1: TSaveDialog
    Title = 'Save As'
    Left = 96
    Top = 64
  end
  object FontDialog1: TFontDialog
    Font.Color = clText
    Font.Height = 13
    Font.Name = 'System'
    Font.Pitch = fpVariable
    Font.Style = []
    Font.Weight = 40
    Left = 168
    Top = 16
  end
  object ColorDialog1: TColorDialog
    Left = 312
    Top = 16
  end
  object MainMenu1: TMainMenu
    Left = 32
    Top = 16
    object Open1: TMenuItem
      Caption = '&Open'
      object TextFiles1: TMenuItem
        Caption = 'Existing &Text Files...'
        OnClick = TextFiles1Click
      end
      object Anynewfile1: TMenuItem
        Caption = '&Any file...'
        OnClick = Anynewfile1Click
      end
      object MultipleSelection1: TMenuItem
        Caption = '&Multiple Selection...'
        OnClick = MultipleSelection1Click
      end
    end
    object Save1: TMenuItem
      Caption = '&Save'
      object TextFile1: TMenuItem
        Caption = '&Text File...'
        OnClick = TextFile1Click
      end
      object AnyFile1: TMenuItem
        Caption = '&Any File...'
        OnClick = AnyFile1Click
      end
    end
    object Others1: TMenuItem
      Caption = 'Others'
      object Font1: TMenuItem
        Caption = '&Font'
        OnClick = OnlyTrueType1Click
      end
      object Standard1: TMenuItem
        Caption = '&Color...'
        OnClick = Standard1Click
      end
    end
    object Search1: TMenuItem
      Caption = '&Search'
      object Search2: TMenuItem
        Caption = '&Search...'
        OnClick = Search2Click
      end
      object Replace1: TMenuItem
        Caption = '&Replace...'
        OnClick = Replace1Click
      end
    end
    object Help1: TMenuItem
      Caption = '&Help'
      object AboutCommonDialogsTest1: TMenuItem
        Caption = 'About Common Dialogs Test...'
        OnClick = AboutCommonDialogsTest1Click
      end
    end
  end
  object FindDialog1: TFindDialog
    Options = [frDown, frMatchCase, frDisableMatchCase, frDisableUpDown, frDisableWholeWord]
    Title = 'Find'
    OnFind = FindDialog1Find
    Left = 376
    Top = 16
  end
  object ReplaceDialog1: TReplaceDialog
    Options = [frDown, frMatchCase, frDisableMatchCase, frDisableWholeWord]
    Title = 'Replace'
    OnFind = ReplaceDialog1Find
    OnReplace = ReplaceDialog1Replace
    Left = 376
    Top = 64
  end
end