(************************************************************************
*    This File is Part of the AHM Triton Tools                          *
*    for Borland Delphi and C++ Builder.                                *
*************************************************************************
* Copyright © 1995-1999 Alexander H. Mehlhorn (AHM) and Tritontools.com *
* All Rights reserved.                                                  *
*                                                                       *
*    For more Information contact us at                                 *
*    E-Mail : support@tritontools.com                                   *
*    URL : http://www.tritontools.com                                   *
*                                                                       *
*    AHM is copyright by Alexander H. Mehlhorn                          *
*    All Parts of this Collection were developed,                       *
*    designed and implemented by AHM                                    *
*                                                                       *
*    Under no Circumstances may you distribute this file                *
*    in this or any other format. This File is supplied                 *
*    as Evaluation of Source only. No Delphi Components may be developed*
*    using extracts or subsets of this code without expressed permission*
*    by AHM.                                                            *
*                                                                       *
*************************************************************************)
unit AHMTFolderLookup;

interface
{$I AHM.INC}
uses
  Windows, Messages, Classes, Forms, Dialogs, SysUtils, Shlobj, Controls,
  Graphics,ShellAPI,AHMTLookupEdit,AHMStdClass;
type
  TAHMPathChange = Procedure (Sender : TObject; OldPath,NewPath : String) of Object;
  TAHMRoots=(csidlDesktop,csidlDesktopExpanded,csidlPrograms,csidlControlPanel,csidlPrinters,csidlPersonal,csidlFavorites,
                csidlStartup,csidlRecent,csidlSendto,csidlRecycleBin,csidlStartMenu,csidlDesktopDirectory,csidlMyComputer,
                csidlNetwork,csidlNetworkNeighborhood,csidlFonts,csidlTemplates);
  TAHMInfoFlags=(FileSystemDirsOnly,DontGoBelowDomain,StatusText,FileSystemAncestors,LookupForComputer,LookupForPrinter,DisplayPath);
  TAHMInfoFlagSet=set of TAHMInfoFlags;
  TAHMFolderLookup = class(TAHMCustomLookupEdit)
  private
     FAboutStr : TAHMAboutSControlStr;
     FDialogHandle: HWnd;
     FTitle: String;
     FParentHandle: HWnd;
     FDisplayName: String;
     FLookupFlags: TAHMInfoFlagSet;
     FLookupRoot: TAHMRoots;
     FBeforeLookup : TNotifyevent;
     FAfterLookup : TNotifyevent;
     FOnPathChanged : TAHMPathChange;
  protected
     function Execute : Boolean;
     procedure OnLookupPress(Sender : TObject);
  public
    constructor Create(AOwner: TComponent); override;
    procedure SetStatusText(const Hwnd: HWND; const StatusText: String);
    procedure SetSelectionPIDL(const Hwnd: HWND; const ItemIDList: PItemIDList);
    procedure SetSelectionPath(const Hwnd: HWND; const Path: String);
    procedure EnableOK(const Hwnd: HWND; const Value: Boolean);
    property DisplayName: String read FDisplayName;
    property ParentHandle: HWnd read FParentHandle write FParentHandle;
    property DialogHandle: HWnd read FDialogHandle write FDialogHandle;
  published
    property About : TAHMAboutSControlStr read FAboutStr write FAboutStr;
    {$IFDEF AHMONLY4}
    property Anchors;
    property BiDiMode;
    property Constraints;
    property DragCursor;
    property DragKind;
    property DragMode;
    property ParentBiDiMode;
    {$ENDIF}
    property LookupCaption: String read FTitle write FTitle;
    property LookupFlags: TAHMInfoFlagSet read FLookupFlags write FLookupFlags;
    property LookupRoot : TAHMRoots read FLookupRoot write FLookupRoot default csidlDesktopExpanded;
    property BeforeLookup : TNotifyevent read FBeforeLookup write FBeforeLookup;
    property AfterLookup : TNotifyEvent read FAfterLookup write FAfterLookup;
    property OnPathChanged : TAHMPathChange read FOnPathChanged write FOnPathChanged;
    property EditButton1;
    Property Enabled;
    property Alignment;
    property EditMask;
    property MaxLength;
    property Text;
    property AutoSize;
    property CharCase;
    property PasswordChar;
    property ReadOnly;
    property Font;
    property OnEnter;
    property OnExit;
    property OnKeyDown;
    property OnKeyPress;
    property OnKeyUp;
    property OnClick;
    property OnDblClick;
    property OnDragDrop;
    property OnDragOver;
    property OnEndDrag;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnStartDrag;
  end;
  procedure AHMLookuprCallbackProc(HWindow: HWND; uMsg: Integer; lParameter: LPARAM; lpLookupFolder: LPARAM); stdcall;

