使用ScanLine获取像素颜色异常的问题排查

我正在处理一张原始图像，已实现通过鼠标在图像上绘制矩形并填充该矩形区域平均颜色的功能，效果正常；但通过程序化方式批量绘制矩形并填充时，矩形边界正确但颜色错误。此外，若移除鼠标移动事件中擦除和重绘矩形的代码，鼠标绘制也会出现颜色错误。

相关效果说明 #

• 原始图像：待处理的初始图片
• 鼠标绘制后效果：鼠标绘制矩形并填充平均颜色的正确效果
• 程序化绘制后效果：批量绘制矩形后颜色错误的效果

鼠标绘制代码 #

procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState;
    X, Y: Integer);
begin
    PenModeSave := Image1.Canvas.Pen.Mode;
    Image1.Canvas.Pen.Mode := pmNot;
    Image1.Canvas.Brush.Style := bsClear;
    MouseFirstPt := Point(X, Y);
    MouseLastPt := MouseFirstPt;
    Dragging := True;
end;

procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
begin
    if Dragging then
    begin
        // 擦除之前的矩形
        Image1.Canvas.Rectangle(MouseFirstPt.X, MouseFirstPt.Y, MouseLastPt.X, MouseLastPt.Y);
        MouseLastPt := Point(X, Y);
        // 绘制新矩形
        Image1.Canvas.Rectangle(MouseFirstPt.X, MouseFirstPt.Y, MouseLastPt.X, MouseLastPt.Y);
    end;
end;

procedure TForm1.Image1MouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X,
    Y: Integer);
var
    Rectangle: TRect;
begin
    Dragging := False;
    MouseLastPt := Point(X, Y);
    Image1.Canvas.Pen.Mode := PenModeSave;
    Rectangle.TopLeft := MouseFirstPt;
    Rectangle.BottomRight := MouseLastPt;
    DrawAverageColor(Rectangle);
end;

程序化批量绘制代码 #

procedure TForm1.BtnDrawMatrixClick(Sender: TObject);
var
    X, Y: Integer;
    R: TRect;
begin
    for Y := 1 to 15 do
        for X := 1 to 20 do
        begin
            R.TopLeft := Point(50 * X, 50 * Y);
            R.BottomRight := Point(50 * X + 40, 50 * Y + 40);
            DrawAverageColor(R);
        end;
end;

平均颜色计算与填充代码 #

procedure TForm1.CalculateAverageColor(aRect: TRect; var aR, aG, aB: Integer);
var
    X, Y, Area: Integer;
    R, G, B: Int64;
    Line : Prgb24Array;
begin
    R := 0;
    G := 0;
    B := 0;
    for Y := aRect.Top to aRect.Bottom - 1 do
    begin
        Line := Image1.Picture.Bitmap.ScanLine[Y];
        for X := aRect.Left to aRect.Right - 1 do
        begin
            R := R + Line[X].R;
            G := G + Line[X].G;
            B := B + Line[X].B;
        end;
    end;
    Area := Abs((aRect.Top - aRect.Bottom + 1) * (aRect.Left - aRect.Right + 1));
    aR := Round(R / Area) and $FF;
    aG := Round(G / Area) and $FF;
    aB := Round(B / Area) and $FF;
end;

procedure TForm1.DrawAverageColor(aRect: TRect);
var
    X, Y, R, G, B: Integer;
    Line : Prgb24Array;
begin
    CalculateAverageColor(aRect, R, G, B);
    for Y := aRect.Top to aRect.Bottom - 1 do
    begin
        Line := Image1.Picture.Bitmap.ScanLine[Y];
        for X := aRect.Left to aRect.Right - 1 do
        begin
            Line[X].R := R;
            Line[X].G := G;
            Line[X].B := B;
        end;
    end;
    Image1.Refresh;
end;

类型定义 #

type
    Trgb24 = packed record
        B, G, R: Byte;
    end;
    Trgb24Array = packed array[0..High(Word) div SizeOf(Trgb24)-1] of Trgb24;
    Prgb24Array = ^Trgb24Array;

核心原因 #

1. TRect坐标顺序未做规范处理 #

鼠标拖动时，可能会生成Top > Bottom或Left > Right的矩形（比如从右下角往左上角拖动）。Canvas.Rectangle会自动修正这种颠倒的坐标顺序，但你的CalculateAverageColor和DrawAverageColor中的循环是从aRect.Top到aRect.Bottom-1，如果起始值大于结束值，循环根本不会执行，导致R/G/B的累计值为0，计算出错误的平均颜色。

