Гость
Целевая тема:
Создать новую тему:
Автор:
Форумы / Delphi [игнор отключен] [закрыт для гостей] / Как добавить в FileOpenDialog чекбоксы к файлам/каталогам? / 12 сообщений из 12, страница 1 из 1
21.06.2019, 22:09
    #39829365
Страдалецъ
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Как добавить в FileOpenDialog чекбоксы к файлам/каталогам?
Есть ли возможность более удобно выделять файлы и каталоги в стандартном TFileOpenDialog через чекбоксы?
...
Рейтинг: 0 / 0
22.06.2019, 20:08
    #39829490
Кроик Семён
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Как добавить в FileOpenDialog чекбоксы к файлам/каталогам?
Нужно самому написать диалог, внешне очень похожий на стандартный
...
Рейтинг: 0 / 0
22.06.2019, 22:24
    #39829510
Страдалецъ
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Как добавить в FileOpenDialog чекбоксы к файлам/каталогам?
Как-то не хотелось бы изобретать велосипед, скорее всего решение уже есть.
...
Рейтинг: 0 / 0
22.06.2019, 22:47
    #39829514
Aniskin
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Как добавить в FileOpenDialog чекбоксы к файлам/каталогам?
Код: pascal
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.
uses
  ActiveX, CommDlg, ShlObj;

type
  TOpenDialogWithCheckBox = class(TOpenDialog)
  public
    function Execute(ParentWnd: HWND): Boolean; override;
  protected
    procedure WndProc(var AMessage: TMessage); override;
  private
    FSaveOnShow: TNotifyEvent;
    procedure HackOnShow(Sender: TObject);
  end;

const
  WM_GETISHELLBROWSER = WM_USER + 7;

function TOpenDialogWithCheckBox.Execute(ParentWnd: HWND): Boolean;
begin
  FSaveOnShow := OnShow;
  OnShow := HackOnShow;
  try
    inherited Execute(ParentWnd);
  finally
    OnShow := FSaveOnShow;
  end;
end;

procedure TOpenDialogWithCheckBox.WndProc(var AMessage: TMessage);
var
  LOFNotify: POFNotify;
  ShellBrowser: IShellBrowser;
  ShellView: IShellView;
  FolderView2: IFolderView2;
begin
  inherited WndProc(AMessage);
  if (AMessage.Msg = WM_NOTIFY) then
    begin
      LOFNotify := POFNotify(AMessage.LParam);
      case (LOFNotify.hdr.code) of
        CDN_FOLDERCHANGE:
          if LOFNotify.hdr.hwndFrom <> 0 then
            begin
              ShellBrowser := IShellBrowser(SendMessage(LOFNotify.hdr.hwndFrom, WM_GETISHELLBROWSER, 0, 0));
              if Assigned(ShellBrowser) then
                begin
                  if Succeeded(ShellBrowser.QueryActiveShellView(ShellView)) then
                    begin
                      if Succeeded(ShellView.QueryInterface(IFolderView2, FolderView2)) then
                        FolderView2.SetCurrentFolderFlags(FWF_CHECKSELECT, FWF_CHECKSELECT);
                      ShellView := nil;
                    end;
                  Pointer(ShellBrowser) := nil;
                end;
            end;
      end;
    end;
end;

procedure TOpenDialogWithCheckBox.HackOnShow(Sender: TObject);
begin
  if Assigned(FSaveOnShow) then
    FSaveOnShow(Sender);
end;

procedure TForm4.FormCreate(Sender: TObject);
begin
  with TOpenDialogWithCheckBox.Create(Self) do
    try
      Execute(Handle);
    finally
      Free;
    end;
end;
...
Рейтинг: 0 / 0
23.06.2019, 01:35
    #39829523
alekcvp
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Как добавить в FileOpenDialog чекбоксы к файлам/каталогам?
Aniskin,

А зачем танцы с HackOnShow() ?..
...
Рейтинг: 0 / 0
23.06.2019, 02:40
    #39829524
Aniskin
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Как добавить в FileOpenDialog чекбоксы к файлам/каталогам?
alekcvp,

Что бы приходил WM_NOTIFY.
...
Рейтинг: 0 / 0
23.06.2019, 08:51
    #39829533
Страдалецъ
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Как добавить в FileOpenDialog чекбоксы к файлам/каталогам?
Ага, добавились чекбоксы, но где теперь читать информацию о том что отмечено?
...
Рейтинг: 0 / 0
23.06.2019, 13:37
    #39829581
