Текущий архив: 2006.10.22;
Скачать: CL | DM;

Вниз

Как создавать новую папку с названием, заранее определенным   Найти похожие ветки 

← →
susergey   (2006-06-04 19:51) [0]

Мастера, помогите plz!

Стандартное окно Обзора папок, создается новая папка путем выбора нужной директории, при нажатии на кнопку  Создать папку, имя по умолчанию в винде - Новая папка, а надо - мое название. Как реализовать? вот нашел кое-что, но не работает как надо.



function AdvSelectDirectory(const Caption: string; const Root: WideString;
  var Directory: string; EditBox: Boolean = False; ShowFiles: Boolean = False;
  AllowCreateDirs: Boolean = True): Boolean;
  initialized
 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));
     to react on the
     
     BFFM_SELCHANGED:
     begin
       SHGetPathFromIDList(PItemIDList(lParam), @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(Directory) then
    Directory := "";
  FillChar(BrowseInfo, SizeOf(BrowseInfo), 0);
  if (ShGetMalloc(ShellMalloc) = S_OK) and (ShellMalloc <> nil) then
  begin
    Buffer := ShellMalloc.Alloc(MAX_PATH);
    try
      RootItemIDList := nil;
      if Root <> "" then
      begin
        SHGetDesktopFolder(IDesktopFolder);
        IDesktopFolder.ParseDisplayName(Application.Handle, nil,
          POleStr(Root), Eaten, RootItemIDList, Flags);
      end;
      OleInitialize(nil);
      with BrowseInfo do
      begin
        hwndOwner := Application.Handle;
        pidlRoot := RootItemIDList;
        pszDisplayName := Buffer;
        lpszTitle := PChar(Caption);
       

       ulFlags := BIF_RETURNONLYFSDIRS or BIF_USENEWUI or
          BIF_EDITBOX * Ord(EditBox) or BIF_BROWSEINCLUDEFILES * Ord(ShowFiles) or
          BIF_NOCREATEDIRS * Ord(not AllowCreateDirs);
        lpfn    := @SelectDirCB;
        if Directory <> "" then
          lParam := Integer(PChar(Directory));
      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);
        Directory := Buffer;
      end;
    finally
      ShellMalloc.Free(Buffer);
    end;
  end;
end;

procedure TForm1.Button2Click(Sender: TObject);
var
 dir: string;
begin
   AdvSelectDirectory("Update.net", ":\", dir, False, False, True);
 end;



---

← →
DevilDevil ©   (2006-06-04 22:36) [1]

ForceDirectories("C:\MyDirectory1\MyDir2\MyDir3\Sergey");

---

Страницы: 1 вся ветка

Текущий архив: 2006.10.22;
Скачать: CL | DM;

Наверх

Память: 0.47 MB
Время: 0.035 c