Image resizer

[dangerduck]

I have an program which must to resizing image from 3200 X 1290 to 800 x 600 pixels but i dont now how to format is jpeg
i try to take two Timage (one for showing another one for stretching )but it's don't work well...
can someone tell me please how to resize it faster with delphi ?

[jfheins]

See StretchBlt ;)

Zitat:

BOOL StretchBlt(
HDC hdcDest, // handle to destination DC
int nXOriginDest, // x-coord of destination upper-left corner
int nYOriginDest, // y-coord of destination upper-left corner
int nWidthDest, // width of destination rectangle
int nHeightDest, // height of destination rectangle
HDC hdcSrc, // handle to source DC
int nXOriginSrc, // x-coord of source upper-left corner
int nYOriginSrc, // y-coord of source upper-left corner
int nWidthSrc, // width of source rectangle
int nHeightSrc, // height of source rectangle
DWORD dwRop // raster operation code
);

HDC <=> Canvas.Handle

dwRop: SRCCOPY

If the Qualtity is bad, try

Code:

int SetStretchBltMode(Canvas.Handle, HALFTONE;

;)

[Douglas Quintaine]

Delphi-Quellcode:

procedure CopyImagePart(const src: TGraphic; const dest: TBitmap; aWidth, aHeight: Integer);
var
  tempBMP: TBitmap;
begin
  tempBMP := TBitmap.Create;
  try
    tempBMP.Width := src.Width;
    tempBMP.Height := src.Height;
    tempBMP.Assign(src);
    dest.Width := aWidth;
    dest.Height := aHeight;
    BitBlt(dest.Canvas.Handle,0,0,aWidth,aHeight,tempBMP.Canvas.Handle,0,0,SRCCOPY);
  finally
    tempBMP.Free;
  end;
end;

procedure ReSizeJPGImage(url: String; x,y: Integer);
var
 aCopy: TBitmap;
 JPG: TJPEGImage;
begin
  JPG := TJPEGImage.Create;
   try
     aCopy := TBitmap.Create;
     try
       JPG.LoadFromFile(url);
       CopyImagePart(JPG,aCopy,x,y);
       aCopy.SaveToFile(url);
     finally
       aCopy.Free;
     end;
   finally
     JPG.Free;
   end;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  ReSizeJPGImage(edit1.Text, 260,30); // (url, x, y)
end;

[DeddyH]

Here' s a procedure I wrote for a similar task. It converts a TGraphic into a TJPEGImage proportionally. For this you have to add the "jpeg"-unit to your uses-clause.

Delphi-Quellcode:

procedure StretchGraphic(const src: TGraphic;  //the TGraphic to convert
                         const dest: TJPEGImage;  //the TJPEGImage which receives the converted graphic
                         const DestWidth, DestHeight: integer); //maximum width and height of the destination jpeg
var temp, aCopy: TBitmap;
    faktor: double;
begin
  if src.Width > DestWidth then
    begin
      faktor := DestWidth / src.Width;
      if (src.Height * faktor) > DestHeight then
        faktor := DestHeight / src.Height;
    end
  else
    begin
      faktor := DestHeight / src.Height;
      if (src.Width * faktor) > DestWidth then
        faktor := DestWidth / src.Width;
    end;
  aCopy := TBitmap.Create;
  try
    aCopy.PixelFormat := pf24Bit;
    aCopy.Assign(src);
    temp := TBitmap.Create;
    try
      temp.Width := round(src.Width * faktor);
      temp.Height := round(src.Height * faktor);
      try
        SetStretchBltMode(temp.Canvas.Handle,HALFTONE);
        StretchBlt(temp.Canvas.Handle,
                   0,0,temp.Width,temp.Height,
                   aCopy.Canvas.Handle,
                   0,0,aCopy.Width,aCopy.Height,
                   SRCCOPY);
        dest.Assign(temp);
      except
        on E: Exception do
          MessageBox(0,PAnsiChar(E.Message),nil,MB_OK or MB_ICONERROR);
      end;
    finally
      temp.Free;
    end;
  finally
    aCopy.Free;
  end;
end;

[dangerduck]

thanks to all :D