Пара вопросов про FileCtrl

Karsh · #1 04.10.2007, 01:03

Вопрос номер 1:
Что значит:
[Warning] Unit1.pas(28): Unit 'FileCtrl' is specific to a platform
и как с ним бороться?

Вопрос номер 2:
Есть код:

Код:

procedure TForm1.Button1Click(Sender: TObject);
var S, path: string;
begin
if SelectDirectory('Select Directory', '', S) then
  path:=s;
end;

Но при таком вызове функции SelectDirectory окно выбора директории появляеться внизу экрана. Как установить свои значения положения окна?

4kusNick · #2 04.10.2007, 02:24

Unit 'FileCtrl' is specific to a platform - значит, что этот модуль привязан к платформе, т.е. твоя прога не будет кроссплатформенной, если ты будешь юзать этот модуль.

А выбор папки вызывай с помощью этого:

Код:

function AdvBrowseDirectory(sCaption: String; wsRoot: WideString; var sDirectory: String; bEditBox: Boolean = False; bShowFiles: Boolean = False; bAllowCreateDirs: Boolean = True; bRootIsMyComp: Boolean = False): Boolean;

  // callback функция, которая вызывается при инициализации диалога
  // или когда создается новая папка

  function SelectDirCB(Wnd: HWND; uMsg: UINT; lParam, lpData: lParam): Integer; stdcall;
	//var
		//PathName: array[0..MAX_PATH] of Char;
  begin
    case uMsg of
      BFFM_INITIALIZED: SendMessage(Wnd, BFFM_SETSELECTION, Ord(True), Integer(lpData));
      // включите этот код, если хотите реагировать на выбор новой папки
      {BFFM_SELCHANGED: 
      begin
        SHGetPathFromIDList(PItemIDList(lParam), @PathName); 
        // папка "PathName" была выбрана
      end;}
     end;
     Result := 0;
   end;
var
  WindowList: Pointer;
  BrowseInfo: TBrowseInfo;
  Buffer: PChar;
  RootItemIDList, ItemIDList: PItemIDList;
  ShellMalloc: IMalloc;
  IDesktopFolder: IShellFolder;
  Eaten, Flags: LongWord;

const
  BIF_USENEWUI = $0040;
  BIF_NOCREATEDIRS = $0200;

begin
  Result := False;
  if not DirectoryExists(sDirectory) then sDirectory := '';
  FillChar(BrowseInfo, SizeOf(BrowseInfo), 0);
  if (ShGetMalloc(ShellMalloc) = S_OK) and (ShellMalloc <> nil) then
  begin
    Buffer := ShellMalloc.Alloc(MAX_PATH);
    try
      RootItemIDList := nil;
      if wsRoot <> '' then
      begin
        SHGetDesktopFolder(IDesktopFolder);
        IDesktopFolder.ParseDisplayName(Application.Handle, nil,
        POleStr(wsRoot), Eaten, RootItemIDList, Flags);
			end
			else
			begin

				if bRootIsMyComp then
					SHGetSpecialFolderLocation(0, CSIDL_DRIVES, RootItemIDList);

			end;
      OleInitialize(nil);
      with BrowseInfo do
      begin
        hwndOwner := Application.Handle;
				pidlRoot := RootItemIDList;
        pszDisplayName := Buffer;
				lpszTitle := PChar(sCaption);
        // определяет то, как диалог будет появляться:
        ulFlags :=
          BIF_RETURNONLYFSDIRS or
          BIF_USENEWUI or
					BIF_EDITBOX * Ord(bEditBox) or
					BIF_BROWSEINCLUDEFILES * Ord(bShowFiles) or
					BIF_NOCREATEDIRS * Ord(not bAllowCreateDirs);
        lpfn    := @SelectDirCB;
        if sDirectory <> '' then lParam := Integer(PChar(sDirectory));
      end;
      WindowList := DisableTaskWindows(0);
      try
        ItemIDList := ShBrowseForFolder(BrowseInfo);
      finally
        EnableTaskWindows(WindowList);
      end;
      Result := ItemIDList <> nil;
      if Result then
      begin
        ShGetPathFromIDList(ItemIDList, Buffer);
        ShellMalloc.Free(ItemIDList);
        sDirectory := Buffer;
      end;
    finally
      ShellMalloc.Free(Buffer);
    end;
  end;
