Форум: "Основная";
Текущий архив: 2002.10.28;
Скачать: [xml.tar.bz2];

Вниз

Помогите заблудшему   Найти похожие ветки 

← →
boa   (2002-10-16 05:53) [0]

Мне нужно диалоговое окно для выбора каталога. Попробовал использовать OpenDialog, повертел-повертел его, чего-то желаемого не достиг. Может я его не так вертел? Или для выбора каталога есть другое диалоговое окно?
Помогите пожалуйста!

---

← →
iNew   (2002-10-16 06:12) [1]

По моему вполне нормальное окно, хочешь чего-то другого напиши сам.

---

← →
MBo   (2002-10-16 06:20) [2]

SelectDirectory

---

← →
boa   (2002-10-16 06:42) [3]

Спасибо!!!

---

← →
roadster   (2002-10-16 09:00) [4]

Кстати, SelectDirectory двояко работать изволит, ибо перегружена

---

← →
turusov   (2002-10-16 14:59) [5]

TMFileExplorer - Классный и простой в использовании компонент
http://www.mitec.d2.cz/Downloads/MiTeCSE.zip - гдето или у меня
File: mfileexp.zip
Product: MiTeC File Explorer
Version: 1.3
Author: Michal Mutl
E-Mail: michal.mutl@atlas.cz
Target: Delphi 5.x, Delphi 6.x
Platform: W95, W98, NT, W2000, Windows ME
Status: Fully Functional
Source: Included
Description: Windows Explorer-like component.
EXE demo included.

---

← →
EugeneM   (2002-10-16 15:16) [6]

Попробуй это:

unit uBrowseFolder;

interface

uses Controls,Classes,Windows,ShlObj;

type
TBrowseForFolder = class
private
Handle : HWND;
FDirName: String;
FTitle: String;
FInitialPath: String;
procedure SetDirName(const Value: String);
procedure SetTitle(const Value: String);
procedure SetInitialPath(const Value: String);
public
property DirName:String read FDirName write SetDirName;
property Title:String read FTitle write SetTitle;
property InitialPath:String read FInitialPath write SetInitialPath;
function Execute: TModalResult;
constructor Create(Parent: HWND);
end;

implementation

function BrowseCallbackProc(hwnd: HWND; uMsg: UINT; lParam, lpData: LPARAM): Integer; stdcall;
var
Path: array[0..MAX_PATH] of Char;
begin
case uMsg of
BFFM_INITIALIZED:
begin
// Initialization has been done, now set our initial directory which is passed in lpData
// (and set btw. the status text too).
// Note: There"s no need to cast lpData to a PChar since the following call needs a
// LPARAM parameter anyway.
SendMessage(hwnd, BFFM_SETSELECTION, 1, lpData);
SendMessage(hwnd, BFFM_SETSTATUSTEXT, 0, lpData);
end;
BFFM_SELCHANGED:
begin
// Set the status window to the currently selected path.
if SHGetPathFromIDList(Pointer(lParam), Path) then
SendMessage(hwnd, BFFM_SETSTATUSTEXT, 0, Integer(@Path));
end;
end;
Result := 0;
end;


constructor TBrowseForFolder.Create(Parent: HWND);
begin
Handle := Parent;
// CallBackFunc := CallBack;
end;

