RealICQClient/Controls/RealICQUI/RealICQColors.pas

{
文件名：RealICQColors.pas
功  能：此单元定义了进行颜色变换，绘图等功能所必须的方法、过程。
建  立：尹进
历  史：
2005.12.23：补文件说明信息（尹进）
}
unit RealICQColors;

interface

uses
  Windows, Graphics, SysUtils, Math, Forms, Classes, pngimage;
  
const
   MaxPixelCount = 65536;

type
  PRGBTripleArray = ^TRGBTripleArray;
  TRGBTripleArray = array[0..MaxPixelCount - 1] of TRGBTriple;

  TIconButtonState = (ibDown, ibUp, ibClear);
  
  procedure Grayscale(Const Bitmap:TBitmap);
  procedure PrintBitmap(aCanvas : TCanvas; Dest : TRect; Bitmap : TBitmap);

  function  ConvertBitmapToRTF(const Bitmap: TBitmap): string;
  procedure HSLtoRGB(H, S, L: Double; var R, G, B: Integer);
  procedure RGBtoHSL(R, G, B: Integer; var H, S, L: Double);
  procedure ConvertBitmapToColor(DestBitmap:TBitmap;DestColor:TColor);
  procedure ConvertBitmapToLighter(DestBitmap:TBitmap;FLightAdd:Integer);
  procedure ConvertBitmapToSaturation(DestBitmap:TBitmap;FSaturationAdd:Integer);
  function ConvertColorToColor(SourceColor: TColor; DestColor: TColor): TColor;
  function ConvertColorToLighter(SourceColor: TColor; FLightAdd:Integer): TColor;

  //平均模糊
  procedure SmoothAverage(SrcBitmap: TBitmap; TargetBitmap: TBitmap; iBlockLen: Integer);

  //从位图获取路径
  function GetRegionFromBitmap(StartX, StartY: Integer; DestBitmap:TBitmap; TransparentColor: TColor): HRGN;

  //拉幕方式显示位置
  procedure AnimateShowBitmap(SrcBMP: TBitmap; DestBMP: TBitmap);

  //对图片进行大小变换
  function GetSamllBitmap(AFileName: String; ANewWidth, ANewHeight: Integer; AKeepScale: Boolean = False): TBitmap;

  //绘制按钮的边框
  procedure DrawIconButton(ACanvas: TCanvas; ADefaultColor, ALightColor, AShadownColor: TColor;
    ARect: TRect; AIconButtonState: TIconButtonState; ABaseTop: Integer = 0);
    
implementation
{改变Bitmap的亮度}
procedure ConvertBitmapToLighter(DestBitmap:TBitmap;FLightAdd:Integer);
var
   x, y, ScanlineBytes: integer;
   p: prgbtriplearray;
   RVALUE, bvalue, gvalue: integer;
   hVALUE, sVALUE, lVALUE: Double;
begin
  if not DestBitmap.Empty then
  begin
    DestBitmap.PixelFormat:=pf24bit;
    p := DestBitmap.ScanLine[0];
    ScanlineBytes := integer(DestBitmap.ScanLine[1]) - integer(DestBitmap.ScanLine[0]);
    for y := 0 to DestBitmap.Height - 1 do
    begin
      for x := 0 to DestBitmap.Width - 1 do
      begin
        RVALUE := p[x].rgbtRed;
        gVALUE := p[x].rgbtGreen;
        bVALUE := p[x].rgbtBlue;
        RGBtoHSL(RVALUE, gVALUE, bVALUE, hVALUE, sVALUE, lVALUE);
        lVALUE := min(100, lVALUE + FLightAdd);
        HSLtorgb(hVALUE, sVALUE, lVALUE, rVALUE, gVALUE, bVALUE);
        p[x].rgbtRed := RVALUE;
        p[x].rgbtGreen := gVALUE;
        p[x].rgbtBlue := bVALUE;
      end;
      inc(integer(p), ScanlineBytes);
    end;
  end;
