source: cprs/branches/tmg-cprs/TntWare/Delphi Unicode Controls/Source/TntFileCtrl.pas@ 1123

Last change on this file since 1123 was 453, checked in by Kevin Toppenberg, 16 years ago

Initial upload of TMG-CPRS 1.0.26.69

File size: 3.8 KB
RevLine 
[453]1
2{*****************************************************************************}
3{ }
4{ Tnt Delphi Unicode Controls }
5{ http://www.tntware.com/delphicontrols/unicode/ }
6{ Version: 2.3.0 }
7{ }
8{ Copyright (c) 2002-2007, Troy Wolbrink (troy.wolbrink@tntware.com) }
9{ }
10{*****************************************************************************}
11
12unit TntFileCtrl;
13
14{$INCLUDE TntCompilers.inc}
15
16interface
17
18{$WARN UNIT_PLATFORM OFF}
19
20uses
21 Classes, Windows, FileCtrl;
22
23{TNT-WARN SelectDirectory}
24function WideSelectDirectory(const Caption: WideString; const Root: WideString;
25 var Directory: WideString): Boolean;
26
27implementation
28
29uses
30 SysUtils, Forms, ActiveX, ShlObj, ShellApi, TntSysUtils, TntWindows;
31
32function SelectDirCB_W(Wnd: HWND; uMsg: UINT; lParam, lpData: LPARAM): Integer stdcall;
33begin
34 if (uMsg = BFFM_INITIALIZED) and (lpData <> 0) then
35 SendMessageW(Wnd, BFFM_SETSELECTIONW, Integer(True), lpdata);
36 result := 0;
37end;
38
39function WideSelectDirectory(const Caption: WideString; const Root: WideString;
40 var Directory: WideString): Boolean;
41{$IFNDEF COMPILER_7_UP}
42const
43 BIF_NEWDIALOGSTYLE = $0040;
44 BIF_USENEWUI = BIF_NEWDIALOGSTYLE or BIF_EDITBOX;
45{$ENDIF}
46var
47 WindowList: Pointer;
48 BrowseInfo: TBrowseInfoW;
49 Buffer: PWideChar;
50 OldErrorMode: Cardinal;
51 RootItemIDList, ItemIDList: PItemIDList;
52 ShellMalloc: IMalloc;
53 IDesktopFolder: IShellFolder;
54 Eaten, Flags: LongWord;
55 AnsiDirectory: AnsiString;
56begin
57 if (not Win32PlatformIsUnicode) then begin
58 AnsiDirectory := Directory;
59 Result := SelectDirectory{TNT-ALLOW SelectDirectory}(Caption, Root, AnsiDirectory);
60 Directory := AnsiDirectory;
61 end else begin
62 Result := False;
63 if not WideDirectoryExists(Directory) then
64 Directory := '';
65 FillChar(BrowseInfo, SizeOf(BrowseInfo), 0);
66 if (ShGetMalloc(ShellMalloc) = S_OK) and (ShellMalloc <> nil) then
67 begin
68 Buffer := ShellMalloc.Alloc(MAX_PATH * SizeOf(WideChar));
69 try
70 RootItemIDList := nil;
71 if Root <> '' then
72 begin
73 SHGetDesktopFolder(IDesktopFolder);
74 IDesktopFolder.ParseDisplayName(Application.Handle, nil,
75 POleStr(Root), Eaten, RootItemIDList, Flags);
76 end;
77 with BrowseInfo do
78 begin
79 {$IFDEF COMPILER_9_UP}
80 hWndOwner := Application.ActiveFormHandle;
81 {$ELSE}
82 hWndOwner := Application.Handle;
83 {$ENDIF}
84 pidlRoot := RootItemIDList;
85 pszDisplayName := Buffer;
86 lpszTitle := PWideChar(Caption);
87 ulFlags := BIF_RETURNONLYFSDIRS;
88 if Win32MajorVersion >= 5 then
89 ulFlags := ulFlags or BIF_USENEWUI;
90 if Directory <> '' then
91 begin
92 lpfn := SelectDirCB_W;
93 lParam := Integer(PWideChar(Directory));
94 end;
95 end;
96 WindowList := DisableTaskWindows(0);
97 OldErrorMode := SetErrorMode(SEM_FAILCRITICALERRORS);
98 try
99 ItemIDList := Tnt_ShBrowseForFolderW(BrowseInfo);
100 finally
101 SetErrorMode(OldErrorMode);
102 EnableTaskWindows(WindowList);
103 end;
104 Result := ItemIDList <> nil;
105 if Result then
106 begin
107 Tnt_ShGetPathFromIDListW(ItemIDList, Buffer);
108 ShellMalloc.Free(ItemIDList);
109 Directory := Buffer;
110 end;
111 finally
112 ShellMalloc.Free(Buffer);
113 end;
114 end;
115 end;
116end;
117
118end.
Note: See TracBrowser for help on using the repository browser.