Comment définir la position et la taille des Common Dialogs ?

Twitter iPhone pliant OnePlus 11 PS5 Disney+ Orange Livebox Windows 11

Entraide Développement Développement Visual Basic Comment définir la position et la taille des Common Dialogs ?

2 réponses

Christian HUBERT-HUGOUD- Xtrem7

24/07/2004 à 09:50

Bonjour,

J'utilise des Common Dialog par les API ; je voudrais définir la position
d'apparition (c'est facile il y a plein de code partout) mais je n'ai rien
trouvé pour définir la taille. Des pistes ?

Christian

2 réponses

Zoury

26/07/2004 à 23:01

Salut Chirstian! :O)

tu m'as donné du fil à retorde.. ;O)
s'il est "simple" de positionner une boîte de dialogue où l'on veut, la
redimensionné n'avait rien d'évident! (avant de trouvé comment...)

Voici un exemple :
'***
Option Explicit

Private Declare Function GetOpenFileNameA _
Lib "comdlg32.dll" _
( _
ByRef pOpenfilename As OPENFILENAME _
) As Long

Private Declare Function MoveWindow _
Lib "user32" _
( _
ByVal hwnd As Long, _
ByVal X As Long, _
ByVal Y As Long, _
ByVal nWidth As Long, _
ByVal nHeight As Long, _
ByVal bRepaint As Long _
) As Long

Private Declare Function GetParent _
Lib "user32" _
( _
ByVal hwnd As Long _
) As Long

Private Declare Function PostMessage _
Lib "user32" _
Alias "PostMessageA" _
( _
ByVal hwnd As Long, _
ByVal wMsg As Long, _
ByVal wParam As Long, _
ByRef lParam As Any _
) As Long

Private Declare Sub CopyMemory _
Lib "kernel32" _
Alias "RtlMoveMemory" _
( _
ByRef pDst As Any, _
ByRef pSrc As Any, _
ByVal ByteLen As Long _
)

Private Declare Function GetWindowRect _
Lib "user32" _
( _
ByVal hwnd As Long, _
ByRef lpRect As RECT _
) As Long

Private Type OPENFILENAME
lStructSize As Long
hWndOwner As Long
hInstance As Long
lpstrFilter As String
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
nFileOffset As Integer
nFileExtension As Integer
lpstrDefExt As String
lCustData As Long
lpfnHook As Long
lpTemplateName As String
End Type

Public Enum eOpenDialogFlag
odfReadOnly = &H1
odfOverWritePrompt = &H2
odfHideReadOnly = &H4
odfNoChangeDir = &H8
odfShowHelp = &H10
odfEnableHook = &H20
odfEnableTemplate = &H40
odfEnableTemplateHandle = &H80
odfNoValidate = &H100
odfAllowMultiselect = &H200
odfExtensionDifferent = &H400
odfPathMustExist = &H800
odfFileMustExist = &H1000
odfCreatePrompt = &H2000
odfShareAware = &H4000
odfNoReadOnlyReturn = &H8000
odfNoTestFileCreate = &H10000
odfNoNetworkButton = &H20000
odfNoLongNames = &H40000 ' force no long names for
4.x modules
odfExplorer = &H80000 ' new look commdlg
odfNoDereferenceLinks = &H100000
odfLongNames = &H200000 ' force long names for
3.x modules
odfEnableIncludeNotify = &H400000 ' send include message to
callback
odfEnableSizing = &H800000
End Enum

Private Type NMHDR
hwndFrom As Long
idFrom As Long
Code As Long
End Type

Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type

Private Const CDN_FIRST As Long = (-601&)
Private Const CDN_INITDONE As Long = CDN_FIRST
Private Const WM_USER As Long = &H400&
Private Const WM_NOTIFY As Long = &H4E&

Private Sub Main()

Dim s As String

s = GetOpenFileName( _
0, _
"Fichier Texte (*.txt)" & Chr$(0) & "*.txt" & Chr$(0), "c:", _
"Ouvrir...", _
"", _
odfEnableHook Or odfExplorer Or odfEnableIncludeNotify Or
odfEnableSizing)

' Si la chaine est null, l'utilisateur
' a annuler l'opération
If StrPtr(s) = 0 Then
Debug.Print "Annuler"
Else
Debug.Print s
End If

