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

 > 

  • Pergunta

  • Question
    Entrar para Votar
    0
    Entrar para Votar

    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

  • Question
    Entrar para Votar
    0
    Entrar para Votar

    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

  • Question
    Entrar para Votar
    0
    Entrar para Votar

    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
    |
  • Question
    Entrar para Votar
    0
    Entrar para Votar

    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
    |