Тема: Delphi,Access...
Показать сообщение отдельно
Старый 31.01.2006, 01:38     # 12
ЕЖ
::VIP::
 
Регистрация: 19.03.2004
Сообщения: 1 329

ЕЖ Бог с наворотамиЕЖ Бог с наворотами
ЕЖ Бог с наворотамиЕЖ Бог с наворотами
Самый простой вариант для выбора папки
PHP код:
uses FileCtrl;
var
   
Dir: string='';
begin
  
if SelectDirectory('текст', '', Dir) then
    Edit1
.Text:=Dir;
end; 
Либо вот Unit реализации диалога выбора папки, который напрямую обращается к API функции SHBrowseForFolder (SelectDirectory тоже её пользует). Тут функция BrowseFolder будет возвращать тебе путь к выбранной папке
PHP код:
unit SHBrowseFolder;
interface

  
Uses Windows, SysUtils;

  Function 
BrowseFolder(aWndOwner: THandle; aTitle: String; FromPath: String = ''): String;

implementation

  Uses ActiveX
, ShlObj;
  Var 
fSHMalloc: IMalloc = Nil;

    Function 
BrowseCallbackProc(ahwnd: HWND; uMsg: UINT; alParam, lpData: LPARAM): integer; StdCall;
    
Begin
      
If uMsg = BFFM_INITIALIZED Then
        PostMessage
(ahwnd, BFFM_SETSELECTION, DWORD(True), DWORD(lpData));
      
Result := 0;
    
End;

  Function 
BrowseFolder(aWndOwner: THandle; aTitle: String; FromPath: String = ''): String;
  Var
    
anInfo: TBrowseInfo;
    
aResult: PItemIDList;
  
Begin
    ZeroMemory
(@anInfo, SizeOf(anInfo));
    
anInfo.hwndOwner := aWndOwner;
    
anInfo.lpszTitle := PChar(aTitle);
    
anInfo.ulFlags := BIF_RETURNONLYFSDIRS;
    If 
FromPath <> '' Then
    Begin
      anInfo
.lpfn := @BrowseCallbackProc;
      
anInfo.lParam := DWORD(PChar(FromPath));
    
End;
    
aResult := SHBrowseForFolder(anInfo);
    If 
aResult = Nil Then Abort;
    Try
      
SetLength(Result, MAX_PATH);
      
Win32Check(SHGetPathFromIDList(aResult, PChar(Result)));
      
SetLength(Result, StrLen(PChar(Result)));
    
Finally
      fSHMalloc
.Free(aResult);
    
End;
  
End;

Initialization
  Win32Check
(SHGetMalloc(fSHMalloc) = NOERROR);

Finalization
  
If fSHMalloc <> Nil Then
    fSHMalloc
._Release;
end. 
ЕЖ вне форума