精确缩放图片 Resize Picture

最新推荐文章于 2024-04-16 14:39:29 发布

转载最新推荐文章于 2024-04-16 14:39:29 发布 · 1.7k 阅读

文章标签：

#integer #image #function

Delphi 专栏收录该内容

12 篇文章

订阅专栏

介绍了一种用于TBitmap的精确图片缩放算法，该算法通过计算目标像素区域内的平均颜色值来实现高质量的图片缩放效果，适用于JPEG和BITMAP等格式。

这个方法比 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;