none
Carregar Imagem em tempo de execução VB6 + Crystal 8.5 RRS feed

  • Pergunta

  • Bom dia,

    Preciso criar a impressão de uma venda que mostre a imagem do produto, porém o caminho da imagem não é gravado no banco de dados e sim recuperado através de uma função.

    A função retorna o caminho corretamente a minha dificuldade esta em mostrar essa imagem no relatório.

    Ele abre o relatório mas sem as imagens. O campo no relatório é do tipo IBlobFieldObject.

    Segue o trecho de código em que é atribuído a imagem.

    Dim rsReport As ADODB.Recordset
    
        Set rsReport = New ADODB.Recordset
        With rsReport
            .Fields.Append "numpedido", adVarChar, 9, adFldIsNullable
            .Fields.Append "data", adDate, adFldIsNullable
            .Fields.Append "dtpreventrega", adDate, adFldIsNullable
            .Fields.Append "cliente", adVarChar, 6, adFldIsNullable
            .Fields.Append "nome", adVarChar, 60, adFldIsNullable
            .Fields.Append "cpf", adVarChar, 14, adFldIsNullable
            .Fields.Append "endereco", adVarChar, 40, adFldIsNullable
            .Fields.Append "nr_end", adVarChar, 8, adFldIsNullable
            .Fields.Append "municipio", adVarChar, 150, adFldIsNullable
            .Fields.Append "uf", adVarChar, 2, adFldIsNullable
            .Fields.Append "bairro", adVarChar, 30, adFldIsNullable
            .Fields.Append "cep", adVarChar, 9, adFldIsNullable
            .Fields.Append "tel", adVarChar, 40, adFldIsNullable
            .Fields.Append "contato", adLongVarChar, 10000, adFldIsNullable
            .Fields.Append "vltotal", adCurrency, adFldIsNullable
            .Fields.Append "dtencerra", adDate, adFldIsNullable
            .Fields.Append "produto", adVarChar, 10, adFldIsNullable
            .Fields.Append "dsvenda", adVarChar, 60, adFldIsNullable
            .Fields.Append "valor", adCurrency, adFldIsNullable
            .Fields.Append "quantidade", adDouble, adFldIsNullable
            .Fields.Append "total", adCurrency, adFldIsNullable
            .Fields.Append "totalvista", adCurrency, adFldIsNullable
            .Fields.Append "obs", adLongVarChar, 10000, adFldIsNullable
            .Fields.Append "image", adBinary, adFldIsNullable
            .Fields.Append "m2", adDouble, adFldIsNullable
            .Fields.Append "largura", adDouble, adFldIsNullable
            .Fields.Append "altura", adDouble, adFldIsNullable
            .Fields.Append "vidro", adVarChar, 10, adFldIsNullable
            .Fields.Append "dsvidro", adVarChar, 60, adFldIsNullable
            
            .Open
        End With
        
        Do While Not rsRelatorio.EOF
            With rsReport
                .AddNew
                .Fields("numpedido") = rsRelatorio!numpedido & ""
                .Fields("data") = Format(rsRelatorio!Data, "dd/MM/yyyy")
                .Fields("dtpreventrega") = Format(rsRelatorio!dtpreventrega, "dd/MM/yyyy")
                .Fields("cliente") = rsRelatorio!cliente & ""
                .Fields("nome") = rsRelatorio!nome & ""
                .Fields("cpf") = FormataCPF_CNPJ(rsRelatorio!CNPJ & "")
                .Fields("endereco") = rsRelatorio!Endereco & ""
                .Fields("nr_end") = rsRelatorio!nr_end & ""
                .Fields("municipio") = rsRelatorio!municipio & ""
                .Fields("uf") = rsRelatorio!Uf & ""
                .Fields("bairro") = rsRelatorio!Bairro & ""
                .Fields("cep") = rsRelatorio!Cep & ""
                .Fields("tel") = rsRelatorio!tel & ""
                .Fields("contato") = rsRelatorio!Contato & ""
                .Fields("vltotal") = str("0" & rsRelatorio!VlTotal)
                
                If Not IsNull(rsRelatorio!dtencerra) Then
                    .Fields("dtencerra") = Format(rsRelatorio!dtencerra, "dd/MM/yyyy")
                End If
                
                .Fields("produto") = rsRelatorio!produto & ""
                .Fields("dsvenda") = rsRelatorio!dsvenda & ""
                .Fields("valor") = str("0" & rsRelatorio!valor)
                .Fields("quantidade") = str("0" & rsRelatorio!Quantidade)
                .Fields("total") = str("0" & rsRelatorio!Total)
                .Fields("totalvista") = str("0" & rsRelatorio!totalvista)
                .Fields("obs") = rsRelatorio!Obs & ""
                
                'Aqui esta o problema
                .Fields("image") = LoadPicture(GetCaminhoImagemProduto(rsRelatorio!produto))
                
    
                .Fields("m2") = str("0" & rsRelatorio!m2)
                .Fields("largura") = str("0" & rsRelatorio!largura)
                .Fields("altura") = str("0" & rsRelatorio!Altura)
                .Fields("vidro") = rsRelatorio!vidro & ""
                .Fields("dsvidro") = rsRelatorio!dsvidro & ""
                .Update
            End With
            
            rsRelatorio.MoveNext
        Loop
        
        Set MontaPedidoImagem = rsReport

    Desde já Obrigado

    terça-feira, 18 de novembro de 2014 13:40