implementation

{$R AHMFolderLookup.res}
const
  CUSTOM_BUTTON_ID=255;
  MAX_PATH_DISPLAY_LENGTH=35;
  LookupPathA:
    array[TAHMRoots] of LongInt=(CSIDL_DESKTOP,-1,CSIDL_PROGRAMS,CSIDL_CONTROLS,CSIDL_PRINTERS,
      CSIDL_PERSONAL,CSIDL_FAVORITES,CSIDL_STARTUP,CSIDL_RECENT,CSIDL_SENDTO,CSIDL_BITBUCKET,
      CSIDL_STARTMENU,CSIDL_DESKTOPDIRECTORY,CSIDL_DRIVES,CSIDL_NETWORK,CSIDL_NETHOOD,CSIDL_FONTS,
      CSIDL_TEMPLATES);
  LookupFlagsA:
    array[TAHMInfoFlags] of DWord=(BIF_RETURNONLYFSDIRS,BIF_DONTGOBELOWDOMAIN,BIF_STATUSTEXT,
                                 BIF_RETURNFSANCESTORS,BIF_BROWSEFORCOMPUTER,BIF_BROWSEFORPRINTER,1000);

procedure AHMCenterWindow(HWindow: HWND);
var
  Rect: TRect;
  FWRect: TRect;
  fw,fh : Integer;
begin
  GetWindowRect(HWindow,Rect);
  fw:=(Screen.Width div 2)-((Rect.Right-Rect.Left) div 2);
  fh:=(Screen.Height div 2)-((Rect.bottom-Rect.top) div 2);
  GetWindowRect(0,FWRect);
  SetWindowPos(HWindow,0,fw,fh,0,0,SWP_NOACTIVATE or SWP_NOSIZE or SWP_NOZORDER);
end;

function AHMDirectoryExists(const Name: string): Boolean;
var
  Code: Integer;
begin
  Code := GetFileAttributes(PChar(Name));
  Result := (Code <> -1) and (FILE_ATTRIBUTE_DIRECTORY and Code <> 0);
end;

procedure AHMLookuprCallbackProc(HWindow: HWND; uMsg: Integer; lParameter: LPARAM;
                                 lpLookupFolder: LPARAM);
var
  Instance: TAHMFolderLookup;
  Path: String;
  ValidPath: Boolean;
  TempPath: array[0..MAX_PATH] of Char;
begin
  Instance:=TAHMFolderLookup(lpLookupFolder);
  case uMsg of
    BFFM_INITIALIZED:
    begin
      Instance.DialogHandle:=HWindow;
      AHMCenterWindow(HWindow);
      SetWindowLong(HWindow,GWL_USERDATA,lpLookupFolder);
      if AHMDirectoryExists(Instance.Text) then
         Instance.SetSelectionPath(HWindow,Instance.Text);
    end;
    BFFM_SELCHANGED:
    begin
      SHGetPathFromIDList(PItemIDList(lParameter),TempPath);
      if (DisplayPath in Instance.FLookupFlags) then
      begin
        SetLength(Path,MAX_PATH);
        Path:=StrPas(TempPath);
        SendMessage(HWindow,BFFM_SETSTATUSTEXT,0,Longint(PChar(Path)));
      end;
      ValidPath:=SHGetPathFromIDList(PItemIDList(lParameter),TempPath);
      Instance.EnableOK(HWIndow,ValidPath);
    end;
  end;
