この発言に対し以下のコメントが寄せられています

#01163　さざえ          さん　RE:SHBrowseForFolder のオブジェクト






　フォルダツリービューのＶＣＬは　いろいろな方が作られていますが
　自分の勉強もかねて SHBrowseForFolder のフォルダ選択ダイアログボックスを
　オブジェクトにしてみました。　位置やサイズ変更もできます。
　（紅月　燐火さん、GetClientPos 関数ありがとうございます）

　なお、前回アップした BrowseCallbackProc 内では

        ppmem.Free( PItemIDList( lParam ) );  ★不要

　の行をそのまま行っていましたが　ナリさんに指摘していただいて修正しました。
　SHBrowseForFolder、SHGetSpecialFolderLocation の場合はそれぞれの関数自身が
　領域を確保するので　使い終わった後に取得したポインタを自分で解放する必要が
　あるのですが、SHGetPathFromIDList 関数はすでに確保されている領域を使用する
　だけです。　ですので「 SHGetPathFromIDList 処理をしたからポインタを解放」と
　いう手順をうっかり行っていると危険です。
　（ナリさん、アドバイスありがとうございました）


///////【使用例】///////
program FldTree;
uses    BrwsFldr;
{$APPTYPE CONSOLE}
var
        BF : TBrowseFolderBox;
begin
        BF := TBrowseFolderBox.Create;
        try
                BF.InitFolder := 'c:\';         //初期選択フォルダを C:\ に
                BF.Title := 'フォルダを選択';   //ダイアログボックスのタイトル
                BF.Flags := BF.Flags or bifStatusText;
                                                //ステータステキストにカーソル
                                                //位置フォルダのフルパス表示
                BF.PosX := 100; BF.PosY := 10;  //ダイアログの位置を指定
                BF.SizeX := -50; BF.SizeY := 100;
                                                //サイズを変更（オリジナルより
                                                //横-50、縦+100の大きさ）
                if BF.Execute then begin
                        Writeln( BF.SelectFolder );
                        Writeln( BF.DisplayName );
                end;
        finally
                BF.Free;
        end;
end.
////////////////////

-------------------------------------------------------------------
unit BrwsFldr;

// SHBrowseForFolder のフォルダ選択ダイアログのオブジェクト

interface

uses
        Windows, ShlObj, ActiveX;

type
        TBrowseFolderBox = class
        private
                FHandle         : HWND;         //ダイアログの hwnd
                FBrowseInfo     : TBrowseInfo;  //BROWSEINFO
                FRootFolderNum  : Integer;      //CSIDL_??? ルートフォルダ
                FInitFolder     : String;       //初期選択フォルダ
                FSelectFolder   : String;       //選択されたフォルダパス
                FDisplayName    : String;       //選択されたフォルダ文字列
                FTitle          : String;       //タイトル
                FStatusText     : String;       //ステータス文字列
                FFlags          : UINT;         //ダイアログのフラグ
                FPosX, FPosY    : Integer;      //ダイアログの位置
                FSizeX, FSizeY  : Integer;      //ダイアログのサイズの増減
                procedure       ResizeOwnDialog;
        public
                constructor     Create;
                function        Execute: Boolean;
        published
                property        Handle: HWND            read FHandle;
                property        SelectFolder: String    read FSelectFolder;
                property        DisplayName: String     read FDisplayName;
                property        RootFolderNum: Integer  read FRootFolderNum
                                                        write FRootFolderNum;
                property        InitFolder: String      read FInitFolder
                                                        write FInitFolder;
                property        Title: String           read FTitle
                                                        write FTitle;
                property        StatusText: String      read FStatusText;
                property        Flags: UINT             read FFlags
                                                        write FFlags;
                property        PosX: Integer           read FPosX
                                                        write FPosX;
                property        PosY: Integer           read FPosY
                                                        write FPosY;
                property        SizeX: Integer          read FSizeX
                                                        write FSizeX;
                property        SizeY: Integer          read FSizeY
                                                        write FSizeY;
        end;

const
        bifReturnOnlyFSDIRs = BIF_RETURNONLYFSDIRS;
        bifDontGoBelowDomain = BIF_DONTGOBELOWDOMAIN;
        bifStatusText = BIF_STATUSTEXT;
        bifReturnFSAncestors = BIF_RETURNFSANCESTORS;
        bifBrowseForComputer = BIF_BROWSEFORCOMPUTER;
        bifBrowseForPrinter = BIF_BROWSEFORPRINTER;
        bifBrowseIncludeFiles = BIF_BROWSEINCLUDEFILES;

implementation

function GetClientPos(hOwner, hChild: THandle): TPoint;
 (* 子ウインドウの親ウインドウクライアント座標 *)
var
        rc: TRect;
begin
        GetWindowRect(hChild, rc);
        Result := rc.TopLeft;
        Windows.ScreenToClient(hOwner, Result);
end;

constructor TBrowseFolderBox.Create;
begin
        {* プロパティ初期値 *}
        FFlags := BIF_RETURNONLYFSDIRS;
        FRootFolderNum := CSIDL_DESKTOP;
end;

procedure TBrowseFolderBox.ResizeOwnDialog;
 (* ダイアログのサイズ、位置変更 *)
type    sResizeType = ( rtOwner, rtSize, rtAncRB );
        TResizeTable = Record
                Parent : Boolean;
                Name, Text : String;
                ReType : sResizeType;
        end;
const   ResizeTable : array [0..4] of TResizeTable = (
                ( Parent:False; Name:'SysTreeView32'; Text:''; ReType:rtSize ),
                ( Parent:False; Name:'Button'; Text:'OK'; ReType:rtAncRB ),
                ( Parent:False; Name:'Button'; Text:'ｷｬﾝｾﾙ'; ReType:rtAncRB ),
                ( Parent:True;  Name:' '; ReType:rtOwner ),
                ( Parent:False; Name:'' )
        );
var
        wnd : HWND;
        idx, OrgCX, OrgCY : Integer;
        rect : TRect; 
        Pnt : TPoint;
begin
        idx := 0;
        while ResizeTable[idx].Name<>'' do begin
                if ResizeTable[idx].Parent then
                        wnd := FHandle
                else
                        wnd := FindWindowEx( FHandle, 0,
                                        PChar( ResizeTable[idx].Name ),
                                        PChar( ResizeTable[idx].Text ) );
                if wnd<>0 then begin
                        // Pnt が元のクライアント座標
                        Pnt := GetClientPos( FHandle, wnd );
                        // OrgCX, OrgCY が元のサイズ
                        GetWindowRect( wnd, rect );
                        OrgCX := rect.Right-rect.Left;
                        OrgCY := rect.Bottom-rect.Top;

                        //移動、サイズ変更
                        case ResizeTable[idx].ReType of
                                //親ウインドウ
                                rtOwner : MoveWindow( wnd, FPosX, FPosY,
                                        OrgCX+FSizeX, OrgCY+FSizeY, True );
                                //サイズ変更（場所はそのまま）
                                rtSize : MoveWindow( wnd, Pnt.X, Pnt.Y,
                                        OrgCX+FSizeX, OrgCY+FSizeY, False );
                                //右下をアンカーにして移動（サイズはそのまま）
                                rtAncRB : MoveWindow( wnd,
                                        Pnt.X+FSizeX, Pnt.Y+FSizeY,
                                        OrgCX, OrgCY, False );
                        end;
                end;
                inc( idx );
        end;
end;

function BrowseCallbackProc(hwnd: HWND; uMsg: UINT; lParam, lpData: LPARAM)
: Integer; stdcall;
 (* SHBrowseForFolder のコールバック *)
var
        ppmem : IMalloc;
        Path : String;
begin
        Result:= 0;
        SetLength( Path, MAX_PATH );
        SHGetMalloc( ppmem );

        with ( TObject( lpData ) as TBrowseFolderBox ) do begin
                //ダイアログの hwnd を設定
                if FHandle=0 then FHandle := hwnd;

                if uMsg=BFFM_INITIALIZED then begin
                        //初期フォルダの設定
                        SendMessage( hwnd, BFFM_SETSELECTION, 1,
                        Longint( PChar( FInitFolder ) ) );
                        ResizeOwnDialog;
                end
                else if uMsg=BFFM_SELCHANGED then begin
                        SHGetPathFromIDList( PItemIDList( lParam ),
                                        PChar( Path ) );
                        FStatusText := Path;
                        //ステータスにカーソル位置フォルダ表示
                        if ( BIF_STATUSTEXT and FFlags <>0 ) then begin
                                SendMessage( hwnd, BFFM_SETSTATUSTEXT, 0,
                                        Longint( PChar( FStatusText ) ) );
                        end;
                        //ppmem.Free( PItemIDList( lParam ) );  ★不要
                end;
        end;
end;

function TBrowseFolderBox.Execute: Boolean;
 (* ダイアログボックスを出す *)
var
        pidlRoot, pidlSelect : PItemIDList;
        ppmem : IMalloc;
        DisplayNameBuf, SelectFolderBuf : array [0..MAX_PATH] of Char;
begin
        Result := FALSE;
        SHGetMalloc( ppmem );

        if not SUCCEEDED( SHGetSpecialFolderLocation( 0, FRootFolderNum,
        pidlRoot ) ) then Exit;
        // BROWSEINFO を設定
        with FBrowseInfo do begin
                pidlRoot := pidlRoot;
                pszDisplayName := DisplayNameBuf;
                lpszTitle := PChar( FTitle );
                ulFlags := FFlags;
                lpfn := @BrowseCallbackProc;
                lParam := Longint( Self );
        end;

        //ダイアログボックスを出す
        pidlSelect := SHBrowseForFolder( FBrowseInfo );
        FHandle := 0;
        //フォルダが選択されたか？
        if Assigned( pidlSelect ) then begin
                if SHGetPathFromIDList( pidlSelect, SelectFolderBuf )
                then begin
                        Result := True;
                        FSelectFolder := String( SelectFolderBuf );
                        FDisplayName := String( DisplayNameBuf );
                end;
                ppmem.Free( pidlSelect );
        end;
        ppmem.Free( pidlRoot );
end;

end.
-------------------------------------------------------------------

(PXC07042) - とらじ -

Original document by 寅次            氏 ID:(PXC07042)

ここにあるドキュメントは NIFTY SERVEの Delphi Users' Forum の16番会議室「玉石混淆みんなで作るSample蔵」に投稿されたサンプルです。これらのサンプルはボーランド株式会社がサポートする公式のものではありません。また、必ずしも動作が検証されているものではありません。これらのサンプルを使用したことに起因するいかなる損害も投稿者、およびフォーラムスタッフはその責めを負いません。使用者のリスクの範疇でご使用下さい。