Delphi图像处理 -- 填充浮雕效果

这个填充浮雕效果过程代码已经完成好几天了，但是一直没敢在BLOG上发表，因为这是我在研究Photoshop浮雕效果做实验时，无意中写的一段代码，当时就感觉这个效果虽然不是我想要的Photoshop浮雕效果，但比Photoshop浮雕效果的应用价值应该不会差，可以说是各有特色。只是当时感觉处理速度较慢，同时顾虑该浮雕效果是我妙想天开，发表后会不会有引起嘲笑。经过了几天的改进和原理论证，我觉得该浮雕效果从原理上是说得通的，而改进后的速度一般情况下比彩色浮雕处理快，在浮雕深度较小（< 8）的时候，比灰色浮雕处理还快，所以还是决定发表在这里，供大家讨论其实用性，或给出改进意见。至于这种浮雕效果的名称，刚开始时因其效果类似石雕，准备取名石雕效果，经改进后，可用任何颜色或者图案进行填充浮雕画面，所以取名填充浮雕效果。

下面先给出浮雕过程处理代码：

过程定义：

  // 图案填充浮雕。Angle 角度, Size 长度, FillData 填充图像数据结构
  procedure ImageTextureSculpture(var Data: TImageData; Angle: Single;
    Size: LongWord; FillData: TImageData); overload;
  // 图案填充浮雕。Angle 角度, Size 长度, FillGraph 填充图像
  procedure ImageTextureSculpture(var Data: TImageData; Angle: Single;
    Size: LongWord; const FillGraph: TGraphic); overload;
  // 实填充浮雕。Angle 角度, Size 长度, Color 填充色
  procedure ImageSolidSculpture(var Data: TImageData; Angle: Single;
    Size: LongWord; Color: LongWord = $FF808080);

实现代码：

procedure GetBilinearGray;
asm
    push      esi
    push      edx
    push      ecx
    mov       esi, ecx
    sar       esi, 8
    imul      esi, [ebx].TImageData.Stride
    mov       eax, edx
    sar       eax, 8
    shl       eax, 2
    add       esi, eax
    add       esi, [ebx].TImageData.Scan0
    and       edx, 255
    and       ecx, 255
    mov       eax, BilinearTable
    movq      mm0, [esi]
    add       esi, [ebx].TImageData.Stride
    movq      mm1, [esi]
    pand      mm0, mm7         // mm0 = Gray2(x0+1,y0)   Gray0(x0,y0)
    pand      mm1, mm7         // mm1 = Gray3(x0+1,y0+1) Gray1(x0,y0+1)
    psllq     mm1, 16
    por       mm0, mm1         // mm0 = Gray3 Gray2 Gray1 Gray0
    movq      mm2, [eax+edx*8]
    pmullw    mm2, [eax+ecx*8+256*8] // mm2 = 00 m3 00 m2 00 m1 00 m0
    psrlw     mm2, 1           // 先除以2，否则后面的word有符号乘法会扩展符号位
    pmaddwd   mm0, mm2         // mm0 = Gray3*m3+Gray2*m2 Gray1*m1+Gray0*m0
    movq      mm1, mm0
    psrlq     mm1, 32          // mm1 = 00 00 00 00       Gray3*m3+Gray2*m2
    paddd     mm0, mm1         // mm0 = Gray3*m3+Gray2*m2+Gray1*m1+Gray0*m0
    psrld     mm0, 15          // mm0 /= 0x8000
    movd      eax, mm0
    pop       ecx
    pop       edx
    pop       esi
end;

procedure ImageFillSculpture(var Data: TImageData; Angle: Single; Size: LongWord;
  Color: LongWord; FillData: PImageData);