End Sub

Private Function GetOpenFileName _
( _
ByRef hwnd As Long, _
ByRef sFilter As String, _
ByRef sInitialDirectory As String, _
ByRef sTitle As String, _
Optional ByRef sDefaultFileName As String, _
Optional ByRef odf As eOpenDialogFlag _
) As String

Dim ofn As OPENFILENAME

With ofn
.lStructSize = LenB(ofn)
.hWndOwner = hwnd
.hInstance = App.hInstance
.lpstrFilter = sFilter
.lpstrFile = String$(254, Chr$(0))
.nMaxFile = 255
.lpstrFileTitle = sDefaultFileName
.nMaxFileTitle = 255
.lpstrInitialDir = sInitialDirectory
.lpstrTitle = sTitle
.flags = odf
.lpfnHook = FARPROC(AddressOf OFNHookProc)
If GetOpenFileNameA(ofn) <> 0 Then
GetOpenFileName = Trim$(.lpstrFile)
End If
End With

End Function

' renvoi la valeur de l'opérateur AddressOf
' au lieu de la valeur du pointeur
Private Function FARPROC(ByVal lp As Long) As Long
FARPROC = lp
End Function

Public Function OFNHookProc _
( _
ByVal hdlg As Long, _
ByVal uiMsg As Long, _
ByVal wParam As Long, _
ByVal lParam As Long _
) As Long

Dim lpNMHDR As NMHDR
Dim rc As RECT

If (uiMsg = WM_NOTIFY) Then
Call CopyMemory(lpNMHDR, ByVal lParam, LenB(lpNMHDR))
If (lpNMHDR.Code = CDN_INITDONE) Then
' il faut redimensionner la fenêtre *après*
' l'exécution de ce message, sinon les
' contrôles se trouvant dans la fenêtre
' ne se redimensionne pas correctement.
' On envoit donc un message custom (WM_USER+1)
' qui sera traité *après* CDN_INITDONE
'
Call PostMessage(hdlg, WM_USER + 1, 0, ByVal 0&)
End If
ElseIf (uiMsg = WM_USER + 1) Then
' on vient de recevoir notre message custom,
' on repositionne/redimensionne la fenêtre
Call GetWindowRect(GetParent(hdlg), rc)
Call MoveWindow(GetParent(hdlg), _
rc.Left, _
rc.Top, _
(rc.Right - rc.Left) * 1.5, _
(rc.Bottom - rc.Top) * 1.5, _
1)
' on a traité le message et
' on ne veut pas que Windows y touche.
OFNHookProc = 1
End If

End Function
'***

--
Cordialement
Yanick Lefebvre - MVP pour Visual Basic
http://faq.vb.free.fr/?rubrique=0 - http://www.mvps.org/vbnet/
http://www.mentalis.org/agnet/apiguide.shtml - http://www.mztools.com/

Vous avez filtré cet utilisateur ! Consultez son message

Salut Chirstian! :O)

tu m'as donné du fil à retorde.. ;O)
s'il est "simple" de positionner une boîte de dialogue où l'on veut, la
redimensionné n'avait rien d'évident! (avant de trouvé comment...)

Voici un exemple :
'***
Option Explicit

Private Declare Function GetOpenFileNameA _
Lib "comdlg32.dll" _
( _
ByRef pOpenfilename As OPENFILENAME _
) As Long

Private Declare Function MoveWindow _
Lib "user32" _
( _
ByVal hwnd As Long, _
ByVal X As Long, _
ByVal Y As Long, _
ByVal nWidth As Long, _
ByVal nHeight As Long, _
ByVal bRepaint As Long _
) As Long

Private Declare Function GetParent _
Lib "user32" _
( _
ByVal hwnd As Long _
) As Long

Private Declare Function PostMessage _
Lib "user32" _
Alias "PostMessageA" _
( _
ByVal hwnd As Long, _
ByVal wMsg As Long, _
ByVal wParam As Long, _
ByRef lParam As Any _
) As Long

Private Declare Sub CopyMemory _
Lib "kernel32" _
Alias "RtlMoveMemory" _
( _
ByRef pDst As Any, _
ByRef pSrc As Any, _
ByVal ByteLen As Long _
)

