Pessoal,
tenho essa unit que o nosso colega Enio Marconcini passou a um tempo atrás,
que achei aqui na lista, que parece que deveria funcionar para salvar uma
imagem jpg diretamente no banco de dados FB em um campo blob sub_type 0, só que
não salva, dá msg de erro "bitmat image is not valid", gente segue abaixo a
unit tal qual peguei aqui.Não sei o que pode estar havendo de errado.
{
Unit: U_BlobImageFB.pas
Versão: 1.0
Autor: Enio Rodrigo Marconcini
Email: [EMAIL PROTECTED]
Msn: [EMAIL PROTECTED]
GoogleTalk: [EMAIL PROTECTED]
Skype: eniorm
DELFOS Desenvolvimento de Sistemas
www.delfosdesenvolvimentos.com
[EMAIL PROTECTED]
** DESCRICAO **
Unit específica para trabalhar com imagens em banco de dados
Firebird/Interbase, utilizando campos BLOB.
Funciona com os componentes de acesso IBX (palheta Interbase) e com o
Mercury Data Objects (MDO). Não foi testado com outros componentes de acesso.
Visa compatibilidade apenas com os citados acima.
Suporta arquivos JPEG (*.jpg ou *.jpeg) ou Bitmaps (*.bmp).
Imagens Bitmap, antes de serem gravadas no banco, são convertidas em Jpeg e
comprensadas pelo procedimento Compress do TJpegImage.
Um bitmap de 1.30 Mb fica reduzido a um jpg de cerca de 150 Kb.
** a taxa de compressão varia de acordo com a imagem **
Os códigos para gravar a imagem no campo blob foram copiados de tópicos
dos foruns ClubeDelphi (www.clubedelphi.net)
Após ter criado esses procedimentos numa unit U_CadastroClientes.pas resolvi
criar uma unit somente para manipular imagens.
==============================================================================
** Modus Operandi **
PARA EXIBIR UM CAMPO BLOB COM IMAGEM NUM TImage
procedure ExibeFoto(DataSet : TDataSet; BlobFieldName : String; ImageExibicao
: TImage);
ExibeFoto(qryCliente,'FOTO',Image1);
qryCliente - é a query/dataset com os dados
'FOTO' - string com o nome do campo blob
Image1 - componente TImage onde será exibido a foto
-----
GRAVAR UMA IMAGEM NUM CAMPO BLOB
(a query/dataset deve estar com State in [dsEdit,dsInsert]
procedure GravaFoto(DataSet : TDataSet; BlobFieldName, FileName : String);
GravaFoto(qryCliente,'FOTO','filename.jpg');
qryCliente - é a query/dataset com os dados
'FOTO' - string com o nome do campo blob
'filename' - string com o nome de arquivo jpg ou bmp
** você poderá substituir o 'filename' por: OpenPictureDialog1.FileName
-----
EXCLUIR A FOTO DE UM CAMPO BLOB
procedure ExcluiFoto(DataSet : TDataSet; BlobFieldName : String);
ExcluiFoto(qryCliente,'FOTO');
qryCliente - é a query/dataset com os dados
'FOTO' - string com o nome do campo blob
** para limpar a imagem do TImage: TImage1.Picture := Nil
**
** não coloquei o codigo nessa unit, talvez você poderá não querer que a
imagem
** seja limpada do TImage apos ter sido excluida do campo.
-----
PARA EXPORTAR UMA IMAGEM DE UM CAMPO BLOB PARA UM ARQUIVO
procedure ExportaFoto(DataSet : TDataSet; BlobFieldName, FileName : String;
TipoImagem : TTipoImagem);
ExportaFoto(qryCliente,'FOTO','filename.jpg',tiJpeg);
qryCliente - é a query/dataset com os dados
'FOTO' - string com o nome do campo blob
'filename' - string com o nome de arquivo jpg ou bmp a ser exportado
tiJpeg/tiBitmap - tipo do arquivo a ser exportado: Bitmap ou Jpeg
** você poderá substituir o 'filename' por: OpenPictureDialog1.FileName
}
unit U_BlobImageFB;
interface
uses
Jpeg,
Graphics,
ExtDlgs,
Classes,
DB,
SysUtils,
ExtCtrls,
Dialogs,
Consts;
const
OffsetMemoryStream : Int64 = 0;
type
TTipoImagem = (tiBitmap, tiJpeg);
procedure ExibeFoto(DataSet : TDataSet; BlobFieldName : String; ImageExibicao :
TImage);
procedure GravaFoto(DataSet : TDataSet; BlobFieldName, FileName : String);
procedure ExcluiFoto(DataSet : TDataSet; BlobFieldName : String);
procedure ExportaFoto(DataSet : TDataSet; BlobFieldName, FileName : String;
TipoImagem : TTipoImagem);
var
MemoryStream : TMemoryStream;
Jpg : TJpegImage;
Bitmap : TBitmap;
implementation
procedure ExibeFoto(DataSet : TDataSet; BlobFieldName : String; ImageExibicao :
TImage);
begin
if not(DataSet.IsEmpty) and
not((DataSet.FieldByName(BlobFieldName) as TBlobField).IsNull) then
try
MemoryStream := TMemoryStream.Create;
Jpg := TJpegImage.Create;
(DataSet.FieldByName(BlobFieldName) as
TBlobField).SaveToStream(MemoryStream);
MemoryStream.Position := OffsetMemoryStream;
Jpg.LoadFromStream(MemoryStream);
ImageExibicao.Picture.Assign(Jpg);
finally
Jpg.Free;
MemoryStream.Free;
end
else
// o Else faz com que, caso o campo esteja Null, o TImage seja limpado
ImageExibicao.Picture := Nil;
end;
procedure GravaFoto(DataSet : TDataSet; BlobFieldName, FileName : String);
var
ext : string;
begin
if (DataSet.State in [dsEdit,dsInsert]) then begin
ext := UpperCase(ExtractFileExt(FileName));
if (ext <> '.BMP') and (ext <> '.JPG') and (ext <> '.JPEG') then begin
raise EAccessViolation.Create('Formato de imagem não suportado! Formato
suportado: Jpeg ou Bitmap');
Abort;
end;
try
Jpg := TJpegImage.Create;
MemoryStream := TMemoryStream.Create;
Bitmap := TBitmap.Create;
if (ext = '.BMP') then begin
Bitmap.LoadFromFile(FileName);
Jpg.Assign(Bitmap);
Jpg.Compress;
end else
Jpg.LoadFromFile(FileName);
Jpg.SaveToStream(MemoryStream);
MemoryStream.Position := OffsetMemoryStream;
(DataSet.FieldByName(BlobFieldName) as TBlobField).BlobType :=
ftTypedBinary;
(DataSet.FieldByName(BlobFieldName) as
TBlobField).LoadFromStream(MemoryStream);
finally
MemoryStream.Free;
Bitmap.Free;
Jpg.Free;
end;
end;
end;
procedure ExcluiFoto(DataSet : TDataSet; BlobFieldName : String);
begin
if (DataSet.State in [dsEdit,dsInsert])
and not((DataSet.FieldByName(BlobFieldName) as TBlobField).IsNull) then
(DataSet.FieldByName(BlobFieldName) as TBlobField).Clear;
// para limpar o TImage use
// Image1.Picture := Nil;
end;
procedure ExportaFoto(DataSet : TDataSet; BlobFieldName, FileName : string;
TipoImagem : TTipoImagem);
begin
// SERÁ IMPLEMENTADO FUTURAMENTE
// ME FALTA TEMPO :)
end;
end.
A linha de comando q estou usando no botão grava imagem é:
If DataM.IbQuery.State in [DsEdit,Dsinsert] then
GravaFoto(DataM.IbQuery,'IMAGEM',OpenPictureDialog1.FileName); // aqui
seleciona uma jpg
Obrigado desde já pelas dicas.
DEUS É PAI.
[]'s
Allan
msn [EMAIL PROTECTED]
Skype allan_gabriel
Conheça o grupo OPEN PDV, acesse:
http://br.groups.yahoo.com/group/OpenPDV
[As partes desta mensagem que não continham texto foram removidas]
--
<<<<< FAVOR REMOVER ESTA PARTE AO RESPONDER ESTA MENSAGEM >>>>>
<*> Para ver as mensagens antigas, acesse:
http://br.groups.yahoo.com/group/delphi-br/messages
<*> Para falar com o moderador, envie um e-mail para:
[EMAIL PROTECTED]
Links do Yahoo! Grupos
<*> Para visitar o site do seu grupo na web, acesse:
http://br.groups.yahoo.com/group/delphi-br/
<*> Para sair deste grupo, envie um e-mail para:
[EMAIL PROTECTED]
<*> O uso que você faz do Yahoo! Grupos está sujeito aos:
http://br.yahoo.com/info/utos.html