Respostas

  • Mr. GMSOFT acabei de conseguir.

    Eu alterei

    .Fields.Append "image", adBinary, adFldIsNullable

    .Fields("image") = LoadPicture(GetCaminhoImagemProduto(rsRelatorio!produto))

    por

    .Fields.Append "image", adVariant, adFldIsNullable

    .Fields("image") = FileToByteaString(GetCaminhoImagemProduto(rsRelatorio!produto))

    Public Function FileToByteaString(FileName As String) As Variant
        Dim bData() As Byte
        Dim filelength As Long
        Dim fnum As Integer
        
        fnum = FreeFile()
            
        filelength = FileLen(FileName)
        
        Open FileName For Binary As #fnum
        ReDim bData(0 To filelength - 1)
        
        For i = 0 To filelength - 1
            Get #fnum, , bData(i)
        Next i
        
        FileToByteaString = bData()
        
    End Function

    Vlw pela ajuda.


    • Marcado como Resposta AndersonShort terça-feira, 18 de novembro de 2014 14:08
    terça-feira, 18 de novembro de 2014 14:01

Todas as Respostas

  • Bom dia,

    Preciso criar a impressão de uma venda que mostre a imagem do produto, porém o caminho da imagem não é gravado no banco de dados e sim recuperado através de uma função.

    A função retorna o caminho corretamente a minha dificuldade esta em mostrar essa imagem no relatório.

    Ele abre o relatório mas sem as imagens. O campo no relatório é do tipo IBlobFieldObject.

    Segue o trecho de código em que é atribuído a imagem.

    Dim rsReport As ADODB.Recordset
    
        Set rsReport = New ADODB.Recordset
        With rsReport
            .Fields.Append "numpedido", adVarChar, 9, adFldIsNullable
            .Fields.Append "data", adDate, adFldIsNullable
            .Fields.Append "dtpreventrega", adDate, adFldIsNullable
            .Fields.Append "cliente", adVarChar, 6, adFldIsNullable
            .Fields.Append "nome", adVarChar, 60, adFldIsNullable
            .Fields.Append "cpf", adVarChar, 14, adFldIsNullable
            .Fields.Append "endereco", adVarChar, 40, adFldIsNullable
            .Fields.Append "nr_end", adVarChar, 8, adFldIsNullable
            .Fields.Append "municipio", adVarChar, 150, adFldIsNullable
            .Fields.Append "uf", adVarChar, 2, adFldIsNullable
            .Fields.Append "bairro", adVarChar, 30, adFldIsNullable
            .Fields.Append "cep", adVarChar, 9, adFldIsNullable
            .Fields.Append "tel", adVarChar, 40, adFldIsNullable
            .Fields.Append "contato", adLongVarChar, 10000, adFldIsNullable
            .Fields.Append "vltotal", adCurrency, adFldIsNullable
            .Fields.Append "dtencerra", adDate, adFldIsNullable
            .Fields.Append "produto", adVarChar, 10, adFldIsNullable
            .Fields.Append "dsvenda", adVarChar, 60, adFldIsNullable
            .Fields.Append "valor", adCurrency, adFldIsNullable
            .Fields.Append "quantidade", adDouble, adFldIsNullable
            .Fields.Append "total", adCurrency, adFldIsNullable
            .Fields.Append "totalvista", adCurrency, adFldIsNullable
            .Fields.Append "obs", adLongVarChar, 10000, adFldIsNullable
            .Fields.Append "image", adBinary, adFldIsNullable
            .Fields.Append "m2", adDouble, adFldIsNullable
            .Fields.Append "largura", adDouble, adFldIsNullable
            .Fields.Append "altura", adDouble, adFldIsNullable
            .Fields.Append "vidro", adVarChar, 10, adFldIsNullable
            .Fields.Append "dsvidro", adVarChar, 60, adFldIsNullable
            
            .Open
        End With
        
        Do While Not rsRelatorio.EOF
            With rsReport
                .AddNew
                .Fields("numpedido") = rsRelatorio!numpedido & ""
                .Fields("data") = Format(rsRelatorio!Data, "dd/MM/yyyy")
                .Fields("dtpreventrega") = Format(rsRelatorio!dtpreventrega, "dd/MM/yyyy")
                .Fields("cliente") = rsRelatorio!cliente & ""
                .Fields("nome") = rsRelatorio!nome & ""
                .Fields("cpf") = FormataCPF_CNPJ(rsRelatorio!CNPJ & "")
                .Fields("endereco") = rsRelatorio!Endereco & ""
                .Fields("nr_end") = rsRelatorio!nr_end & ""
                .Fields("municipio") = rsRelatorio!municipio & ""
                .Fields("uf") = rsRelatorio!Uf & ""
                .Fields("bairro") = rsRelatorio!Bairro & ""
                .Fields("cep") = rsRelatorio!Cep & ""
                .Fields("tel") = rsRelatorio!tel & ""
                .Fields("contato") = rsRelatorio!Contato & ""
                .Fields("vltotal") = str("0" & rsRelatorio!VlTotal)
                
                If Not IsNull(rsRelatorio!dtencerra) Then
                    .Fields("dtencerra") = Format(rsRelatorio!dtencerra, "dd/MM/yyyy")
                End If
                
                .Fields("produto") = rsRelatorio!produto & ""
                .Fields("dsvenda") = rsRelatorio!dsvenda & ""
                .Fields("valor") = str("0" & rsRelatorio!valor)
                .Fields("quantidade") = str("0" & rsRelatorio!Quantidade)
                .Fields("total") = str("0" & rsRelatorio!Total)
                .Fields("totalvista") = str("0" & rsRelatorio!totalvista)
                .Fields("obs") = rsRelatorio!Obs & ""
                
                'Aqui esta o problema
                .Fields("image") = LoadPicture(GetCaminhoImagemProduto(rsRelatorio!produto))
                
    
                .Fields("m2") = str("0" & rsRelatorio!m2)
                .Fields("largura") = str("0" & rsRelatorio!largura)
                .Fields("altura") = str("0" & rsRelatorio!Altura)
                .Fields("vidro") = rsRelatorio!vidro & ""
                .Fields("dsvidro") = rsRelatorio!dsvidro & ""
                .Update
            End With
            
            rsRelatorio.MoveNext
        Loop
        
        Set MontaPedidoImagem = rsReport

    Desde já Obrigado

    Veja se isso ai abaixo esta retornando alguma coisa:

    .Fields("image") = LoadPicture(GetCaminhoImagemProduto(rsRelatorio!produto))
    terça-feira, 18 de novembro de 2014 13:49
  • Mr. GMSOFT acabei de conseguir.

    Eu alterei

    .Fields.Append "image", adBinary, adFldIsNullable

    .Fields("image") = LoadPicture(GetCaminhoImagemProduto(rsRelatorio!produto))

    por

    .Fields.Append "image", adVariant, adFldIsNullable

    .Fields("image") = FileToByteaString(GetCaminhoImagemProduto(rsRelatorio!produto))

    Public Function FileToByteaString(FileName As String) As Variant
        Dim bData() As Byte
        Dim filelength As Long
        Dim fnum As Integer
        
        fnum = FreeFile()
            
        filelength = FileLen(FileName)
        
        Open FileName For Binary As #fnum
        ReDim bData(0 To filelength - 1)
        
        For i = 0 To filelength - 1
            Get #fnum, , bData(i)
        Next i
        
        FileToByteaString = bData()
        
    End Function

    Vlw pela ajuda.


    • Marcado como Resposta AndersonShort terça-feira, 18 de novembro de 2014 14:08
    terça-feira, 18 de novembro de 2014 14:01