end;
//------------------------------------------------------------------------------
{改变Color的亮度}
function ConvertColorToLighter(SourceColor: TColor; FLightAdd:Integer): TColor;
var
   RVALUE, bvalue, gvalue: integer;
   hVALUE, sVALUE, lVALUE: Double;
begin
  rVALUE := StrToInt('$'+Copy(IntToHex(SourceColor,6),5,2));
  gVALUE := StrToInt('$'+Copy(IntToHex(SourceColor,6),3,2));
  bVALUE := StrToInt('$'+Copy(IntToHex(SourceColor,6),1,2));

  RGBtoHSL(rVALUE, gVALUE, bVALUE, hVALUE, sVALUE, lVALUE);
  HSLtoRGB(hVALUE, sVALUE, Max(0, Min(100, lVALUE + FLightAdd)), rVALUE, gVALUE, bVALUE);
  Result := TColor( StrToInt('$' + IntToHex(bVALUE,2) + IntToHex(gVALUE,2) + IntToHex(rVALUE,2)) );
end;

//------------------------------------------------------------------------------
procedure DrawIconButton(ACanvas: TCanvas; ADefaultColor, ALightColor, AShadownColor: TColor;
  ARect: TRect; AIconButtonState: TIconButtonState; ABaseTop: Integer = 0);
begin
    ARect.Top := ARect.Top + ABaseTop;
    ARect.Bottom := ARect.Bottom + ABaseTop;

    //------------------
    if AIconButtonState = ibClear then
      ACanvas.Pen.Color := ADefaultColor
    else if AIconButtonState = ibDown then
      ACanvas.Pen.Color := AShadownColor
    else
      ACanvas.Pen.Color := ALightColor;
    
    ACanvas.MoveTo(ARect.Left, ARect.Top + 1);
    ACanvas.LineTo(ARect.Left, ARect.Bottom - 1);
    
    ACanvas.MoveTo(ARect.Left + 1, ARect.Top);
    ACanvas.LineTo(ARect.Right - 1, ARect.Top);
    
    //------------------
    //------------------
    if AIconButtonState = ibClear then
      ACanvas.Pen.Color := ADefaultColor
    else if AIconButtonState = ibDown then
      ACanvas.Pen.Color := ALightColor
    else
      ACanvas.Pen.Color := AShadownColor;

    ACanvas.MoveTo(ARect.Right - 1, ARect.Top + 1);
    ACanvas.LineTo(ARect.Right - 1, ARect.Bottom  - 1);
    
    ACanvas.MoveTo(ARect.Right - 2, ARect.Bottom  - 1);
    ACanvas.LineTo(ARect.Left, ARect.Bottom - 1);
end;

//------------------------------------------------------------------------------
function GetSamllBitmap(AFileName: String; ANewWidth, ANewHeight: Integer; AKeepScale: Boolean = False): TBitmap;
var
  Picture: TPicture;
  Bitmap1,
  Bitmap2: TBitmap;

  Rect2: TRect;
  PngObject: TPngObject;
  BMP: TBitmap;
