Visualizar imagens em vb. como?

[Visitante]

Tenho "n" arquivos de imagem dentro de um diretorio. como faço para visualiza mais de um arquivo de cada vez. Criando miniaturas dos mesmos.

Por exemplo: tenho 20 arquivos *.jpg dentro de um diretório. Quero fazer um programa que mostre 10 arquivos de uma vez em modo miniatura, igual a opção detalhes miniatura do win2000/xp.

SuporteRMA

[Clemente Silva]

Colega, não sei se isso ajuda mas já é um começo.

Basicamente você deve trabalhar com FileSystemObject, um array de extensões para validar os arquivos e inclusão dos controles 'Image' em run-time.

Coloque um CommandButton num Form, em seguide cole esse código:

Private Sub ExibirMiniaturas(Caminho As String)
    
    '--------------------------------------------------
    'Variáveis
    '--------------------------------------------------
    Dim FSO As Object, Pasta As Object, Arquivos As Object
    Dim Arquivo As Variant, Contador As Long, Cont As Integer, QtdArquivos As Long
    Dim ArquivoImagem As String
    Dim Extensoes() As String, ArquivoValido As Boolean
    Dim Miniatura() As Object, Esquerda As Single, Topo As Single, Colunas As Byte
    
    'Isto ajusta (em colunas) a qtd de miniaturas à ser exibida por linha
    Const MaxColunas As Byte = 5
    
    '--------------------------------------------------
    'Criação dos objetos "FileSystemObject"
    '--------------------------------------------------
    Set FSO = CreateObject("Scripting.FileSystemObject")
    Set Pasta = FSO.GetFolder(Caminho)
    Set Arquivos = Pasta.Files
    QtdArquivos = Pasta.Files.Count
    
    '--------------------------------------------------
    'Preparação dos arrays e variáveis
    '--------------------------------------------------
    ReDim Extensoes(0 To 8)
    
    Extensoes(0) = "bmp"
    Extensoes(1) = "dib"
    Extensoes(2) = "gif"
    Extensoes(3) = "jpg"
    Extensoes(4) = "jpeg"
    Extensoes(5) = "wmf"
    Extensoes(6) = "emf"
    Extensoes(7) = "ico"
    Extensoes(8) = "cur"

    Contador = 0
    Topo = 0
    Esquerda = 0
    Colunas = 0

    '--------------------------------------------------
    'Enumeração dos arquivos de imagem
    '--------------------------------------------------
    For Each Arquivo In Arquivos
        
        DoEvents
        
        'Nenhum arquivo foi avaliado nesta repetição
        ArquivoValido = False
        
        'Validar extensão
        For Cont = 0 To 8
            
            DoEvents
            
            'Se a extensão for a de um arquivo de imagem válido,
            'validar o arquivo e exibir a miniatura.
            If Extensoes(Cont) = ArquivoExtensao(CStr(Arquivo)) Then
                ArquivoImagem = LCase$(Arquivo.Name)
                ArquivoValido = True
                Exit For
            End If
            
        Next
        
        If ArquivoValido Then
            
            Contador = Contador + 1
                        
            ReDim Preserve Miniatura(Contador)
            Set Miniatura(Contador) = Me.Controls.Add("VB.Image", "Miniatura" & Contador)
            
            With Miniatura(Contador)
                .Width = 1000
                .Height = 1000
                .Move Esquerda, Topo
                .Visible = True
                .Stretch = True
                Set .Picture = LoadPicture(CorrigirPasta(Caminho) & ArquivoImagem)
            End With
            
            'Isto ajusta a posição de exibição da próxima miniatura
            Colunas = Colunas + 1
            If Colunas = MaxColunas Then
                Colunas = 0
                Topo = Topo + 1000
                Esquerda = 0
            Else
                Esquerda = Esquerda + 1000
            End If
        
        End If
        
    Next
    
    Set FSO = Nothing
    Set Pasta = Nothing
    Set Arquivos = Nothing
    
    Erase Extensoes
    
End Sub

Private Function ArquivoExtensao(Arquivo As String) As String
    Dim FSO As Object
    Set FSO = CreateObject("Scripting.FileSystemObject")
    ArquivoExtensao = FSO.GetExtensionName(Arquivo)
    Set FSO = Nothing
End Function

Private Function CorrigirPasta(Pasta As String) As String
    If Not (Right$(Pasta, 1) = "\") Then CorrigirPasta = Pasta & "\" Else CorrigirPasta = Pasta
End Function

Private Sub Command1_Click()
    ExibirMiniaturas "C:\Meus Documentos"
End Sub

Este é um pedaço do código de um visualizador de imagens que eu desenvolvi mas não terminei ainda. Essa parte das miniaturas foi a última atualização que eu fiz no meu prj...