Redimensionar foto e compactar
04/02/2009
0
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
Curtir tópico
+ 0
Responder
Post mais votado
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.
Vitor Alcantara
Responder
Mais Posts
04/02/2009
Rodc
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
Responder
04/02/2009
Erucci
Obrigado amigos, valew, vou testar!!!!! Abraços!! Sucesso para vocês!!! :D
Responder
Clique aqui para fazer login e interagir na Comunidade :)