Redimensionar JPG e usar FTP

[jonikaites 0]

Salve amigos programadores...tenho 2 dúvidas, kem puder me ajudar, fikarei mto grato:-- 1 --estou fazendo um programa para cadastro de notícias em BD Mysql e estou tendo uma dúvida quanto a como fazer para redimensionar imagens proporcionalmente.por exemplo...o usuário seleciona um imagem qq, q pode estar em 800x600, 1024x748 ou ateh 600x800 ou 748x1024, etc...o q desejo eh q ela fike redimensionada proporcionalmente para 220x165 px ou 165x220 px, dependendo da orientação da imagem...pra fazer essas alteracoes em escala eu jah +- sei como fazer, mas o maior problema é para salvar a imagem depois...tentei varias formas, mas ela simplesmente soh salva a imagem original (com o tamanho original).então, resumindo, q funcao eu uso para transformar uma imagem de 1024x748 px com 150 Kb pra uma imagem em 220x165px e ~30 Kb???a perda de qualidade da imagem não pode ser mto grande tb.-- 2 --após redimensionar as imagens e talz, eu preciso mandar pro ftp, por se tratar de um programa para gerenciamento Web.como fazer pra conectar no servere mandar as imagens previamente salvar num diretorio temporario para uma pasta do ftp, como /public_html/images/e depois desconetar do FTP.taum eh isso...desde já gratos com vossa sabedoria,e que Deus abençoe todos vocês.abraços,Roberto Jonikaites

[locorj 0]

função pra redimencionar....

procedure SmoothResize(Src, Dst: TBitmap);

var

x, y: Integer;

xP, yP: Integer;

xP2, yP2: Integer;

SrcLine1, SrcLine2: pRGBArray;

t3: Integer;

z, z2, iz2: Integer;

DstLine: pRGBArray;

DstGap: Integer;

w1, w2, w3, w4: Integer;

begin

Src.PixelFormat := pf24Bit;

Dst.PixelFormat := pf24Bit;

 

if (Src.Width = Dst.Width) and (Src.Height = Dst.Height) then

Dst.Assign(Src)

else

begin

DstLine := Dst.ScanLine[0];

DstGap := Integer(Dst.ScanLine[1]) - Integer(DstLine);

 

xP2 := MulDiv(pred(Src.Width), $10000, Dst.Width);

yP2 := MulDiv(pred(Src.Height), $10000, Dst.Height);

yP := 0;

 

for y := 0 to pred(Dst.Height) do

begin

xP := 0;

 

SrcLine1 := Src.ScanLine[yP shr 16];

 

if (yP shr 16 < pred(Src.Height)) then

SrcLine2 := Src.ScanLine[succ(yP shr 16)]

else

SrcLine2 := Src.ScanLine[yP shr 16];

 

z2 := succ(yP and $FFFF);

iz2 := succ((not yp) and $FFFF);

for x := 0 to pred(Dst.Width) do

begin

t3 := xP shr 16;

z := xP and $FFFF;

w2 := MulDiv(z, iz2, $10000);

w1 := iz2 - w2;

w4 := MulDiv(z, z2, $10000);

w3 := z2 - w4;

DstLine[x].rgbtRed := (SrcLine1[t3].rgbtRed * w1 +

SrcLine1[t3 + 1].rgbtRed * w2 +

SrcLine2[t3].rgbtRed * w3 + SrcLine2[t3 + 1].rgbtRed * w4) shr 16;

DstLine[x].rgbtGreen :=

(SrcLine1[t3].rgbtGreen * w1 + SrcLine1[t3 + 1].rgbtGreen * w2 +

 

SrcLine2[t3].rgbtGreen * w3 + SrcLine2[t3 + 1].rgbtGreen * w4) shr 16;

DstLine[x].rgbtBlue := (SrcLine1[t3].rgbtBlue * w1 +

SrcLine1[t3 + 1].rgbtBlue * w2 +

SrcLine2[t3].rgbtBlue * w3 +

SrcLine2[t3 + 1].rgbtBlue * w4) shr 16;

