特点：

1、真彩色图像转换为单色、16色、256色及16位(555和565)彩色图像；

2、可选的抖动仿色功能，使图像转换质量得到了很大提高；

3、转换256色索引图像时，使用16位映射表匹配调色板（可选），使转换速度得到了大幅度提高；

4、采用八叉树节点获取索引图像调色板时，使用了图像像素样本进行计算（可选），不仅提高了处理速度，而且也可使图像中的主色调（俗称流行色）更有机会进入调色板；

5、对索引图像，可输入任意的外部调色板进行匹配处理；

6、32位图像转索引图像时，可设置背景色，对原Alpha通道进行背景色填充。注意：在使用映射表匹配调色板时，颜色有可能发生微小变换，此时可取消映射表匹配调色板功能，好在此类图片一般不是很大，对处理速度影响不是很大。

下面是真彩色图像转低色彩图像类的全部代码：

unit IndexImage; (***************************************************************************** * * * TIndexImage: 真彩色图像转换为低色彩图像。 * * * * TIndexBitmap: TBitmap真彩色图像转换为低色彩图像。 * * * * TGpIndexBitmap: TGpBitmap真彩色图像转换为低色彩图像。 * * * * 编 制 人: 湖北省公安县统计局 毛泽发 2008.10 * * * *****************************************************************************) interface uses Windows, SysUtils, Graphics, ImageData; const MinSamplings = 1024; MaxSamplings = $7fffffff; type TIndexFormat = (if1Bit, if4Bit, if8Bit, if15Bit, if16Bit); PIndexColorArray = ^TIndexColorArray; TIndexColorArray = array[Byte] of TRGBQuad; PErrQuad = ^TErrQuad; TErrQuad = packed record Blue: SmallInt; Green: SmallInt; Red: SmallInt; Alpha: SmallInt; end; TSetDitherPixel = procedure(var Err: TErrQuad; PixelAddr: Pointer; x: Integer) of Object; PErrQuadArray = ^TErrQuadArray; TErrQuadArray = array[0..(MaxLongInt div 12) - 1] of TErrQuad; TIndexImage = class; TColorNode = class private FIsLeaf: Boolean; FPixelCount: LongWord; FRedSum: LongWord; FGreenSum: LongWord; FBlueSum: LongWord; FChild: array[0..7] of TColorNode; FNext: TColorNode; FData: TIndexImage; public constructor Create(Level: Integer; Tree: TIndexImage); destructor Destroy; override; procedure AddColor(PColor: PRGBQuad; Level: Integer); procedure GetPaletteColors(var Index: Integer); end; TIndexImage = class private FColorBits: Integer; FMaxColors: Integer; FLeafCount: Integer; FMinSamplingCount: Integer; FMonochromeThreshold: LongWord; FIndexFormat: TIndexFormat; FDithering: Boolean; FUseColorMap: Boolean; FSource: TImageData; FColorMap: PByteArray; FColors: PIndexColorArray; FNodes: array[0..8] of TColorNode; procedure CreateColorMap; procedure CreateIndexData1(var IndexData: TImageData); procedure CreateIndexData4(var IndexData: TImageData); procedure CreateIndexData8(var IndexData: TImageData); procedure CreateIndexData8_2(var IndexData: TImageData); procedure CreateIndexData15(var IndexData: TImageData); procedure CreateIndexData16(var IndexData: TImageData); procedure CreateSamplingData(Dest: TImageData); function GetColorCount: Integer; function GetColors: PIndexColorArray; function GetBitmap: HBitmap; function GetIndexColor(PColor: PRGBQuad): Integer; function GetPalette: HPalette; procedure SetBitmap(const Value: HBitmap); procedure SetDitherPixel1(var Err: TErrQuad; PixelAddr: Pointer; x: Integer); procedure SetDitherPixel4(var Err: TErrQuad; PixelAddr: Pointer; x: Integer); procedure SetDitherPixel8(var Err: TErrQuad; PixelAddr: Pointer; x: Integer); procedure SetDitherPixel8_2(var Err: TErrQuad; PixelAddr: Pointer; x: Integer); procedure SetDitherPixel15(var Err: TErrQuad; PixelAddr: Pointer; x: Integer); procedure SetDitherPixel16(var Err: TErrQuad; PixelAddr: Pointer; x: Integer); procedure SetFormat(const Value: TIndexFormat); procedure SetMinSamplingCount(const Value: Integer); procedure SetMonochromeThreshold(const Value: LongWord); procedure SetPalette(const Value: HPalette); procedure SetSourceData(const Value: TImageData); protected function CanIndex: Boolean; procedure CreateColors; procedure CreateDitherData(var IndexData: TImageData; SetPixelProc: TSetDitherPixel); procedure CreateIndexImageData(var IndexData: TImageData); procedure FillBackground(ColorBackground: LongWord); procedure ColorsChange; virtual; procedure ReduceTree; procedure SetColorCount(Count: Integer); property ColorBits: Integer read FColorBits; property MaxColorCount: Integer read FMaxColors; // 获取或设置数据源结构，注意：设置数据源是浅拷贝 property SourceData: TImageData read FSource write SetSourceData; public constructor Create; destructor Destroy; override; // 设置颜色表(可按给定颜色表匹配索引位图)。AColors=[]清除颜色表。 procedure SetColors(const AColors: array of TRGBQuad); // 获取按IndexFormat匹配的位图句柄，或者设置位图源句柄。不清除调色板颜色表 property Bitmap: HBitmap read GetBitmap write SetBitmap; // 获取调色板颜色的个数 property ColorCount: Integer read GetColorCount; // 获取调色板颜色表 property Colors: PIndexColorArray read GetColors; // 转换图像时是否抖动仿色，缺省为False property Dithering: Boolean read FDithering write FDithering; // 获取或设置索引图格式。设置格式将清除可能存在的调色板颜色表 property IndexFormat: TIndexFormat read FIndexFormat write SetFormat; // 转换单色图像时的阀值。缺省为128 property MonochromeThreshold: LongWord read FMonochromeThreshold write SetMonochromeThreshold; // 建立调色板的像素最小样本数(不得小于MinSamplings)，缺省为4096。 // 如果像素个数/100>=最小样本数，取图像尺寸1/10为样本，否则取>=4096的图像尺寸 property MinSamplingCount: Integer read FMinSamplingCount write SetMinSamplingCount; // 获取或设置调色板(可按给定调色板匹配索引位图)，Palette=0清除颜色表 property Palette: HPalette read GetPalette write SetPalette; // True: 使用16位颜色映射表匹配调色板转换8bit图像(4bit图像转换无映射表) // Flae: 直接匹配调色板，但匹配速度较慢。缺省为True。 property UseColorMap: Boolean read FUseColorMap write FUseColorMap; end; TIndexBitmap = class(TIndexImage) public // 获取按IndexFormat匹配的TBitmap对象 function GetIndexBitmap: TBitmap; // 设置源对象。ColorBackground为32位图像Alpha背景色，0不填充。不清除调色板颜色表 procedure SetSource(Bitmap: TBitmap; ColorBackground: TColor = 0); overload; procedure SetSource(Graphic: TGraphic; ColorBackground: TColor = 0); overload; end; TGpIndexBitmap = class(TIndexImage) private FPalette: PColorPalette; function GetPalette: PColorPalette; procedure SetPalette(const Value: PColorPalette); protected procedure ColorsChange; override; public // 获取按IndexFormat匹配的TGpBitmap对象 function GetIndexBitmap: TGpBitmap; // 设置源对象。ColorBackground为32位图像Alpha背景色，0不填充。不清除调色板颜色表 procedure SetSource(Bitmap: TGpBitmap; ColorBackground: TARGB = 0); // 获取或设置GDI+调色板(可按给定调色板匹配索引位图)，ColorPalette=nil清除颜色表 property ColorPalette: PColorPalette read GetPalette write SetPalette; end; implementation { TColorNode } procedure TColorNode.AddColor(PColor: PRGBQuad; Level: Integer); const mask: array[0..7] of Byte = ($80, $40, $20, $10, $08, $04, $02, $01); var Index, shift: Integer; begin if FIsLeaf then begin Inc(FPixelCount); Inc(FRedSum, PColor^.rgbRed); Inc(FGreenSum, PColor^.rgbGreen); Inc(FBlueSum, PColor^.rgbBlue); end else begin shift := 7 - Level; Index := (((PColor.rgbRed and mask[Level]) shr shift) shl 2) or (((PColor.rgbGreen and mask[Level]) shr shift) shl 1) or ((PColor.rgbBlue and mask[Level]) shr shift); Inc(Level); if not Assigned(FChild[Index]) then FChild[Index] := TColorNode.Create(Level, FData); FChild[Index].AddColor(PColor, Level); end; end; constructor TColorNode.Create(Level: Integer; Tree: TIndexImage); begin FData := Tree; FIsLeaf := Level = FData.FColorBits; if FIsLeaf then Inc(FData.FLeafCount) else begin FNext := FData.FNodes[Level]; FData.FNodes[Level] := Self; end; end; destructor TColorNode.Destroy; var I: Integer; begin for I := 0 to 7 do if Assigned(FChild[I]) then FChild[I].Free; end; procedure TColorNode.GetPaletteColors(var Index: Integer); var I: Integer; begin if FIsLeaf then begin FData.FColors[Index].rgbRed := FRedSum div FPixelCount; FData.FColors[Index].rgbGreen := FGreenSum div FPixelCount; FData.FColors[Index].rgbBlue := FBlueSum div FPixelCount; FData.FColors[Index].rgbReserved := 0; Inc(Index); end else begin for I := 0 to 7 do if Assigned(FChild[I]) then FChild[I].GetPaletteColors(Index); end; end; { TIndexImage } function TIndexImage.CanIndex: Boolean; begin Result := FSource.Scan0 <> nil; end; procedure TIndexImage.ColorsChange; begin end; constructor TIndexImage.Create; begin IndexFormat := if8bit; FMinSamplingCount := 4096; FMonochromeThreshold := 128; FUseColorMap := True; end; // 建立调色板颜色表 procedure TIndexImage.CreateColors; var Node: TColorNode; x, y, Index: Integer; Offset: Integer; P: PRGBQuad; Scale: Single; tmp: TImageData; begin if not CanIndex or (FLeafCount > 0) or (IndexFormat > if8Bit) then Exit; if IndexFormat = if1Bit then begin SetColorCount(2); LongWord(FColors[0]) := 0; LongWord(FColors[1]) := $FFFFFF; Exit; end; Node := TColorNode.Create(0, Self); try if (FSource.Width * FSource.Height div 100) >= FMinSamplingCount then Scale := 0.1 else begin Scale := 0.9; while (Trunc(FSource.Width * Scale * FSource.Height * Scale)) > FMinSamplingCount do Scale := Scale - 0.1; Scale := Scale + 0.1; end; if Scale < 1.0 then // 如果Source像素数量>MinSamplingCount，取样本数据 begin tmp := GetImageData(Round(Scale * FSource.Width), Round(Scale * FSource.Height)); CreateSamplingData(tmp); end else // 否则取原图像数据 tmp := GetImageData(FSource.Width, FSource.Height, FSource.Stride, FSource.Scan0); try P := tmp.Scan0; // 建立颜色八叉树 Offset := tmp.Stride - (tmp.Width shl 2); for y := 1 to tmp.Height do begin for x := 1 to tmp.Width do begin Node.AddColor(P, 0); while FLeafCount > FMaxColors do ReduceTree; Inc(P); end; Inc(Integer(P), Offset); end; finally FreeImageData(tmp); end; SetColorCount(FLeafCount); Index := 0; Node.GetPaletteColors(Index); // 获取调色板颜色表 finally Node.Free; end; end; // 根据调色板颜色表建立8位索引图像的16位颜色映射表 procedure TIndexImage.CreateColorMap; var r, g, b: Integer; Color: TRGBQuad; begin r := 32 * 32 * 32; GetMem(FColorMap, r); while r > 0 do begin Dec(r, 32 * 32); Color.rgbRed := r shr 7; g := 32 * 32; while g > 0 do begin Dec(g, 32); Color.rgbGreen := g shr 2; b := 32; while b > 0 do begin Dec(b); Color.rgbBlue := b shl 3; FColorMap[r or g or b] := GetIndexColor(@Color); end; end; end; end; procedure TIndexImage.CreateDitherData(var IndexData: TImageData; SetPixelProc: TSetDitherPixel); var PErrs, Errs0, Errs1: PErrQuadArray; Width: Integer; srcOffset, dstStride: Integer; this, dstScan0: Pointer; procedure FillErrs; asm push edi push ecx mov edi, Errs1 mov ecx, Width add ecx, ecx xor eax, eax rep stosd pop ecx pop edi end; asm push esi push edi push ebx mov this, eax push edx mov eax, [edx].TImageData.Stride mov dstStride, eax mov edx, [edx].TImageData.Width add edx, 2 shl edx, 3 + 1 // edx = (Dest.Width + 2) * Sizeof(TErrQuad) * 2 push edx mov eax, GMEM_MOVEABLE call GlobalAllocPtr mov PErrs, eax // PErrs = GlobalAllocPtr(GMEM_MOVEABLE, edx) add eax, 8 mov Errs0, eax // Errs0 = @PErrs[1] pop edx shr edx, 1 add eax, edx mov Errs1, eax // Errs1 = @PErrs[Dest.Width + 2 + 1] pop edx mov eax, this lea eax, [eax].TIndexImage.FSource call SetCopyRegs mov srcOffset, ebx mov dstScan0, esi mov esi, edi // esi = Source.Scan0 mov Width, ecx pxor mm7, mm7 mov ebx, 70007h movd mm6, ebx punpcklwd mm6, mm6 mov ebx, 50005h movd mm5, ebx punpcklwd mm5, mm5 mov ebx, 30003h movd mm4, ebx punpcklwd mm4, mm4 call FillErrs // FillErrs(Errs1, Dest.Width, 0) @yLoop: // for (y = 0; y < Height; y ++) mov ebx, Errs0 // { mov edi, Errs1 mov ecx, Width @readLoop: // for (x = 0; x < Width; x ++) movd mm0, [esi] // { punpcklbw mm0, mm7 // Errs0[x] = Errs1[x] + Source.Pixels[x, y] paddw mm0, [edi] // if (Errs0[x] < 0) packuswb mm0, mm7 // Errs[x] = 0 punpcklbw mm0, mm7 // else if (Errs0[x] > 255) movq [ebx], mm0 // Errs0[x] = 255 add esi, 4 // add edi, 8 add ebx, 8 loop @readLoop // } call FillErrs // FillErrs(Errs1, Dest.Width, 0) xor ecx, ecx push edx mov ebx, Errs0 mov edi, Errs1 @xLoop: // for (x = 0; x < Width; x ++) movq mm1, [ebx] // { push ecx // mm1 = Errs0[x] push ecx mov edx, ebx mov ecx, dstScan0 mov eax, this // SetPixelProc(Errs0[x], Dest.Scan0, x) call dword ptr SetPixelProc pop ecx // mm1 = currErr = SetPixelProc return value add ebx, 8 movq mm0, mm1 // Right: pmullw mm0, mm6 // Errs0[x+1] += (currErr * 7/16) psraw mm0, 4 // if (Errs0[x] < 0) Errs0[x] = 0 paddsw mm0, [ebx] // if (Errs0[x] > 255) Errs0[x] = 255 packuswb mm0, mm7 punpcklbw mm0, mm7 movq [ebx], mm0 movq mm0, mm1 // Bottom: pmullw mm0, mm5 // Errs1[x] += (currErr * 5/16) psraw mm0, 4 // if (Errs1[x] < 0) Errs1[x] = 0 paddsw mm0, [edi] // if (Errs1[x] > 255) Errs1[x] = 255 packuswb mm0, mm7 punpcklbw mm0, mm7 movq [edi], mm0 sub edi, 8 movq mm0, mm1 // Left Bottom: pmullw mm0, mm4 // Errs1[x-1] += (currErr * 3/16) psraw mm0, 4 // if (Errs1[x-1] < 0) Errs1[x-1] = 0 paddsw mm0, [edi] // if (Errs1[x-1] > 255) Errs1[x-1] = 255 packuswb mm0, mm7 punpcklbw mm0, mm7 movq [edi], mm0 add edi, 16 // Right Bottom: psraw mm1, 4 // Errs1[x+1] += (currErr * 1/16) paddsw mm1, [edi] // if (Errs1[x+1] < 0) Errs1[x+1] = 0 packuswb mm1, mm7 // if (Errs1[x+1] > 255) Errs1[x+1] = 255 punpcklbw mm1, mm7 movq [edi], mm1 inc ecx cmp ecx, Width jl @xLoop // } pop edx add esi, srcOffset // esi += srcOffset mov eax, dstStride add dstScan0, eax // dstScan0 += Dest.Stride dec edx jnz @yLoop // } emms mov eax, PErrs call GlobalFreePtr // GlobalFreePtr(PErrs) pop ebx pop edi pop esi end; procedure TIndexImage.CreateIndexData1(var IndexData: TImageData); var dstOffset, srcOffset, Height: Integer; procedure CopyPixel; asm mov eax, 8000h @PixelLoop: cmp [esi], bl jb @@1 or al, ah @@1: shr ah, 1 add esi, 4 loop @PixelLoop stosb end; asm push esi push edi push ebx push [eax].TIndexImage.FMonochromeThreshold lea eax, [eax].TIndexImage.FSource xchg eax, edx call SetCopyRegs mov dstOffset, ebx mov srcOffset, eax mov Height, edx mov edx, 7 and edx, ecx shr ecx, 3 pop ebx @yLoop: push ecx jecxz @@1 @xLoop: push ecx mov ecx, 8 call CopyPixel pop ecx loop @xLoop @@1: mov ecx, edx jecxz @@2 call CopyPixel @@2: pop ecx add esi, srcOffset add edi, dstOffset dec Height jnz @yLoop pop ebx pop edi pop esi end; procedure TIndexImage.CreateIndexData4(var IndexData: TImageData); var srcOffset, dstOffset, Width, Height: Integer; asm push esi push edi push ebx push eax lea eax, [eax].TIndexImage.FSource xchg eax, edx call SetCopyRegs mov srcOffset, eax mov dstOffset, ebx mov Height, edx mov Width, ecx shr ecx, 1 pop ebx @yLoop: push ecx jecxz @@1 @xLoop: push ecx mov edx, esi mov eax, ebx call GetIndexColor shl eax, 4 add esi, 4 push eax mov edx, esi mov eax, ebx call GetIndexColor pop ecx or eax, ecx stosb add esi, 4 pop ecx loop @xLoop @@1: test Width, 1 jz @@2 mov edx, esi mov eax, ebx call GetIndexColor shl eax, 4 stosb add esi, 4 @@2: pop ecx add esi, srcOffset add edi, dstOffset dec Height jnz @yLoop pop ebx pop edi pop esi end; procedure TIndexImage.CreateIndexData8(var IndexData: TImageData); var srcOffset, dstOffset, Height: Integer; asm push esi push edi push ebx push eax lea eax, [eax].TIndexImage.FSource xchg eax, edx call SetCopyRegs mov srcOffset, eax mov dstOffset, ebx mov Height, edx pop eax mov ebx, [eax].TIndexImage.FColorMap @yLoop: push ecx @xLoop: lodsd mov edx, eax shr dh, 3 shr dx, 3 shr eax, 9 and eax, 7c00h or ax, dx mov al, [ebx + eax] stosb loop @xLoop pop ecx add esi, srcOffset add edi, dstOffset dec Height jnz @yLoop pop ebx pop edi pop esi end; procedure TIndexImage.CreateIndexData8_2(var IndexData: TImageData); var srcOffset, dstOffset, Height: Integer; asm push esi push edi push ebx push eax lea eax, [eax].TIndexImage.FSource xchg eax, edx call SetCopyRegs mov srcOffset, eax mov dstOffset, ebx mov Height, edx pop ebx @yLoop: push ecx @xLoop: push ecx mov edx, esi mov eax, ebx call GetIndexColor stosb pop ecx add esi, 4 loop @xLoop pop ecx add esi, srcOffset add edi, dstOffset dec Height jnz @yLoop pop ebx pop edi pop esi end; procedure TIndexImage.CreateIndexData15(var IndexData: TImageData); var dstOffset, srcoffset: Integer; asm push esi push edi push ebx lea eax, [eax].TIndexImage.FSource xchg eax, edx call SetCopyRegs mov dstOffset, ebx mov srcOffset, eax @yLoop: push ecx @xLoop: lodsd mov ebx, eax shr bh, 3 shr bx, 3 shr eax, 9 and ax, 7c00h or ax, bx stosw loop @xLoop pop ecx add esi, srcOffset add edi, dstOffset dec edx jnz @yLoop pop ebx pop edi pop esi end; procedure TIndexImage.CreateIndexData16(var IndexData: TImageData); var dstOffset, srcoffset: Integer; asm push esi push edi push ebx lea eax, [eax].TIndexImage.FSource xchg eax, edx call SetCopyRegs mov dstOffset, ebx mov srcOffset, eax @yLoop: push ecx @xLoop: lodsd mov ebx, eax shr bh, 2 shr bx, 3 shr eax, 8 and ax, 0f800h or ax, bx stosw loop @xLoop pop ecx add esi, srcOffset add edi, dstOffset dec edx jnz @yLoop pop ebx pop edi pop esi end; // 获取索引位图 procedure TIndexImage.CreateIndexImageData(var IndexData: TImageData); procedure GrayCopy(Dest, Source: TImageData); var srcOffset: Integer; asm push esi push edi push ebx call SetCopyRegs mov srcOffset, eax @yLoop: push ecx @xLoop: movzx eax, [esi] movzx ebx, [esi + 1] imul eax, 117 // blue 0.114 * 1024 imul ebx, 601 // green 0.587 * 1024 add eax, ebx movzx ebx, [esi + 2] imul ebx, 306 // red 0.299 * 1024 add eax, ebx add eax, 512 // Rounding shr eax, 10 // eax = Round((R * 306 + G * 601 + B * 117) / 1024) mov [edi], al // blue = al add edi, 4 add esi, 4 loop @xLoop pop ecx add esi, srcOffset dec edx jnz @yLoop pop ebx pop edi pop esi end; var saveData: TImageData; begin if not CanIndex then // 数据源不存在，错误 raise EImageDataError.Create(EIDErrorEmptyData); CreateColors; // 建立颜色表 case IndexFormat of if1Bit: // 单色 begin saveData := FSource; // 保存源图像数据 FSource := GetImageData(saveData.Width, saveData.Height); try GrayCopy(FSource, saveData);// 拷贝灰度图像 if FDithering then CreateDitherData(IndexData, SetDitherPixel1) else CreateIndexData1(IndexData); finally FreeImageData(FSource); FSource := saveData; // 恢复源图像数据 end; end; if4Bit: // 16色 if FDithering then CreateDitherData(IndexData, SetDitherPixel4) else CreateIndexData4(IndexData); if8Bit: // 256色 begin if UseColorMap then // 使用映射表匹配调色板 begin CreateColorMap; if FDithering then CreateDitherData(IndexData, SetDitherPixel8) else CreateIndexData8(IndexData); FreeMem(FColorMap); end else // 直接匹配调色板 begin if FDithering then CreateDitherData(IndexData, SetDitherPixel8_2) else CreateIndexData8_2(IndexData); end; end; if15Bit: // 15位(555) if FDithering then CreateDitherData(IndexData, SetDitherPixel15) else CreateIndexData15(IndexData); if16Bit: if FDithering then // 16位(565) CreateDitherData(IndexData, SetDitherPixel16) else CreateIndexData16(IndexData); end; end; // 获取样本图像数据 procedure TIndexImage.CreateSamplingData(Dest: TImageData); var xDelta, yDelta: Integer; asm push esi push edi push ebx mov edi, edx lea ebx, [eax].TIndexImage.FSource mov eax, [ebx].TimageData.Height shl eax, 8 cdq div [edi].TimageData.Height mov yDelta, eax // yDelta = Source.Height * 256 / Dest.Height mov ecx, [edi].TimageData.Height dec ecx imul ecx, eax // y = (Dest.Height - 1) * yDelta mov eax, [ebx].TimageData.Width shl eax, 8 cdq div [edi].TimageData.Width mov xDelta, eax // xDelta = Source.Width * 256 / Dest.Width mov edx, [edi].TimageData.Width dec edx imul edx, eax // x = (Dest.Width - 1) * xDelta mov edi, [edi].TImageData.Scan0 // edi = Dest.Scan0 @yLoop: // for (; y >= 0; y -= yDelta) mov esi, ecx // { shr esi, 8 // esi = Source.Scan0 + y / 256 * Source.Stride imul esi, [ebx].TImageData.Stride add esi, [ebx].TImageData.Scan0 push edx @xLoop: push esi // for (; x >= 0; x -= xDelta) mov eax, edx // { shr eax, 8 shl eax, 2 add esi, eax // esi += (x / 256 * 4) movsd // *edi ++ = *esi pop esi sub edx, xDelta jns @xLoop // } pop edx sub ecx, yDelta jns @yLoop // } pop ebx pop edi pop esi end; destructor TIndexImage.Destroy; begin SetColorCount(0); FreeImageData(FSource); end; // 填充Alpha通道背景颜色 procedure TIndexImage.FillBackground(ColorBackground: LongWord); asm push edi push ebx or edx, 0ff000000h pxor mm7, mm7 // mm7 = 00 00 00 00 00 00 00 00 movd mm3, edx // mm3 = 00 00 00 00 Ad Rd Gd Bd punpcklbw mm3, mm7 // mm3 = 00 Ad 00 Rd 00 Gd 00 Bd movq mm1, mm3 psllw mm1, 8 // mm1 = Ad*256 Rd*256 Gd*256 Bd*256 lea edi, [eax].TIndexImage.FSource mov ecx, [edi].TImageData.Width mov edx, [edi].TImageData.Height mov ebx, [edi].TImageData.Stride mov edi, [edi].TImageData.Scan0 mov eax, ecx shl eax, 2 sub ebx, eax cld @yLoop: push ecx @xLoop: movd mm0, [edi] // mm0 = 00 00 00 00 As Rs Gs Bs punpcklbw mm0, mm7 // mm0 = 00 As 00 Rs 00 Gs 00 Bs movq mm2, mm0 punpckhwd mm2, mm2 punpckhdq mm2, mm2 // mm2 = Alpha Alpha Alpha Alpha psubw mm0, mm3 // mm0 = As-Ad Rs-Rd Gs-Gd Bs-Bd pmullw mm0, mm2 // mm0 = As*Alpha Rs*Alpha Gs*Alpha Bs*Alpha paddw mm0, mm1 // mm0 = 00 An 00 Rn 00 Gn 00 Bn psrlw mm0, 8 // mm0 = An/256 Rn/256 Gn/256 Bn/256 packuswb mm0, mm7 // mm0 = 00 00 00 00 An Rn Gn Bn movd [edi], mm0 add edi, 4 loop @xLoop pop ecx add edi, ebx dec edx jnz @yLoop emms pop ebx pop edi end; // 获取Windows位图句柄 function TIndexImage.GetBitmap: HBitmap; const BitFields: array[0..2] of LongWord = ($F800, $07E0, $001F); var pbi: PBitmapInfo; Data: TImageData; DC: HDC; begin Result := 0; if not CanIndex then Exit; Data := GetImageData(FSource.Width, FSource.Height, TPixelFormat(Integer(IndexFormat) + 1)); Data.InvertLine := True; DC := GetDC(0); try CreateIndexImageData(Data); GetMem(pbi, Sizeof(TBitmapInfoHeader) + 12 + Sizeof(TRGBQuad) * FLeafCount); try pbi^.bmiHeader := GetBitmapInfoHeader(Data); if Data.PixelFormat and $ffff = $1000 then begin pbi^.bmiHeader.biCompression := BI_BITFIELDS; Move(BitFields, pbi^.bmiColors, Sizeof(TRGBQuad) * 3); end else Move(FColors^, pbi^.bmiColors, Sizeof(TRGBQuad) * FLeafCount); Result := CreateDIBitmap(DC, pbi^.bmiHeader, CBM_INIT, Data.Scan0, pbi^, DIB_RGB_COLORS); finally FreeMem(pbi); end; finally ReleaseDC(0, DC); FreeImageData(Data); end; end; function TIndexImage.GetColorCount: Integer; begin if FLeafCount = 0 then CreateColors; Result := FLeafCount; end; function TIndexImage.GetColors: PIndexColorArray; begin CreateColors; Result := FColors; end; // 按颜色表平方差匹配像素颜色 function TIndexImage.GetIndexColor(PColor: PRGBQuad): Integer; var Count, Index, Diff: LongWord; asm push esi push edi push ebx mov ecx, [eax].TIndexImage.FLeafCount mov Count, ecx mov esi, [eax].TIndexImage.FColors movzx ebx, [edx] movzx ecx, [edx + 1] movzx edi, [edx + 2] mov Diff, 7FFFFFFFh mov Index, esi push esi @Loop: movzx eax, [esi] movzx edx, [esi + 1] sub eax, ebx sub edx, ecx imul eax, eax imul edx, edx add eax, edx movzx edx, [esi + 2] sub edx, edi imul edx, edx add eax, edx jnz @@4 mov Index, esi jmp @@6 @@4: cmp eax, Diff jae @@5 mov Diff, eax mov Index, esi @@5: add esi, 4 dec Count jnz @Loop @@6: pop esi mov eax, Index sub eax, esi shr eax, 2 pop ebx pop edi pop esi end; // 获取Windows位图调色板句柄 function TIndexImage.GetPalette: HPalette; var Pal: TMaxLogPalette; begin Result := 0; CreateColors; if FLeafCount = 0 then Exit; Move(FColors^, Pal.palPalEntry, Sizeof(TRGBQuad) * FLeafCount); SwapColors(@Pal.palPalEntry, FLeafCount); Pal.palVersion := $300; Pal.palNumEntries := FLeafCount; Result := CreatePalette(PLogPalette(@Pal)^); end; // 归并八叉树 procedure TIndexImage.ReduceTree; var I: Integer; Node: TColorNode; begin I := FColorBits - 1; while FNodes[I] = nil do Dec(I); Node := FNodes[I]; FNodes[I] := Node.FNext; for I := 0 to 7 do begin if Node.FChild[I] <> nil then begin Inc(Node.FRedSum, Node.FChild[I].FRedSum); Inc(Node.FGreenSum, Node.FChild[I].FGreenSum); Inc(Node.FBlueSum, Node.FChild[I].FBlueSum); Inc(Node.FPixelCount, Node.FChild[I].FPixelCount); FreeAndNil(Node.FChild[I]); Dec(FLeafCount); end; end; Inc(FLeafCount); Node.FIsLeaf := True; end; // 通过Windows位图调色板句柄获取源图像数据结构 procedure TIndexImage.SetBitmap(const Value: HBitmap); var DC: HDC; bmi: TBitmapInfo; begin FreeImageData(FSource); if Value = 0 then Exit; DC := GetDC(0); try FSource.PixelFormat := 0; bmi.bmiHeader := GetBitmapInfoHeader(FSource); if GetDIBits(DC, Value, 0, 1, nil, bmi, DIB_RGB_COLORS) = 0 then raise EImageDataError.Create(EIDErrorParam); FSource := GetImageData(bmi.bmiHeader.biWidth, bmi.bmiHeader.biHeight, pf32bit); FSource.InvertLine := True; bmi.bmiHeader := GetBitmapInfoHeader(FSource); GetDIBits(DC, Value, 0, FSource.Height, FSource.Scan0, bmi, DIB_RGB_COLORS); finally ReleaseDC(0, DC); end; end; procedure TIndexImage.SetColorCount(Count: Integer); begin if FColors <> nil then begin FreeMem(FColors); FColors := nil; end; FLeafCount := Count; if FLeafCount > 0 then GetMem(FColors, Sizeof(TRGBQuad) * FLeafCount); ColorsChange; end; // 设置外部颜色表 procedure TIndexImage.SetColors(const AColors: array of TRGBQuad); begin if IndexFormat > if8Bit then Exit; SetColorCount(Length(AColors)); if FLeafCount = 0 then Exit; Move(AColors, FColors^, Sizeof(TRGBQuad) * FLeafCount); end; // in mm1 = Errs[x]; out mm1 = currErr procedure TIndexImage.SetDitherPixel1(var Err: TErrQuad; PixelAddr: Pointer; x: Integer); const mask1: int64 = $00ff00ff00ff; asm push edi mov edi, x shr edi, 3 // edi = PixelAddr + x / 8 add edi, ecx mov eax, [eax].TIndexImage.FMonochromeThreshold test x, 7 jnz @@1 mov [edi], ah // if (x & 7 == 0) *edi = 0 (init) @@1: cmp ax, [edx].TErrQuad.Blue jae @@2 mov eax, 80h // if (Err > Threshold) mov ecx, 7 // { and ecx, x // *edi |= (0x80 >> (x & 7)) shr eax, cl // currErr = Errs[x] - 255 or [edi], al // } psubsw mm1, mask1 @@2: pop edi end; // in mm1 = Errs[x]; out mm1 = currErr procedure TIndexImage.SetDitherPixel4(var Err: TErrQuad; PixelAddr: Pointer; x: Integer); asm push [eax].TIndexImage.FColors push ecx movq mm0, mm1 packuswb mm0, mm7 movq [edx], mm0 call GetIndexColor // index = GetIndexColor(@Errs[x]) pop ecx mov edx, x shr edx, 1 add edx, ecx // edx = PixelAddr + x / 2 test x, 1 jnz @@1 shl eax, 4 mov [edx], al // if (x & 1 == 0) *edx = index << 4 shr eax, 4 jmp @@2 @@1: or [edx], al // else *edx |= index @@2: pop ecx shl eax, 2 add ecx, eax movd mm0, [ecx] punpcklbw mm0, mm7 psubsw mm1, mm0 // currErr = Errs[x] - FColors[index] end; // in mm1 = Errs[x]; out mm1 = currErr procedure TIndexImage.SetDitherPixel8(var Err: TErrQuad; PixelAddr: Pointer; x: Integer); asm add ecx, x push ecx mov ecx, [edx] mov dx, [edx].TErrQuad.Red and edx, 0f8h and ecx, 0f800f8h shl edx, 7 shr cx, 3 or dx, cx shr ecx, 14 or edx, ecx add edx, [eax].TIndexImage.FColorMap movzx edx, [edx] // index = FColorMap[Errs[x] to 16Bit] (555) pop ecx // ecx = PixelAddr + x mov [ecx], dl // *ecx = index shl edx, 2 add edx, [eax].TIndexImage.FColors movd mm0, [edx] punpcklbw mm0, mm7 psubsw mm1, mm0 // currErr = Errs[x] - FColors[index] end; // in mm1 = Errs[x]; out mm1 = currErr procedure TIndexImage.SetDitherPixel8_2(var Err: TErrQuad; PixelAddr: Pointer; x: Integer); asm push [eax].TIndexImage.FColors push ecx movq mm0, mm1 packuswb mm0, mm7 movq [edx], mm0 call GetIndexColor // index = GetIndexColor(@Errs[x]) pop ecx add ecx, x mov [ecx], al // *ecx = index pop edx shl eax, 2 movd mm0, [edx + eax] punpcklbw mm0, mm7 psubsw mm1, mm0 // currErr = Errs[x] - FColors[index] end; // in mm1 = Errs[x]; out mm1 = currErr procedure TIndexImage.SetDitherPixel15(var Err: TErrQuad; PixelAddr: Pointer; x: Integer); const mask16: int64 = $000700070007; asm pand mm1, mask16 // currErr = Errs[x] & 0x0700030007 mov eax, [edx] mov dx, [edx].TErrQuad.Red and edx, 0f8h and eax, 0f800f8h shl edx, 7 shr ax, 3 or dx, ax shr eax, 14 or eax, edx add ecx, x add ecx, x // ecx = PixelAddr + x * 2 mov [ecx], ax // *ecx = Errs[x] to 16Bit (555) end; // in mm1 = Errs[x]; out mm1 = currErr procedure TIndexImage.SetDitherPixel16(var Err: TErrQuad; PixelAddr: Pointer; x: Integer); const mask16: int64 = $000700030007; asm pand mm1, mask16 // currErr = Errs[x] & 0x0700030007 mov eax, [edx] mov dx, [edx].TErrQuad.Red and edx, 0f8h and eax, 0fc00f8h shl edx, 8 shr ax, 3 or dx, ax shr eax, 13 or eax, edx add ecx, x add ecx, x // ecx = PixelAddr + x * 2 mov [ecx], ax // *ecx = Errs[x] to 16Bit (565) end; procedure TIndexImage.SetFormat(const Value: TIndexFormat); const Bits: array[TIndexFormat] of Integer = (1, 4, 8, 16, 16); begin if IndexFormat <> Value then begin FIndexFormat := Value; FColorBits := Bits[Value]; FMaxColors := 1 shl FColorBits; SetColorCount(0); end; end; // 设置图像样本图的像素个数 procedure TIndexImage.SetMinSamplingCount(const Value: Integer); begin if FMinSamplingCount <> Value then begin FMinSamplingCount := Value; if FMinSamplingCount < MinSamplings then FMinSamplingCount := MinSamplings; SetColorCount(0); end; end; procedure TIndexImage.SetMonochromeThreshold(const Value: LongWord); begin if Value < 256 then FMonochromeThreshold := Value; end; // 通过外部Windows调色板句柄获取颜色表 procedure TIndexImage.SetPalette(const Value: HPalette); var Pal: TMaxLogPalette; begin if Value = 0 then SetColorCount(0) else if IndexFormat <= if8Bit then begin SetColorCount(GetPaletteEntries(Value, 0, FMaxColors, Pal.palPalEntry)); if FLeafCount > 0 then begin SwapColors(@Pal.palPalEntry, FLeafCount); Move(Pal.palPalEntry, FColors^, Sizeof(TRGBQuad) * FLeafCount); end; end; end; // 设置源图像数据结构(浅拷贝) procedure TIndexImage.SetSourceData(const Value: TImageData); begin if (Value.PixelFormat shr 8) and $ff <> 32 then raise EImageDataError.CreateFmt(EIDErrorSourceMust, [32]); FreeImageData(FSource); FSource := Value; end; { TIndexBitmap } function TIndexBitmap.GetIndexBitmap: TBitmap; begin if CanIndex then begin Result := TBitmap.Create; Result.Handle := GetBitmap; end else Result := nil; end; procedure TIndexBitmap.SetSource(Bitmap: TBitmap; ColorBackground: TColor); begin SetBitmap(Bitmap.Handle); if (Bitmap.PixelFormat = pf32Bit) and (ColorBackground <> 0) then begin SwapColors(@ColorBackground, 1); FillBackground(ColorBackground); end; end; procedure TIndexBitmap.SetSource(Graphic: TGraphic; ColorBackground: TColor); var tmp: TBitmap; begin if Graphic is TBitmap then SetSource(TBitmap(Graphic)) else begin tmp := TBitmap.Create; try tmp.Assign(Graphic); SetSource(tmp); finally tmp.Free; end; end; end; { TGpIndexBitmap } procedure TGpIndexBitmap.ColorsChange; begin if FPalette <> nil then begin FreeMem(FPalette); FPalette := nil; end; end; function TGpIndexBitmap.GetIndexBitmap: TGpBitmap; const Formats: array[TIndexFormat] of Gdiplus.TPixelFormat = (pf1bppIndexed, pf4bppIndexed, pf8bppIndexed, pf16bppRGB555, pf16bppRGB565); var Data: TBitmapData; begin if CanIndex then begin Result := TGpBitmap.Create(SourceData.Width, SourceData.Height, Formats[IndexFormat]); if (IndexFormat <= if8bit) then Result.Palette := GetPalette; Data := Result.LockBits(GpRect(0, 0, Result.Width, Result.Height), [imRead, imWrite], Result.PixelFormat); try CreateIndexImageData(TImageData(Data)); finally Result.UnlockBits(Data); end; end else Result := nil; end; function TGpIndexBitmap.GetPalette: PColorPalette; var I: Integer; cols: PIndexColorArray; begin if ColorCount > 0 then begin GetMem(FPalette, Sizeof(TColorPalette) + Sizeof(TARGB) * (ColorCount - 1)); FPalette^.Flags := 0; FPalette^.Count := ColorCount; cols := Colors; for I := 0 to FPalette^.Count - 1 do FPalette^.Entries[I] := TARGB(cols[I]) or $ff000000; end; Result := FPalette; end; procedure TGpIndexBitmap.SetPalette(const Value: PColorPalette); var Count: Integer; cols: PIndexColorArray; begin if IndexFormat > if8Bit then Exit; Count := 0; if Value <> nil then begin Count := Value.Count; if Count > MaxColorCount then Count := MaxColorCount; end; SetColorCount(Count); if Count > 0 then begin cols := Colors; Move(Value.Entries, cols^, Count * Sizeof(TARGB)); end; end; procedure TGpIndexBitmap.SetSource(Bitmap: TGpBitmap; ColorBackground: TARGB); var Data: TBitmapData; begin TImageData(Data) := GetImageData(Bitmap.Width, Bitmap.Height); Data := Bitmap.LockBits(GpRect(0, 0, Integer(Data.Width), Integer(Data.Height)), [imRead, imUserInputBuf], pf32bppARGB); Bitmap.UnlockBits(Data); SourceData := TImageData(Data); if (Bitmap.PixelFormat = pf32bppARGB) and (ColorBackground <> 0) then FillBackground(ColorBackground); end; end.

