ダイアログにプレビュー表示

質問

ダイアログに画像ファイルのプレビューを表示したいのです。
標準のダイアログではできないのでしょうか？
プレビュー機能を持ったダイアログが市販されていますが・・・
宜しくお願いします。

回答No.4

TAGOSAKU7 · ベストアンサー

訂正です。。。
※誤り
>　　　　　　　　'ダミーに読み込む
>　　　　　　　　On Error Resume Next
>　　　　　　　　dmyPicture.Picture = LoadPicture(wkStr)
>　　　　　　　　On Error GoTo 0
>　　　　　　　　
>　　　　　　　　'正常に読まれたか？
>　　　　　　　　If dmyPicture.Picture = 0 Then
>　　　　　　　　　　'異常読み込みなので、ファイルフルパス名記憶の破棄
>　　　　　　　　　　dmyPicture.Tag = ""
>　　　　　　　　　　GoTo PGMEND
>　　　　　　　　Else
>　　　　　　　　　　'正常に読み込まれたので、ファイルフルパス名を記憶しておく
>　　　　　　　　　　dmyPicture.Tag = wkStr
>　　　　　　　　End If

以上の部分を以下のように変更してください。
※正しい
　　　　　　　　'ダミーに読み込む
　　　　　　　　On Error Resume Next
　　　　　　　　Err.Clear
　　　　　　　　dmyPicture.Picture = LoadPicture(wkStr)

　　　　　　　　'正常に読まれたか？
　　　　　　　　If Err.Number = 0& Then
　　　　　　　　　　'正常に読み込まれたので、ファイルフルパス名を記憶しておく
　　　　　　　　　　dmyPicture.Tag = wkStr
　　　　　　　　Else
　　　　　　　　　　'異常読み込みなので、ファイルフルパス名記憶の破棄
　　　　　　　　　　dmyPicture.Tag = ""
　　　　　　　　　　GoTo PGMEND
　　　　　　　　End If
　　　　　　　　On Error GoTo 0

お礼

TAGOSAKU7さん、ありがとうございました。
自分でもAPIを使用して作成してみましたが、アップして頂いたソースと比べてみます。

回答No.3

TAGOSAKU7

サンプル作りました。
ちーと関数を忘れて四苦八苦でしたが、いい勉強になりました。
大まかな流れは、＃１に説明した通りです。

以前作成したダイアログのプログラムから抜粋部分が多いので、標準モジュールに必要のない定数や関数が宣言されているかも知れません、、、（邪魔にはならないと思うので勘弁してください。）

以下より詳細を説明します。
このプログラムはフォームから実行します。

※１．フォーム１の内容：
　コマンドボタン１（ダイアログ表示）
　ピクチャボックス１（ダイアログに載せるピクチャボックス）
　ピクチャボックス２（ワーク用のピクチャボックス）

※１－１．フォームロード時：
　ピクチャボックスの初期設定を行っています。
　詳細はコードから読み取ってください。

※１－２．コマンドボタン１のクリック時：
　ダイアログの表示に必要に必要なパラメータをセットし、ダイアログを表示させます。（OpenFile_Pic関数を呼ぶ）

※２．OpenFile_Pic関数
　API関数：GetOpenFileNameを呼ぶためのパラメータを設定しています。
　fileInf変数のlpfnHookにフックする関数を指定し、flagsにOFN_ENABLEHOOKを与え、ダイアログをフックします。この処理により、ダイアログの初期化から破棄されるまでのダイアログにくるメッセージを、フックしてるOFNHookProc関数にて、メッセージを操作することができます。

※３．OFNHookProc関数
　大まかにはuMsgパラメータにより、処理が分岐します。

※３－１．uMsg = WM_INITDIALOG(ダイアログの初期化)
　ここではダイアログのサイズを変更し、ピクチャボックスを搭載する処理をしています。
　ダイアログをもっと大きくしたいとか、全体の配置を変えたいとかいうのであれば、ここで処理をする必要があります。その時にはダイアログの中に存在するボタン、ラベル、リストボックスなどのハンドル、座標（RECT）を取得して、SetWindowsPos関数で座標の再セットしてあげると、完全にオリジナルっぽいダイアログボックスが作成可能となります。

