Fórum Redimensionar foto e compactar #368142

function PadronizaTamanho(Imagem: TGraphic; W, H: Integer;
  Tipo: TGraphicClass): TGraphic;
var
  B: TBitmap;
begin
  B := TBitmap.Create;
  try
    B.Width := W;
    B.Height := H;
    B.Canvas.StretchDraw(Rect(0, 0, W, H), Imagem);
    if Tipo = nil
    then
      Result := TGraphic(Imagem.ClassType.Create)
    else
      Result := Tipo.Create;
    Result.Assign ( B ) ;
  finally
    B.Free;
  end;
end;

procedure SalvarImageBanco(Field: tField; Image: tImage);
var
  jpg:TJPEGImage;
begin
  Try
  if Image.Picture <> nil then
  begin
    Try
      Jpg := TJPEGImage.Create;
      Jpg.Assign(Image.Picture);
      Jpg.CompressionQuality := 50;
      jpg.Compress;
      Jpg.SaveToFile(´Tmp.jpg´);
      if FileExists(´Tmp.jpg´) then
      begin
        TBlobField(Field).LoadFromFile(´Tmp.jpg´);
      end
      else
      begin
        Field.Clear;
      end;
    Finally
      Jpg.Free;
      DeleteFile(´Tmp.jpg´)
    End;
  end
  else
  begin
    Field.Clear;
  end;
  Except
    Field.Clear;

  End;
end;

procedure AbrirImageBanco(Field: tField; Image: tImage);
var
  Stm: TStream;
  Jpg: TJPEGImage;
  res: TResourceStream;//Classe específica  do Delphi
                       //para manipulação de recursos

begin
  with Field do
  try
    if TBlobField(Field).BlobSize > 0 then
    begin
      try
        Stm := TMemoryStream.Create;
        Jpg := TJpegImage.Create;
        TBlobField(Field).SaveToStream(Stm);
        Stm.Position := 0;
        Jpg.LoadFromStream(Stm);
        try
          Image.Picture.Assign(Jpg);
          Image.Tag := 0;
        except   
          Image.Picture.Assign(Nil);
        end;
      finally
        Stm.Free;
        Jpg.Free;
      end;
    end
    else
    begin
      Try
        Jpg := TJpegImage.Create;
        Res := TResourceStream.Create(Hinstance, ´SEMIMAGEM´, ´JPGFILE´);
        Res.SaveToFile(´tmp.jpg´);
        jpg.LoadFromFile(´tmp.jpg´);
        Image.Picture.Assign(Jpg);
        Image.Tag := 1;
      Finally
        DeleteFile(´tmp.jpg´);
        Jpg.Free;
        Res.Free;
      End;
      //Image.Picture.Assign(nil);
    end;
  except
    // controle de erro
  end;
end;

procedure AbrirImageOpenPicutre(OpenPicture: TOpenPictureDialog;
  Image: tImage);
var
  jpg:TJPEGImage;
begin
  if OpenPicture.Execute then
  begin
    Try
      jpg := TJPEGImage.Create;
      jpg.LoadFromFile(OpenPicture.FileName);


      if (jpg.Width > 128) or (jpg.Height > 128) then
      begin
        //ShowMessage(´A imagem tem que ter tamanho igual ou menor a 128x128 pixels.´);
        //exit;
        PadronizaTamanho(Jpg,128,128,TJPEGImage);
      end;
      Image.Picture.Assign(jpg);
      Image.Tag := 0;
    Finally
      jpg.Free;
    End;
  end;
end;