Logo New book: Delphi 2007 Handbook
My blog in online
Delphi tech support service: support.marcocantu.com
Google
  Web www.marcocantu.com

Menu for Development

Site Menu
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)

Breaking News
Buy Mastering Borland Delphi 2005 from Amazon
Free ebook: Mastering Delphi Update for Delphi 2006

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