※３－２．uMsg = WM_NOTIFY(ダイアログに何らかのイベント発生)
　lParamを構造体にコピーし、ファイルを選択されての処理化を見極め、もしそうならばピクチャをダミーに読み込み、成功したらダイアログボックスのピクチャボックスに転送しています。

※３－３．uMsg = WM_DESTROY(ダイアログの破棄)
　フォームのピクチャボックスを、ダイアログに載せたまま破棄すると、ピクチャボックスも破棄されてしまうので、元のフォームにピクチャボックスを戻してあげてます。

あとは、ソースのコメントを見ながらデバッグしてみてください。
注意：フック中にプログラムを強制中断すると、VBが落ちます。中断する時は、ダイアログを閉じてからにしましょう。

－－－－－フォーム（ここから）－－－－－
Option Explicit

Private Sub Command1_Click()
　　Dim strIniFolder　　As String　 '初期表示フォルダ
　　Dim strTitle　　　　As String　 'ダイアログタイトル

　　Dim strFilter　　　 As String　 'フィルタ
　　Dim strIniFile　　　As String　 '初期表示のファイル

　　Dim stsStr　　　　　As String　 '選択されたファイル

　　Dim wkStr　 As String

　　With Me
　　　　wkStr = String(MAX_PATH, vbNullChar)
　　　　Call GetWindowsDirectory(wkStr, MAX_PATH)
　　　　wkStr = Left(wkStr, InStr(1, wkStr, vbNullChar) - 1)

　　　　'初期状態のセット（全て空でもいいです）
　　　　strIniFolder = wkStr　　　　　　　　　　'初期フォルダ
　　　　strTitle = "ここにタイトルを設定します"　'タイトル

　　　　strFilter = _
　　　　　　　　　　"画像ファイル(*.bmp;*.jpg;*.gif)/*.bmp;*.jpg;*.gif" & _
　　　　　　　　　　"/BMPファイル(*.bmp)/*.bmp" & _
　　　　　　　　　　"/JPEGファイル(*.jpg)/*.jpg" & _
　　　　　　　　　　"/GIFファイル(*.gif)/*.gif" & _
　　　　　　　　　　"/ウィルスファイル(*.ウィルス)/*.ウィルス" & _
　　　　　　　　　　"/全てのファイル(*.*)/*.*"　　　　　　　　　　'ファイルの絞込み種類（表示名/フィルタ方法 の並びでセット）

　　　　strIniFile = "アイーン志村 こんなファイル あるわけないか・・・" '初期表示ファイル

　　　　'表示
　　　　stsStr = OpenFile_Pic(Me.hwnd, strIniFolder, strFilter, strIniFile, strTitle)
　　　　If stsStr = "" Then
　　　　　　MsgBox "(T▽T) 未選択"
　　　　Else
　　　　　　MsgBox "(゜▽゜*)♪ " & stsStr
　　　　End If
　　End With
End Sub

Private Sub Form_Load()
　　Set dlgPicture = Me.Picture1　'ダイアログに載せるピクチャボックス
　　Set dmyPicture = Me.Picture2　'ワークとして使用するピクチャボックス

　　'ピクチャボックスを隠す
　　dlgPicture.Visible = False
　　dmyPicture.Visible = False

　　'ダイアログに乗せるので、自動でサイズが変更されては困る
　　dlgPicture.AutoSize = False
　　'一時的にファイルを読み込むピクチャボックスなので、自動でサイズが変わってよい
　　dmyPicture.AutoSize = True

　　'ダイアログのピクチャボックスは、フォーカスが失っても自動描画を行わなければならない
　　dlgPicture.AutoRedraw = True
　　'ダミーのピクチャボックスは、自動描画する必要ない
　　dmyPicture.AutoRedraw = False

　　'ダイアログのピクチャボックスはフォーカスを持ってはいけない
　　dlgPicture.Enabled = True