Private Declare Function GetWindowRect _
Lib "user32" _
( _
ByVal hwnd As Long, _
ByRef lpRect As RECT _
) As Long

Private Type OPENFILENAME
lStructSize As Long
hWndOwner As Long
hInstance As Long
lpstrFilter As String
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
nFileOffset As Integer
nFileExtension As Integer
lpstrDefExt As String
lCustData As Long
lpfnHook As Long
lpTemplateName As String
End Type

Public Enum eOpenDialogFlag
odfReadOnly = &H1
odfOverWritePrompt = &H2
odfHideReadOnly = &H4
odfNoChangeDir = &H8
odfShowHelp = &H10
odfEnableHook = &H20
odfEnableTemplate = &H40
odfEnableTemplateHandle = &H80
odfNoValidate = &H100
odfAllowMultiselect = &H200
odfExtensionDifferent = &H400
odfPathMustExist = &H800
odfFileMustExist = &H1000
odfCreatePrompt = &H2000
odfShareAware = &H4000
odfNoReadOnlyReturn = &H8000
odfNoTestFileCreate = &H10000
odfNoNetworkButton = &H20000
odfNoLongNames = &H40000 ' force no long names for
4.x modules
odfExplorer = &H80000 ' new look commdlg
odfNoDereferenceLinks = &H100000
odfLongNames = &H200000 ' force long names for
3.x modules
odfEnableIncludeNotify = &H400000 ' send include message to
callback
odfEnableSizing = &H800000
End Enum

Private Type NMHDR
hwndFrom As Long
idFrom As Long
Code As Long
End Type

Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type

Private Const CDN_FIRST As Long = (-601&)
Private Const CDN_INITDONE As Long = CDN_FIRST
Private Const WM_USER As Long = &H400&
Private Const WM_NOTIFY As Long = &H4E&

Private Sub Main()

Dim s As String

s = GetOpenFileName( _
0, _
"Fichier Texte (*.txt)" & Chr$(0) & "*.txt" & Chr$(0), "c:", _
"Ouvrir...", _
"", _
odfEnableHook Or odfExplorer Or odfEnableIncludeNotify Or
odfEnableSizing)

' Si la chaine est null, l'utilisateur
' a annuler l'opération
If StrPtr(s) = 0 Then
Debug.Print "Annuler"
Else
Debug.Print s
End If

End Sub

Private Function GetOpenFileName _
( _
ByRef hwnd As Long, _
ByRef sFilter As String, _
ByRef sInitialDirectory As String, _
ByRef sTitle As String, _
Optional ByRef sDefaultFileName As String, _
Optional ByRef odf As eOpenDialogFlag _
) As String

Dim ofn As OPENFILENAME

With ofn
.lStructSize = LenB(ofn)
.hWndOwner = hwnd
.hInstance = App.hInstance
.lpstrFilter = sFilter
.lpstrFile = String$(254, Chr$(0))
.nMaxFile = 255
.lpstrFileTitle = sDefaultFileName
.nMaxFileTitle = 255
.lpstrInitialDir = sInitialDirectory
.lpstrTitle = sTitle
.flags = odf
.lpfnHook = FARPROC(AddressOf OFNHookProc)
If GetOpenFileNameA(ofn) <> 0 Then
GetOpenFileName = Trim$(.lpstrFile)
End If
End With

End Function

' renvoi la valeur de l'opérateur AddressOf
' au lieu de la valeur du pointeur
Private Function FARPROC(ByVal lp As Long) As Long
FARPROC = lp
End Function

Public Function OFNHookProc _
( _
ByVal hdlg As Long, _
ByVal uiMsg As Long, _
ByVal wParam As Long, _
ByVal lParam As Long _
) As Long

Dim lpNMHDR As NMHDR
Dim rc As RECT

If (uiMsg = WM_NOTIFY) Then
Call CopyMemory(lpNMHDR, ByVal lParam, LenB(lpNMHDR))
If (lpNMHDR.Code = CDN_INITDONE) Then
' il faut redimensionner la fenêtre *après*
' l'exécution de ce message, sinon les
' contrôles se trouvant dans la fenêtre
' ne se redimensionne pas correctement.
' On envoit donc un message custom (WM_USER+1)
' qui sera traité *après* CDN_INITDONE
'
Call PostMessage(hdlg, WM_USER + 1, 0, ByVal 0&)
End If
ElseIf (uiMsg = WM_USER + 1) Then
' on vient de recevoir notre message custom,
' on repositionne/redimensionne la fenêtre
Call GetWindowRect(GetParent(hdlg), rc)
Call MoveWindow(GetParent(hdlg), _
rc.Left, _
rc.Top, _
(rc.Right - rc.Left) * 1.5, _
(rc.Bottom - rc.Top) * 1.5, _
1)
' on a traité le message et
' on ne veut pas que Windows y touche.
OFNHookProc = 1
End If

End Function
'***

--
Cordialement
Yanick Lefebvre - MVP pour Visual Basic
http://faq.vb.free.fr/?rubrique=0 - http://www.mvps.org/vbnet/
http://www.mentalis.org/agnet/apiguide.shtml - http://www.mztools.com/

Christian HUBERT-HUGOUD- Xtrem7

27/07/2004 à 07:51

Super job. Merci beaucoup. En effet, la centrer, il y a du code partout.

Merci encore.

Christian

"Zoury" a écrit dans le message de
news:

Salut Chirstian! :O)

tu m'as donné du fil à retorde.. ;O)
s'il est "simple" de positionner une boîte de dialogue où l'on veut, la
redimensionné n'avait rien d'évident! (avant de trouvé comment...)

Voici un exemple :
'***
Option Explicit

Private Declare Function GetOpenFileNameA _
Lib "comdlg32.dll" _
( _
ByRef pOpenfilename As OPENFILENAME _
) As Long

Private Declare Function MoveWindow _
Lib "user32" _
( _
ByVal hwnd As Long, _
ByVal X As Long, _
ByVal Y As Long, _
ByVal nWidth As Long, _
ByVal nHeight As Long, _
ByVal bRepaint As Long _
) As Long

Private Declare Function GetParent _
Lib "user32" _
( _
ByVal hwnd As Long _
) As Long

Private Declare Function PostMessage _
Lib "user32" _
Alias "PostMessageA" _
( _
ByVal hwnd As Long, _
ByVal wMsg As Long, _
ByVal wParam As Long, _
ByRef lParam As Any _
) As Long

Private Declare Sub CopyMemory _
Lib "kernel32" _
Alias "RtlMoveMemory" _
( _
ByRef pDst As Any, _
ByRef pSrc As Any, _
ByVal ByteLen As Long _
)

Private Declare Function GetWindowRect _
Lib "user32" _
( _
ByVal hwnd As Long, _
ByRef lpRect As RECT _
) As Long

Private Type OPENFILENAME
lStructSize As Long
hWndOwner As Long
hInstance As Long
lpstrFilter As String
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
nFileOffset As Integer
nFileExtension As Integer
lpstrDefExt As String
lCustData As Long
lpfnHook As Long
lpTemplateName As String
End Type

Public Enum eOpenDialogFlag
odfReadOnly = &H1
odfOverWritePrompt = &H2
odfHideReadOnly = &H4
odfNoChangeDir = &H8
odfShowHelp = &H10
odfEnableHook = &H20
odfEnableTemplate = &H40
odfEnableTemplateHandle = &H80
odfNoValidate = &H100
odfAllowMultiselect = &H200
odfExtensionDifferent = &H400
odfPathMustExist = &H800
odfFileMustExist = &H1000
odfCreatePrompt = &H2000
odfShareAware = &H4000
odfNoReadOnlyReturn = &H8000
odfNoTestFileCreate = &H10000
odfNoNetworkButton = &H20000
odfNoLongNames = &H40000 ' force no long names

for

4.x modules
odfExplorer = &H80000 ' new look commdlg
odfNoDereferenceLinks = &H100000
odfLongNames = &H200000 ' force long names for
3.x modules
odfEnableIncludeNotify = &H400000 ' send include message

to

callback
odfEnableSizing = &H800000
End Enum

Private Type NMHDR
hwndFrom As Long
idFrom As Long
Code As Long
End Type

Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type

Private Const CDN_FIRST As Long = (-601&)
Private Const CDN_INITDONE As Long = CDN_FIRST
Private Const WM_USER As Long = &H400&
Private Const WM_NOTIFY As Long = &H4E&

