Marco's Web Center

Menu for Development

Site Menu
Object Pascal Handbook
Delphi Handbooks Collection
Mastering Borland Delphi 2005
(Old) White Papers
(Old)Tools
(Old) Conferences

My Other Sites
Italian Site (www.marcocantu.it)
the delphi search

Spirit of delphi

Advertising
Home My Blog Books Object Pascal 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