GDI+在Delphi程序的应用 – 真彩色图像转索引图像

    最近有几张真彩色图片需要转换为GIF图片，直接用GDI+位图转换存储效果太差，网上搜索半天，也没找到完全合适的，有关Delphi语言和GDI+转换的详细资料更是没发现，只好自己写了几个Delphi类，发表在这里供大家参考。

    下面是几个真彩色转索引图像类的完整代码：

type TImageData = packed record Width: Integer; // 像素宽度 Height: Integer; // 像素高度 Stride: Integer; // 扫描宽度 LineOffset: Integer; // 扫描行偏移 Scan0: Pointer; // 扫描行首地址 Reserved: Integer; // 保留 end; PImageData = ^TImageData; TIndexTree = class; TColorNode = class private FIsLeaf: Boolean; FPixelCount: LongWord; FRedSum: LongWord; FGreenSum: LongWord; FBlueSum: LongWord; FChild: array[0..7] of TColorNode; FNext: TColorNode; FTree: TIndexTree; public constructor Create(Level: Integer; Tree: TIndexTree); destructor Destroy; override; procedure AddColor(PColor: PRGBQuad; Level: Integer); procedure GetPaletteColors(var Index: Integer); end; TIndexFormat = (if4bit, if8bit); TIndexTree = class private FColorBits: LongWord; FMaxColors: LongWord; FLeafCount: LongWord; FData: TImageData; FColorBackground: TColor; FPal: PLogPalette; FNodes: array[0..8] of TColorNode; function GetFormat: TIndexFormat; procedure SetFormat(const Value: TIndexFormat); procedure SetColorBackground(const Value: TColor); protected function CanIndex: Boolean; procedure CreateIndexData(var IndexData: TImageData); procedure CreatePalette(GDIBitmap: Boolean); procedure CopySourceData(Source: TImageData; Source24bit: Boolean); function GetImageData(Width, Height, Stride: Integer; Scan0: Pointer; Bits: Integer): TImageData; function GetIndexData(Scan0: Pointer): TImageData; function GetIndexColor(PColor: PRGBQuad): Integer; virtual; procedure ReduceTree; procedure SetSourceData(Width, Height: Integer); procedure Update; virtual; property LogPalette: PLogPalette read FPal; property LeafCount: LongWord read FLeafCount write FLeafCount; property Data: TImageData read FData write FData; public constructor Create; destructor Destroy; override; // 32位图像Alpha通道背景颜色，必须在设置图像源之前设置，缺省为白色， property ColorBackground: TColor read FColorBackground write SetColorBackground; // 索引图格式 property IndexFormat: TIndexFormat read GetFormat write SetFormat; end; TBitmapIndexTree = class(TIndexTree) private procedure SetSource(const Value: TGraphic); protected function CreateBitmap: TBitmap; public // 获取按索引图格式建立的索引位图 function GetIndexBitmap: TBitmap; // 获取按索引图格式建立的调色板 function GetPalette: HPalette; // 设置源图像 property Source: TGraphic write SetSource; end; TGpBitmapIndexTree = class(TIndexTree) private FPalette: PColorPalette; procedure SetSource(const Value: TGpBitmap); protected function CreateBitmap: TGpBitmap; procedure Update; override; public destructor Destroy; override; // 获取按索引图格式建立的GDI+索引位图 function GetIndexBitmap: TGpBitmap; // 获取按索引图格式建立的GDI+调色板 function GetPalette: PColorPalette; // 设置源图像 property Source: TGpBitmap write SetSource; end; { 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, FTree); FChild[Index].AddColor(PColor, Level); end; end; constructor TColorNode.Create(Level: Integer; Tree: TIndexTree); begin FTree := Tree; FIsLeaf := Level = FTree.FColorBits; if FIsLeaf then Inc(FTree.FLeafCount) else begin FNext := FTree.FNodes[Level]; FTree.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 FTree.FPal^.palPalEntry[Index].peRed := FRedSum div FPixelCount; FTree.FPal^.palPalEntry[Index].peGreen := FGreenSum div FPixelCount; FTree.FPal^.palPalEntry[Index].peBlue := FBlueSum div FPixelCount; FTree.FPal^.palPalEntry[Index].peFlags := 0; Inc(Index); end else begin for I := 0 to 7 do if Assigned(FChild[I]) then FChild[I].GetPaletteColors(Index); end; end; { TIndexTree } function TIndexTree.CanIndex: Boolean; begin Result := FData.Scan0 <> nil; end; procedure TIndexTree.CopySourceData(Source: TImageData; Source24bit: Boolean); var Color: LongWord; asm push esi push edi push ebx push ecx lea edi, [eax].TIndexTree.FData mov eax, [eax].TIndexTree.FColorBackground bswap eax shr eax, 8 or eax, 0ff000000h mov Color, eax mov ebx, [edx].TImageData.LineOffset mov esi, [edx].TImageData.Scan0 mov ecx, [edi].TImageData.Width mov edx, [edi].TImageData.Height mov edi, [edi].TImageData.Scan0 cld pop eax test eax, 1 jnz @@1 pxor mm7, mm7 // mm7 = 00 00 00 00 00 00 00 00 movd mm3, Color // 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 @yLoop32: push ecx @xLoop32: movd mm0, [esi] // 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 esi, 4 add edi, 4 loop @xLoop32 pop ecx add esi, ebx dec edx jnz @yLoop32 emms jmp @@2 @@1: @yLoop: push ecx @xLoop: movsw movsb inc edi loop @xLoop pop ecx add esi, ebx dec edx jnz @yLoop @@2: pop ebx pop edi pop esi end; constructor TIndexTree.Create; begin IndexFormat := if8bit; FColorBackground := clWhite; end; procedure TIndexTree.CreateIndexData(var IndexData: TImageData); var P: PRGBQuad; Pd: PByte; // 设置256色图像像素 procedure SetPixels8; var x, y: Integer; begin for y := 1 to FData.Height do begin for x := 1 to FData.Width do begin Pd^ := GetIndexColor(P); Inc(P); Inc(Pd); end; // Inc(Integer(P), FData.LineOffset); Inc(Integer(Pd), IndexData.LineOffset); end; end; // 设置16色图像像素 procedure SetPixels4; var x, y, n: Integer; begin n := FData.Width shr 1; for y := 1 to FData.Height do begin for x := 1 to n do begin // 每字节2像素交错存放(首像素高4位，次像素低4位) Pd^ := GetIndexColor(P) shl 4; Inc(P); Pd^ := Pd^ or GetIndexColor(P); Inc(P); Inc(Pd); end; if (FData.Width and 1) <> 0 then begin Pd^ := GetIndexColor(P) shl 4; Inc(P); Inc(Pd); end; // Inc(Integer(P), FData.LineOffset); Inc(Pd, IndexData.LineOffset); end; end; begin P := FData.Scan0; Pd := IndexData.Scan0; if FColorBits = 8 then SetPixels8 else SetPixels4; end; procedure TIndexTree.CreatePalette(GDIBitmap: Boolean); var Node: TColorNode; x, y, Index: Integer; P: PRGBQuad; Offset: Integer; begin if FPal <> nil then Exit; Node := TColorNode.Create(0, Self); try P := FData.Scan0; Offset := FData.LineOffset; if GDIBitmap then begin Inc(LongWord(P), (FData.Height - 1) * FData.Stride); Dec(Offset, FData.Stride shl 1); end; for y := 1 to FData.Height do begin for x := 1 to FData.Width do begin Node.AddColor(P, 0); while FLeafCount > FMaxColors do ReduceTree; Inc(P); end; Inc(Integer(P), Offset); end; GetMem(FPal, Sizeof(TLogPalette) + (FLeafCount - 1) * Sizeof(TPaletteEntry)); Index := 0; Node.GetPaletteColors(Index); FPal^.palVersion := $300; FPal^.palNumEntries := FLeafCount; finally Node.Free; end; end; destructor TIndexTree.Destroy; begin if FPal <> nil then FreeMem(FPal); if FData.Scan0 <> nil then FreeMem(FData.Scan0); end; function TIndexTree.GetFormat: TIndexFormat; begin if FColorBits = 8 then Result := if8bit else Result := if4bit; end; function TIndexTree.GetImageData(Width, Height, Stride: Integer; Scan0: Pointer; Bits: Integer): TImageData; begin Result.Width := Width; Result.Height := Height; Result.Scan0 := Scan0; Result.Stride := Stride; if Result.Stride = 0 then Result.Stride := ((Bits * Width + 31) and $ffffffe0) shr 3; if Bits = 4 then Inc(Width); Result.LineOffset := Result.Stride - ((Width * Bits) shr 3); end; function TIndexTree.GetIndexColor(PColor: PRGBQuad): Integer; var Count, Index, Diff: LongWord; asm push esi push edi push ebx mov ecx, [eax].TIndexTree.FLeafCount mov Count, ecx mov esi, [eax].TIndexTree.FPal lea esi, [esi].TLogPalette.palPalEntry movzx edi, [edx] movzx ecx, [edx + 1] movzx ebx, [edx + 2] mov Diff, 655025 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 test eax, eax 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; { function TIndexTree.GetIndexColor(PColor: PRGBQuad): Integer; var I: Integer; Diff, MinDiff: LongWord; rv, gv, bv: Integer; begin MinDiff := 655025; Result := -1; for I := 0 to FPal^.palNumEntries - 1 do begin rv := PColor^.rgbRed - FPal^.palPalEntry[I].peRed; gv := PColor^.rgbGreen - FPal^.palPalEntry[I].peGreen; bv := PColor^.rgbBlue - FPal^.palPalEntry[I].peBlue; Diff := LongWord(rv * rv + gv * gv + bv * bv); if Diff = 0 then begin Result := I; Exit; end; if Diff < MinDiff then begin MinDiff := Diff; Result := I; end; end; end; } function TIndexTree.GetIndexData(Scan0: Pointer): TImageData; begin Result := GetImageData(FData.Width, FData.Height, 0, Scan0, FColorBits); end; procedure TIndexTree.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; procedure TIndexTree.SetColorBackground(const Value: TColor); begin if Value < 0 then FColorBackground := GetSysColor(Value and $FF) else FColorBackground := Value; end; procedure TIndexTree.SetFormat(const Value: TIndexFormat); begin if IndexFormat <> Value then begin if Value = if8bit then FColorBits := 8 else FColorBits := 4; FMaxColors := 1 shl FColorBits; Update; end; end; procedure TIndexTree.SetSourceData(Width, Height: Integer); begin if FData.Scan0 <> nil then FreeMem(FData.Scan0); FData := GetImageData(Width, Height, 0, nil, 32); GetMem(FData.Scan0, FData.Height * FData.Stride); end; procedure TIndexTree.Update; begin if FPal <> nil then begin FreeMem(FPal); FPal := nil; end; FLeafCount := 0; end; { TBitmapIndexTree } function TBitmapIndexTree.CreateBitmap: TBitmap; var IndexData: TImageData; palette: HPalette; begin Result := TBitmap.Create; if FColorBits = 8 then Result.PixelFormat := pf8bit else Result.PixelFormat := pf4bit; Result.Width := SourceData.Width; Result.Height := SourceData.Height; Palette := GetPalette; Result.Palette := Palette; DeleteObject(Palette); IndexData := GetIndexData(Result.ScanLine[SourceData.Height - 1]); CreateIndexData(IndexData); end; function TBitmapIndexTree.GetIndexBitmap: TBitmap; begin if CanIndex then Result := CreateBitmap else Result := nil; end; function TBitmapIndexTree.GetPalette: HPalette; begin if CanIndex then begin CreatePalette(True); Result := Windows.CreatePalette(LogPalette^); end else Result := 0; end; procedure TBitmapIndexTree.SetSource(const Value: TGraphic); var bmp: TBitmap; sData: TImageData; Bits: Integer; begin if Assigned(Value) and not Value.Empty then begin Bmp := TBitmap.Create; try Bmp.Assign(Value); if Bmp.PixelFormat = pf24bit then Bits := 24 else if Bmp.PixelFormat = pf32bit then Bits := 32 else raise Exception.Create('Only supports 24 or 32 image sources.'); sData := GetImageData(Bmp.Width, Bmp.Height, 0, Bmp.ScanLine[Bmp.Height - 1], Bits); SetSourceData(sData.Width, sData.Height); CopySourceData(sData, Bits = 24); Update; finally Bmp.Free; end; end; end; { TGpBitmapIndexTree } function TGpBitmapIndexTree.CreateBitmap: TGpBitmap; var IndexData: TImageData; GpData: TBitmapData; begin if FColorBits = 8 then Result := TGpBitmap.Create(Data.Width, Data.Height, pf8bppIndexed) else Result := TGpBitmap.Create(Data.Width, Data.Height, pf4bppIndexed); Result.Palette := GetPalette; GpData := Result.LockBits(GpRect(0, 0, Data.Width, Data.Height), [imRead, imWrite], Result.PixelFormat); try IndexData := GetIndexData(GpData.Scan0); CreateIndexData(IndexData); finally Result.UnlockBits(GpData); end; end; destructor TGpBitmapIndexTree.Destroy; begin if FPalette <> nil then FreeMem(FPalette); inherited; end; function TGpBitmapIndexTree.GetIndexBitmap: TGpBitmap; begin if CanIndex then Result := CreateBitmap else Result := nil; end; function TGpBitmapIndexTree.GetPalette: PColorPalette; var I: Integer; begin if CanIndex and (FPalette = nil) then begin CreatePalette(False); GetMem(FPalette, Sizeof(TColorPalette) + (LeafCount - 1) * Sizeof(TARGB)); with LogPalette^ do for I := 0 to LeafCount - 1 do FPalette^.Entries[I] := (palPalEntry[I].peRed shl 16) or (palPalEntry[I].peGreen shl 8) or palPalEntry[I].peBlue or $FF000000; FPalette.Flags := 0; FPalette.Count := LeafCount; end; Result := FPalette; end; procedure TGpBitmapIndexTree.SetSource(const Value: TGpBitmap); var GpData: TBitmapData; sData: TImageData; begin if Assigned(Value) then begin if Value.PixelFormat = pf32bppARGB then begin GpData := Value.LockBits(GpRect(0, 0, Value.Width, Value.Height), [imRead], pf32bppARGB); sData := GetImageData(GpData.Width, GpData.Height, GpData.Stride, GpData.Scan0, 32); SetSourceData(sData.Width, sData.Height); CopySourceData(sData, False); Value.UnlockBits(GpData); end else begin SetSourceData(Value.Width, Value.Height); GpData.Stride := Data.Stride; GpData.Scan0 := Data.Scan0; GpData := Value.LockBits(GpRect(0, 0, Data.Width, Data.Height), [imRead, imUserInputBuf], pf32bppARGB); Value.UnlockBits(GpData); end; Update; end; end; procedure TGpBitmapIndexTree.Update; begin inherited; if FPalette <> nil then begin FreeMem(FPalette); FPalette := nil; end; end;

    代码中共定义了四个类：TColorNode是一个八叉树颜色节点类；TIndexTree是图像转换基类，支持真彩色转换256色和16色图像，绝大部分转换工作都写在了这个类中；TBitmapIndexTree是Delphi的TGraphic对象转换类；TGpBitmapIndexTree是GDI+位图转换类。代码没做大的优化，除了一个数据拷贝过程TIndexTree.CopySourceData和像素色彩的调色板匹配方法TIndexTree.GetIndexColor采用了BASM代码，其余都采用纯Delphi代码（TIndexTree.GetIndexColor也有一个被注销的纯Delphi代码，可供参考）。

    下面是GDI+32位PNG图像转256色图片例子代码（保存代码没在例子中）：