TBitmap应用举例：

var Bmp, Bmp8: TBitmap; IdxData: TIndexBitmap; begin Bmp := TBitmap.Create; Bmp.LoadFromFile('D:/VclLib/GdiplusDemo/Media/20041001.bmp'); IdxData := TIndexBitmap.Create; IdxData.SetSource(Bmp); IdxData.Dithering := True; IdxData.IndexFormat := if8bit; // 转换为256色 Bmp8 := IdxData.GetIndexBitmap; Canvas.Draw(0, 0, Bmp); Canvas.Draw(0, Bmp.Height, Bmp8); Bmp8.Free; IdxData.Free; Bmp.Free; end;

GDI+应用举例：

var Bmp, Bmp8: TGpBitmap; IdxData: TGpIndexBitmap; g: TGpGraphics; begin Bmp := TGpBitmap.Create('D:/56-3.jpg'); IdxData := TGpIndexBitmap.Create; IdxData.SetSource(Bmp); IdxData.Dithering := True; IdxData.IndexFormat := if1bit; // 转换为单色 Bmp8 := IdxData.GetIndexBitmap; g := TGpGraphics.Create(Canvas.Handle); g.DrawImage(Bmp, 0, 0); g.DrawImage(Bmp8, 0, Bmp.Height); g.Free; Bmp8.Free; IdxData.Free; Bmp.Free;

下面是本类转换的几张图片效果，从上到下，依次为：源图，单色图，单色仿色图，16色图，16色仿色图，256色图，256色仿色图：

源图：

单色图：

单色仿色图：

16色图：

16色仿色图：

256色图：

256色仿色图：

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

文章中所用数据类型及某些过程见《Delphi图像处理 -- 数据类型及内部过程》。

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

[email protected]

注：本文章已于2009.10.27重新整理过。