lazarus/components/lazcontrols/shortpathedit.pas

unit ShortPathEdit;

{$mode objfpc}{$H+}

interface

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

type

  { TShortPathEdit }

  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.