Aniskin
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Как добавить в FileOpenDialog чекбоксы к файлам/каталогам?

Код: pascal
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.
142.
143.
144.
145.
146.
147.
148.
149.
150.
151.
152.
153.
154.
155.
156.
157.
158.
159.
160.
161.
162.
163.
164.
165.
166.
167.
168.
uses
  ActiveX, CommDlg, ShlObj;

type
  TOpenDialogWithCheckBox = class(TOpenDialog)
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    function Execute(ParentWnd: HWND): Boolean; override;
  protected
    procedure WndProc(var AMessage: TMessage); override;
  private
    FSaveOnShow: TNotifyEvent;
    procedure HackOnShow(Sender: TObject);
  private
    FItems: TStrings;
  public
    property Items: TStrings read FItems;
  end;

const
  WM_GETISHELLBROWSER = WM_USER + 7;

constructor TOpenDialogWithCheckBox.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FItems := TStringList.Create;
end;

destructor TOpenDialogWithCheckBox.Destroy;
begin
  FreeAndNil(FItems);
  inherited Destroy;
end;

function TOpenDialogWithCheckBox.Execute(ParentWnd: HWND): Boolean;
begin
  FItems.Clear;
  FSaveOnShow := OnShow;
  OnShow := HackOnShow;
  try
    Result := inherited Execute(ParentWnd);
  finally
    OnShow := FSaveOnShow;
  end;
end;

procedure FreeStrRet(var AStrRet: TStrRet);
begin
  case AStrRet.uType of
    STRRET_WSTR:
      begin
        CoTaskMemFree(AStrRet.pOleStr);
        AStrRet.pOleStr := nil;
      end;
  end;
end;

function StrRetToString(AItemIdList: PItemIdList; var AStrRet: TStrRet; AFree: Boolean = True): string;
begin
  case AStrRet.uType of
    STRRET_WSTR:
      Result := string(AStrRet.pOleStr);
    STRRET_OFFSET:
      if Assigned(AItemIdList) then
        begin
          Inc(PByte(AItemIdList), AStrRet.uOffset);
          Result := string(PAnsiChar(AItemIdList));
        end
      else
        Result := '';
    STRRET_CSTR:
      Result := string(AnsiString(AStrRet.cStr));
  else
    Result := '';
  end;

  if AFree then
    FreeStrRet(AStrRet);
end;

procedure TOpenDialogWithCheckBox.WndProc(var AMessage: TMessage);
var
  LOFNotify: POFNotify;
  ShellBrowser: IShellBrowser;
  ShellView: IShellView;
  FolderView2: IFolderView2;
  Folder: IShellFolder;
  Count: Integer;
  IDList: IEnumIDList;
  Item: PItemIDList;
  Fetched: Cardinal;
  StrRet: TStrRet;
begin
  inherited WndProc(AMessage);
  if (AMessage.Msg = WM_NOTIFY) then
    begin
      LOFNotify := POFNotify(AMessage.LParam);
      case (LOFNotify.hdr.code) of
        CDN_FOLDERCHANGE:
          if LOFNotify.hdr.hwndFrom <> 0 then
            begin
              ShellBrowser := IShellBrowser(SendMessage(LOFNotify.hdr.hwndFrom, WM_GETISHELLBROWSER, 0, 0));
              if Assigned(ShellBrowser) then
                begin
                  if Succeeded(ShellBrowser.QueryActiveShellView(ShellView)) then
                    begin
                      if Succeeded(ShellView.QueryInterface(IFolderView2, FolderView2)) then
                        begin
                          FolderView2.SetCurrentFolderFlags(FWF_CHECKSELECT, FWF_CHECKSELECT);
                          FolderView2 := nil;
                        end;
                      ShellView := nil;
                    end;
                  Pointer(ShellBrowser) := nil;
                end;
            end;
        CDN_FILEOK:
          begin
              ShellBrowser := IShellBrowser(SendMessage(LOFNotify.hdr.hwndFrom, WM_GETISHELLBROWSER, 0, 0));
              if Assigned(ShellBrowser) then
                begin
                  if Succeeded(ShellBrowser.QueryActiveShellView(ShellView)) then
                    begin
                      if Succeeded(ShellView.QueryInterface(IFolderView2, FolderView2)) then
                        begin
                          if Succeeded(FolderView2.GetFolder(IShellFolder, Folder)) then
                            begin
                              if Succeeded(FolderView2.ItemCount(SVGIO_CHECKED, Count)) and (Count > 0) then
                                if Succeeded(FolderView2.Items(SVGIO_CHECKED, IEnumIDList, IDList)) then
                                  begin
                                    while IDList.Next(1, Item, Fetched) = S_OK do
                                      begin
                                        if Succeeded(Folder.GetDisplayNameOf(Item, SHGDN_FORPARSING, StrRet)) then
                                          FItems.Add(StrRetToString(Item, StrRet, True));
                                        CoTaskMemFree(Item);
                                      end;
                                    IDList := nil;
                                  end;
                              Folder := nil;
                            end;
                          FolderView2 := nil;
                        end;
                      ShellView := nil;
                    end;
                  Pointer(ShellBrowser) := nil;
                end;
          end;
      end;
    end;