Private Sub Main()

Dim s As String

s = GetOpenFileName( _
0, _
"Fichier Texte (*.txt)" & Chr$(0) & "*.txt" & Chr$(0), "c:",

_

"Ouvrir...", _
"", _
odfEnableHook Or odfExplorer Or odfEnableIncludeNotify Or
odfEnableSizing)

' Si la chaine est null, l'utilisateur
' a annuler l'opération
If StrPtr(s) = 0 Then
Debug.Print "Annuler"
Else
Debug.Print s
End If

End Sub

Private Function GetOpenFileName _
( _
ByRef hwnd As Long, _
ByRef sFilter As String, _
ByRef sInitialDirectory As String, _
ByRef sTitle As String, _
Optional ByRef sDefaultFileName As String, _
Optional ByRef odf As eOpenDialogFlag _
) As String

Dim ofn As OPENFILENAME

With ofn
.lStructSize = LenB(ofn)
.hWndOwner = hwnd
.hInstance = App.hInstance
.lpstrFilter = sFilter
.lpstrFile = String$(254, Chr$(0))
.nMaxFile = 255
.lpstrFileTitle = sDefaultFileName
.nMaxFileTitle = 255
.lpstrInitialDir = sInitialDirectory
.lpstrTitle = sTitle
.flags = odf
.lpfnHook = FARPROC(AddressOf OFNHookProc)
If GetOpenFileNameA(ofn) <> 0 Then
GetOpenFileName = Trim$(.lpstrFile)
End If
End With

End Function

' renvoi la valeur de l'opérateur AddressOf
' au lieu de la valeur du pointeur
Private Function FARPROC(ByVal lp As Long) As Long
FARPROC = lp
End Function

Public Function OFNHookProc _
( _
ByVal hdlg As Long, _
ByVal uiMsg As Long, _
ByVal wParam As Long, _
ByVal lParam As Long _
) As Long

Dim lpNMHDR As NMHDR
Dim rc As RECT

If (uiMsg = WM_NOTIFY) Then
Call CopyMemory(lpNMHDR, ByVal lParam, LenB(lpNMHDR))
If (lpNMHDR.Code = CDN_INITDONE) Then
' il faut redimensionner la fenêtre *après*
' l'exécution de ce message, sinon les
' contrôles se trouvant dans la fenêtre
' ne se redimensionne pas correctement.
' On envoit donc un message custom (WM_USER+1)
' qui sera traité *après* CDN_INITDONE
'
Call PostMessage(hdlg, WM_USER + 1, 0, ByVal 0&)
End If
ElseIf (uiMsg = WM_USER + 1) Then
' on vient de recevoir notre message custom,
' on repositionne/redimensionne la fenêtre
Call GetWindowRect(GetParent(hdlg), rc)
Call MoveWindow(GetParent(hdlg), _
rc.Left, _
rc.Top, _
(rc.Right - rc.Left) * 1.5, _
(rc.Bottom - rc.Top) * 1.5, _
1)
' on a traité le message et
' on ne veut pas que Windows y touche.
OFNHookProc = 1
End If

End Function
'***

--
Cordialement
Yanick Lefebvre - MVP pour Visual Basic
http://faq.vb.free.fr/?rubrique=0 - http://www.mvps.org/vbnet/
http://www.mentalis.org/agnet/apiguide.shtml - http://www.mztools.com/

Super job. Merci beaucoup. En effet, la centrer, il y a du code partout.

Merci encore.

Christian

"Zoury" <yanick_lefebvre@hotmail.com> a écrit dans le message de
news:ehDkNP1cEHA.3420@TK2MSFTNGP12.phx.gbl...

Salut Chirstian! :O)

tu m'as donné du fil à retorde.. ;O)
s'il est "simple" de positionner une boîte de dialogue où l'on veut, la
redimensionné n'avait rien d'évident! (avant de trouvé comment...)

Voici un exemple :
'***
Option Explicit

Private Declare Function GetOpenFileNameA _
Lib "comdlg32.dll" _
( _
ByRef pOpenfilename As OPENFILENAME _
) As Long

