Redimensionar foto e compactar
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!!
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
Curtidas 0
Melhor post
Vitor Alcantara
04/02/2009
Função para redimensionar a image:
Função para salvar em JPG:
Rotina par abrir a imagem do banco para um TImage
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
Acho que talvez de para você adaptar essas rotinas para seu caso.
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
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
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
04/02/2009
Obrigado amigos, valew, vou testar!!!!! Abraços!! Sucesso para vocês!!! :D
GOSTEI 0