begin
  Result := nil;
  
  Picture := TPicture.Create;
  Bitmap1 := TBitmap.Create;
  Bitmap2 := TBitmap.Create;
  Bitmap2.SetSize(ANewWidth, ANewHeight);
  if not FileExists(AFileName) then
  begin
    Result := TBitmap.Create;
    Exit;
  end;
  try
    try
      if AnsiSameText(ExtractFileExt(AFileName), '.png') then
      begin
        PngObject := TPngObject.Create;
        try
          PngObject.LoadFromFile(AFileName);
          Bitmap1.Assign(PngObject);
        finally
          PngObject.Free;
        end;
      end
      else
      begin
        Picture.LoadFromFile(AFileName);
        Bitmap1.Assign(Picture.Graphic);
      end;

      if (Bitmap1.Width < ANewWidth) and (Bitmap1.Height < ANewHeight) and (AKeepScale) then
      begin
        Bitmap2.Assign(Bitmap1);
        Result := Bitmap2;
        Exit;
      end;
    except
      exit;
    end;

    if not AKeepScale then
    begin
      Rect2.Left := 0;
      Rect2.Top := 0;
      Rect2.Right := ANewWidth;
      Rect2.Bottom := ANewHeight;
    end
    else
    begin
      if Bitmap1.Width > Bitmap1.Height then
      begin
        Rect2.Left := 0;
        Rect2.Right := ANewWidth;
        Rect2.Bottom := Round(ANewWidth * (Bitmap1.Height / Bitmap1.Width));
        Rect2.Top := (ANewHeight - Rect2.Bottom) div 2;
        Rect2.Bottom := Rect2.Bottom + Rect2.Top;
      end
      else
      begin
        Rect2.Top := 0;
        Rect2.Bottom := ANewHeight;
        Rect2.Right := Round(ANewHeight * (Bitmap1.Width / Bitmap1.Height));
        Rect2.Left := (ANewWidth - Rect2.Right) div 2;
        Rect2.Right := Rect2.Right + Rect2.Left;
      end
    end;

    Bitmap2.Canvas.FillRect(Rect2);
    Bitmap2.Canvas.StretchDraw(Rect2, Bitmap1);
    Result := Bitmap2;
  finally
    if Result = nil then Bitmap2.Free;
    
    Bitmap1.Free;
    Picture.Free;
  end;
end;

//------------------------------------------------------------------------------
procedure AnimateShowBitmap(SrcBMP: TBitmap; DestBMP: TBitmap);
var
  iLoop: Integer;
  TempBitmap1,
  TempBitmap2: TBitmap;
begin
  TempBitmap1 := TBitmap.Create;
  TempBitmap2 := TBitmap.Create;
  try
    TempBitmap1.Assign(SrcBMP);

    TempBitmap2.SetSize(DestBMP.Width, DestBMP.Height);
    TempBitmap2.Canvas.StretchDraw(Rect(0, 0, DestBMP.Width, DestBMP.Height),
                                  TempBitmap1);
    for iLoop := 0 to TempBitmap2.Height - 1 do
    begin
      if (DestBMP = nil) or (SrcBMP = nil) then Exit;
      
      DestBMP.Canvas.CopyRect(Rect(0, iLoop, TempBitmap2.Width, iLoop + 1),
                              TempBitmap2.Canvas,
                              Rect(0, iLoop, TempBitmap2.Width, iLoop + 1));
      Sleep(5);
    end;
  finally
    TempBitmap2.free;
    TempBitmap1.free;
  end;
end;

//------------------------------------------------------------------------------
 function GetRegionFromBitmap(StartX, StartY: Integer; DestBitmap:TBitmap; TransparentColor: TColor): HRGN;
 var
  Region1,
  Region2 :HRGN;
  
  X, Y, ScanlineBytes: Integer;
  P: PRGBTripleArray;
begin
  Region1 := CreateRectRgn(StartX, StartY, StartX, StartY);
  if not DestBitmap.Empty then
  begin
    P := DestBitmap.ScanLine[0];

    ScanlineBytes := Integer(DestBitmap.ScanLine[1]) - Integer(DestBitmap.ScanLine[0]);
    for Y := 0 to DestBitmap.Height - 1 do
    begin
      for X := 0 to DestBitmap.Width - 1 do
      begin
        if TransparentColor = p[X].rgbtBlue * 256 * 256 + p[X].rgbtGreen * 256 + p[X].rgbtBlue then continue;

        Region2 := CreateRectRgn(StartX + X, StartY + Y, StartX + X + 1, StartY + Y + 1);
        CombineRgn(Region1, Region1, Region2, RGN_OR);
        DeleteObject(Region2);
      end;
      Inc(Integer(P), ScanlineBytes);
    end;
    
  end;
  Result := Region1;
end;

//------------------------------------------------------------------------------
{将Bitmap转换为RTF格式}
function ConvertBitmapToRTF(const Bitmap: TBitmap): string;
var
  bi, bb: string;
  bis, bbs: Cardinal;
  achar: string[2];
  Buffer: string;
  I: Integer;
type
  PWord = ^Word;
