1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:
116:
117:
118:
119:
120:
121:
122:
123:
124:
125:
126:
127:
128:
129:
130:
131:
132:
133:
134:
135:
136:
137:
138:
139:
140:
141:

unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes,
  Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls,
  BrowseForFolderU, Vcl.ExtCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Memo1: TMemo;
    Timer1: TTimer;
    procedure Button2Click(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button2Click(Sender: TObject);
begin
Timer1.Enabled:= TRUE;
Memo1.Text:=
BrowseForFolder('myTitle','F:\',0,FALSE);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  Timer1.Enabled:= FALSE;
  Timer1.Interval:= 500;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
var Fo1 : HWND;
begin
  fo1:= FindWindow('#32770',nil);
  if fo1<>0 then BEGIN
    Timer1.Enabled:= FALSE;
    caption:= 'TEST1';
    SetWindowText(fo1, 'TEST2');
    SetWindowPos(fo1, 0, 500, 0, 450, 500, 0);
  END;
end;

end.
//---------------------------
unit BrowseForFolderU;

interface

function BrowseForFolder(const browseTitle: String;
const initialFolder: String = '';
const appHWND: THandle = 0;
mayCreateNewFolder: Boolean = False): String;

implementation

uses
  Winapi.Windows, Winapi.Shlobj;

var
  lg_StartFolder: String;

// With later versions of Delphi you may not need these constants.
const
  BIF_NEWDIALOGSTYLE=$40;
  BIF_NONEWFOLDERBUTTON=$200;

////////////////////////////////////////////////////////////////////////
// Call back function used to set the initial browse directory.
////////////////////////////////////////////////////////////////////////
function BrowseForFolderCallBack(Wnd: HWND; uMsg: UINT; lParam,
lpData: LPARAM): Integer stdcall;
begin
  if uMsg = BFFM_INITIALIZED then
    SendMessage(Wnd,BFFM_SETSELECTION, 1, Integer(@lg_StartFolder[1]));
  result := 0;
end;

////////////////////////////////////////////////////////////////////////
// This function allows the user to browse for a folder
//
// Arguments:-
//         browseTitle : The title to display on the browse dialog.
//       initialFolder : Optional argument. Use to specify the folder
//                       initially selected when the dialog opens.
//  mayCreateNewFolder : Flag indicating whether the user can create a
//                       new folder.
//
// Returns: The empty string if no folder was selected (i.e. if the user
//          clicked cancel), otherwise the full folder path.
////////////////////////////////////////////////////////////////////////
function BrowseForFolder(const browseTitle: String;
const initialFolder: String = '';
const appHWND: THandle = 0;
mayCreateNewFolder: Boolean = False): String;
var
  browse_info: TBrowseInfo;
  folder: array[0..MAX_PATH] of char;
  find_context: PItemIDList;
begin
  //--------------------------
  // Initialise the structure.
  //--------------------------
  FillChar(browse_info,SizeOf(browse_info),#0);
  lg_StartFolder := initialFolder;
  browse_info.pszDisplayName := @folder[0];
  browse_info.lpszTitle := PChar(browseTitle);
  browse_info.ulFlags := BIF_RETURNONLYFSDIRS or BIF_NEWDIALOGSTYLE;
  if not mayCreateNewFolder then
    browse_info.ulFlags := browse_info.ulFlags or BIF_NONEWFOLDERBUTTON;

  browse_info.hwndOwner := appHWND; //Application.Handle;
  if initialFolder <> '' then
    browse_info.lpfn := BrowseForFolderCallBack;
  find_context := SHBrowseForFolder(browse_info);
  if Assigned(find_context) then
  begin
    if SHGetPathFromIDList(find_context,folder) then
      result := folder
    else
      result := '';
    GlobalFreePtr(find_context);
  end
  else
    result := '';
end;

end.                    

1:
2:
3:
4:

...
//  browse_info.ulFlags := BIF_RETURNONLYFSDIRS or BIF_NEWDIALOGSTYLE;
  browse_info.ulFlags := BIF_BROWSEINCLUDEFILES  or BIF_NEWDIALOGSTYLE;
...                    

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:

// Call back function used to set the initial browse directory.
function BrowseForFolderCallBack(Wnd: HWND; uMsg: UINT; lParam,
lpData: LPARAM): Integer stdcall;
var bh : hWnd;
begin
  if uMsg = BFFM_INITIALIZED then
  BEGIN
    SendMessage(Wnd,BFFM_SETSELECTION, 1, Integer(@lg_StartFolder[1]));

    SetWindowText(GetDlgItem(Wnd, IDOK), PChar('Mach mal'));
    SetWindowText(GetDlgItem(Wnd, IDCANCEL), PChar('Verschwinde'));
    SetWindowText(GetDlgItem(Wnd, 14150), PChar('Mach ein Dingens'));
// 14146
    SetWindowText(GetDlgItem(Wnd, 14146), PChar('NEIN - Das ist mein Titel'));
// Nach Dateien oder Ordnern suchen
    SetWindowText(Wnd, 'LOS: Suche nach Dateien oder Ordnern');
    SetWindowPos(Wnd, 0, 500, 0, 0, 0, SWP_NOSIZE);
  END;
  result := 0;
end;
// Die Grösse lässt sich leider nur mit dem Timer ändern - der läuft aber nur 500 msec.
procedure TForm1.Timer1Timer(Sender: TObject);
var BfF : HWND;
begin
  BfF:= FindWindow('#32770',nil);
  if BfF<>0 then BEGIN
    Timer1.Enabled:= FALSE;
    SetWindowPos(BfF, 0, 500, 0, 450, 500, 0);
  END;
end;