source: cprs/branches/tmg-cprs/TMG_Extra/tntUniCode/Source/TntFileCtrl.pas

Last change on this file was 672, checked in by Kevin Toppenberg, 9 years ago

Adding source to tntControls for compilation

File size: 3.8 KB
Line 
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.