[firebase-br] Rotinas para BMP / JPEG no banco [ meio OFF ]

[Felix - Sol]

Rotinas do Delphi que podem ser implementadas em qualquer banco, não necessariamente apenas no Firebird; todas foram conseguidas na Internet, com algumas adequações para suprir minhas necessidades.

ImFoto é um componente do tipo TImage.
Dialog é um TOpenPictureDialog.

procedure TFm_Cadastro.ImFotoClick(Sender: TObject);
var
  ext : string;
  image: TJPEGImage;
begin
   if LabelCodigo.Caption <> '' then // ou seja, se estiver com um registro na tela no modo de edição
   begin
      Dialog.FileName := '';
      Dialog.Execute;
      if Dialog.FileName <> '' Then
      begin
         ext := UpperCase(ExtractFileExt(Dialog.FileName));
         if (ext <> '.BMP') and (ext <> '.JPG') and (ext <> '.JPEG') then
         begin
            messagedlg('Formato de imagem não suportado! Utilize Jpeg ou Bitmap.',mtError,[mbOk],0);
            Abort;
         end;
         image:= TJPEGImage.Create;
         if ext <> '.BMP' then
         begin
            image.LoadFromFile(Dialog.FileName);
            _ImFoto.Picture.Bitmap := jpeg2bmp( image );
         end
         else
            _ImFoto.Picture.LoadFromFile( Dialog.FileName );
         ImFoto.Picture.Bitmap := QualityResizeBitmap(_ImFoto.Picture.Bitmap,ImFoto.Width,ImFoto.Height,Gauge1);
         image.Assign( ImFoto.Picture.Bitmap );
         ImFoto.Picture.Assign( image );
         FreeAndNil(image);
      end;
   end;
end;

// converte imagem de jpeg para bmp
function jpeg2bmp(imagem: TJPEGImage): TBitmap;
begin
  result:= TBitmap.Create; // instancia o bitmap
  result.Width:= imagem.Width; // altera as propriedades (largura/altura) para desenhar a imagem jpeg nele
  result.Height:= imagem.Height;
  result.Canvas.Draw(0, 0, imagem); // desenha a imagem jpeg no canvas
end;

// faz um resize na imagem BMP
function QualityResizeBitmap(bmpOrig : TBitmap; newWidth, newHeight: Integer; gauge : TGauge) : TBitmap;
var
   xIni, xFin, yIni, yFin, xSalt, ySalt: Double;
   _ii, X, Y, pX, pY, tpX: Integer;
   R, G, B: Integer;
   pxColor: TColor;
begin
   _ii := 0;
   gauge.Visible := True;
   gauge.MaxValue:= pred(newHeight) * pred(newWidth);
   result:= TBitmap.Create; // instancia o bitmap

   result.Width  := newWidth;
   result.Height := newHeight;

   xSalt := bmpOrig.Width / newWidth;
   ySalt := bmpOrig.Height / newHeight;

   yFin := 0;
   for Y := 0 to pred(newHeight) do
   begin
      yIni := yFin;
      yFin := yIni + ySalt;
      if yFin >= bmpOrig.Height then
         yFin := pred(bmpOrig.Height);

      xFin := 0;
      for X := 0 to pred(newWidth) do
      begin
         Inc(_ii);
         gauge.Progress:= _ii;
         xIni := xFin;
         xFin := xIni + xSalt;
         if xFin >= bmpOrig.Width then
            xFin := pred(bmpOrig.Width);

         R := 0;
         G := 0;
         B := 0;
         tpX := 0;

         for pY := Round(yIni) to Round(yFin) do
            for pX := Round(xIni) to Round(xFin) do
            begin
               Inc(tpX);
               pxColor := ColorToRGB(bmpOrig.Canvas.Pixels[pX, pY]);
               R := R + GetRValue(pxColor);
               G := G + GetGValue(pxColor);
               B := B + GetBValue(pxColor);
            end;

         result.Canvas.Pixels[X,Y] := RGB(Round(R/tpX),Round(G/tpX),Round(B/tpX));
      end;
   end;
   gauge.Visible := False;
end;


Para salvar o cadastro eu uso StoredProc, segue código relativo a foto:

  var
   _objeto : TMemoryStream;
{
...
}
 // converte objeto image
   _objeto := TMemoryStream.Create;
   if ImFoto.Picture.Graphic <> nil then
      ImFoto.Picture.Graphic.SaveToStream(_objeto);
{
...
}
      if ImFoto.Picture.Graphic <> nil then
         SP_Ins_Upd_Del.ParamByName('pfoto').LoadFromStream( _objeto ,ftBlob)
      else
         SP_Ins_Upd_Del.Params[27].Value := '';


Como dizem aqui, hth 


Fco. Felix
Desenvolvimento de Sistemas
www.soltecnologia.com.br