Private Declare Function MoveWindow _
Lib "user32" _
( _
ByVal hwnd As Long, _
ByVal X As Long, _
ByVal Y As Long, _
ByVal nWidth As Long, _
ByVal nHeight As Long, _
ByVal bRepaint As Long _
) As Long

Private Declare Function GetParent _
Lib "user32" _
( _
ByVal hwnd As Long _
) As Long

Private Declare Function PostMessage _
Lib "user32" _
Alias "PostMessageA" _
( _
ByVal hwnd As Long, _
ByVal wMsg As Long, _
ByVal wParam As Long, _
ByRef lParam As Any _
) As Long

Private Declare Sub CopyMemory _
Lib "kernel32" _
Alias "RtlMoveMemory" _
( _
ByRef pDst As Any, _
ByRef pSrc As Any, _
ByVal ByteLen As Long _
)

Private Declare Function GetWindowRect _
Lib "user32" _
( _
ByVal hwnd As Long, _
ByRef lpRect As RECT _
) As Long

Private Type OPENFILENAME
lStructSize As Long
hWndOwner As Long
hInstance As Long
lpstrFilter As String
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
nFileOffset As Integer
nFileExtension As Integer
lpstrDefExt As String
lCustData As Long
lpfnHook As Long
lpTemplateName As String
End Type

Public Enum eOpenDialogFlag
odfReadOnly = &H1
odfOverWritePrompt = &H2
odfHideReadOnly = &H4
odfNoChangeDir = &H8
odfShowHelp = &H10
odfEnableHook = &H20
odfEnableTemplate = &H40
odfEnableTemplateHandle = &H80
odfNoValidate = &H100
odfAllowMultiselect = &H200
odfExtensionDifferent = &H400
odfPathMustExist = &H800
odfFileMustExist = &H1000
odfCreatePrompt = &H2000
odfShareAware = &H4000
odfNoReadOnlyReturn = &H8000
odfNoTestFileCreate = &H10000
odfNoNetworkButton = &H20000
odfNoLongNames = &H40000 ' force no long names

for

4.x modules
odfExplorer = &H80000 ' new look commdlg
odfNoDereferenceLinks = &H100000
odfLongNames = &H200000 ' force long names for
3.x modules
odfEnableIncludeNotify = &H400000 ' send include message

to

callback
odfEnableSizing = &H800000
End Enum

Private Type NMHDR
hwndFrom As Long
idFrom As Long
Code As Long
End Type

Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type

Private Const CDN_FIRST As Long = (-601&)
Private Const CDN_INITDONE As Long = CDN_FIRST
Private Const WM_USER As Long = &H400&
Private Const WM_NOTIFY As Long = &H4E&

Private Sub Main()

Dim s As String

s = GetOpenFileName( _
0, _
"Fichier Texte (*.txt)" & Chr$(0) & "*.txt" & Chr$(0), "c:",

_

"Ouvrir...", _
"", _
odfEnableHook Or odfExplorer Or odfEnableIncludeNotify Or
odfEnableSizing)

' Si la chaine est null, l'utilisateur
' a annuler l'opération
If StrPtr(s) = 0 Then
Debug.Print "Annuler"
Else
Debug.Print s
End If

End Sub

Private Function GetOpenFileName _
( _
ByRef hwnd As Long, _
ByRef sFilter As String, _
ByRef sInitialDirectory As String, _
ByRef sTitle As String, _
Optional ByRef sDefaultFileName As String, _
Optional ByRef odf As eOpenDialogFlag _
) As String

Dim ofn As OPENFILENAME

With ofn
.lStructSize = LenB(ofn)
.hWndOwner = hwnd
.hInstance = App.hInstance
.lpstrFilter = sFilter
.lpstrFile = String$(254, Chr$(0))
.nMaxFile = 255
.lpstrFileTitle = sDefaultFileName
.nMaxFileTitle = 255
.lpstrInitialDir = sInitialDirectory
.lpstrTitle = sTitle
.flags = odf
.lpfnHook = FARPROC(AddressOf OFNHookProc)
If GetOpenFileNameA(ofn) <> 0 Then
GetOpenFileName = Trim$(.lpstrFile)
End If
End With

End Function

' renvoi la valeur de l'opérateur AddressOf
' au lieu de la valeur du pointeur
Private Function FARPROC(ByVal lp As Long) As Long
FARPROC = lp
End Function

