问一个很弱的问题：怎样调出windows的选择目录的对话框？(0分)

hello8 · 2002-08-05

怎么调出windows的选择目录的对话框并且得到选择的结果 最好有个sample

Nstar · 2002-08-05

SelectDiretory

koyochen · 2002-08-05

uses FileCtrl; var   strPath: string; begin   if SelectDirectory('请选择上报数据文件路径','', strPath) then   begin     //   end; end;

hello8 · 2002-08-05

执行完以后，没有返回到form1，怎么让程序返回焦点到form1？

naughtboy · 2002-08-05

焦点回到form1？这样 label1.caption:=strPath或edit1.text:=strPath，呵呵 不想显出来就设置他们visible为false

北斗 · 2002-08-05

在FORM上加一个OPENDIALOG 选文件之前执行，OPENDIALOG.EXCUTE就可以了。 选择值用OPENDIALOG.SELECTED返回。

SupermanTm · 2002-08-17

unit ShlFunc; {本单元可使用尽可能少的资源完成下面的功能} interface const //用于描述系统文件夹的前缀常量   nvF_PgmMenu = #$82; // [开始][程序]   nvF_MyDoc   = #$85; // 我的文档   nvF_BookMrk = #$86; // 收藏夹   nvF_Startup = #$87; // [开始][启动]   nvF_Recent  = #$88; // [开始][文档]   nvF_SendTo  = #$89; // 发送到...   nvF_StrMenu = #$8B; // [开始]   nvF_Desktop = #$90; // 桌面   nvF_Windows = #$A0; // Windows   nvF_System  = #$A1; // Windows/System   nvF_Temp    = #$A2; // Temp Directory   nvF_PgmFile = #$A3; // Program Files   nvF_PgmComm = #$A4;   nvF_AppData = #$A5; // Application Data //-----------------------------------------   nvF_ProgramMenu     = nvF_PgmMenu;   nvF_MyDocuments     = nvF_MyDoc;   nvF_Favorites       = nvF_Bookmrk;   nvF_Bookmark        = nvF_Bookmrk;   nvF_StartMenu       = nvF_StrMenu;   nvF_ProgramFile     = nvF_PgmFile;   nvF_CommonFile      = nvF_PgmComm;   nvF_ApplicationData = nvF_AppData; {/----------------------------------------- =============================================================================== 取系统文件夹, nvFolder 为上述常数, 可返回短文件名} function GetSysFolder(nvFolder: Char; ShortPath: Boolean): String; function DoGetSysFolder(nvFolder: Char; ShortPath: Boolean; var S: String): Integer; // 返回长度 { 展开如 nvF_Desktop+'MyFolder/MySubFolder' 的路径名, 结果可用 ExpandedPathName 变量访问} function GetExpandPathName(const xPath: String): String; function  DoExpandPathName(const xPath: String): Integer; // 返回长度 { 搜索文件夹, 可返回短文件名, hWnd可以是0(nil)或调用窗口的Handle} function SearchPaths(hWND: Integer; const Title: String; ShortPath: Boolean): String; { 创建快捷方式(ShortCutName可描述为 nvF_xxx+'.../.../YYY" ) 如果ShortCutName='' 那么加入到[开始][文档], 成功返回实际的lnk文件名长度, 失败返回0} function CreateFileShortCut(const FileName, ShortCutName: String): Integer; { 通用字符串函数(从Src中的第SrcId个开始拷贝Count个字符到Tar的TarId开始的位置, 返回目标串的长度) 该函数可避免频繁的字符串内存重分配 SrcId, TarId, Count都可以为0, TarId=0 时将在Tar后面连接Src, Count=0 时将一直复制到Src的结尾} function StrCopyEx(const Src: String; var Tar: String; SrcId, TarId, Count: Integer): Integer; { 取文件的短文件名} function DOSFileName(const FileName: String): String; function FileName8_3(var FileName: String): Integer; // 返回长度 { 路径是否存在, 如果AutoCreate, 那么如果路径不存在则自动创建} function PathExists(const xPath: String; AutoCreate: Boolean): Boolean; { 把文件删除到回收站} procedure EraseToRecyle(const FileName: String); var   ExpandedPathName: string; /////////////////////////////////////////////////////////////////////////////// implementation uses   ShellAPI, ShlObj, Windows; var   pxBrowse: PBrowseInfoA;   pxItemID: PItemIDList;   BrowseDlgTitle: String; { =============================================================================== } function StrCopyEx(const Src: String; var Tar: String; SrcId, TarId, Count: Integer): Integer; var   I: Integer; begin   if SrcId <= 0 then SrcId:= 0 else Dec(SrcId);   if Count <= 0 then Count:= Length(Src) - SrcId;   if TarId <= 0 then TarId:= Length(Tar) else Dec(TarId);   Result:= TarId + Count;   if Result > Length(Tar) then SetLength(Tar, Result);   for I:= 1 to Count do Tar[TarId + I]:= Src[SrcId + I]; end; { =============================================================================== } function DOSFileName(const FileName: String): String; begin   Result:= FileName;   SetLength(Result, FileName8_3(Result)); end; function FileName8_3(var FileName: String): Integer; begin   try     Result:= GetShortPathName(PChar(FileName), @FileName[1], Length(FileName));     if Result < Length(FileName) then FileName[Result+1]:= #0;   except     Result:= 0;   end; end; { =============================================================================== } function GetExpandPathName(const xPath: String): String; var   I, X: Integer; begin   X:= DoExpandPathName(xPath);   SetLength(Result, X);   for I:= 1 to X do Result:= ExpandedPathName; end; function DoExpandPathName(const xPath: String): Integer; begin   if Ord(xPath[1]) < $80 then begin     ExpandedPathName:= xPath + #0;     Result:= Length(xPath);   end else begin     if Length(ExpandedPathName) < 255 then SetLength(ExpandedPathName, 255);     Result:= DoGetSysFolder(xPath[1], false, ExpandedPathName);     Result:= StrCopyEx(xPath, ExpandedPathName, 2, Result+1, 0);     ExpandedPathName[Result+1]:= #0;   end; end; function PathExists(const xPath: String; AutoCreate: Boolean): Boolean; var   X: Integer; procedure CreatePaths; var   I: Integer; ch: char; begin   for I:= 1 to Length(ExpandedPathName) do begin     ch:= ExpandedPathName;     if ch = #0 then Break;     if ch <> '/' then Continue;     ch:= ExpandedPathName[I+1];     ExpandedPathName[I+1]:= #0;     X:= GetFileAttributes(@ExpandedPathName[1]);     ExpandedPathName[I+1]:= ch;     if (X <> -1) and (FILE_ATTRIBUTE_DIRECTORY and X <> 0) then Continue;     ExpandedPathName:= #0;     CreateDirectory(@ExpandedPathName[1], nil);     ExpandedPathName:= '/';   end; end; begin   DoExpandPathName(xPath);   X:= GetFileAttributes(@ExpandedPathName[1]);   Result:= (X <> -1) and (FILE_ATTRIBUTE_DIRECTORY and X <> 0);   if Result or (not AutoCreate) then Exit;   try CreatePaths; Result:= True; except end; end; { =============================================================================== } function GetSysFolder(nvFolder: Char; ShortPath: Boolean): String; begin   SetLength(Result, 255);   SetLength(Result, DoGetSysFolder(nvFolder, ShortPath, Result)); end; function DoGetSysFolder(nvFolder: Char; ShortPath: Boolean; var S: String): Integer; var   X: Integer; procedure zReadRegistry(const KeyName: String); var   phk: HKEY; begin   PShortString(X):= @S[1]; PShortString(X)^:= 'Software/Microsoft/Windows/CurrentVersion/Explorer/Shell Folders'#0;   if KeyName[1] = '/' then begin           //01234567890123456789012345678901234567890123     S[43]:= #0; X:= HKEY_LOCAL_MACHINE;    //0---------1---------2---------3---------4---   end else      X:= HKEY_CURRENT_USER;     //~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~   if RegOpenKeyEx(X, @S[2], 0, KEY_QUERY_VALUE, phk) = ERROR_SUCCESS then begin     X:= Length(S);     if RegQueryValueEx(phk, @KeyName[2], nil, nil, @S[1], Addr(X)) = ERROR_SUCCESS then Dec(X) else X:= 0;   end else X:= 0; end; begin Result:= 0; try   X:= Ord(nvFolder);   if X < $A0 then begin     if SHGetSpecialFolderLocation(0, (X and $7F), pxItemID) <> NOERROR then Exit;     if pxItemID = nil then Exit;     if not SHGetPathFromIDList(pxItemID, @S[1]) then Exit;     X:= Pos(#0, S) - 1;   end else case nvFolder of     nvF_Windows: X:= GetWindowsDirectory(@S[1], 255);     nvF_System : X:= GetSystemDirectory(@S[1], 255);     nvF_Temp   : X:= GetTempPath(255, @S[1]);     nvF_PgmFile: zReadRegistry('/ProgramFilesDir'#0);     nvF_PgmComm: zReadRegistry('/CommonFilesDir'#0);     nvF_AppData: zReadRegistry('.AppData'#0);   end; {case}   if X = 0 then Exit;   if ShortPath then X:= FileName8_3(S);   if S[X] <> '/' then begin Inc(X); S[X]:= '/'; end;   Result:= X; S[X+1]:= #0; except Exit; end; end; { =============================================================================== } function CreateFileShortCut(const FileName, ShortCutName: String): Integer; var   X: Integer; S: String; begin Result:= 0; try   //首先在"文档"里创建快捷方式, 如不指定目标则算完成   SHAddToRecentDocs(SHARD_PATH, PChar(FileName));   if Length(ShortCutName) = 0 then begin Dec(Result); Exit; end;   //取文件名的开始   for X:= Length(FileName) downto 1 do   if FileName[X] = '/' then begin Result:= X; Break; end;   //取源文件名("文档"菜单的路径)   SetLength(S, 255);   SHGetSpecialFolderLocation(0, CSIDL_RECENT, pxItemID);   SHGetPathFromIDList(pxItemID, @S[1]);   X:= Pos(#0, S); if S[X-1] <> '/' then begin S[X]:= '/'; Inc(X); end;   X:= StrCopyEx(FileName, S, Result + 1, X, 0) + 1;   Result:= 0; PShortString(@S[X])^:= 'lnk'#0; S[X]:= '.';   //定位目标文件   X:= DoExpandPathName(ShortCutName);   if not PathExists(ExpandedPathName, True) then Exit;   Result:= StrCopyEx('.lnk'#0, ExpandedPathName, 0, X+1, 0);   if CopyFile(@S[1], @ExpandedPathName[1], False) then DeleteFile(@S[1]); except Result:= 0; end; end; { =============================================================================== } procedure InitBrowseInfo(hWND: Integer); begin   if pxBrowse = nil then New(pxBrowse);   with pxBrowse^ do begin     hWndOwner:= hWND;     pidlRoot:= nil;     pszDisplayName:= nil;     lpszTitle:= @BrowseDlgTitle[1];     ulFlags:= BIF_RETURNONLYFSDIRS;     lpfn:= nil;   end; end; { =============================================================================== } function SearchPaths(hWND: Integer; const Title: String; ShortPath: Boolean): String; begin SetLength(Result, 0); try;   if Length(Title) > 0 then BrowseDlgTitle:= Title + #0;   InitBrowseInfo(hWND);   pxItemID:= SHBrowseForFolder(pxBrowse^);   Dispose(pxBrowse); pxBrowse:= nil;   if pxItemID = nil then Exit;   SetLength(Result, 255);   SHGetPathFromIDList(pxItemID, @Result[1]);   if ShortPath then hWND:= FileName8_3(Result) else hWND:= Pos(#0, Result) - 1;   if Result[hWND] <> '/' then begin Inc(hWND); Result[hWND]:= '/'; end;   SetLength(Result, hWND); except SetLength(Result, 0); end; end; procedure EraseToRecyle(const FileName: String); { 利用ShellApi中: function SHFileOperation(const lpFileOp:TSHFileOpStruct): Integer; stdcall; } var   T: TSHFileOpStruct; begin   with T do begin     Wnd:=0;     wFunc:=FO_DELETE;     pFrom:=Pchar(FileName);     fFlags:=FOF_ALLOWUNDO   end;   SHFileOperation(T); end; { =============================================================================== } initialization   BrowseDlgTitle:= '搜索文件夹'#0;   SetLength(ExpandedPathName, 0);   pxBrowse:= nil; finalization   if pxBrowse <> nil then Dispose(pxBrowse); end.

xman · 2002-08-17

向SupermanTm同志学习

qiujsh · 2002-08-17

使用RX控件中有

问一个很弱的问题：怎样调出windows的选择目录的对话框？(0分)

hello8

Unregistered / Unconfirmed

Nstar

Unregistered / Unconfirmed

koyochen

Unregistered / Unconfirmed

hello8

Unregistered / Unconfirmed

naughtboy

Unregistered / Unconfirmed

北斗

Unregistered / Unconfirmed

SupermanTm

Unregistered / Unconfirmed

xman

Unregistered / Unconfirmed

qiujsh

Unregistered / Unconfirmed

Similar threads