Logo Delphi Developer Days 2011

Menu for Development

Site Menu
Delphi 2010 Handbook
Delphi 2009 Handbook
Delphi 2007 Handbook
Mastering Borland Delphi 2005
Essential Pascal
Essential Delphi
Buy Books Online
Code Repository
Newsgroups
White Papers
Tools
Conferences
Training
Delphi Links
Contact Marco

My Other Sites
Italian Site (www.marcocantu.it)
Developers Newsgroups Browser (dev.newswhat.com)
My town (www.piazzacavalli.net)
the delphi search
Wintech Italia (my company)

Advertising
Home My Blog Books My Bookstore Development Links Marco



Home: Code Repository: Mastering Delphi 5

Project DIRS

Project Structure


DIRS.DPR

program Dirs;

uses
  Forms,
  DirsForm in 'DirsForm.pas' {Form1};

{$R *.RES}

begin
  Application.CreateForm(TForm1, Form1);
  Application.Run;
end.

DIRSFORM.PAS

unit DirsForm;

interface

uses
  SysUtils, Windows, Messages, Classes, Graphics, Controls,
  Forms, Dialogs, StdCtrls, FileCtrl, ShlObj;

type
  TForm1 = class(TForm)
    Edit1: TEdit;
    Label1: TLabel;
    TestButton: TButton;
    CreateButton: TButton;
    SelectButton: TButton;
    btnBrowse: TButton;
    procedure TestButtonClick(Sender: TObject);
    procedure Edit1Change(Sender: TObject);
    procedure CreateButtonClick(Sender: TObject);
    procedure SelectButtonClick(Sender: TObject);
    procedure btnBrowseClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.TestButtonClick(Sender: TObject);
begin
  if DirectoryExists (Edit1.Text) then
    MessageDlg ('OK, the directory ' +
      Edit1.Text + ' exists', mtInformation, [mbOk], 0)
  else
    MessageDlg ('Sorry, the directory ' + Edit1.Text +
      ' doesn''t exist', mtError, [mbOk], 0);
end;

procedure TForm1.Edit1Change(Sender: TObject);
begin
  if Edit1.TExt <> '' then
  begin
    TestButton.Enabled := True;
    CreateButton.Enabled := True;
  end
  else
  begin
    TestButton.Enabled := False;
    CreateButton.Enabled := False;
  end;
end;

procedure TForm1.CreateButtonClick(Sender: TObject);
begin
  if MessageDlg ('Are you sure you want to create the ' +
      Edit1.Text + ' directory', mtConfirmation,
      [mbYes, mbNo], 0) = mrYes then
    ForceDirectories (Edit1.Text);
end;

procedure TForm1.SelectButtonClick(Sender: TObject);
var
  Text: string;
begin
  Text := Edit1.Text;
  if SelectDirectory (Text, [sdAllowCreate,
      sdPerformCreate, sdPrompt], 0) then
    Edit1.Text := Text;
end;

procedure TForm1.btnBrowseClick(Sender: TObject);
var
  bi: TBrowseInfo;
  pidl: pItemIdList;
  strpath: string;
begin
  bi.hwndOwner := Handle;
  bi.pidlRoot := nil;
  bi.pszDisplayName := '';
  bi.lpszTitle := 'Select a folder';
  bi.ulFlags := bif_StatusText;
  bi.lpfn := nil;
  bi.lParam := 0;

  pidl := ShBrowseForFolder (bi);

  SetLength (strPath, 100);
  ShGetPathFromIdList (pidl, PChar(strPath));
  Edit1.Text := strPath;
end;

end.

DIRSFORM.DFM

object Form1: TForm1
  Left = 99
  Top = 151
  Width = 460
  Height = 198
  Caption = 'Dirs'
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clBlack
  Font.Height = -11
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  OldCreateOrder = True
  PixelsPerInch = 96
  TextHeight = 13
  object Label1: TLabel
    Left = 16
    Top = 35
    Width = 16
    Height = 13
    Caption = '&Dir:'
    FocusControl = Edit1
  end
  object Edit1: TEdit
    Left = 48
    Top = 32
    Width = 377
    Height = 21
    TabOrder = 0
    OnChange = Edit1Change
  end
  object TestButton: TButton
    Left = 72
    Top = 72
    Width = 89
    Height = 25
    Caption = 'Test'
    Enabled = False
    TabOrder = 1
    OnClick = TestButtonClick
  end
  object CreateButton: TButton
    Left = 196
    Top = 72
    Width = 85
    Height = 25
    Caption = 'Create'
    Enabled = False
    TabOrder = 2
    OnClick = CreateButtonClick
  end
  object SelectButton: TButton
    Left = 320
    Top = 72
    Width = 81
    Height = 25
    Caption = 'Select'
    TabOrder = 3
    OnClick = SelectButtonClick
  end
  object btnBrowse: TButton
    Left = 72
    Top = 112
    Width = 329
    Height = 25
    Caption = 'Browse for Folder (Windows Shell)'
    TabOrder = 4
    OnClick = btnBrowseClick
  end
end