Problem s CommonDialog

'Ето ти начин Usera да влиза само в директорията която искаш

'------------------ това го слагаш в формата ----------------------



Private Sub Command1_Click()

DlgFlags = OFN_EXPLORER Or OFN_ENABLEHOOK Or OFN_HIDEREADONLY

InitOFN ' Me.hwnd

ShowOpen

End Sub



'-----------------------------------------------------------------------------



'------------------ това го слагаш в Modul ---------------------------



Option Explicit



Private Const MAX_PATH = 260

Private Const MAX_FILE = 260



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 Long

End Type



Private Declare Function GetOpenFileName Lib "COMDLG32" Alias _

"GetOpenFileNameA" (File As OPENFILENAME) As Long



Public Enum EOpenFile

    OFN_READONLY = &H1

    OFN_OVERWRITEPROMPT = &H2

    OFN_HIDEREADONLY = &H4

    OFN_NOCHANGEDIR = &H8

    OFN_SHOWHELP = &H10

    OFN_ENABLEHOOK = &H20

    OFN_ENABLETEMPLATE = &H40

    OFN_ENABLETEMPLATEHANDLE = &H80

    OFN_NOVALIDATE = &H100

    OFN_ALLOWMULTISELECT = &H200

    OFN_EXTENSIONDIFFERENT = &H400

    OFN_PATHMUSTEXIST = &H800

    OFN_FILEMUSTEXIST = &H1000

    OFN_CREATEPROMPT = &H2000

    OFN_SHAREAWARE = &H4000

    OFN_NOREADONLYRETURN = &H8000

    OFN_NOTESTFILECREATE = &H10000

    OFN_NONETWORKBUTTON = &H20000

    OFN_NOLONGNAMES = &H40000

    OFN_EXPLORER = &H80000

    OFN_NODEREFERENCELINKS = &H100000

    OFN_LONGNAMES = &H200000

End Enum



' Messages:

Private Const WM_DESTROY = &H2

Private Const WM_NOTIFY = &H4E

Private Const WM_NCDESTROY = &H82

Private Const WM_GETDLGCODE = &H87

Private Const WM_INITDIALOG = &H110

Private Const WM_COMMAND = &H111

Private Const WM_USER = &H400







Private Const CDM_FIRST = (WM_USER + 100)

Private Const CDM_LAST = (WM_USER + 200)



Private Const CDM_GETSPEC = (CDM_FIRST + &H0)

Private Const CDM_GETFILEPATH = (CDM_FIRST + &H1)

Private Const CDM_GETFOLDERPATH = (CDM_FIRST + &H2)

Private Const CDM_GETFOLDERIDLIST = (CDM_FIRST + &H3)

Private Const CDM_SETCONTROLTEXT = (CDM_FIRST + &H4)

Private Const CDM_HIDECONTROL = (CDM_FIRST + &H5)

Private Const CDM_SETDEFEXT = (CDM_FIRST + &H6)



' Dialog controls IDs

Private Const ID_OPEN = &H1  'Open or Save button

Private Const ID_CANCEL = &H2 'Cancel Button

Private Const ID_HELP = &H40E 'Help Button

Private Const ID_READONLY = &H410 'Read-only check box

Private Const ID_FILETYPELABEL = &H441 'FileType label

Private Const ID_FILELABEL = &H442 'FileName label

Private Const ID_FOLDERLABEL = &H443 'Folder label

Private Const ID_FORMAT = &H470 'FileType combo box

Private Const ID_FOLDER = &H471 'Folder combo box

Private Const ID_FILETEXT = &H480 'FileName text box



Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" _

(ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, _

lParam As Any) As Long



Private Declare Function GetParent Lib "user32" _

(ByVal hwnd As Long) As Long



Dim OFN As OPENFILENAME

Public hDlg As Long

Public DlgFlags As EOpenFile

Public DlgLeft As Long, DlgTop As Long

Public DlgOpenVisible As Boolean, DlgCancelVisible As Boolean



Public Declare Function GetWindowLong Lib "user32" Alias _

"GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long



Public Declare Function SetWindowLong Lib "user32" Alias _