而鼠标移动事件中的代码，其实间接帮你修正了坐标顺序——因为Canvas.Rectangle会自动调整坐标，所以MouseUp时得到的TRect是规范后的；一旦移除这段代码，MouseUp得到的就是原始颠倒的坐标，自然计算出错。

2. 批量绘制时覆盖了原始像素 #

程序化批量绘制时，前一个矩形填充后会修改Bitmap的像素数据，后续矩形计算平均颜色时，读取的是已经被修改过的像素，而非原始图像的像素，导致颜色计算完全偏离预期。而鼠标绘制时，每次只修改一个区域，且计算时基于的是原始Bitmap（鼠标移动的临时框是画在Canvas层，没有修改Bitmap本身），所以结果正确。

修复方案 #

1. 规范TRect坐标顺序 #

新增一个修正矩形坐标的函数，在计算和填充前调用：

procedure NormalizeRect(var Rect: TRect);
var
  Temp: Integer;
begin
  // 确保Top <= Bottom
  if Rect.Top > Rect.Bottom then
  begin
    Temp := Rect.Top;
    Rect.Top := Rect.Bottom;
    Rect.Bottom := Temp;
  end;
  // 确保Left <= Right
  if Rect.Left > Rect.Right then
  begin
    Temp := Rect.Left;
    Rect.Left := Rect.Right;
    Rect.Right := Temp;
  end;
end;

在CalculateAverageColor和DrawAverageColor的第一行添加：

NormalizeRect(aRect);

2. 基于原始图像批量计算 #

如果要批量处理，先复制一份原始Bitmap，所有平均颜色的计算都基于这份副本，避免后续计算被已修改的像素干扰：

procedure TForm1.BtnDrawMatrixClick(Sender: TObject);
var
    X, Y: Integer;
    R: TRect;
    OriginalBmp: TBitmap;
    RVal, GVal, BVal: Integer;
begin
    OriginalBmp := TBitmap.Create;
    try
        OriginalBmp.Assign(Image1.Picture.Bitmap);
        OriginalBmp.PixelFormat := pf24bit; // 确保格式一致

        for Y := 1 to 15 do
            for X := 1 to 20 do
            begin
                R.TopLeft := Point(50 * X, 50 * Y);
                R.BottomRight := Point(50 * X + 40, 50 * Y + 40);
                NormalizeRect(R);
                // 基于原始Bitmap计算平均颜色
                CalculateAverageColorFromBmp(OriginalBmp, R, RVal, GVal, BVal);
                // 填充到目标Bitmap
                FillRectWithColor(Image1.Picture.Bitmap, R, RVal, GVal, BVal);
            end;
        Image1.Refresh;
    finally
        OriginalBmp.Free;
    end;
end;

// 新增基于指定Bitmap计算平均颜色的函数
procedure TForm1.CalculateAverageColorFromBmp(aBmp: TBitmap; aRect: TRect; var aR, aG, aB: Integer);
var
    X, Y, Area: Integer;
    R, G, B: Int64;
    Line : Prgb24Array;
begin
    R := 0;
    G := 0;
    B := 0;
    for Y := aRect.Top to aRect.Bottom - 1 do
    begin
        Line := aBmp.ScanLine[Y];
        for X := aRect.Left to aRect.Right - 1 do
        begin
            R := R + Line[X].R;
            G := G + Line[X].G;
            B := B + Line[X].B;
        end;
    end;
    Area := (aRect.Bottom - aRect.Top) * (aRect.Right - aRect.Left);
    aR := Round(R / Area) and $FF;
    aG := Round(G / Area) and $FF;
    aB := Round(B / Area) and $FF;
end;

// 新增填充指定Bitmap矩形的函数
procedure TForm1.FillRectWithColor(aBmp: TBitmap; aRect: TRect; aR, aG, aB: Integer);
var
    X, Y: Integer;
    Line : Prgb24Array;
begin
    for Y := aRect.Top to aRect.Bottom - 1 do
    begin
        Line := aBmp.ScanLine[Y];
        for X := aRect.Left to aRect.Right - 1 do
        begin
            Line[X].R := aR;
            Line[X].G := aG;
            Line[X].B := aB;
        end;
    end;
end;

内容的提问来源于stack exchange，提问作者stevenvh