end;

procedure TOpenDialogWithCheckBox.HackOnShow(Sender: TObject);
begin
  if Assigned(FSaveOnShow) then
    FSaveOnShow(Sender);
end;

procedure TForm4.FormCreate(Sender: TObject);
begin
  with TOpenDialogWithCheckBox.Create(Self) do
    try
      if Execute(Self.Handle) then
        lst1.Items.Assign(Items);
    finally
      Free;
    end;
end;


...
Рейтинг: 0 / 0
23.06.2019, 16:24
    #39829606
ёёёёё
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Как добавить в FileOpenDialog чекбоксы к файлам/каталогам?
+1000!

Хороший топик, и тема, и решение.
...
Рейтинг: 0 / 0
23.06.2019, 18:37
    #39829621
Страдалецъ
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Как добавить в FileOpenDialog чекбоксы к файлам/каталогам?
Да, весьма интересно. Некоторые вещи впервые вижу. Респект.
Не сочтите за наглость, но может и для TFileOpenDialog тоже самое можно сделать? Уж очень полезная функция выделения каталогов там есть, а в OpenDialog этот функционал не реализован.
...
Рейтинг: 0 / 0
23.06.2019, 19:46
    #39829633
Aniskin
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Как добавить в FileOpenDialog чекбоксы к файлам/каталогам?
Страдалецъдля TFileOpenDialog тоже самое можно сделать?

Для TFileOpenDialog код даже проще, чем для TOpenDialog. Но есть одна серьезная проблема. Он не работает :)

Оставлю для потомков, может быть кто нибудь разберется.
Код: pascal
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.
uses
  ActiveX, ShlObj;

procedure EnableCheckBoxes(ADialog: TCustomFileDialog);
var
  ServiceProvider: IServiceProvider;
  ShellView: IShellView;
  FolderView2: IFolderView2;
begin
  if Assigned(ADialog.Dialog) then
    if Succeeded(ADialog.Dialog.QueryInterface(IServiceProvider, ServiceProvider)) then
      begin
        if Succeeded(ServiceProvider.QueryService(SID_SFolderView, IShellView, ShellView)) then
          begin
            if Succeeded(ShellView.QueryInterface(IFolderView2, FolderView2)) then
              begin
                // Не работает к сожалению
                FolderView2.SetCurrentFolderFlags(FWF_CHECKSELECT or FWF_AUTOCHECKSELECT, FWF_CHECKSELECT or FWF_AUTOCHECKSELECT);
                FolderView2 := nil;
              end;
            ShellView := nil;
          end;
        ServiceProvider := nil;
      end;
end;

procedure TForm5.FileOpenDialog1FolderChange(Sender: TObject);
begin
  EnableCheckBoxes(Sender as TCustomFileDialog);
end;

procedure TForm5.FormCreate(Sender: TObject);
begin
  FileOpenDialog1.Execute;
end;

...
Рейтинг: 0 / 0
23.06.2019, 21:10
    #39829646
makhaon
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Как добавить в FileOpenDialog чекбоксы к файлам/каталогам?
Благодарю! Интересно.
...
Рейтинг: 0 / 0
Форумы / Delphi [игнор отключен] [закрыт для гостей] / Как добавить в FileOpenDialog чекбоксы к файлам/каталогам? / 12 сообщений из 12, страница 1 из 1
Найденые пользователи ...
Разблокировать пользователей ...
Читали форум (0):
Пользователи онлайн (0):
x
x
Закрыть


Просмотр
0 / 0
Close
Debug Console [Select Text]