"SetWindowLongA" (ByVal hwnd As Long, _

ByVal nIndex As Long, ByVal dwNewLong As Long) As Long



Public Declare Function GetClassName Lib "user32" Alias _

"GetClassNameA" (ByVal hwnd As Long, ByVal lpClassName As String, _

ByVal nMaxCount As Long) As Long



Public Const GWL_EXSTYLE = (-20)

Public Const GWL_STYLE = (-16)

Public Const CBS_OWNERDRAWFIXED = 16

Public Const WS_VISIBLE = &H10000000

Public Const WS_DISABLED = &H8000000



Public Declare Function EnumChildWindows Lib "user32" _

(ByVal hWndParent As Long, ByVal lpEnumFunc As Long, _

ByVal lParam As Long) As Long



Public Declare Function EnableWindow Lib "user32" _

(ByVal hwnd As Long, ByVal fEnable As Long) As Long

Private Function lHookAddress(lPtr As Long) As Long

  lHookAddress = lPtr

End Function



Public Function DialogHookFunction(ByVal hDlg As Long, _

ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long

   Select Case wMsg

          Case WM_INITDIALOG

              ModifyDlg hDlg

          Case Else

   End Select

End Function

Public Sub InitOFN(Optional ByVal hOwner As Long)

   With OFN

       .hwndOwner = hOwner

       .lpfnHook = lHookAddress(AddressOf DialogHookFunction)

       .Flags = DlgFlags

       .lStructSize = LenB(OFN)

       

       .lpstrFilter = "All files" & Chr(0) & "*.*" & Chr(0) & _

       "Documents" & Chr(0) & "*.doc" & Chr(0) & _

       "Templates" & Chr(0) & "*.dot" & Chr(0) & _

       "Text Files" & Chr(0) & "*.txt" & Chr(0)



   End With

End Sub



Public Sub ShowOpen()

  hDlg = GetOpenFileName(OFN)

End Sub



Private Sub ModifyDlg(hDlg)

  Dim DlgHwnd As Long

  DlgHwnd = GetParent(hDlg)

  

 'Ако искаш да смениш заглавията на бутоните

' SendMessage DlgHwnd, _

CDM_SETCONTROLTEXT , ID_OPEN, ByVal "Отвори"

' SendMessage DlgHwnd, _

CDM_SETCONTROLTEXT, ID_CANCEL, ByVal "Отмени"

' SendMessage DlgHwnd, _

CDM_SETCONTROLTEXT, ID_FILETYPELABEL, ByVal "Разширение"

' SendMessage DlgHwnd, _

CDM_SETCONTROLTEXT, ID_FILELABEL, ByVal "Име на файла"

 

Call EnumChildWindows(DlgHwnd, AddressOf fEnumChildProc, 0)

 

  

End Sub



Function fEnumChildProc(ByVal hwnd As Long, _

                                        ByVal lParam As Long) _

                                        As Long

Dim lngStyle As Long

Dim strLen As Long

Dim ClassName As String

Const TOOLBAR_CLASS = "ToolbarWindow32"

Const COMBO_BOX = "ComboBox"

 

 ClassName = Space(256)

    strLen = GetClassName(hwnd, ClassName, 256)

        ClassName = Left(ClassName, strLen)



    If ClassName = COMBO_BOX Then

    

     lngStyle = GetWindowLong(hwnd, GWL_STYLE)

    

    'Disable на падащия списък с директориите

    If lngStyle And CBS_OWNERDRAWFIXED Then

        Call EnableWindow(hwnd, 0)

     End If

    

    End If



    

   If ClassName = TOOLBAR_CLASS Then

   'Disable на Tool bara с Бутона 'Up one level'

   Call EnableWindow(hwnd, 0)

        

' Ако искаш да го скриеш

'        lngStyle = GetWindowLong(hwnd, GWL_STYLE)

'        lngStyle = lngStyle And Not WS_VISIBLE

'        Call SetWindowLong(hwnd, GWL_STYLE, lngStyle)

   

   End If

    

    fEnumChildProc = True



End Function