begin
  GetDIBSizes(Bitmap.Handle, bis, bbs);
  SetLength(bi, bis);
  SetLength(bb, bbs);
  GetDIB(Bitmap.Handle, Bitmap.Palette, PChar(bi)^, PChar(bb)^);
  SetLength(Buffer, (Length(bb) + Length(bi)) * 2);
  i := 1;
  for bis := 1 to Length(bi) do
  begin
    achar := IntToHex(Integer(bi[bis]), 2);
    PWord(@Buffer[i])^ := PWord(@achar[1])^;
    inc(i, 2);
  end;
  for bbs := 1 to Length(bb) do
  begin
    achar := IntToHex(Integer(bb[bbs]), 2);
    PWord(@Buffer[i])^ := PWord(@achar[1])^;
    inc(i, 2);
  end;
  Result := '{\rtf1 {\pict\dibitmap ' + Buffer + ' }}';
end;

//------------------------------------------------------------------------------
{改变Bitmap的饱和度}
procedure ConvertBitmapToSaturation(DestBitmap:TBitmap;FSaturationAdd:Integer);
var
   x, y, ScanlineBytes: integer;
   p: prgbtriplearray;
   RVALUE, bvalue, gvalue: integer;
   hVALUE, sVALUE, lVALUE: Double;
begin
   if not DestBitmap.Empty then
   begin
    DestBitmap.PixelFormat:=pf24bit;
    p := DestBitmap.ScanLine[0];
    ScanlineBytes := integer(DestBitmap.ScanLine[1]) - integer(DestBitmap.ScanLine[0]);
    for y := 0 to DestBitmap.Height - 1 do
    begin
      for x := 0 to DestBitmap.Width - 1 do
      begin
        RVALUE := p[x].rgbtRed;
        gVALUE := p[x].rgbtGreen;
        bVALUE := p[x].rgbtBlue;
        RGBtoHSL(RVALUE, gVALUE, bVALUE, hVALUE, sVALUE, lVALUE);
        sVALUE := min(100, sVALUE + FSaturationAdd);
        HSLtorgb(hVALUE, sVALUE, lVALUE, rVALUE, gVALUE, bVALUE);
        p[x].rgbtRed := RVALUE;
        p[x].rgbtGreen := gVALUE;
        p[x].rgbtBlue := bVALUE;
      end;
      inc(integer(p), ScanlineBytes);
    end;
  end;
end;


//------------------------------------------------------------------------------
{改变Bitmap的色调}
procedure ConvertBitmapToColor(DestBitmap:TBitmap;DestColor:TColor);
var
   hexString:String;
   x, y, ScanlineBytes: integer;
   p: prgbtriplearray;
   RVALUE, bvalue, gvalue: integer;
   hVALUE, sVALUE, lVALUE: Double;
   hNewVALUE, sNewVALUE, lNewVALUE  : Double;
begin
  if not DestBitmap.Empty then
  begin
    hexString:=IntToHex(DestColor,6);
    RGBtoHSL(StrToInt('$'+Copy(hexString,5,2)), StrToInt('$'+Copy(hexString,3,2)), StrToInt('$'+Copy(hexString,1,2)), hNewVALUE, sNewVALUE, lNewVALUE);

    DestBitmap.PixelFormat:=pf24bit;
    p := DestBitmap.ScanLine[0];
    ScanlineBytes := integer(DestBitmap.ScanLine[1]) - integer(DestBitmap.ScanLine[0]);
    for y := 0 to DestBitmap.Height - 1 do
    begin
      for x := 0 to DestBitmap.Width - 1 do
      begin
        RVALUE := p[x].rgbtRed;
        gVALUE := p[x].rgbtGreen;
        bVALUE := p[x].rgbtBlue;
        RGBtoHSL(RVALUE, gVALUE, bVALUE, hVALUE, sVALUE, lVALUE);
        HSLtoRGB(hNewVALUE, sNewVALUE, lVALUE, rVALUE, gVALUE, bVALUE);
        p[x].rgbtRed := RVALUE;
        p[x].rgbtGreen := gVALUE;
        p[x].rgbtBlue := bVALUE;
      end;
      inc(integer(p), ScanlineBytes);
    end;
  end;
end;

//------------------------------------------------------------------------------
{改变Color的色调}
function ConvertColorToColor(SourceColor: TColor; DestColor: TColor): TColor;
var
   hexString:String;
   hNewVALUE, sNewVALUE, lNewVALUE  : Double;
   RVALUE, bvalue, gvalue: integer;
   hVALUE, sVALUE, lVALUE: Double;
begin
  hexString:=IntToHex(DestColor,6);
  RGBtoHSL(StrToInt('$'+Copy(hexString,5,2)), StrToInt('$'+Copy(hexString,3,2)), StrToInt('$'+Copy(hexString,1,2)), hNewVALUE, sNewVALUE, lNewVALUE);

  rVALUE := StrToInt('$'+Copy(IntToHex(SourceColor,6),5,2));
  gVALUE := StrToInt('$'+Copy(IntToHex(SourceColor,6),3,2));
  bVALUE := StrToInt('$'+Copy(IntToHex(SourceColor,6),1,2));
  
  RGBtoHSL(rVALUE, gVALUE, bVALUE, hVALUE, sVALUE, lVALUE);
  HSLtoRGB(hNewVALUE, sNewVALUE, lVALUE, rVALUE, gVALUE, bVALUE);
  Result := TColor( StrToInt('$' + IntToHex(bVALUE,2) + IntToHex(gVALUE,2) + IntToHex(rVALUE,2)) );
end;

//------------------------------------------------------------------------------
{hsl颜色空间到rgb空间的转换}
procedure HSLtoRGB(H, S, L: Double; var R, G, B: Integer);
var //类似于返回多个值的函数
   Sat, Lum: Double;
begin
   R := 0;
   G := 0;
   B := 0;
   if (H < 360) and (H >= 0) and (S <= 100) and (S >= 0) and (L <= 100) and (L
      >=
      0) then
      begin
         if H <= 60 then
            begin
               R := 255;
               G := Round((255 / 60) * H);
               B := 0;
            end
         else if H <= 120 then
            begin
               R := Round(255 - (255 / 60) * (H - 60));
               G := 255;
               B := 0;
            end
         else if H <= 180 then
            begin
               R := 0;
               G := 255;
               B := Round((255 / 60) * (H - 120));
            end
         else if H <= 240 then
            begin
               R := 0;
               G := Round(255 - (255 / 60) * (H - 180));
               B := 255;
            end
         else if H <= 300 then
            begin
               R := Round((255 / 60) * (H - 240));
               G := 0;
               B := 255;
            end
         else if H < 360 then
            begin
               R := 255;
               G := 0;
               B := Round(255 - (255 / 60) * (H - 300));
            end;

         Sat := Abs((S - 100) / 100);
         R := Round(R - ((R - 128) * Sat));
         G := Round(G - ((G - 128) * Sat));
         B := Round(B - ((B - 128) * Sat));

         Lum := (L - 50) / 50;
         if Lum > 0 then
            begin
               R := Round(R + ((255 - R) * Lum));
               G := Round(G + ((255 - G) * Lum));
               B := Round(B + ((255 - B) * Lum));
            end
         else if Lum < 0 then
            begin
               R := Round(R + (R * Lum));
               G := Round(G + (G * Lum));
               B := Round(B + (B * Lum));
            end;
      end;
end;

//------------------------------------------------------------------------------
{RGB空间到HSL空间的转换}
procedure RGBtoHSL(R, G, B: Integer; var H, S, L: Double);
var
   Delta: Double;
   CMax, CMin: Double;
   Red, Green, Blue, Hue, Sat, Lum: Double;
begin
   Red := R / 255;
   Green := G / 255;
   Blue := B / 255;
   CMax := Max(Red, Max(Green, Blue));
   CMin := Min(Red, Min(Green, Blue));
   Lum := (CMax + CMin) / 2;
   if CMax = CMin then
      begin
         Sat := 0;
         Hue := 0;
      end
   else
      begin
         if Lum < 0.5 then
            Sat := (CMax - CMin) / (CMax + CMin)
         else
            Sat := (cmax - cmin) / (2 - cmax - cmin);
         delta := CMax - CMin;
         if Red = CMax then
            Hue := (Green - Blue) / Delta
         else if Green = CMax then
            Hue := 2 + (Blue - Red) / Delta
         else
            Hue := 4.0 + (Red - Green) / Delta;
         Hue := Hue / 6;
         if Hue < 0 then
            Hue := Hue + 1;
      end;
   H := (Hue * 360);
   S := (Sat * 100);
   L := (Lum * 100);
end;

//------------------------------------------------------------------------------
procedure Grayscale(Const Bitmap:TBitmap);
var
  X: Integer;
  Y: Integer;
  PRGB: pRGBTriple;
  Gray: Byte;
begin
  Bitmap.HandleType:=bmDIB;
  Bitmap.PixelFormat:=pf24bit;
  for Y := 0 to (Bitmap.Height - 1) do
  begin
    PRGB := Bitmap.ScanLine[Y];
    for X := 0 to (Bitmap.Width - 1) do
    begin
      Gray := (77 * PRGB^.rgbtRed + 151 * PRGB^.rgbtGreen + 28 * PRGB^.rgbtBlue) shr 8;
      PRGB^.rgbtRed:=Gray;
      PRGB^.rgbtGreen:=Gray;
      PRGB^.rgbtBlue:=Gray;
      Inc(PRGB);
    end;
  end;
end;

//------------------------------------------------------------------------------
procedure PrintBitmap(ACanvas: TCanvas; Dest: TRect; Bitmap: TBitmap);
var
    Info : PBitmapInfo;
    InfoSize : DWORD;
    Image : Pointer;
{$ifdef ver80}
    ImageSize : Longint;
{$else}
    ImageSize : DWord;
{$endif}
begin
    with Bitmap do
    begin
      GetDIBSizes(Handle, InfoSize, ImageSize);
      Info := AllocMem(InfoSize);
      try
        Image := AllocMem(ImageSize);
        try
          GetDIB(Handle, Palette, Info^, Image^);
          if not Monochrome then
            SetStretchBltMode(ACanvas.Handle, STRETCH_DELETESCANS);
          with Info^.bmiHeader do
            StretchDIBits(aCanvas.Handle, Dest.Left, Dest.Top,
              Dest.RIght - Dest.Left, Dest.Bottom - Dest.Top,
              0, 0, biWidth, biHeight, Image, Info^, DIB_RGB_COLORS, SRCCOPY);
        finally
          FreeMem(Image, ImageSize);
        end;
      finally
        FreeMem(Info, InfoSize);
      end;
    end;
end;

//------------------------------------------------------------------------------
procedure SmoothAverage(SrcBitmap: TBitmap; TargetBitmap: TBitmap; iBlockLen: Integer);
var
  iXStart,
  iYStart,
  iXEnd,
  iYEnd,
  iNum,
  iFirstR,
  iFirstG,
  iFirstB,
  iCurrR,
  iCurrG,
  iCurrB,
  x,
  y,
  ny,
  nx,
  iy,
  ix: Integer;
 
  pPixel,
  pUp,
  pDown,
  pWrite,
  pLeftRight: PRGBTripleArray;

  OldBitmap: TBitmap;
  DestBitmap: TBitmap;
  
  R,SR: TRect;

  StartTicket: Cardinal;
begin
  DestBitmap := TBitmap.Create;
  DestBitmap.PixelFormat:=pf24bit;
  DestBitmap.Width := SrcBitmap.Width + iBlockLen * 2;
  DestBitmap.Height := SrcBitmap.Height + iBlockLen * 2;

  OldBitmap := TBitmap.Create;
  OldBitmap.PixelFormat:=pf24bit;
  OldBitmap.Width := SrcBitmap.Width + iBlockLen * 2;
  OldBitmap.Height := SrcBitmap.Height + iBlockLen * 2;

  SR.Left := 0;
  SR.Top := 0;
  SR.Right := SrcBitmap.Width;
  SR.Bottom := SrcBitmap.Height;
  
  R.Left := iBlockLen;
  R.Top := iBlockLen;
  R.Right := OldBitmap.Width - iBlockLen;
  R.Bottom := OldBitmap.Height - iBlockLen;
  OldBitmap.Canvas.CopyRect(R, SrcBitmap.Canvas, SR);

  iNum := iBlockLen * iBlockLen;

  iXStart := iBlockLen div 2; // 左上角的起始位置
  iYStart := iXStart;
  
  iXEnd := DestBitmap.Width - iBlockLen ;	// X结束位置
  iYEnd := DestBitmap.Height - iBlockLen ;	// Y结束位置

  iFirstR := 0;
  iFirstG := 0;
  iFirstB := 0; // 每行第一子块RGB和

  for y := 0 to iYEnd do
  begin
    if (y = 0) then // 计算第一个块 (左上角)
    begin
      for ny := 0 to iBlockLen - 1 do
			begin
        pPixel := OldBitmap.ScanLine[ny];
        for nx := 0 to iBlockLen - 1 do
        begin
          Inc(iFirstB, pPixel[nx].rgbtBlue);
          Inc(iFirstG, pPixel[nx].rgbtGreen);
          Inc(iFirstR, pPixel[nx].rgbtRed);
        end;
      end;
    end
    else // y方向下移块
    begin
      pUp := OldBitmap.ScanLine[y - 1];
      pDown := OldBitmap.ScanLine[y - 1 + iBlockLen];
      for nx := 0 to iBlockLen - 1 do
      begin
        iFirstB := iFirstB - pUp[nx].rgbtBlue + pDown[nx].rgbtBlue;
        iFirstG := iFirstG - pUp[nx].rgbtGreen + pDown[nx].rgbtGreen ;
        iFirstR := iFirstR - pUp[nx].rgbtRed + pDown[nx].rgbtRed;
      end;
    end;

    // 设置每行第一个象素
    pWrite := DestBitmap.ScanLine[y + iYStart];
    ix := iXStart;

    pWrite[ix].rgbtBlue := Round(iFirstB / iNum);
    pWrite[ix].rgbtGreen := Round(iFirstG / iNum);
    pWrite[ix].rgbtRed := Round(iFirstR / iNum);
    Inc(ix);
    
    // x方向推移块
    iCurrR := iFirstR;
    iCurrG := iFirstG;
    iCurrB := iFirstB;

    for x := 1 to iXEnd do
    begin
      // 减左列加右列
      for iy := 0 to iBlockLen - 1 do
			begin
        pLeftRight := OldBitmap.ScanLine[y + iy];
        iCurrB := iCurrB - pLeftRight[x - 1].rgbtBlue + pLeftRight[x + iBlockLen - 1].rgbtBlue;
        iCurrG := iCurrG - pLeftRight[x - 1].rgbtGreen + pLeftRight[x + iBlockLen - 1].rgbtGreen;
        iCurrR := iCurrR - pLeftRight[x - 1].rgbtRed + pLeftRight[x + iBlockLen - 1].rgbtRed;
			end;

      // 设置象素值
      pWrite[ix].rgbtBlue := Round(iCurrB / iNum);
      pWrite[ix].rgbtGreen := Round(iCurrG / iNum);
      pWrite[ix].rgbtRed := Round(iCurrR / iNum);
      Inc(ix);
    end;
  end;

  SR.Left := 0;
  SR.Top := 0;
  SR.Right := SrcBitmap.Width;
  SR.Bottom := SrcBitmap.Height;
  
  R.Left := iBlockLen;
  R.Top := iBlockLen;
  R.Right := OldBitmap.Width - iBlockLen;
  R.Bottom := OldBitmap.Height - iBlockLen;
  TargetBitmap.Canvas.CopyRect(SR, DestBitmap.Canvas, R);
end;

end.