Redimensionar foto e compactar

Delphi

04/02/2009

Bom dia a todos,

Preciso do seguinte:
Quando a pessoa procurar uma foto no computador para adicionar no cadastro, o software precisa redimensionar o tamanho da foto e compactar. Está acontecendo que alguns clientes do software selecionam fotos com 1, 2,3 MB de tamanho.

Se alguém souber de uma rotina assim, ou quiser vender uma rotina assim, entre em contato: luis_erucci@yahoo.com.br

Abraços!!


Erucci

Erucci

Curtidas 0

Melhor post

Vitor Alcantara

Vitor Alcantara

04/02/2009

Função para redimensionar a image:

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;


Função para salvar em JPG:

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;


Rotina par abrir a imagem do banco para um TImage

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;


PS : Nessa rotina eu utilizo um arquivo *.res com uma imagem para mostrar que o item não possui imagem.

Rotina que para abrir imagem do arquivo para um TImage

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;


Acho que talvez de para você adaptar essas rotinas para seu caso.


GOSTEI 1

Mais Respostas

Rodc

Rodc

04/02/2009

Não lembro bem como se faz, mas segue aí a teoria que deve funcionar...

Carrege a foto em um TImage com o tamanho que deseja e com a propriedade Stretch como True. Depois pegue o Canvas do TImage, coloque em um TBitmap e salve convertendo para JPG. Procure na internet o código que converte para JPG.
Qualquer dúvida posta aqui que vou tentar ajudá-lo


GOSTEI 0
Erucci

Erucci

04/02/2009

Obrigado amigos, valew, vou testar!!!!! Abraços!! Sucesso para vocês!!! :D


GOSTEI 0
POSTAR