var Bmp, Bmp8: TGpBitmap; IndexTree: TGpBitmapIndexTree; g: TGpGraphics; begin Bmp := TGpBitmap.Create('d:/xmas_011.png'); IndexTree := TGpBitmapIndexTree.Create; try IndexTree.Source := Bmp; Bmp8 := IndexTree.GetIndexBitmap; g := TGpGraphics.Create(Canvas.Handle); try g.DrawImage(Bmp, 0, 0); g.DrawImage(Bmp8, 0, 200); finally g.Free; Bmp8.Free; end; finally IndexTree.Free; Bmp.Free; end; end;

    效果图如下，左边是PNG源图，中间是转换后存储的白色背景GIF图片（设置ColorBackground属性可改变背景颜色），右边是没经过转换直接存储的GIF图片：

  下面是TJPEGImage对象真彩色转256色图像例子：

var JPG: TJPEGImage; Bmp8: TBitmap; IndexTree: TBitmapIndexTree; begin JPG := TJPEGImage.Create; JPG.LoadFromFile('D:/VclLib/GdiplusDemo/Media/20041001.jpg'{'d:/20041001-1.bmp'}); IndexTree := TBitmapIndexTree.Create; try Canvas.Draw(0, 0, JPG); IndexTree.Source := JPG; Bmp8 := IndexTree.GetIndexBitmap; try Canvas.Draw(0, 200, Bmp8); finally Bmp8.Free; end; finally IndexTree.Free; JPG.Free; end;

效果图如下（上边是JPEG源图，下边是转换后的256色GIF图像）：

 

代码中所用Gdiplus单元下载地址及BUG更正见文章《GDI+ for VCL基础 -- GDI+ 与 VCL》。

建议和指导请来信：maozefa@hotmail.com