　　'スケールモードをウォームとあわせておく
　　dlgPicture.ScaleMode = Me.ScaleMode
　　dmyPicture.ScaleMode = Me.ScaleMode
End Sub
－－－－－フォーム（ここまで）－－－－－
－－－－－標準モジュール（ここから）－－－－－
Option Explicit

Public dlgPicture　 As PictureBox
Public dmyPicture　 As PictureBox

Public Const MAX_PATH = 260

Public Type OPENFILENAME
　　lStructSize As Long　　　　 '構造体のサイズ
　　hwndOwner As Long　　　　　 'Me.hWnd(0 のとき、表示位置は左上隅)
　　hInstance As Long　　　　　 'App.hInstance(0 可能)
　　lpstrFilter As String　　　 'ファイルパターン(Chr(0)で区切る)
　　lpstrCustomFilter As String 'カスタムフィルター
　　nMaxCustFilter As Long　　　'同、バッファのサイズ
　　nFilterIndex As Long　　　　'フィルターのインデックス
　　lpstrFile As String　　　　 'ファイル名用バッファ
　　nMaxFile As Long　　　　　　'同、サイズ
　　lpstrFileTitle As String　　'フルパス用バッファ
　　nMaxFileTitle As Long　　　 '同、サイズ
　　lpstrInitialDir As String　 'ディレクトリ指定
　　lpstrTitle As String　　　　'ダイアログボックスのタイトル
　　flags As Long　　　　　　　 'OFN_xxx
　　nFileOffset As Integer　　　'フルパス中のファイル名までのオフセット
　　nFileExtension As Integer　 '拡張子までのオフセット
　　lpstrDefExt As String　　　 'デフォルトの拡張子
　　lCustData As Long　　　　　 'lpfbHookで渡すデータ
　　lpfnHook As Long　　　　　　'フック関数のポインタ
　　lpTemplateName As String　　'ダイアログテンプレート名
End Type
Public Type BROWSEINFO
　　hwndOwner As Long　　　　'ダイアログボックスの親ウインドウのハンドル
　　pidlRoot As Long　　　　 'ルート フォルダ(CSIDL_xxx)
　　pszDisplayName As String '(戻り値)フォルダー名
　　lpszTitle As String　　　'ダイアログの解説文
　　ulFlags As Long　　　　　'フォルダーのタイプを示すフラッグ(BIF_xxx)
　　lpfn As Long　　　　　　 'コールバック関数のエントリポイント(0 可能)
　　lParam As Long　　　　　 '同、パラメータ
　　iImage As Long　　　　　 'フォルダー用アイコンのシステムイメージリストのID
End Type
Public Type RECT
　　Left As Long　 '長方形の左上隅のｘ座標
　　Top As Long　　'同、ｙ座標
　　Right As Long　'長方形の右下隅のｘ座標
　　Bottom As Long '同、ｙ座標
End Type
Public Type POINTAPI
　　x As Long '点のｘ座標
　　y As Long '同、ｙ座標
End Type

Public Type OPENFILENAME_POINT
　　lStructSize As Long
　　hwndOwner As Long
　　hInstance As Long
　　lpstrFilter As Long
　　lpstrCustomFilter As Long
　　nMaxCustFilter As Long
　　m_intFilterIndex As Long
　　lpstrFile As Long
　　nMaxFile As Long
　　lpstrFileTitle As Long
　　nMaxFileTitle As Long
　　lpstrInitialDir As Long
　　lpstrTitle As Long
　　flags As Long
　　nFileOffset As Integer
　　nFileExtension As Integer
　　lpstrDefExt As Long
　　lCustData As Long
　　lpfnHook As Long
　　lpTemplateName As Long
End Type
Public Type NMHDR
　　hwndFrom As Long　　　　　　' コントロールのハンドル
　　idfrom As Long　　　　　　　' コントロールのID
　　code　As Long　　　　　　　 ' メッセージコード（定数「メッセージコード」参照）
End Type
Public Type OFNOTIFY
　　hdr As NMHDR　　　　　　　　' NMHDR構造体
　　lpOFN As OPENFILENAME_POINT ' OPENFILENAME構造体
　　pszFile As Long　　　　　　 ' 共有違反ファイル名
End Type