var
  Radius: Integer;
  Width, Height: Integer;
  xDelta, yDelta: Integer;
  xSize, ySize: Integer;
  dstOffset: Integer;
  Src: TImageData;

  procedure CheckFillData(FillData: PImageData);
  asm
    bsr     ecx, [eax]
    xor     edx, edx
    bts     edx, ecx
    dec     edx
    mov     [eax], edx
    bsr     ecx, [eax + 4]
    xor     edx, edx
    bts     edx, ecx
    dec     edx
    mov     [eax + 4], edx
  end;

  procedure FillSculpture;
  asm
    push      esi
    push      edi
    push      ebx
    pxor      mm6, mm6        // mm6 = 00 00 00 00 00 00 00 00
    mov       edx, 0ffh
    movd      mm7, edx
    punpckldq mm7, mm7        // mm7 = 00 00 00 ff 00 00 00 ff
    mov       edi, Data
		mov		    edi, [edi].TImageData.Scan0
    lea		    ebx, Src        // ebx = &Src, edi = Data.Scan0
		mov		    ecx, Radius     // for (y = Radius; y < Height; y += 256)
	@yLoop:                     // {
		mov 	    edx, Radius     //   for (x = Radius; x < Width; x += 256)
	@xLoop:                     //   {
    push      edi
    push      edx
    push      ecx
    xor       edi, edi        //     Grays = 0
    sub       ecx, ySize
    sub       edx, xSize      //     x0 = x - xSize, y0 = y - ySize
    mov       esi, Size       //     for (i = Size; i > 0; i --)
  @SumLoop:                   //     {
    call      GetBilinearGray //       Grays += GetBilinearGray(ebx, x0, y0)
    add       edi, eax
    add       ecx, yDelta
    add       edx, xDelta     //       x0 += xDelta, y0 += yDelta
    dec       esi
    jnz       @SumLoop        //     }
    call      GetBilinearGray //     Gray1 = GetBilinearGray(ebx, x1, y1)
    xchg      eax, edi
    cdq
    div       dword ptr Size
    sub       eax, edi        //     Grays = Grays / Size - Gray1
    movd      mm0, eax
    punpcklwd mm0, mm0
    punpcklwd mm0, mm0        //     mm0 = Grays Grays Grays Grays
    pop       ecx
    pop       edx
    cmp		    dword ptr FillData, 0
    je        @@1             //     if (FillData != NULL)
    mov       edi, FillData   //     {
    mov       esi, ecx        //       esi = FillData.Scan0 +
    mov       eax, edx        //         ((y >> 8) & FillData.Height) *
    shr       esi, 8          //         FillData.Stride +
    shr       eax, 8          //         ((x >> 8) & FillData.Width) * 4
    and       esi, [edi].TImageData.Height
    and       eax, [edi].TImageData.Width
    imul      esi, [edi].TImageData.Stride
    add       esi, [edi].TImageData.Scan0
    shl       eax, 2
    add       esi, eax
    movd      mm1, [esi]      //       mm1 = *esi
    jmp       @@2             //     }
  @@1:
    movd      mm1, Color      //     else mm1 = Color
  @@2:
    punpcklbw mm1, mm6        //     mm1 = 00 A 00 R 00 G 00 B
    paddsw    mm0, mm1        //     mm0 = Grays+A Grays+R Grays+G Grays+B
    packuswb  mm0, mm6        //     mm0 word --> byte
    pop       edi
    mov       al, [edi].TARGBQuad.Alpha
    movd      [edi], mm0      //     *edi = mm0
    mov       [edi].TARGBQuad.Alpha, al
    add       edi, 4          //     edi += 4
		add		    edx, 256
    cmp       edx, Width
    jl        @xLoop          //   }
    add       ecx, 256
    add       edi, dstOffset
    cmp       ecx, Height
    jl        @yLoop          // }
    emms
    pop       ebx
    pop       edi
    pop       esi
  end;

begin
  if Size = 0 then Size := 1;
  Radius := (Size + 1) shr 1;        // 图像边框扩展半径
  Angle := PI * Angle / 180;
  xDelta := Round(Cos(Angle) * 256);
  yDelta := Round(Sin(Angle) * 256);
  xSize := xDelta * (Size shr 1);
  ySize := yDelta * (Size shr 1);
  dstOffset := Data.Stride - (Data.Width shl 2);
  if FillData <> nil then
    CheckFillData(FillData);
  Src := GetExpandData(Data, Radius);
  try
    Radius := Radius shl 8;
    Width := (Data.Width shl 8) + Radius;
    Height := (Data.Height shl 8) + Radius;
    ImageGray(Src);
    FillSculpture;
  finally
    FreeImageData(Src);
  end;
end;

procedure ImageTextureSculpture(var Data: TImageData; Angle: Single;
  Size: LongWord; FillData: TImageData);
begin
  ImageFillSculpture(Data, Angle, Size, $FF808080, @FillData);
end;

procedure ImageTextureSculpture(var Data: TImageData; Angle: Single;
    Size: LongWord; const FillGraph: TGraphic);
var
  FillData: TImageData;
begin
  FillData := GetImageData(FillGraph);
  ImageFillSculpture(Data, Angle, Size, $FF808080, @FillData);
  FreeImageData(FillData);
end;

procedure ImageSolidSculpture(var Data: TImageData; Angle: Single;
  Size, Color: LongWord);
begin
  ImageFillSculpture(Data, Angle, Size, Color, nil);
end;

代码中所用到的变量BilinearTable见《Delphi图像处理 -- 图像像素结构与图像数据转换》，ImageGray过程在《Delphi图像处理 -- 图像的灰度化、二值化及反色》。

从处理流程看，填充浮雕和彩色浮雕、灰色浮雕是一样的，但在像素处理上是不相同的。下面是用一个用45度角，2像素深度浮雕差值计算矩阵图来说明几种浮雕效果像素处理的差异

