Seleccionar imagen

Estoy haciendo una bd de productos y no se como poner en el formulario de alta una opcion para elegir una foto de una coleccion de un directorio, ya que el usuario quiere ver las fotos de alguna forma y pinchar en la que quiere que tenga ese producto. Si puedes darme alguna idea de como hacerlo.

1 Respuesta

Respuesta
1
Dim arxius As String
Dim MiPath As String
'con esto puedes seleccionar los archivos a selecionar
arxius = "Todas las imágenes" & Chr$(0) & "*.jpg;*.jpeg;*.bmp"
MiPath = DialogoComun(Me, " ", arxius, trayprog)
If MiPath <> "" Then
' en mipath tienes la trayectoria + el archivo selecionado
End If
Ahora te mano un modulo que debes colocar en modulos que es el que tiene definida la funcion dialogocomun utilizada en la rutina anterior mas otra que te sirve para seleccionar directorios, browsefolder
Option Compare Database
Option Explicit
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
Private Type BROWSEINFO
hOwner 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
Public Const OFN_READONLY = &H1
Public Const OFN_OVERWRITEPROMPT = &H2
Public Const OFN_HIDEREADONLY = &H4
Public Const OFN_NOCHANGEDIR = &H8
Public Const OFN_SHOWHELP = &H10
Public Const OFN_ENABLEHOOK = &H20
Public Const OFN_ENABLETEMPLATE = &H40
Public Const OFN_ENABLETEMPLATEHANDLE = &H80
Public Const OFN_NOVALIDATE = &H100
Public Const OFN_ALLOWMULTISELECT = &H200
Public Const OFN_EXTENSIONDIFFERENT = &H400
Public Const OFN_PATHMUSTEXIST = &H800
Public Const OFN_FILEMUSTEXIST = &H1000
Public Const OFN_CREATEPROMPT = &H2000
Public Const OFN_SHAREAWARE = &H4000
Public Const OFN_NOREADONLYRETURN = &H8000
Public Const OFN_NOTESTFILECREATE = &H10000
Public Const OFN_NONETWORKBUTTON = &H20000
Public Const OFN_NOLONGNAMES = &H40000
Public Const OFN_EXPLORER = &H80000
Public Const OFN_NODEREFERENCELINKS = &H100000
Public Const OFN_LONGNAMES = &H200000
Declare Function GetOpenFileName Lib "comdlg32.dll" Alias "GetOpenFileNameA" (pOPENFILENAME As OPENFILENAME) As Long
Declare Function GetSaveFileName Lib "comdlg32.dll" Alias "GetSaveFileNameA" (pOPENFILENAME As OPENFILENAME) As Long
Declare Function GetFileTitle Lib "comdlg32.dll" Alias "GetFileTitleA" (ByVal lpszFile As String, ByVal lpszTitle As String, ByVal cbBuf As Integer) As Integer
Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias _
"SHGetPathFromIDListA" (ByVal pidl As Long, _
ByVal pszPath As String) As Long
Declare Function SHBrowseForFolder Lib "shell32.dll" Alias _
"SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) _
As Long
Public Const BIF_RETURNONLYFSDIRS = &H1
Public Const OFN_SHAREFALLTHROUGH = 2
Public Const OFN_SHARENOWARN = 1
Public Const OFN_SHAREWARN = 0
Function DialogoComun(ObjForm As Form, FiltroArch As String, TipoArch As String, DirectIni As String) As String
'*********************************************************************
' Uso de la función
' Path = DialogoComun(Me, "*.mdb", "Título del Mensaje","\\servidor\Directorio")
'*********************************************************************
Dim File As OPENFILENAME, sFile As String, sFileTitle As String, lResult As Long, iDelim As Integer
File.lStructSize = Len(File)
File.hwndOwner = ObjForm.hwnd
File.flags = OFN_HIDEREADONLY + OFN_PATHMUSTEXIST + OFN_FILEMUSTEXIST
File.lpstrFile = FiltroArch & String$(250, 0)
File.nMaxFile = 255
File.lpstrFileTitle = String$(255, 0)
File.nMaxFileTitle = 255
'Path Inicial
'file.lpstrInitialDir = Environ$(DirectIni)
File.lpstrInitialDir = DirectIni
'Filtro
File.lpstrFilter = TipoArch & Chr$(0)
File.nFilterIndex = 1
'Título del diálogo
File.lpstrTitle = "Seleccionar archivo"
lResult = GetOpenFileName(File)
If lResult <> 0 Then
iDelim = InStr(File.lpstrFile, Chr$(0))
If iDelim > 0 Then
sFile = Left$(File.lpstrFile, iDelim - 1)
End If
DialogoComun = sFile
End If
End Function
Public Function BrowseFolder(szDialogTitle As String) As String
Dim X As Long, bi As BROWSEINFO, dwIList As Long
Dim szPath As String, wPos As Integer
With bi
.hOwner = hWndAccessApp
.lpszTitle = szDialogTitle
.ulFlags = BIF_RETURNONLYFSDIRS
End With
dwIList = SHBrowseForFolder(bi)
szPath = Space$(512)
X = SHGetPathFromIDList(ByVal dwIList, ByVal szPath)
If X Then
wPos = InStr(szPath, Chr(0))
BrowseFolder = Left$(szPath, wPos - 1)
Else
BrowseFolder = ""
End If
End Function
'MiPath = BrowseFolder("Seleccione el directorio")
'MsgBox (MiPath)

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas