Ver Mensaje Individual
  #2 (permalink)  
Antiguo 17/03/2006, 14:00
Avatar de [EX3]
[EX3]
 
Fecha de Ingreso: marzo-2006
Ubicación: Fuenlabrada, Madrid
Mensajes: 203
Antigüedad: 18 años, 2 meses
Puntos: 1
En vez de un CommonDialog usa un BrowseDialog:
Código:
Option Explicit

Private Const BIF_BROWSEFORCOMPUTER = 1000
Private Const BIF_BROWSEFORPRINTER = 2000
Private Const BIF_DONTGOBELOWDOMAIN = 2
Private Const BIF_RETURNFSANCESTORS = 8
Private Const BIF_RETURNONLYFSDIRS = 1
Private Const BIF_STATUSTEXT = 4
Private Const MAX_SIZE = 255

Private Type BROWSEINFO
         hwndOwner As Long
         pidlRoot As Long
         pszDisplayName As String
         lpszTitle As String
         ulFlags As Long
         lpfn As Long
         lParam As Long
         iImage As Long
End Type

Private Declare Function BrowseFolderDlg Lib "shell32.dll" Alias "SHBrowseForFolder" (lpBrowseInfo As BROWSEINFO) As Long
Private Declare Function GetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDList" (ByVal PointerToIDList As Long, ByVal pszPath As String) As Long

 Private Sub Form_Load()
MsgBox DLG_BrowseFolder(Me.hwnd, "Elija directorio para obtener su ruta:")

 End Sub

 Private Function DLG_BrowseFolder(hwnd As Long, Title As String) As String
On Local Error Resume Next

Dim mBrowseInfo As BROWSEINFO
Dim mPointerToIDList As Long
Dim mResult As Long
Dim mPathBuffer As String
Dim sReturn As String

        ' this string is returned as result if you have canceled the action
         'sReturn = "You canceled operation"
         sReturn = ""
         With mBrowseInfo
                     ' set parent window (hWnd of this window)
                      .hwndOwner = hwnd
                       ' set start folder (0=desktor folder)
                      .pidlRoot = 0
                       ' dialog title
                      .lpszTitle = Title
                      ' pointer to a buffer that receives the display name of the folder selected by the user
                      .pszDisplayName = String(MAX_SIZE, Chr(0))
                       ' value specifying the types of folders to be listed in the dialog box as well as other options
                      .ulFlags = BIF_RETURNONLYFSDIRS
         End With
         ' returns a pointer to an item identifier list that specifies the location of the selected folder relative to the root of the name space
          mPointerToIDList = BrowseFolderDlg(mBrowseInfo)

         If mPointerToIDList <> 0& Then
                       ' create a buffer
                      mPathBuffer = String(MAX_SIZE, Chr(0))
                       ' now get the selected path
                      mResult = GetPathFromIDList(ByVal mPointerToIDList, ByVal mPathBuffer)
                       ' returned path
                      sReturn = VBA.Left$(mPathBuffer, InStr(mPathBuffer, Chr(0)) - 1)  'and return just that
         End If

DLG_BrowseFolder = sReturn

 End Function 
Salu2...
__________________
Proyecto dx_lib32 (http://dxlib32.se32.com) Libreria DLL ActiveX para el desarollo de juegos y programas multimedia en Visual Basic 6.0 con la potencia de DirectX

Dice un dicho que "el que calla otorga". En internet tenemos otro que dice "nunca alimentes a un troll" que viene a decir "dejale hablar solo que se ya se cansara de incordiar". Solo los necios creen tener la razon con la ultima palabra.