De Blob para TImage

{

  Unit: U_BlobImageFB.pas
  Versão: 1.5
  Autor: Enio Rodrigo Marconcini
  Email: eniorm@gmail.com
  Msn: mestreenio@gmail.com
  GoogleTalk: eniorm@gmail.com
  Skype: eniorm

  Update: 22/09/2006

  DELFOS Desenvolvimento de Sistemas
  www.delfosistemas.com
  suporte@delfosistemas.com

  ** 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.

  **************************************
  PROBLEMAS ENCONTRADOS

  IBQUERY - muito estranho, caso vc tente gravar a imagem usando a dupla IBQuery
  com IBUpdateSQL dá erro e não funciona. Quem me avisou isso foi um amigo chamado
  Alan Gabriel, da lista Delphi-BR (Yahoo). Fiz os testes e verifiquei que realmente
  acontece isso.
  O mais estranho de tudo é que se vc usar IBDataset funciona blza!

  ==============================================================================

  ** 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 path/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(´Formado 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
  if not(DataSet.IsEmpty) and
  not((DataSet.FieldByName(BlobFieldName) as TBlobField).IsNull) then
    try
      MemoryStream := TMemoryStream.Create;
      Jpg := TJpegImage.Create;
      Bitmap := TBitmap.Create;
      (DataSet.FieldByName(BlobFieldName) as TBlobField).SaveToStream(MemoryStream);
      MemoryStream.Position := OffsetMemoryStream;
      Jpg.LoadFromStream(MemoryStream);
      Bitmap.LoadFromStream(MemoryStream);
      if (TipoImagem = tiJpeg) then
        Jpg.SaveToFile(FileName);
      if (TipoImagem = tiBitmap) then
        Bitmap.SaveToFile(FileName);
    finally
      Jpg.Free;
      Bitmap.Free;
      MemoryStream.Free;
    end
end;

end.