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
|