精确缩放图片 Resize Picture

这个方法比 Canvas.StretchDraw 要精确，故名。
经整理更具可读性。源：http://www.andyz.go.ro/ (andyz@go.ro)

procedure ResizeBitmap(AInImg, AOutImg: TBitmap;
  const ATgtWid, ATgtHgt: Integer);
const
  n_MaxPixCnt = 32768;
type
  PRGBArray = ^TRGBArray;
  TRGBArray = array[0..n_MaxPixCnt-1] of TRGBTriple;
var
  DrawedX, DrawingX, DrawedY, DrawingY, DeltaX, DeltaY: Double;
  x, y, px, py, pCnt: Integer;
  r, g, b: Longint;
  Row1, Row2: PRGBArray;
  PixFmt: TPixelFormat;

  function TruncRound(const AVal: Double): Integer;
  begin
    if AVal <= 0 then
    begin
      Result := Trunc(AVal);
    end else begin
      Result := Round(AVal);
    end;
  end;
begin
  AOutImg.Width := ATgtWid;
  AOutImg.Height := ATgtHgt;

  PixFmt := AInImg.PixelFormat;
  AInImg.PixelFormat := pf24bit;
  AOutImg.PixelFormat := pf24bit;

  DeltaX := AInImg.Width / ATgtWid;
  DeltaY := AInImg.Height / ATgtHgt;

  DrawingY := 0;
  for y := 0 to ATgtHgt - 1 do
  begin
    // Sets the initial and final Y coordinate of a pixel area.
    Row1 := AOutImg.ScanLine[y];
    DrawedY := DrawingY;
    DrawingY  := DrawedY + DeltaY;
    if DrawingY >= AInImg.Height then
      DrawingY := AInImg.Height - 1;

    DrawingX := 0;
    for x := 0 to ATgtWid - 1 do
    begin
      DrawedX := DrawingX;
      DrawingX  := DrawedX + DeltaX;
      if DrawingX >= AInImg.Width then
        DrawingX := AInImg.Width - 1;

      r := 0;
      g := 0;
      b := 0;
      pCnt := 0;

      // Gets the RGB values of all points. 
      for py := TruncRound(DrawedY) to TruncRound(DrawingY) do
      begin
        Row2 := AInImg.ScanLine[py];
        for px := TruncRound(DrawedX) to TruncRound(DrawingX) do
        begin
          Inc(pCnt);
          if px <= TruncRound(DrawingX) then
          begin
           if px < AInImg.Width  then
           begin
             if py < AInImg.Height then
             begin
               r := r + Row2[px].rgbtRed;
               g := g + Row2[px].rgbtGreen;
               b := b + Row2[px].rgbtBlue;
             end;
           end;
          end;
        end;
      end;

      // Calculates the average value of the delta area and paints.
      if (r = 0) or (pCnt = 0) then
      begin
        Row1[x].rgbtRed := 0;
      end else begin
        Row1[x].rgbtRed := TruncRound(r / pCnt);
      end;

      if (g = 0) or (pCnt = 0) then
      begin
        Row1[x].rgbtGreen := 0;
      end else begin
        Row1[x].rgbtGreen := TruncRound(g / pCnt);
      end;

      if (b = 0) or (pCnt = 0) then
      begin
        Row1[x].rgbtBlue:=0
      end else begin
        Row1[x].rgbtBlue := TruncRound(b / pCnt);
      end;
    end;
  end;
  AOutImg.PixelFormat := PixFmt;
end;

通过TImage，支持JPEG, BITMAP，调用：
var
  tmpBitmap: TBitmap;
  Wid, Hgt: Integer;
  Zoom: Double;
begin
  if OpenDialog1.Execute then
  begin
    tmpBitmap := TBitmap.Create;
    try
      Image1.Picture.LoadFromFile(OpenDialog1.FileName);
      tmpBitmap.Assign(Image1.Picture.Graphic);

      if (tmpBitmap.Width < 160) and (tmpBitmap.Height < 120) then
      begin
        Wid := tmpBitmap.Width;
        Hgt := tmpBitmap.Height;
      end else begin
        Zoom := Max(tmpBitmap.Width / 160, tmpBitmap.Height / 120);
        Zoom := Max(Zoom, 1);

        Wid := Trunc(tmpBitmap.Width / Zoom);
        Hgt := Trunc(tmpBitmap.Height / Zoom);
      end;

      ResizeBitmap(tmpBitmap, Image1.Picture.Bitmap, Wid, Hgt);
    finally
      tmpBitmap.Free;
    end;
  end;
end;