Usuário com melhor resposta
Carregar Imagem em tempo de execução VB6 + Crystal 8.5

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
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
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
.Fields("image") = LoadPicture(GetCaminhoImagemProduto(rsRelatorio!produto))
-
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