Public Function OFNHookProc _
( _
ByVal hdlg As Long, _
ByVal uiMsg As Long, _
ByVal wParam As Long, _
ByVal lParam As Long _
) As Long

Dim lpNMHDR As NMHDR
Dim rc As RECT

If (uiMsg = WM_NOTIFY) Then
Call CopyMemory(lpNMHDR, ByVal lParam, LenB(lpNMHDR))
If (lpNMHDR.Code = CDN_INITDONE) Then
' il faut redimensionner la fenêtre *après*
' l'exécution de ce message, sinon les
' contrôles se trouvant dans la fenêtre
' ne se redimensionne pas correctement.
' On envoit donc un message custom (WM_USER+1)
' qui sera traité *après* CDN_INITDONE
'
Call PostMessage(hdlg, WM_USER + 1, 0, ByVal 0&)
End If
ElseIf (uiMsg = WM_USER + 1) Then
' on vient de recevoir notre message custom,
' on repositionne/redimensionne la fenêtre
Call GetWindowRect(GetParent(hdlg), rc)
Call MoveWindow(GetParent(hdlg), _
rc.Left, _
rc.Top, _
(rc.Right - rc.Left) * 1.5, _
(rc.Bottom - rc.Top) * 1.5, _
1)
' on a traité le message et
' on ne veut pas que Windows y touche.
OFNHookProc = 1
End If

End Function
'***

--
Cordialement
Yanick Lefebvre - MVP pour Visual Basic
http://faq.vb.free.fr/?rubrique=0 - http://www.mvps.org/vbnet/
http://www.mentalis.org/agnet/apiguide.shtml - http://www.mztools.com/

Vous avez filtré cet utilisateur ! Consultez son message

Super job. Merci beaucoup. En effet, la centrer, il y a du code partout.

Merci encore.

Christian

"Zoury" a écrit dans le message de
news:

Salut Chirstian! :O)

tu m'as donné du fil à retorde.. ;O)
s'il est "simple" de positionner une boîte de dialogue où l'on veut, la
redimensionné n'avait rien d'évident! (avant de trouvé comment...)

Voici un exemple :
'***
Option Explicit

Private Declare Function GetOpenFileNameA _
Lib "comdlg32.dll" _
( _
ByRef pOpenfilename As OPENFILENAME _
) As Long

Private Declare Function MoveWindow _
Lib "user32" _
( _
ByVal hwnd As Long, _
ByVal X As Long, _
ByVal Y As Long, _
ByVal nWidth As Long, _
ByVal nHeight As Long, _
ByVal bRepaint As Long _
) As Long

Private Declare Function GetParent _
Lib "user32" _
( _
ByVal hwnd As Long _
) As Long

Private Declare Function PostMessage _
Lib "user32" _
Alias "PostMessageA" _
( _
ByVal hwnd As Long, _
ByVal wMsg As Long, _
ByVal wParam As Long, _
ByRef lParam As Any _
) As Long

Private Declare Sub CopyMemory _
Lib "kernel32" _
Alias "RtlMoveMemory" _
( _
ByRef pDst As Any, _
ByRef pSrc As Any, _
ByVal ByteLen As Long _
)

Private Declare Function GetWindowRect _
Lib "user32" _
( _
ByVal hwnd As Long, _
ByRef lpRect As RECT _
) As Long

Private Type OPENFILENAME
lStructSize As Long
hWndOwner As Long
hInstance As Long
lpstrFilter As String
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
nFileOffset As Integer
nFileExtension As Integer
lpstrDefExt As String
lCustData As Long
lpfnHook As Long
lpTemplateName As String
End Type

Public Enum eOpenDialogFlag
odfReadOnly = &H1
odfOverWritePrompt = &H2
odfHideReadOnly = &H4
odfNoChangeDir = &H8
odfShowHelp = &H10
odfEnableHook = &H20
odfEnableTemplate = &H40
odfEnableTemplateHandle = &H80
odfNoValidate = &H100
odfAllowMultiselect = &H200
odfExtensionDifferent = &H400
odfPathMustExist = &H800
odfFileMustExist = &H1000
odfCreatePrompt = &H2000
odfShareAware = &H4000
odfNoReadOnlyReturn = &H8000
odfNoTestFileCreate = &H10000
odfNoNetworkButton = &H20000
odfNoLongNames = &H40000 ' force no long names