各矩阵中，中间的点可以看作为要处理的像素。

灰度浮雕固定地取左上角点和右下角的差值加上128背景值 (无论深度多大，都是如此，只是矩阵中间的0多少的问题)，如此一来，差异小的像素趋向于背景色，差异大的像素形成“黑白分明”的阴线和阳线，这就成了灰色的浮雕效果，浮雕深度越大，“黑白分明”的效果就越明显，当深度达到一个比较大的值时，画面上会形成加强了的正、负片以及图像原色彩3层画面的共存状态；

彩色浮雕也是固定的取邻近3个点的值减去2倍右下角点的值，由于被减的点数大于减的点数，在雕刻阴影形成时保留了很大的亮度，这就相当于给各像素加了一个不固定的背景值，所以形成彩色浮雕效果；

而填充浮雕的则是取主对角线除右下角外的各点之和的平均值，减去右下角点的值，再加上填充背景色，在背景色固定的前提下（假定128），会形成类似灰度浮雕的效果，但是由于是取主对角线除右下角外的各点之和的平均值，就相当于先对像素点做了一定的表面模糊后再减去右下角点的值，所以，当雕刻深度增大时，不会形成明显的“黑白分明”效应，而是有一定的模糊过渡带，即类似阴影的半影调。

下面是以45度角，深度为10，背景色128的灰度浮雕和填充浮雕效果比较图：

左上角是原图，左下角是灰度浮雕效果图，右上角是填充浮雕效果图，因为填充浮雕在浮雕效果处理前对原图作了灰度处理，为便于比较，所以右下角是灰度化后的灰色浮雕效果图。

从比较图上可以看出，当浮雕深度较大时，无论是否去色，灰度浮雕效果的阳线带和阴线带都很明显，而填充浮雕则存在过渡半影调，所以，看起来有石雕的效果。另外，从灰色背景上看，填充浮雕效果明显的平坦于灰色浮雕效果，这是因为填充浮雕处理有一定的表面模糊作用的缘故。

填充浮雕可以以任意颜色和图案作为背景填充，这就使得填充浮雕过程能产生各种效果的浮雕图，为了便于使用，我把填充浮雕过程写成了2个过程，分别用来处理实色填充和图案填充。对于图案填充所用的图片大小，最好是2的幂次方，因为为了避免作除法运算，加快处理过程，代码对填充图片大小作了2的幂次方处理，这样一来，有可能破坏填充图案的衔接。

下面先对实色填充作几个图片处理测试：

测试代码（仿玉石浮雕效果）：

var
  Data: TImageData;
begin
  Data := GetImageData(TGpBitmap.Create('d:\56-3.jpg'), True);
  ImageSolidSculpture(Data, 45, 5, $AEC0C8);
  DrawImage(Canvas, 0, 0, Data);
  FreeImageData(Data);
end;

例子中的DrawImage过程见《Delphi图像处理 -- 图像显示》。

效果图如下，上面是原图，下面左边是45度，深度为5的浮雕效果，下面右边是45度，深度为10的浮雕效果。

原图:

你是否觉得象玉石浮雕？特别是右边图中那些重叠着的叶片， 真有着一种晶莹剔透的感觉！

下面是以角度30，深度8，填充颜色为$A5140A的仿玛瑙色浮雕效果图，测试代码就不贴了：

下面是使用4种不同填充图案调用ImageTextureSculpture过程分别形成的浮雕效果图（原图在文章前面），角度50，浮雕深度从左上角开始，依次是8，6，5，7：

通过几天的研究和测试，发现浮雕角度、深度和填充色（图案）的选择，应根据图片的实际情况确定，如上图中，左上角的填充图案颜色较深、较杂，这就需要把浮雕深度用大一点，反之，如左下角就要相应小一点；图像较平淡的，不宜用很深的浮雕；浮雕角度与图像光照方向基本对应；填充颜色（图案）也应按图像具体选用，如前面的玉雕效果图，如果换成其它图片，效果不一定那么好，反过来也可以说，那张图用玛瑙色效果就差多了。

关于填充效果图的介绍就到此为止，欢迎朋友们提出改进意见。

最后重申一下，该效果确是本人无意中搞出来的，如果已经有类似的方法，纯属巧合，本人不和你争“专利权”了。

文章中使用GDI+版本下载地址和说明见《GDI+ for VCL基础 -- GDI+ 与 VCL》。

文章中所用数据类型及一些过程见《Delphi图像处理 -- 数据类型及内部过程》，《Delphi图像处理 -- 图像像素结构与图像数据转换》和《Delphi图像处理 -- 图像缩放》。

尽管我十分努力，但水平有限，错误在所难免，欢迎指正和指导。邮箱地址：

[e-mail]

注：本文章与2009.10.30重新整理。