OKWAVEのAI「あい」が美容・健康の悩みに最適な回答をご提案!
-PR-
解決
済み

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

  • すぐに回答を!
  • 質問No.157966
  • 閲覧数1013
  • ありがとう数4
  • 気になる数0
  • 回答数4
  • コメント数0

お礼率 43% (32/74)

ダイアログに画像ファイルのプレビューを表示したいのです。
標準のダイアログではできないのでしょうか?
プレビュー機能を持ったダイアログが市販されていますが・・・
宜しくお願いします。
通報する
  • 回答数4
  • 気になる
    質問をブックマークします。
    マイページでまとめて確認できます。

質問者が選んだベストアンサー

  • 回答No.4
レベル12

ベストアンサー率 65% (276/422)

訂正です。。。
※誤り
>        'ダミーに読み込む
>        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
お礼コメント
ken-mm

お礼率 43% (32/74)

TAGOSAKU7さん、ありがとうございました。
自分でもAPIを使用して作成してみましたが、アップして頂いたソースと比べてみます。
投稿日時 - 2001-10-30 19:41:42
-PR-
-PR-

その他の回答 (全3件)

  • 回答No.1
レベル12

ベストアンサー率 65% (276/422)

うーん。。。 MS-WORDとかの画像の挿入時に出るような、プレビュー付きダイアログですよね。 あれは基本的には、MS-Office専用のDLLを使用してるから、使用できないので・・・ なので作るしかないと思います。 もし作るとしたらWindowsAPIをたくさん使いますよ。 ぼくはいつもサンプルを作って、ここで公開していますが、使用するAPIはせいぜい2個ぐらいです。もしAPI未経験者 ...続きを読む
うーん。。。

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

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

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


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

お礼率 43% (32/74)

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


  • 回答No.2
レベル12

ベストアンサー率 65% (276/422)

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

お礼率 43% (32/74)

TAGOSAKU7さん、お忙しいのに本当にありがとうございます。
「ファイルを保存するダイアログ」見てみます。
締め切りはソースアップ後の方がいいんですよね?
宜しくお願いします。
投稿日時 - 2001-10-29 11:24:56
  • 回答No.3
レベル12

ベストアンサー率 65% (276/422)

サンプル作りました。 ちーと関数を忘れて四苦八苦でしたが、いい勉強になりました。 大まかな流れは、#1に説明した通りです。 以前作成したダイアログのプログラムから抜粋部分が多いので、標準モジュールに必要のない定数や関数が宣言されているかも知れません、、、(邪魔にはならないと思うので勘弁してください。) 以下より詳細を説明します。 このプログラムはフォームから実行します。 ※1. ...続きを読む
サンプル作りました。
ちーと関数を忘れて四苦八苦でしたが、いい勉強になりました。
大まかな流れは、#1に説明した通りです。

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

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


※1.フォーム1の内容:
 コマンドボタン1(ダイアログ表示)
 ピクチャボックス1(ダイアログに載せるピクチャボックス)
 ピクチャボックス2(ワーク用のピクチャボックス)

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

※1-2.コマンドボタン1のクリック時:
 ダイアログの表示に必要に必要なパラメータをセットし、ダイアログを表示させます。(OpenFile_Pic関数を呼ぶ)



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



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

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

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

※3-3.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  '長方形の左上隅のx座標
  Top As Long  '同、y座標
  Right As Long '長方形の右下隅のx座標
  Bottom As Long '同、y座標
End Type
Public Type POINTAPI
  x As Long '点のx座標
  y As Long '同、y座標
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
'【機能】  :コモン ダイアログを開く
'【引数】  :
'【戻り値】 :選択した時、1。キャンセル時、0。他、予期せぬエラー

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構造体(スクリーン座標)
'【戻り値】 :成功すると0以外。失敗時は、0。

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


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 参照
'【戻り値】 :成功すると0以外。失敗時は、0。

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
-----標準モジュール(ここまで)-----


あとがき・・・
ぼくはWIN2000を使用してます。2000のダイアログは便利で、デスクトップやお気に入りというボタンがダイアログについているのですが・・・フックするとなくなっちゃいます・・・
(T▽T)
このQ&Aで解決しましたか?
関連するQ&A
-PR-
-PR-
こんな書き方もあるよ!この情報は知ってる?あなたの知識を教えて!
このQ&Aにはまだコメントがありません。
あなたの思ったこと、知っていることをここにコメントしてみましょう。

その他の関連するQ&A、テーマをキーワードで探す

キーワードでQ&A、テーマを検索する
-PR-
-PR-
-PR-

特集


いま みんなが気になるQ&A

関連するQ&A

-PR-

ピックアップ

-PR-
ページ先頭へ