unit udir;

interface

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

type
  Tform_dir = class(TForm)
    DirectoryListBox1: TDirectoryListBox;
    Button1: TButton;
    e_nomeDir: TEdit;
    b_ok: TButton;
    b_cancela: TButton;
    procedure FormActivate(Sender: TObject);
    procedure b_cancelaClick(Sender: TObject);
    procedure b_okClick(Sender: TObject);
    procedure DirectoryListBox1Change(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  form_dir: Tform_dir;

function escolhePastaBase (dirAtual: string): string;

implementation

var
    dir_escolhido: string;

  {$R *.dfm}

procedure Tform_dir.FormActivate(Sender: TObject);
begin
    DirectoryListBox1.Directory := dir_escolhido;
    e_nomeDir.Text := dir_escolhido;
end;

procedure Tform_dir.b_cancelaClick(Sender: TObject);
begin
    dir_escolhido := '';
    close;
end;

procedure Tform_dir.b_okClick(Sender: TObject);
begin
    dir_escolhido := e_nomeDir.Text;
    close;
end;

function escolhePastaBase (dirAtual: string): string;
begin
    dir_escolhido := dirAtual;
    form_dir.ShowModal;
    result := dir_escolhido;
end;

procedure Tform_dir.DirectoryListBox1Change(Sender: TObject);
begin
    e_nomeDir.Text := DirectoryListBox1.Directory;
end;

procedure Tform_dir.Button1Click(Sender: TObject);
var novoNome: string;
begin
    novoNome := '';
    if InputQuery('Criando subpasta', 'Qual o nome? ', novoNome) then
        begin
            {$I-} mkdir (DirectoryListBox1.Directory+'\'+novoNome);  {$I+}
            if ioresult <> 0 then
                showMessage ('Não foi possível criar com este nome')
            else
                begin
                    DirectoryListBox1.Directory := DirectoryListBox1.Directory+'\'+novoNome;
                    DirectoryListBox1.Refresh;
                end;
        end;
end;

end.