end;

constructor TAHMFolderLookup.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  EditButton1.Glyph.LoadFromResourceName(HInstance,'AHMFolderLookup');
  EditButton1.NumGlyphs:=2;
  EditButton2.Visible:=False;
  OnButton1Click:=OnLookupPress;
  SetLength(FDisplayName,MAX_PATH);
  FParentHandle:=0;
  FLookupRoot:=csidlDesktopExpanded;
  FLookupFlags:=[FileSystemDirsOnly,StatusText];
end;

procedure TAHMFolderLookup.SetStatusText(const Hwnd: HWND; const StatusText: String);
begin
  SendMessage(Hwnd,BFFM_SETSTATUSTEXT,0,Longint(PChar(StatusText)));
end;

procedure TAHMFolderLookup.SetSelectionPIDL(const Hwnd: HWND; const ItemIDList: PItemIDList);
begin
  SendMessage(Hwnd,BFFM_SETSELECTION,Ord(FALSE),Longint(ItemIDList));
end;

procedure TAHMFolderLookup.SetSelectionPath(const Hwnd: HWND; const Path: String);
begin
  SendMessage(Hwnd,BFFM_SETSELECTION,Ord(TRUE),Longint(PChar(Path)));
end;

procedure TAHMFolderLookup.EnableOK(const Hwnd: HWND; const Value: Boolean);
begin
  SendMessage(Hwnd,BFFM_ENABLEOK,0,Ord(Value));
end;

procedure TAHMFolderLookup.OnLookupPress(Sender : TObject);
begin
  Execute;
end;

function TAHMFolderLookup.Execute: Boolean;
var
  SearchOptions: TBrowseInfo;
  i: Integer;
  ItemIDList : PItemIDList;
  TempPath: array[0..MAX_PATH] of Char;
  OldText:String;
begin
  FillChar(SearchOptions,Sizeof(TBrowseInfo),#0);
  if assigned(FBeforeLookup) then FBeforeLookup(self);
  try
    if IsWindow(FParentHandle) then SearchOptions.hwndOwner:=FParentHandle else
       if (Owner is TWinControl) then SearchOptions.hwndOwner:=TWinControl(Owner).Handle
           else SearchOptions.hwndOwner:=Application.MainForm.Handle;
    if FLookupRoot=csidlDesktopExpanded then SearchOptions.pidlRoot:=nil else
       SHGetSpecialFolderLocation(Application.Handle,LookupPathA[FLookupRoot],SearchOptions.pidlRoot);
    SearchOptions.pszDisplayName:=PChar(FDisplayName);
    SearchOptions.lpszTitle:=PChar(FTitle);
    SearchOptions.ulFlags:=0;
    for i:=0 to 5 do
    if TAHMInfoFlags(i) in FLookupFlags then
       SearchOptions.ulFlags:=SearchOptions.ulFlags or LookupFlagsA[TAHMInfoFlags(i)];
    SearchOptions.lpfn:=@AHMLookuprCallbackProc;
    SearchOptions.lParam:=Longint(Self);
    SearchOptions.iImage:=0;
    ItemIDList:=SHBrowseForFolder(SearchOptions);
    Result:=ItemIDList<>nil;
    if Result then
    begin
      SHGetPathFromIDList(ItemIDList,TempPath);
      if Text<>StrPas(TempPath) then
      begin
         OldText:=Text;
         Text:=StrPas(TempPath);
         If Assigned(FOnPathChanged) then FOnPathChanged(Self,OldText,Text);
      end else Text:=StrPas(TempPath);
    end;
  finally
    SearchOptions.pidlRoot:=nil;
  end;
  if assigned(FAfterLookup) then FAfterLookup(self);
end;

end.
