[Resolvido]Comparar duas imagens

Ola,

Estou pesquisando a possibilidade de comparar duas imagens de um formulario usando um codigo VBA.

Eu consegui achar uma rotina, mas acredito que ela seja para visual studio, e eu nao consegui fazer funcionar no access.




Private Sub btnGo_Click(ByVal sender As System.Object, _
ByVal e As System.EventArgs) Handles btnGo.Click
Me.Cursor = Cursors.WaitCursor
Application.DoEvents()

' Load the images.
Dim bm1 As Bitmap = Image.FromFile(txtFile1.Text)
Dim bm2 As Bitmap = Image.FromFile(txtFile2.Text)

' Make a difference image.
Dim wid As Integer = Math.Min(bm1.Width, bm2.Width)
Dim hgt As Integer = Math.Min(bm1.Height, bm2.Height)
Dim bm3 As New Bitmap(wid, hgt)

' Create the difference image.
Dim are_identical As Boolean = True
Dim r1, g1, b1, r2, g2, b2, r3, g3, b3 As Integer
Dim eq_color As Color = Color.White
Dim ne_color As Color = Color.Red
For x As Integer = 0 To wid - 1
For y As Integer = 0 To hgt - 1
If bm1.GetPixel(x, y).Equals(bm2.GetPixel(x, _
y)) Then
bm3.SetPixel(x, y, eq_color)
Else
bm3.SetPixel(x, y, ne_color)
are_identical = False
End If
Next y
Next x

' Display the result.
picResult.Image = bm3

Me.Cursor = Cursors.Default
If (bm1.Width <> bm2.Width) OrElse (bm1.Height <> _
bm2.Height) Then are_identical = False
If are_identical Then
MessageBox.Show("The images are identical")
Else
MessageBox.Show("The images are different")
End If

bm1.Dispose()
bm2.Dispose()
End Sub



alguem tem alguma sugestao?

Obrigado

Bom dia, Ioconte
Tente assim

Private Sub btnGo_Click()
DoEvents()

' Load the images.
Dim bm1 As Bitmap = Image.FromFile(txtFile1.Text)
Dim bm2 As Bitmap = Image.FromFile(txtFile2.Text)

' Make a difference image.
Dim wid As Integer = Math.Min(bm1.Width, bm2.Width)
Dim hgt As Integer = Math.Min(bm1.Height, bm2.Height)
Dim bm3 As New Bitmap(wid, hgt)

' Create the difference image.
Dim are_identical As Boolean = True
Dim r1, g1, b1, r2, g2, b2, r3, g3, b3 As Integer
Dim eq_color As Color = Color.White
Dim ne_color As Color = Color.Red
For x As Integer = 0 To wid - 1
For y As Integer = 0 To hgt - 1
If bm1.GetPixel(x, y)=bm2.GetPixel(x, y) Then 'alterei esta linha 2012-08-11
bm3.SetPixel(x, y, eq_color)
Else
bm3.SetPixel(x, y, ne_color)
are_identical = False
End If
Next y
Next x

' Display the result.
picResult.Image = bm3

Me.Cursor = Cursors.Default
If (bm1.Width <> bm2.Width) OrElse (bm1.Height <> _
bm2.Height) Then are_identical = False
If are_identical Then
MessageBox.Show("The images are identical")
Else
MessageBox.Show("The images are different")
End If

bm1.Dispose()
bm2.Dispose()
End Sub

Vá alterando conforme necessário. Pode acontecer não ser possível fazer em Access o que é possível noutro programa

Valeu Alexandre,

Mas nao consegui... ja da erro na primeira linha...

Estarei pesquisando mais, mas se alguem tiver alguma ideia eu agradeco...

Pode disponibilixar o bd para que vejamos?

Cumprimentos.

Piloto,

eu ainda estou na fase inicial do projeto, so tenho um formulario com o codigo, que nao funciona.

Estou investigado o uso do visual studio. Assim que eu tiver algum avanco eu informo.

abvs

Ok, estive a testar este código que postou... creio que o mesmo não dará certo pois utiliza funções não disponíveis no VBA.


Cumprimentos.

Piloto,

Vc tem razao, instalei o visual studio e o codigo funcionou. Pena que nao consiguirei adaptar para o access.

Obrigado

O Fórum agradece o Retorno.