function TBrowseForFolder.Execute: TModalResult;
var
lpItemID : PItemIDList;
BrowseInfo : TBrowseInfo;
DisplayName : array[0..MAX_PATH] of char;
TempPath : array[0..MAX_PATH] of char;
begin
Result := mrCancel;
FillChar(BrowseInfo, sizeof(TBrowseInfo), #0);
with BrowseInfo do begin
hwndOwner := Handle;
pszDisplayName := @DisplayName;
lpszTitle := PChar(FTitle);
ulFlags := BIF_RETURNONLYFSDIRS or BIF_STATUSTEXT;
lParam := Integer(PChar(FInitialPath));
lpfn := BrowseCallbackProc;
end;

lpItemID := SHBrowseForFolder(BrowseInfo);
if lpItemId <> nil then begin
SHGetPathFromIDList(lpItemID, TempPath);
FDirName := TempPath;
GlobalFreePtr(lpItemID);
Result := mrOK;
end;
end;

procedure TBrowseForFolder.SetDirName(const Value: String);
begin
FDirName := Value;
end;

procedure TBrowseForFolder.SetInitialPath(const Value: String);
begin
FInitialPath := Value;
end;

procedure TBrowseForFolder.SetTitle(const Value: String);
begin
FTitle := Value;
end;

end.



---

← →
Dragon21   (2002-10-16 15:43) [7]

В библиотеке RX, есть компонент DirectoryEdit, Очень удобная вещь для выбора каталога.

---

← →
NickBat   (2002-10-16 17:48) [8]

Увидел ветку: подумал откуда больше одного ответа (SelectDirectory)? А тут оказывается такие "перлы" есть!

---

← →
boa   (2002-10-17 05:41) [9]

Еще раз спасибо всем, кто откликнулся.
SelectDirectory - это то, что мне было нужно.

---

← →
roadster   (2002-10-17 06:45) [10]

Могу предложить компонент:

unit seldir;

interface

uses
Windows, Messages, SysUtils, Classes,
Graphics, Controls, Forms, Dialogs,
FileCtrl;

type
TSDType=(sdClassic,sdMustDie);
TSelectDir = class(TComponent)
private
FCaption: String;
FDirectory: String;
FSDType: TSDType;
FSDClassicOptions: TSelectDirOpts;
FHelpContext: Longint;
FSpecialDir: String;
procedure SetCaption(const Value: String);
procedure SetDirectory(const Value: String);
procedure SetSDType(const Value: TSDType);
procedure SetSDClassicOptions(const Value: TSelectDirOpts);
procedure SetHelpContext(const Value: Longint);
procedure SetSpecialDir(const Value: String);
{ Private declarations }
protected
{ Protected declarations }
public
{ Public declarations }
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
function Execute:Boolean;
property Directory:String read FDirectory write SetDirectory;
published
{ Published declarations }
property Caption:String read FCaption write SetCaption;
property SDType:TSDType read FSDType write SetSDType;
property SDClassicOptions:TSelectDirOpts read FSDClassicOptions write SetSDClassicOptions;
property HelpContext:Longint read FHelpContext write SetHelpContext;
property SpecialDir:String read FSpecialDir write SetSpecialDir;
end;

procedure Register;

implementation
{$R *.DCR}

procedure Register;
begin
RegisterComponents("Roadster Components", [TSelectDir]);
end;

{ TSelectDir }

constructor TSelectDir.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FCaption:="Выбор каталога (ресурса)";
FSDType:=sdMustdie;
FDirectory:="";
end;

destructor TSelectDir.Destroy;
begin
inherited Destroy;
end;

function TSelectDir.Execute: Boolean;
begin
Result:=False;
if DirectoryExists(FSpecialDir) then FDirectory:=FSpecialDir;
if FSDType=sdMustDie then
begin
if not DirectoryExists(FSpecialDir) then FSpecialDir:="";
if SelectDirectory(FCaption,FSpecialDir,FDirectory)
then Result:=True;
end
else begin
if SelectDirectory(FDirectory,FSDClassicOptions,FhelpContext)
then Result:=True;
end;
end;

procedure TSelectDir.SetCaption(const Value: String);
begin
FCaption := Value;
end;

procedure TSelectDir.SetDirectory(const Value: String);
begin
FDirectory := Value;
end;

procedure TSelectDir.SetHelpContext(const Value: Longint);
begin
FHelpContext := Value;
end;

procedure TSelectDir.SetSDClassicOptions(const Value: TSelectDirOpts);
begin
FSDClassicOptions := Value;
end;

procedure TSelectDir.SetSDType(const Value: TSDType);
begin
FSDType := Value;
end;

procedure TSelectDir.SetSpecialDir(const Value: String);
begin
FSpecialDir := Value;
end;

end.

---

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

Форум: "Основная";
Текущий архив: 2002.10.28;
Скачать: [xml.tar.bz2];

Наверх

Память: 0.48 MB
Время: 0.011 c