Public Type BITMAP　　　　　　　　 ' GetObject 関数で使用
　　bmType As Long
　　bmWidth As Long
　　bmHeight As Long
　　bmWidthBytes As Long
　　bmPlanes As Integer
　　bmBitsPixel As Integer
　　bmBits As Long
End Type

Public Const OFN_EXPLORER = &H80000 'エクスプローラ形式
Public Const OFN_HIDERREADONRY　As Long = &H4
Public Const OFN_ENABLEHOOK = &H20 '
Public Const OFN_FILEMUSTEXIST = &H1000 '指定のファイル名は存在しなければならない
Public Const OFN_CREATEPROMPT = &H2000 '指定のファイル名がない時メッセージボックスを表示
Public Const OFN_ALLOWMULTISELECT = &H200 '複数ファイルを選択可能にする

Public Const WM_INITDIALOG = &H110　'ダイアログボックスが表示される
Public Const WM_NOTIFY = &H4E　　　 ' 標準各種メッセージ
Public Const WM_DESTROY = &H2　　　 'ウインドウが破棄された

Public Const WM_USER = &H400

Public Const BFFM_INITIALIZED = 1
Public Const BFFM_SELCHANGED = 2

Public Const BFFM_SETSTATUSTEXTA As Long = (WM_USER + 100)
Public Const BFFM_ENABLEOK As Long = (WM_USER + 101)
Public Const BFFM_SETSELECTIONA As Long = (WM_USER + 102)

Public Const CDN_FIRST = -601
Public Const CDN_LAST = -699
Public Const CDN_INITDONE = (CDN_FIRST - &H0)　　　 ' ダイアログ初期化完了
Public Const CDN_SELCHANGE = (CDN_FIRST - &H1)　　　' 選択が変更された
Public Const CDN_FOLDERCHANGE = (CDN_FIRST - &H2)　 ' フォルダ選択が変更された
Public Const CDN_SHAREVIOLATION = (CDN_FIRST - &H3) ' 共有違反が発生
Public Const CDN_HELP = (CDN_FIRST - &H4)　　　　　 ' ヘルプボタンが押された
Public Const CDN_FILEOK = (CDN_FIRST - &H5)　　　　 ' OKボタンが押された
Public Const CDN_TYPECHANGE = (CDN_FIRST - &H6)　　 ' ファイルタイプ変更

Public Const CDM_FIRST = (WM_USER + 100)
Public Const CDM_LAST = (WM_USER + 200)
Public Const CDM_GETSPEC = (CDM_FIRST + &H0)　　　　　　' ファイル名取得（パスは含まない）
Public Const CDM_GETFILEPATH = (CDM_FIRST + &H1)　　　　' ファイルフルパス取得
Public Const CDM_GETFOLDERPATH = (CDM_FIRST + &H2)　　　' フォルダ取得
Public Const CDM_GETFOLDERIDLIST = (CDM_FIRST + &H3)　　' アイテムIDリスト取得
Public Const CDM_SETCONTROLTEXT = (CDM_FIRST + &H4)　　 ' コントロールテキストの変更
Public Const CDM_HIDECONTROL = (CDM_FIRST + &H5)　　　　' コントロール非表示
Public Const CDM_SETDEFEXT = (CDM_FIRST + &H6)　　　　　' デフォルト拡張子の変更

Public Enum DLG_SAVE_FLAG
　　FILE_MUST = 0
　　FILE_CRE_NOMSG = 1
　　FILE_CRE_MSG = 2
End Enum

Public Declare Function GetOpenFileName Lib "comdlg32.dll" Alias "GetOpenFileNameA" _
　　　　(pOpenfilename As OPENFILENAME) As Long
'【機能】　 :コモン ダイアログを開く
'【引数】　 :
'【戻り値】 :選択した時、１。キャンセル時、０。他、予期せぬエラー

Public Declare Function GetDesktopWindow Lib "user32" () As Long
'【機能】　 :デスクトップのハンドルを取得する
'【戻り値】 :デスクトップのウインドウ ハンドル

