Visualizador de imagens

Modelo de Visualizador de imagens no Access

1 - Procura por diretorio
2 - Exibe os arquivos na pasta de acordo com a seleção do formato
2 - Formatos BMP, GIF, JPG, Ico etc..
3 - Função Zomm, Normal e Esticado

Enjoy

LINK 2007
https://www.dropbox.com/s/a17k28ofstnc1wb/Visualizador_IMG.rar

LINK 2003
https://www.dropbox.com/s/weqks5onoqslr2n/Visualizador_IMG2003.rar

*Autor desconhecido
*Adaptado por Harysohn P. Pina


* Agora com impressão das imagens selecionadas
* Módulo para cópia direta do arquivo em outra pasta ou em Unidades de disco

Grande Harysohn, bom dia.

Perfeito o seu exemplo.
Terias algum outro exemplo que exibisse imagem tif?

Abraços, WSenna

Boa noite wsenna, talvez o post do JPaulo possa ajudar:

Mensagem 7

http://maximoaccess.forumeiros.com/t21638-visualizar-arquivo-tif-direto-no-formulario

o exemplo do amigo jpaulo, esta dando uns erros, e para visualizar tem que clicar no botão para o mesmo. fiz um que quando vc seleciona na caixa de listagem ele exibe no proprio form mesmo. somente altere na tabela o caminho de sua tiff, tem outro formulario que faz uma busca no diretorio para pegar os caminhos dos arquivos em tif.


alias, wsenna, acho que estamos fazendo projetos parecidos. "indexação de imagens scaneadas" ou algo do genero gerenciamento de doccumentos

Olá Feras, bom dia.

Depois de apanhar muito consegui desenvolver um código para que ao clicar duas vezes numa caixa de listagem o Microsoft Document Imaging exiba a imagem tif (multi-paginada) do item selecionado.

Vejam:


Private Sub lst_nomes_DblClick(Cancel As Integer)
   
Dim CaminhoDaImagem As String
CaminhoDaImagem = Chr(34) & Me.lst_nomes & Chr(34)
Call Shell("C:\Program Files\Common Files\microsoft shared\MODI\11.0\MSPVIEW.EXE  " & CaminhoDaImagem, 0)

End Sub

A caixa de listagem possui o seguinte:

SELECT Consulta21.Caminho, Consulta21.Aluno, Consulta21.Curso, Consulta21.Semestre FROM Consulta21 WHERE (((Consulta21.Aluno) Like TodosAcentos(Forms!frmProtocolo.txt_nome & "*"))) ORDER BY [Curso], [Aluno];


Dessa forma aliei a busca avançada com a funcionalidade de exibir a referida imagem através do MS Document Imaging.

Note-se que a coluna 0 (zero) de list_Nomes está oculta e refere-se ao caminho das imagens, exemplo:

C:\GRADUAÇÃO 2011\ADMINISTRAÇÃO\1° SEMESTRE\DENIS FERNANDO C MUNIZ OGG DOS SANTOS\MATRICULA.tif

Através de uma consulta eu desmembro o caminho acima em diversas coluna como abaixo:

SELECT tblPastas.Código, tblPastas.Pastas, SeparaNomes([Pastas],"\",1) AS Diretório, SeparaNomes([Pastas],"\",2) AS Área, SeparaNomes([Pastas],"\",3) AS Curso, SeparaNomes([Pastas],"\",4) AS Semestre, SeparaNomes([Pastas],"\",5) AS Aluno, Left(SeparaNomes([Pastas],"\",5),Len(SeparaNomes([Pastas],"\",5))- AS Alunos, SeparaNomes([Pastas],"\",6) AS Documentos
FROM tblPastas
WHERE (((SeparaNomes([Pastas],"\",3))=[Forms]![frmProtocolo]![cboCurso]));

Evidentemente utilizei também os Módulos TodosAcentos e o SeparaNomes, ambos cedidos pelo grande JPaulo

O SeparaNomes transcrevo abaixo:

Option Compare Database
Option Explicit
Public Function SeparaNomes(strFrase As String, QualSimboloVaiPartir As String, QualParteVaiSeparar As Integer) As String
'By@JPaulo2009 Dezembro
'Função separa uma frase pelas virgulas ou outro símbolo
'Exemplo: SeparaNomes("Esta é uma função\feita para separar palavras.", "\", 1)
'O 1 vai mostrar a primeira parte da frase, "Esta é uma função"

Dim strArray() As String
Dim strParteInteira As Integer

On Error GoTo Err_SeparaNomes

strArray = Split(strFrase, QualSimboloVaiPartir)

strParteInteira = UBound(strArray) + 1

If strParteInteira = 0 Then
SeparaNomes = strFrase
Exit Function
End If

If QualParteVaiSeparar = 0 Then
SeparaNomes = strFrase
Exit Function
ElseIf QualParteVaiSeparar > strParteInteira Then
QualParteVaiSeparar = strParteInteira
End If

SeparaNomes = Trim(strArray(QualParteVaiSeparar - 1))

Exit_SeparaNomes:
Exit Function

Err_SeparaNomes:
MsgBox err & " - " & Error$, vbExclamation, "Função SeparaNomes"
Resume Exit_SeparaNomes
Resume
End Function

O resultado conseguido foi esse:


[img][/img]



Abraços, WSenna

... aí você me pergunta:
Como montar uma tabela onde constam os caminhos das imagens tif (multi-paginadas)?

Simples, veja:


[img][/img]


1 - Crie um Módulo e cole o código abaixo:

Option Compare Database
Option Explicit
   Public Function ContaFicheirosExtraiNome(strCaminho As String, strIncluiSubPastas As Boolean)
   'By JPaulo ® Maximo Access
   'Requer a seguinte referência VBA ativa:
   'Microsoft Scripting Runtime
   'Para chamar a função, deve colocar no pressionar de um botão: Call ContaFicheirosExtraiNome("C:\SuaPasta\",True)
   Dim fso As Object, strPasta As Object, strSubPasta As Object, strFicheiro As Object
   Dim strConta As Long, strSql As String
     
       Set fso = CreateObject("Scripting.FileSystemObject")
       Set strPasta = fso.GetFolder(strCaminho)
       'Percorre a drive e extraí o nome das pastas, subPastas e ficheiros
       For Each strFicheiro In strPasta.Files
     
       'Insere na tabela o caminho completo dos ficheiros com as extensões PDF
               If Mid([strFicheiro], InStrRev([strFicheiro], "\") + 1) Like "*.tif*" Then
                   'CurrentDb.Execute "INSERT INTO tblPastas (Pastas) SELECT '" & strPasta.path & "\" & strFicheiro.Name & "'"
                   CurrentDb.Execute "INSERT INTO tblPastas (Pastas) SELECT '" & Replace(strPasta.path, "'", "''") & "\" & strFicheiro.NAME & "'"
           strConta = strConta + 1
           Else
           End If
       Next strFicheiro
       'Se existirem subpastas, insere na tabela o caminho completo dos ficheiros
       If strIncluiSubPastas = True Then
           For Each strSubPasta In strPasta.SubFolders
               ContaFicheirosExtraiNome strSubPasta.path, True
           Next strSubPasta
       End If
       Set strFicheiro = Nothing
       Set strPasta = Nothing
   End Function

2 - No formulário acima eu inseri no evento Ao Clicar do botão de comando Capturar o seguinte código:

Private Sub Comando1_Click()
Dim strCaminho As String
If MsgBox("Você está seguro de executar esta ação no momento ? " & Chr(13) & "Saiba que irá alterar toda a base de dados. ", vbYesNo, " InfoBasic Smart System") = 6 Then
MsgBox "Essa operação pode demorar alguns minutos, por favor, Aguarde ... ", , " InfoBasic Smart System"
strCaminho = InputBox("Introduza o caminho dos ficheiros.")
Me.Caption = "      Por favor, aguarde ..."
Call ContaFicheirosExtraiNome(strCaminho, True)
Me.Refresh
MsgBox "Arquivos importados com sucesso.   ", , "  InfoBasic Smart System"
Me.Caption = "      InfoBasic Smart System"
Else
MsgBox "A ação de capitura foi cancelada pelo usuário. ", vbInformation, " InfoBasic Smart System"
End If
End Sub

3 - Porque eu fiz isso? Explico: No meu caso eu possuo em meu aplicativo outras tabelas que possuem caminhos de outros diretórios como C:\Graduação; C:\Pós Graduação; C:\Mestrado; C:\Doutorado, etc.
Fosse apenas o C:\Graduação deixaria como assinalado acima no código de captura  'Para chamar a função, deve colocar no pressionar de um botão: Call ContaFicheirosExtraiNome("C:\SuaPasta\",True)

4 - É deveras importante que exista coerência nas formas como estão denominadas as pastas e subpastas, devem seguir sempre o mesmo padrão caso contrário a consulta que separa a string "CaminhoDaImagem" não funcionará a contento.

Abraços, WSenna

Olá Feras, bom dia.

Link:

http://maximoaccess.forumeiros.com/t21718-visualizador-de-imagem-tif-multipaginada


Abraços, WSenna