lazarus/components/lazcontrols/shortpathedit.pas

unit shortpathedit;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, EditBtn, LResources, Dialogs, FileUtil;

Type
  TShortPathEdit = class(TDirectoryEdit)
    private
      FDirectory : String;
      FOnAcceptDir: TAcceptFileNameEvent;
    protected
      function CreateDialog: TCommonDialog; override;
      procedure RunDialog; override;
    published
      property Directory: String read FDirectory write FDirectory;
      property OnAcceptDirectory: TAcceptFileNameEvent read FOnAcceptDir write FonAcceptDir;
  end;

procedure Register;

implementation

function TShortPathEdit.CreateDialog: TCommonDialog;
begin
  Result:=TSelectDirectoryDialog.Create(Self);
  if DirPathExists(Directory) then
  begin
    TSelectDirectoryDialog(Result).InitialDir:=Directory;
    TSelectDirectoryDialog(Result).FileName:='';
  end
  else
  begin
    TSelectDirectoryDialog(Result).InitialDir:=RootDir;
    TSelectDirectoryDialog(Result).FileName:=Directory;
  end;
  // Set some common things.
  Result.Title := DialogTitle;
end;

procedure TShortPathEdit.RunDialog;
var
  D: String;
  Dlg: TCommonDialog;
  B: Boolean;
begin
  Dlg:=CreateDialog;
  try
    B:=Dlg.Execute;
    if B then
      D:=GetDialogResult(Dlg);
  finally
    Dlg.Free;
  end;
  if B then
  begin
    if Assigned(FOnAcceptDir) then
    begin
      FOnAcceptdir(Self,D);
      if (D<>'') then
        Directory:=D;
    end
    else
      Directory:=D;
  end;
end;

procedure Register;
begin
  {$I shortpathedit_icon.lrs}
  RegisterComponents('LazControls',[TShortPathEdit]);
end;


end.