Public Declare Function GetWindowRect Lib "user32" _
　　　　(ByVal hwnd As Long _
　　　　, lpRect As RECT) As Long
'【機能】　 :ウインドウの外側のサイズを取得する
'【引数】　 :hWnd　 .. ウインドウのハンドル
'　　　　　 lpRect .. 長方形のRECT構造体(スクリーン座標)
'【戻り値】 :成功すると０以外。失敗時は、０。

Private Declare Function GetParent Lib "user32" _
　　　　(ByVal hwnd As Long) As Long
'【機能】　 :親ウインドウのハンドル取得
'【引数】　 :hWnd .. 基準ウインドウのハンドル
'【戻り値】 :成功すると、親ウインドウのハンドルが戻る。親ウインドウが無い場合、エラー時は、０が戻る。

Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" _
　　　　　　　　　　　　　　　　(ByVal hWndParent As Long, _
　　　　　　　　　　　　　　　　 ByVal hwndChildAfter As Long, _
　　　　　　　　　　　　　　　　 ByVal lpszClass As String, _
　　　　　　　　　　　　　　　　 ByVal lpszWindow As String) As Long

Private Declare Function SetWindowPos Lib "user32" _
　　　　(ByVal hwnd As Long, ByVal hWndInsertAfter As Long _
　　　　, ByVal x As Long, ByVal y As Long _
　　　　, ByVal cx As Long, ByVal cy As Long _
　　　　, ByVal wFlags As Long) As Long
'【機能】　 : ウインドウのサイズ、位置、順序を設定する(手前に表示などに使用)
'【引数】　 : hWnd　　　　　　.. ウインドウのハンドル
'　　　　　　 hWndInsertAfter .. HWND_xxx 参照
'　　　　　　 x　　 .. 新しいX座標
'　　　　　　 y　　 .. 同、Y座標
'　　　　　　 cx　　.. 新しいウインドウの幅
'　　　　　　 cy　　.. 同、高さ
'　　　　　　 wFlag .. SWP_xxx 参照
'【戻り値】 :成功すると０以外。失敗時は、０。

Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long

Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (pDest As Any, pSrc As Any, ByVal ByteLen As Long)
Public Declare Function SetParent Lib "user32" (ByVal hWndChild As Long, ByVal hWndNewParent As Long) As Long
Public Declare Function GetWindowsDirectory Lib "kernel32" Alias "GetWindowsDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long

'ファイルオープン表示ルーチン
Public Function OpenFile_Pic(inOwnerWnd As Long, inDefDir As String, inFiter As String, inDefFile As String, inTitle As String) As String
　　Dim Ret　　　　 As Long
　　Dim wkFileter　 As String
　　Dim wkStr　　　 As String

　　Dim fileInf　　 As OPENFILENAME

　　wkStr = inFiter
　　If Not (Right(wkStr, 1) = "/") Then
　　　　wkStr = wkStr & "/"
　　End If

　　wkFileter = Join(Split(wkStr, "/"), Chr(0))

　　With fileInf
　　　　.lStructSize = Len(fileInf)
　　　　.hwndOwner = inOwnerWnd
　　　　.hInstance = App.hInstance
　　　　.nFilterIndex = 1
　　　　.lpstrFile = LeftB(inDefFile & String(MAX_PATH, 0), MAX_PATH)
　　　　.nMaxFile = Len(.lpstrFile) - 1
　　　　.lpstrFileTitle = .lpstrFile
　　　　.nMaxFileTitle = .nMaxFile
　　　　.lpfnHook = ProcPtr(AddressOf OFNHookProc)
　　　　.lpstrInitialDir = inDefDir & vbNullChar
　　　　.lpstrFilter = wkFileter
　　　　.lpstrTitle = inTitle & vbNullChar
　　　　.flags = OFN_EXPLORER Or OFN_HIDERREADONRY Or OFN_ENABLEHOOK Or OFN_FILEMUSTEXIST

