【delphi开源代码栏目提醒】:本文主要为网学会员提供ColorQuantizationLibrary.pas，希望对需要ColorQuantizationLibrary.pas网友有所帮助，学习一下!
UNIT ColorQuantizationLibrary;
INTERFACE
USES
Windows, // THandle, TRGBTriple, TRGBQuad, GetObject
PaletteLibrary; // TRGBQuadArray
TYPE
TOctreeNode = CLASS; // Forward definition so TReducibleNodes can be declared
TReducibleNodes = ARRAY[0..7] OF TOctreeNode;
TOctreeNode =
CLASS(TObject)
IsLeaf : BOOLEAN;
PixelCount : INTEGER;
RedSum : INTEGER;
GreenSum : INTEGER;
BlueSum : INTEGER;
Next : TOctreeNode;
Child : TReducibleNodes;
CONSTRUCTOR Create (CONST Level : INTEGER;
CONST ColorBits : INTEGER;
VAR LeafCount : INTEGER;
VAR ReducibleNodes: TReducibleNodes);
DESTRUCTOR Destroy; OVERRIDE;
END;
TColorQuantizer =
CLASS(TOBject)
PRIVATE
FTree : TOctreeNode;
FLeafCount : INTEGER;
FReducibleNodes: TReducibleNodes;
FMaxColors : INTEGER;
FColorBits : INTEGER;
PROTECTED
PROCEDURE AddColor(VAR Node : TOctreeNode;
CONST r,g,b : BYTE;
CONST ColorBits : INTEGER;
CONST Level : INTEGER;
VAR LeafCount : INTEGER;
VAR ReducibleNodes: TReducibleNodes);
PROCEDURE DeleteTree(VAR Node: TOctreeNode);
PROCEDURE GetPaletteColors(CONST Node : TOctreeNode;
VAR RGBQuadArray: TRGBQuadArray;
VAR Index : INTEGER);
PROCEDURE ReduceTree(CONST ColorBits: INTEGER;
VAR LeafCount: INTEGER;
VAR ReducibleNodes: TReducibleNodes);
PUBLIC
CONSTRUCTOR Create(CONST MaxColors: INTEGER; CONST ColorBits: INTEGER);
DESTRUCTOR Destroy; OVERRIDE;
PROCEDURE GetColorTable(VAR RGBQuadArray: TRGBQuadArray);
FUNCTION ProcessImage(CONST Handle: THandle): BOOLEAN;
PROPERTY ColorCount: INTEGER READ FLeafCount;
END;
IMPLEMENTATION
//// TOctreeNode ///////////////////////////////////////////////////////////
CONSTRUCTOR TOctreeNode.Create (CONST Level : INTEGER;
CONST ColorBits : INTEGER;
VAR LeafCount : INTEGER;
VAR ReducibleNodes: TReducibleNodes);
VAR
i: INTEGER;
BEGIN
PixelCount := 0;
RedSum := 0;
GreenSum := 0;
BlueSum := 0;
FOR i := Low(Child) TO High(Child) DO
Child[i] := NIL;
IsLeaf := (Level = ColorBits);
IF IsLeaf
THEN BEGIN
Next := NIL;
INC(LeafCount);
END
ELSE BEGIN
Next := ReducibleNodes[Level];
ReducibleNodes[Level] := SELF
END
END {Create};
DESTRUCTOR TOctreeNode.Destroy;
VAR
i: INTEGER;
BEGIN
FOR i := Low(Child) TO High(Child) DO
Child[i].Free
END {Destroy};
//// TColorQuantizer ///////////////////////////////////////////////////////
CONSTRUCTOR TColorQuantizer.Create(CONST MaxColors: INTEGER; CONST ColorBits: INTEGER);
VAR
i: INTEGER;
BEGIN
ASSERT (ColorBits <= 8);
FTree := NIL;
FLeafCount := 0;
// Initialize all nodes even though only ColorBits+1 of them are needed
FOR i := Low(FReducibleNodes) TO High(FReducibleNodes) DO
FReducibleNodes[i] := NIL;
FMaxColors := MaxColors;
FColorBits := ColorBits
END {Create};
DESTRUCTOR TColorQuantizer.Destroy;
BEGIN
IF FTree <> NIL
THEN DeleteTree(FTree)
END {Destroy};
PROCEDURE TColorQuantizer.GetColorTable(VAR RGBQuadArray: TRGBQuadArray);
VAR
Index: INTEGER;
BEGIN
Index := 0;
GetPaletteColors(FTree, RGBQuadArray, Index)
END {GetColorTable};
// Handles passed to ProcessImage should refer to DIB sections, not DDBs.
// In certain cases, specifically when it's called upon to process 1, 4, or
// 8-bit per pixel images on systems with palettized display adapters,
// ProcessImage can produce incorrect results if it's passed a handle to a
// DDB.
FUNCTION TColorQuantizer.ProcessImage(CONST Handle: THandle): BOOLEAN;
CONST
MaxPixelCount = 1048576; // 2^20 shouldn't be much of a limit here
TYPE
pRGBArray = ^TRGBArray;
TRGBArray = ARRAY[0..MaxPixelCount-1] OF TRGBTriple;
VAR
Bytes : INTEGER;
DIBSection: TDIBSection;
// Process 1, 4, or 8-bit DIB:
// The strategy here is to use GetDIBits to convert the image into
// a 24-bit DIB one scan line at a time. A pleasant side effect
// of using GetDIBits in this manner is that RLE-encoded 4-bit and
// 8-bit DIBs will be uncompressed.
// Implemented as in article, but doesn't work (yet) as I would expect.
PROCEDURE ProcessLowBitDIB;
VAR
BitmapInfo : TBitmapInfo;
DeviceContext: hDC;
i : INTEGER;
j : INTEGER;
ScanLine : pRGBArray;
BEGIN
GetMem(ScanLine, 3*DIBSection.dsBmih.biWidth);
TRY
ZeroMemory(@BitmapInfo, SizeOf(BitmapInfo));
WITH BitmapInfo DO
BEGIN
bmiHeader.biSize := SizeOf(TBitmapInfo);
bmiHeader.biWidth := DIBSection.dsBmih.biWidth;
bmiHeader.biHeight := DIBSection.dsBmih.biHeight;
bmiHeader.biPlanes := 1;
bmiHeader.biBitCount := 24;
bmiHeader.biCompression := BI_RGB;
END;
DeviceContext := GetDC(0);
TRY
FOR j := 0 TO DIBSection.dsBmih.biHeight-1 DO
BEGIN
GetDIBits (DeviceContext, Handle, j, 1, ScanLine, BitmapInfo, DIB_RGB_COLORS);
FOR i := 0 TO DIBSection.dsBmih.biWidth-1 DO
BEGIN
WITH Scanline[i] DO
AddColor(FTree, rgbtRed, rgbtGreen, rgbtBlue,
FColorBits, 0, FLeafCount, FReducibleNodes);
WHILE FLeafCount > FMaxColors DO
ReduceTree(FColorbits, FLeafCount, FReducibleNodes)
END
END
FINALLY
ReleaseDC(0, DeviceContext);
END
FINALLY
FreeMem(ScanLine)
END
END {ProcessLowBitDIB};
PROCEDURE Process16BitDIB;
BEGIN
// Not yet implemented
END {Process16BitDIB};
PROCEDURE Process24BitDIB;
VAR
i : INTEGER;
j : INTEGER;
ScanLine: pRGBArray;
BEGIN
Scanline := pRGBArray(DIBSection.dsBm.bmBits);
FOR j := 0 TO DIBSection.dsBmih.biHeight-1 DO
BEGIN
FOR i := 0 TO DIBSection.dsBmih.biWidth-1 DO
BEGIN
WITH Scanline[i] DO
AddColor(FTree, rgbtRed, rgbtGreen, rgbtBlue,
FColorBits, 0, FLeafCount, FReducibleNodes);
WHILE FLeafCount > FMaxColors DO
ReduceTree(FColorbits, FLeafCount, FReducibleNodes)
END;
ScanLine := pRGBArray(INTEGER(Scanline) + DIBSection.dsBm.bmWidthBytes);
END
END {Process24BitDIB};
PROCEDURE Process32BitDIB;
BEGIN
// Not yet implemented
END {Process32BitDIB};
BEGIN {ProcessImage}
RESULT := FALSE;
Bytes := GetObject(Handle, SizeOF(DIBSection), @DIBSection);
IF Bytes > 0 // Invalid Bitmap if Bytes = 0
THEN BEGIN
// PadBytes := DIBSECTION.dsBm.bmWidthBytes -
// (((DIBSection.dsBmih.biWidth * DIBSection.dsBmih.biBitCount) + 7) DIV 8);
ASSERT (DIBSection.dsBmih.biHeight < MaxPixelCount);
ASSERT (DIBSection.dsBmih.biWidth < MaxPixelCount);
CASE DIBSection.dsBmih.biBitCount OF
1: ProcessLowBitDIB;
4: ProcessLowBitDIB;
8:
上一篇：
DocProView.cpp
下一篇：
让我掉下眼泪的
2013-9-1