for

4.x modules
odfExplorer = &H80000 ' new look commdlg
odfNoDereferenceLinks = &H100000
odfLongNames = &H200000 ' force long names for
3.x modules
odfEnableIncludeNotify = &H400000 ' send include message

to

callback
odfEnableSizing = &H800000
End Enum

Private Type NMHDR
hwndFrom As Long
idFrom As Long
Code As Long
End Type

Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type

Private Const CDN_FIRST As Long = (-601&)
Private Const CDN_INITDONE As Long = CDN_FIRST
Private Const WM_USER As Long = &H400&
Private Const WM_NOTIFY As Long = &H4E&

Private Sub Main()

Dim s As String

s = GetOpenFileName( _
0, _
"Fichier Texte (*.txt)" & Chr$(0) & "*.txt" & Chr$(0), "c:",

_

"Ouvrir...", _
"", _
odfEnableHook Or odfExplorer Or odfEnableIncludeNotify Or
odfEnableSizing)

' Si la chaine est null, l'utilisateur
' a annuler l'opération
If StrPtr(s) = 0 Then
Debug.Print "Annuler"
Else
Debug.Print s
End If

End Sub

Private Function GetOpenFileName _
( _
ByRef hwnd As Long, _
ByRef sFilter As String, _
ByRef sInitialDirectory As String, _
ByRef sTitle As String, _
Optional ByRef sDefaultFileName As String, _
Optional ByRef odf As eOpenDialogFlag _
) As String

Dim ofn As OPENFILENAME

With ofn
.lStructSize = LenB(ofn)
.hWndOwner = hwnd
.hInstance = App.hInstance
.lpstrFilter = sFilter
.lpstrFile = String$(254, Chr$(0))
.nMaxFile = 255
.lpstrFileTitle = sDefaultFileName
.nMaxFileTitle = 255
.lpstrInitialDir = sInitialDirectory
.lpstrTitle = sTitle
.flags = odf
.lpfnHook = FARPROC(AddressOf OFNHookProc)
If GetOpenFileNameA(ofn) <> 0 Then
GetOpenFileName = Trim$(.lpstrFile)
End If
End With

End Function

' renvoi la valeur de l'opérateur AddressOf
' au lieu de la valeur du pointeur
Private Function FARPROC(ByVal lp As Long) As Long
FARPROC = lp
End Function

Public Function OFNHookProc _
( _
ByVal hdlg As Long, _
ByVal uiMsg As Long, _
ByVal wParam As Long, _
ByVal lParam As Long _
) As Long

Dim lpNMHDR As NMHDR
Dim rc As RECT

If (uiMsg = WM_NOTIFY) Then
Call CopyMemory(lpNMHDR, ByVal lParam, LenB(lpNMHDR))
If (lpNMHDR.Code = CDN_INITDONE) Then
' il faut redimensionner la fenêtre *après*
' l'exécution de ce message, sinon les
' contrôles se trouvant dans la fenêtre
' ne se redimensionne pas correctement.
' On envoit donc un message custom (WM_USER+1)
' qui sera traité *après* CDN_INITDONE
'
Call PostMessage(hdlg, WM_USER + 1, 0, ByVal 0&)
End If
ElseIf (uiMsg = WM_USER + 1) Then
' on vient de recevoir notre message custom,
' on repositionne/redimensionne la fenêtre
Call GetWindowRect(GetParent(hdlg), rc)
Call MoveWindow(GetParent(hdlg), _
rc.Left, _
rc.Top, _
(rc.Right - rc.Left) * 1.5, _
(rc.Bottom - rc.Top) * 1.5, _
1)
' on a traité le message et
' on ne veut pas que Windows y touche.
OFNHookProc = 1
End If

End Function
'***

--
Cordialement
Yanick Lefebvre - MVP pour Visual Basic
http://faq.vb.free.fr/?rubrique=0 - http://www.mvps.org/vbnet/
http://www.mentalis.org/agnet/apiguide.shtml - http://www.mztools.com/

Comment définir la position et la taille des Common Dialogs ?

2 réponses

Veuillez sélectionner un problème