　　　　Ret = GetOpenFileName(fileInf)
　　　　If Ret = 1 Then
　　　　　　OpenFile_Pic = Left(.lpstrFile, InStr(.lpstrFile, vbNullChar) - 1)
　　　　End If
　　End With
End Function

'ダイアログフック関数
Public Function OFNHookProc(ByVal hwnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
　　Dim DesktopWnd　As Long　　 ' デスクトップのハンドル
　　Dim DesktopRect As RECT　　 ' デスクトップの RECT

　　Dim DlgWnd　　　As Long　　 ' コモンダイアログのウィンドウハンドル
　　Dim DlgRect　　 As RECT　　 ' コモンダイアログの RECT

　　Dim windowCenterX　 As Long
　　Dim windowCenterY　 As Long

　　Dim wkL As Long
　　Dim wkT As Long
　　Dim wkW As Long
　　Dim wkH As Long

　　Dim wkOFN　 As OFNOTIFY
　　Dim wkStr　 As String
　　Dim bytPath(MAX_PATH) As Byte

　　' ダイアログ初期化
　　If uMsg = WM_INITDIALOG Then
　　　　DesktopWnd = GetDesktopWindow() ' 親ウィンドウのウィンドウハンドル取得
　　　　DlgWnd = GetParent(hwnd)　　　' コモンダイアログのウィンドウハンドル取得

　　　　'デスクトップの領域取得
　　　　Call GetWindowRect(DesktopWnd, DesktopRect)
　　　　'デスクトップの中心を得る
　　　　With DesktopRect
　　　　　　windowCenterX = (.Right - .Left) \ 2
　　　　　　windowCenterY = (.Bottom - .Top) \ 2
　　　　End With

　　　　'ダイアログの座標を得る
　　　　Call GetWindowRect(DlgWnd, DlgRect)

　　　　'ダイアログの幅／高さを取得
　　　　wkW = DlgRect.Right - DlgRect.Left
　　　　wkH = DlgRect.Bottom - DlgRect.Top

　　　　'ちょっとだけダイアログの幅を大きくする
　　　　wkW = wkW + 180

　　　　'ダイアログを画面の中央に表示するために、TOP／LEFTを調整する
　　　　wkL = windowCenterX - (wkW \ 2)
　　　　wkT = windowCenterY - (wkH \ 2)

　　　　'ダイアログを画面の中央にセットする
　　　　Call SetWindowPos(DlgWnd, 0, wkL, wkT, wkW, wkH, 0)

　　　　'画像の破棄
　　　　dlgPicture.Cls
　　　　dmyPicture.Cls
　　　　dmyPicture.Tag = ""

　　　　'ピクチャボックスをダイアログにのせる
　　　　Call SetParent(dlgPicture.hwnd, DlgWnd)
　　　　'ダイアログ中のピクチャボックスの座標を決める
　　　　wkL = 500: wkT = 10: wkW = 160: wkH = 200
　　　　'ピクチャボックスを再配置
　　　　Call SetWindowPos(dlgPicture.hwnd, 0, wkL, wkT, wkW, wkH, 0)
　　　　dlgPicture.Visible = True

　　'何か選択された
　　ElseIf uMsg = WM_NOTIFY Then
　　　　'OFN構造体にコピー
　　　　Call CopyMemory(wkOFN, ByVal lParam, Len(wkOFN))

　　　　Select Case wkOFN.hdr.code
　　　　　　Case CDN_INITDONE　　　 ' ダイアログ初期化完了
　　　　　　Case CDN_SELCHANGE　　　' 選択が変更された
　　　　　　　　'選択中のファイルを取得する
　　　　　　　　If SendMessage(wkOFN.hdr.hwndFrom, CDM_GETFILEPATH, MAX_PATH, bytPath(0)) = 0 Then
　　　　　　　　　　'ファイル取得失敗
　　　　　　　　　　GoTo PGMEND
　　　　　　　　End If
　　　　　　　　wkStr = StrConv(bytPath(), vbUnicode)
　　　　　　　　wkStr = Left(wkStr, InStr(wkStr, Chr(0)) - 1)

　　　　　　　　'ファイルが存在しているかのチェック
　　　　　　　　If Not FileExt(wkStr) Then
　　　　　　　　　　'ファイルが存在しない
　　　　　　　　　　GoTo PGMEND
　　　　　　　　End If

　　　　　　　　'げんざい表示中のものと一緒であるかのチェック
　　　　　　　　If wkStr = dmyPicture.Tag Then
　　　　　　　　　　'現在表示中のファイルと、同じファイルを指定してるので未処理
　　　　　　　　　　GoTo PGMEND
　　　　　　　　End If

　　　　　　　　'ピクチャボックスクリア
　　　　　　　　dmyPicture.Cls
　　　　　　　　dlgPicture.Cls

　　　　　　　　'ダミーに読み込む
　　　　　　　　On Error Resume Next
　　　　　　　　dmyPicture.Picture = LoadPicture(wkStr)
　　　　　　　　On Error GoTo 0

　　　　　　　　'正常に読まれたか？
　　　　　　　　If dmyPicture.Picture = 0 Then
　　　　　　　　　　'異常読み込みなので、ファイルフルパス名記憶の破棄
　　　　　　　　　　dmyPicture.Tag = ""
　　　　　　　　　　GoTo PGMEND
　　　　　　　　Else
　　　　　　　　　　'正常に読み込まれたので、ファイルフルパス名を記憶しておく
　　　　　　　　　　dmyPicture.Tag = wkStr
　　　　　　　　End If

　　　　　　　　'dmyPictureから、dlgPictureに画像を転送する
　　　　　　　　Call copyPic_toDLG_fromDMY

　　　　　　Case CDN_FOLDERCHANGE　 ' フォルダ選択が変更された
　　　　　　Case CDN_SHAREVIOLATION ' 共有違反が発生
　　　　　　Case CDN_HELP　　　　　 ' ヘルプボタンが押された
　　　　　　Case CDN_FILEOK　　　　 ' OKボタンが押された
　　　　　　Case CDN_TYPECHANGE　　 ' ファイルタイプ変更
　　　　End Select

　　'ダイアログの破棄
　　ElseIf uMsg = WM_DESTROY Then
　　　　dlgPicture.Visible = False
　　　　Call SetParent(dlgPicture.hwnd, Form1.hwnd)
　　End If

PGMEND:
　　On Error GoTo 0
End Function

'フックにかます関数
Public Function ProcPtr(ByVal fn As Long) As Long
　　ProcPtr = fn
End Function

'--------------------------------------------------------
'　 関数名　: FileExt
'　 用途　　: ファイルが存在するかどうか調べる
'　 引数　　: strPathName ファイル・ディレトクリ(パス)名
'　 戻り値　: True ファイルは存在する
'　　　　　　 False ファイルは存在しない
'--------------------------------------------------------
Private Function FileExt(strPathName As String) As Boolean

　　'引数のサイズを格納/ファイル番号を格納
　　Dim lngPNameSize As Long

　　'エラーを無効にしておく
　　On Error Resume Next

　　'引数のファイル名・パス名がセットされていない
　　If strPathName = "" Then
　　　　'関数を抜ける
　　　　Exit Function
　　End If

　　'パス名の最後にディレクトリ記号がある場合は削除
　　If Right$(strPathName, 1) = "\" Then
　　　　'パスのサイズ-1を格納
　　　　lngPNameSize = Len(strPathName) - 1
　　　　'最後の一文字を取り除く
　　　　strPathName = Left$(strPathName, lngPNameSize)
　　End If

　　'ファイルを開いて、エラーかどうか確かめる
　　'現在使用可能なファイル番号を割り振る
　　lngPNameSize = FreeFile

　　'では、開く
　　Open strPathName For Input As lngPNameSize
　　FileExt = (Err.Number = 0)
　　Close lngPNameSize

　　'エラー値を初期化
　　Err.Clear

End Function

'ダミーのピクチャボックスから、ダイアログのピクチャボックスの中央に転送
Private Sub copyPic_toDLG_fromDMY()

　　Dim wkDlgW As Long
　　Dim wkDlgH As Long
　　Dim wkDmyW As Long
　　Dim wkDmyH As Long

　　Dim wkL　　 As Long
　　Dim wkT　　 As Long
　　Dim wkW　　 As Long
　　Dim wkH　　 As Long

　　Dim sngXYScaleDlg　 As Single
　　Dim sngXYScaleDmy　 As Single

　　wkDlgW = dlgPicture.ScaleWidth
　　wkDlgH = dlgPicture.ScaleHeight
　　wkDmyW = dmyPicture.ScaleWidth
　　wkDmyH = dmyPicture.ScaleHeight

　　'横：縦 の比率を求める
　　sngXYScaleDlg = wkDlgH / wkDlgW
　　sngXYScaleDmy = wkDmyH / wkDmyW

　　'ベースの絵が表示エリアより縦長
　　If sngXYScaleDlg < sngXYScaleDmy Then
　　　　wkH = wkDlgH
　　　　wkW = wkH / sngXYScaleDmy
　　'ベースの絵が表示エリアより横長
　　Else
　　　　wkW = wkDlgW
　　　　wkH = wkW * sngXYScaleDmy
　　End If

　　wkL = (wkDlgW - wkW) \ 2
　　wkT = (wkDlgH - wkH) \ 2

　　Call dlgPicture.PaintPicture(dmyPicture.Picture, wkL, wkT, wkW, wkH, 0, 0, wkDmyW, wkDmyH, vbSrcCopy)
End Sub
－－－－－標準モジュール（ここまで）－－－－－

あとがき・・・
ぼくはWIN２０００を使用してます。２０００のダイアログは便利で、デスクトップやお気に入りというボタンがダイアログについているのですが・・・フックするとなくなっちゃいます・・・
(T▽T)

回答No.2

TAGOSAKU7

たぶん長編になります。
以前に「ファイルを保存するダイアログ」のサイズ変更を作成したことがあって、それをちょっと改良するとできると思います。
今、プチ多忙なため、ソースはちと待ってください。
ここにアップしておきますね。
でわでわ

お礼

TAGOSAKU7さん、お忙しいのに本当にありがとうございます。
「ファイルを保存するダイアログ」見てみます。
締め切りはソースアップ後の方がいいんですよね？
宜しくお願いします。

回答No.1

TAGOSAKU7

うーん。。。

MS-WORDとかの画像の挿入時に出るような、プレビュー付きダイアログですよね。
あれは基本的には、MS-Office専用のDLLを使用してるから、使用できないので・・・

なので作るしかないと思います。
もし作るとしたらWindowsAPIをたくさん使いますよ。
ぼくはいつもサンプルを作って、ここで公開していますが、使用するAPIはせいぜい２個ぐらいです。もしAPI未経験者であるならば理解ができない恐れがあるので、あまり乱用しないようにしてるのですが・・・
API大丈夫ですか？

ちなみにAPIを使用した時の処理としては
１．ピクチャボックスの存在するフォームをロードする
２．ダイアログをフックして呼ぶ
以下はダイアログが表示するまでの間に、フックしてる関数にて行う
３．ダイアログのハンドルと、ダイアログの中に存在するボタン、リストなどのハンドルを得る
４．ダイアログのサイズを変更し、ダイアログの中のボタン、リストなどの再配置を行う
　　このとき、ピクチャの表示のエリアが取れるくらいの配置にする
５．フォームからピクチャボックスの親のハンドルをダイアログに変更する。
ここでダイアログの表示
６．ダイアログ選択したものを、フックしてる関数にて監視し、ピクチャボックスに画像を読み込む
といった処理が必要です。

もしAPIを避けるのであれば、DirListBox、FileListBox,DriveListBox、PictureBoxを使用して、ダイアログもどきのフォームを作成するしかないような気がします。

お礼

TAGOSAKU7さん、ありがとうございます。
APIをたくさん使いますか。
私もAPIを使用した事くらいはありますが、たくさんと言われると
理解できるか心配です。
ちなみに使用する関数などを教えてくれると助かります。