Inc(xP, xP2);

end; {for}

Inc(yP, yP2);

DstLine := pRGBArray(Integer(DstLine) + DstGap);

end; {for}

end; {if}

end; {SmoothResize}

 

 

e quanto ao FTP baixa o arquivo no link abaixo é um sample usando o client FTP do indy...

 

http://www.indyproject.org/DemoDownloads/I...0_FTPClient.zip

[jonikaites 0]

kra q units mais eu tenho q declarar na sesao uses???vlw

[locorj 0]

acredito que as units que o delphi adiciona sejam suficientes... acredito que você esja com esse problema... pRGBArray não declarado...type pRGBArray = array[0..32767] of TRGBTriple;só por garantia olha as units que tem aqui.... Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs;

[jonikaites 0]

kra na verdade esse teu procedimento eh um programinha assim:uses JPEG;type TRGBArray = array[Word] of TRGBTriple; pRGBArray = ^TRGBArray;{ Before importing an image (jpg) into a database, I would like to resize it (reduce its size) and generate the corresponding smaller file. How can I do this? Load the JPEG into a bitmap, create a new bitmap of the size that you want and pass them both into SmoothResize then save it again ... there's a neat routine JPEGDimensions that gets the JPEG dimensions without actually loading the JPEG into a bitmap, saves loads of time if you only need to test its size before resizing.}procedure TfrmNot.SmoothResize(Src, Dst: TBitmap);var x, y: Integer; xP, yP: Integer; xP2, yP2: Integer; SrcLine1, SrcLine2: pRGBArray; t3: Integer; z, z2, iz2: Integer; DstLine: pRGBArray; DstGap: Integer; w1, w2, w3, w4: Integer;begin Src.PixelFormat := pf24Bit; Dst.PixelFormat := pf24Bit;if (Src.Width = Dst.Width) and (Src.Height = Dst.Height) then Dst.Assign(Src)else begin DstLine := Dst.ScanLine[0]; DstGap := Integer(Dst.ScanLine[1]) - Integer(DstLine); xP2 := MulDiv(pred(Src.Width), $10000, Dst.Width); yP2 := MulDiv(pred(Src.Height), $10000, Dst.Height); yP := 0; for y := 0 to pred(Dst.Height) do begin xP := 0; SrcLine1 := Src.ScanLine[yP shr 16]; if (yP shr 16 < pred(Src.Height)) then SrcLine2 := Src.ScanLine[succ(yP shr 16)] else SrcLine2 := Src.ScanLine[yP shr 16]; z2 := succ(yP and $FFFF); iz2 := succ((not yp) and $FFFF); for x := 0 to pred(Dst.Width) do begin t3 := xP shr 16; z := xP and $FFFF; w2 := MulDiv(z, iz2, $10000); w1 := iz2 - w2; w4 := MulDiv(z, z2, $10000); w3 := z2 - w4; DstLine[x].rgbtRed := (SrcLine1[t3].rgbtRed * w1 + SrcLine1[t3 + 1].rgbtRed * w2 + SrcLine2[t3].rgbtRed * w3 + SrcLine2[t3 + 1].rgbtRed * w4) shr 16; DstLine[x].rgbtGreen := (SrcLine1[t3].rgbtGreen * w1 + SrcLine1[t3 + 1].rgbtGreen * w2 + SrcLine2[t3].rgbtGreen * w3 + SrcLine2[t3 + 1].rgbtGreen * w4) shr 16; DstLine[x].rgbtBlue := (SrcLine1[t3].rgbtBlue * w1 + SrcLine1[t3 + 1].rgbtBlue * w2 + SrcLine2[t3].rgbtBlue * w3 + SrcLine2[t3 + 1].rgbtBlue * w4) shr 16; Inc(xP, xP2); end; {for} Inc(yP, yP2); DstLine := pRGBArray(Integer(DstLine) + DstGap); end; {for}end; {if}end; {procedure SmoothResize}function LoadJPEGPictureFile(Bitmap: TBitmap; FilePath, FileName: string): Boolean;var JPEGImage: TJPEGImage;begin if (FileName = '') then // No FileName so nothing Result := False //to load - return False... else begin try // Start of try except JPEGImage := TJPEGImage.Create; // Create the JPEG image... try // now try // to load the file but JPEGImage.LoadFromFile(FilePath + FileName); // might fail...with an Exception. Bitmap.Assign(JPEGImage); // Assign the image to our bitmap.Result := True; // Got it so return True. finally JPEGImage.Free; // ...must get rid of the JPEG image. finally end; {try} except Result := False; // Oops...never Loaded, so return False. end; {try} end; {if}end; {LoadJPEGPictureFile}function SaveJPEGPictureFile(Bitmap: TBitmap; FilePath, FileName: string; Quality: Integer): Boolean;begin Result := True; try if ForceDirectories(FilePath) then begin with TJPegImage.Create do begin try Assign(Bitmap); CompressionQuality := Quality; SaveToFile(FilePath + FileName); finally Free; end; {try} end; {with} end; {if} except raise; Result := False; end; {try}end; {SaveJPEGPictureFile}procedure TfrmNot.ResizeImage(FileName: string; MaxWidth: Integer);var OldBitmap: TBitmap; NewBitmap: TBitmap; aWidth: Integer; JPEGImage: TJPEGImage;begin JPEGImage := TJPEGImage.Create; JPEGImage.LoadFromFile(FileName); OldBitmap := TBitmap.Create; try OldBitmap.Assign(JPEGImage); {if LoadJPEGPictureFile(OldBitmap, ExtractFilePath(FileName), ExtractFileName(FileName)) then begin} aWidth := OldBitmap.Width; if (OldBitmap.Width > MaxWidth) then begin aWidth := MaxWidth; NewBitmap := TBitmap.Create; try NewBitmap.Width := MaxWidth; NewBitmap.Height := MulDiv(MaxWidth, OldBitmap.Height, OldBitmap.Width); SmoothResize(OldBitmap, NewBitmap); RenameFile(FileName, ChangeFileExt(FileName, '.$$$')); if SaveJPEGPictureFile(NewBitmap, ExtractFilePath(FileName), ExtractFileName(FileName), 75) then DeleteFile(ChangeFileExt(FileName, '.$$$')) else RenameFile(ChangeFileExt(FileName, '.$$$'), FileName); finally NewBitmap.Free; end; {try} end; {if}// end; {if} finally OldBitmap.Free; end; {try}end;function JPEGDimensions(Filename : string; var X, Y : Word) : boolean;var SegmentPos : Integer; SOIcount : Integer; b : byte;begin Result := False; with TFileStream.Create(Filename, fmOpenRead or fmShareDenyNone) do begin try Position := 0; Read(X, 2); if (X <> $D8FF) then exit; SOIcount := 0; Position := 0; while (Position + 7 < Size) do begin Read(b, 1); if (b = $FF) then begin Read(b, 1); if (b = $D8) then inc(SOIcount); if (b = $DA) then break; end; {if} end; {while} if (b <> $DA) then exit; SegmentPos := -1; Position := 0; while (Position + 7 < Size) do begin Read(b, 1); if (b = $FF) then begin Read(b, 1); if (b in [$C0, $C1, $C2]) then begin SegmentPos := Position; dec(SOIcount); if (SOIcount = 0) then break; end; {if} end; {if} end; {while} if (SegmentPos = -1) then exit; if (Position + 7 > Size) then exit; Position := SegmentPos + 3; Read(Y, 2); Read(X, 2); X := Swap(X); Y := Swap(Y); Result := true; finally Free; end; {try} end; {with}end; {JPEGDimensions}que pra funcionar tem q usar o seguinte procedimento:ResizeImage({caminho e nome do arquivo}, {largura desejada});revirei uma tarde interira a net e encontrei esse programa em um siteresolveu 100% o meu problema...vou agora começar a fuçar o FTPvlw

[jonikaites 0]

ahh

kem kise dah uma conferidinha no site, tah ae:

 

http://www.swissdelphicenter.ch/en/showcode.php?id=1896