end;

Пример:

Код:

procedure TMain.BrowseInputBtnClick(Sender: TObject);
var
	sSelectedDir:	String;
begin
	//...
	if AdvBrowseDirectory('Выбор папки с файлами для упаковки','',sSelectedDir) then
         //...

Karsh · #3 07.10.2007, 00:58

Попытался включить в проект функцию AdvBrowseDirectory
и получил:

[Error] Unit1.pas(39): Undeclared identifier: 'BFFM_INITIALIZED'
[Error] Unit1.pas(39): Undeclared identifier: 'BFFM_SETSELECTION'
[Error] Unit1.pas(51): Undeclared identifier: 'TBrowseInfo'
[Error] Unit1.pas(53): Undeclared identifier: 'PItemIDList'
[Error] Unit1.pas(54): Undeclared identifier: 'IMalloc'
[Error] Unit1.pas(55): Undeclared identifier: 'IShellFolder'
[Error] Unit1.pas(66): Undeclared identifier: 'ShGetMalloc'
[Warning] Unit1.pas(66): Comparing signed and unsigned types - widened both operands
[Error] Unit1.pas(66): Operator not applicable to this operand type
[Error] Unit1.pas(68): Missing operator or semicolon
[Error] Unit1.pas(73): Undeclared identifier: 'SHGetDesktopFolder'
[Error] Unit1.pas(74): Missing operator or semicolon
[Error] Unit1.pas(75): Undeclared identifier: 'POleStr'
[Error] Unit1.pas(81): Undeclared identifier: 'SHGetSpecialFolderLocation'
[Error] Unit1.pas(81): Undeclared identifier: 'CSIDL_DRIVES'
[Error] Unit1.pas(84): Undeclared identifier: 'OleInitialize'
[Error] Unit1.pas(87): Undeclared identifier: 'hwndOwner'
[Error] Unit1.pas(88): Undeclared identifier: 'pidlRoot'
[Error] Unit1.pas(89): Undeclared identifier: 'pszDisplayName'
[Error] Unit1.pas(90): Undeclared identifier: 'lpszTitle'
[Error] Unit1.pas(92): Undeclared identifier: 'ulFlags'
[Error] Unit1.pas(93): Undeclared identifier: 'BIF_RETURNONLYFSDIRS'
[Warning] Unit1.pas(94): Combining signed and unsigned types - widened both operands
[Error] Unit1.pas(95): Undeclared identifier: 'BIF_EDITBOX'
[Error] Unit1.pas(96): Undeclared identifier: 'BIF_BROWSEINCLUDEFILES'
[Error] Unit1.pas(98): Undeclared identifier: 'lpfn'
[Error] Unit1.pas(99): '(' expected but ':=' found
[Error] Unit1.pas(99): Statement expected, but expression of type 'Integer' found
[Error] Unit1.pas(103): Undeclared identifier: 'ShBrowseForFolder'
[Error] Unit1.pas(107): Operator not applicable to this operand type
[Error] Unit1.pas(110): Undeclared identifier: 'ShGetPathFromIDList'
[Error] Unit1.pas(111): Missing operator or semicolon
[Error] Unit1.pas(115): Missing operator or semicolon
[Error] Unit1.pas(13): Unsatisfied forward or external declaration: 'TForm1.AdvBrowseDirectory'
[Fatal Error] Project1.dpr(5): Could not compile used unit 'Unit1.pas'

4kusNick · #4 07.10.2007, 18:41

Добавь в uses
ShlObj, ActiveX

Вот пример:

Код:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ShlObj, StdCtrls, ActiveX;

type
  TForm1 = class(TForm)
    Edit1: TEdit;
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    function AdvBrowseDirectory(sCaption: String; wsRoot: WideString; var sDirectory: String; bEditBox: Boolean = False; bShowFiles: Boolean = False; bAllowCreateDirs: Boolean = True; bRootIsMyComp: Boolean = False): Boolean;
  end;

var
  Form1: TForm1;

implementation

function TForm1.AdvBrowseDirectory(sCaption: String; wsRoot: WideString; var sDirectory: String; bEditBox: Boolean = False; bShowFiles: Boolean = False; bAllowCreateDirs: Boolean = True; bRootIsMyComp: Boolean = False): Boolean;

  // callback функция, которая вызывается при инициализации диалога
  // или когда создается новая папка

  function SelectDirCB(Wnd: HWND; uMsg: UINT; lParam, lpData: lParam): Integer; stdcall;
	//var
		//PathName: array[0..MAX_PATH] of Char;
  begin
    case uMsg of
      BFFM_INITIALIZED: SendMessage(Wnd, BFFM_SETSELECTION, Ord(True), Integer(lpData));
      // включите этот код, если хотите реагировать на выбор новой папки
      {BFFM_SELCHANGED: 
      begin
        SHGetPathFromIDList(PItemIDList(lParam), @PathName); 
        // папка "PathName" была выбрана
      end;}
     end;
     Result := 0;
   end;
var
  WindowList: Pointer;
  BrowseInfo: TBrowseInfo;
  Buffer: PChar;
  RootItemIDList, ItemIDList: PItemIDList;
  ShellMalloc: IMalloc;
  IDesktopFolder: IShellFolder;
  Eaten, Flags: LongWord;

const
  BIF_USENEWUI = $0040;
  BIF_NOCREATEDIRS = $0200;

begin
  Result := False;
  if not DirectoryExists(sDirectory) then sDirectory := '';
  FillChar(BrowseInfo, SizeOf(BrowseInfo), 0);
  if (ShGetMalloc(ShellMalloc) = S_OK) and (ShellMalloc <> nil) then
  begin
    Buffer := ShellMalloc.Alloc(MAX_PATH);
    try
      RootItemIDList := nil;
      if wsRoot <> '' then
      begin
        SHGetDesktopFolder(IDesktopFolder);
        IDesktopFolder.ParseDisplayName(Application.Handle, nil,
        POleStr(wsRoot), Eaten, RootItemIDList, Flags);
			end
			else
			begin

				if bRootIsMyComp then
					SHGetSpecialFolderLocation(0, CSIDL_DRIVES, RootItemIDList);

			end;
      OleInitialize(nil);
      with BrowseInfo do
      begin
        hwndOwner := Application.Handle;
				pidlRoot := RootItemIDList;
        pszDisplayName := Buffer;
				lpszTitle := PChar(sCaption);
        // определяет то, как диалог будет появляться:
        ulFlags :=
          BIF_RETURNONLYFSDIRS or
          BIF_USENEWUI or
					BIF_EDITBOX * Ord(bEditBox) or
					BIF_BROWSEINCLUDEFILES * Ord(bShowFiles) or
					BIF_NOCREATEDIRS * Ord(not bAllowCreateDirs);
        lpfn    := @SelectDirCB;
        if sDirectory <> '' then lParam := Integer(PChar(sDirectory));
      end;
      WindowList := DisableTaskWindows(0);
      try
        ItemIDList := ShBrowseForFolder(BrowseInfo);
      finally
        EnableTaskWindows(WindowList);
      end;
      Result := ItemIDList <> nil;
      if Result then
      begin
        ShGetPathFromIDList(ItemIDList, Buffer);
        ShellMalloc.Free(ItemIDList);
        sDirectory := Buffer;
      end;
    finally
      ShellMalloc.Free(Buffer);
    end;
  end;
end;

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
var
  sDirPath: String;
begin

  sDirPath := Edit1.Text;
  AdvBrowseDirectory('Browse','',sDirPath,False,False,True,False);
  Edit1.Text := sDirPath;

end;

end.

Karsh · #5 08.10.2007, 00:20

Огромное спасибо!
Как раз, то что доктор прописал

Опции темы	Поиск в этой теме
Версия для печати Отправить на Email	Поиск в этой теме: Расширенный поиск
Опции просмотра
Линейный вид Комбинированный вид Древовидный вид

	Сайт	Форум	FAQ	Соглашения	Прочее
	Новости Исходники Компоненты Статьи Добавить исходник Поиск	Правила Поиск Сообщения за сегодня Пользователи Кто на форуме?	Delphi FAQ - 5000 статей DRKB - 4500 статей (ZIP-архив) Справочник функций и процедур Delphi Delphi Programming Guide Indy in Depth. Глубины Indy	Конфиденциальность Соглашение пользователя Правила обработки cookie	О сайте Donate Контакты