如何实现24位图转化成8位位图!
// 它的思想是:准备一个长度为4096的数组,代表4096种颜色。
// 对图中的每一个像素,取R,G,B的最高四位,拼成一个12位的整数,
// 对应的数组元素加1。全部统计完后,就得到了这4096种颜色的使用频率。
// 这其中,可能有一些颜色一次也没用到,即对应的数组元素为零
// (假设不为零的数组元素共有M个)。将这些为零的数组元素清除出去,
// 使得前M个元素都不为零。将这M个数按从大到小的顺序排列,这样,
// 前256种颜色就是用的最多的颜色,它们将作为调色板上的256种颜色。
// 对于剩下的M-256种颜色并不是简单的丢弃,而是用前256种颜...全部
// 它的思想是:准备一个长度为4096的数组,代表4096种颜色。
// 对图中的每一个像素,取R,G,B的最高四位,拼成一个12位的整数,
// 对应的数组元素加1。全部统计完后,就得到了这4096种颜色的使用频率。
// 这其中,可能有一些颜色一次也没用到,即对应的数组元素为零
// (假设不为零的数组元素共有M个)。将这些为零的数组元素清除出去,
// 使得前M个元素都不为零。将这M个数按从大到小的顺序排列,这样,
// 前256种颜色就是用的最多的颜色,它们将作为调色板上的256种颜色。
// 对于剩下的M-256种颜色并不是简单的丢弃,而是用前256种颜色中的
// 一种来代替,代替的原则是找有最小平方误差的那个。
// 存在的问题: 在该算法中 只取了R、G、B的最高四位,
// 这样剩下的几位被舍去,会使图像亮度降低。
// 当也可以取全R、G、B的八位,那样效率太低。
// 我们可以加上一个小于16的随机数来补偿。
unit CUnit2;
interface
uses
Windows, Graphics;
type
PRGBColor = ^TRGBColor;
TRGBColor = record
B, G, R: Byte;
end;
PByte = ^Byte;
LColor = Record
Color ,Times : Integer;
end;
procedure Convert(SBitmap : TBitMap ; var DBitMap : TBitMap) ;
implementation
var
ColorCount : array[0。
。4096] of LColor; //为记录颜色使用频率的数组
ColorTable : array[0。。4096] of Byte; // 为记录颜色索引值的数组
//统计颜色使用频率
procedure CountColor(BitMap : TBitMap;Var ClrCount : array of LColor);
var
Ptr : PRGBColor;
i,j : Integer;
CIndex : Integer;
begin
for i := 0 to 4096 do // 初始化ColorCount数组
begin
ClrCount[i]。
Color := i;
ClrCount[i]。Times := 0;
end;
with BitMap do
for i := 0 to ( Height - 1 ) do
begin
Ptr := ScanLine[i];
for j := 0 to (Width - 1) do
begin //取 R、G、B三种颜色的前4位组成12位,共4096种颜色
CIndex := (Ptr。
R and $0F0) shl 4;
CIndex := CIndex + (Ptr。G and $0F0);
CIndex := CIndex + ((Ptr。
B and $0F0) shr 4);
Inc(ClrCount[CIndex]。Times,1); //计算颜色的使用次数
Inc(Ptr);
end;
end;
end;//procedure CountColor
// 清除使用次数为 0 的颜色数据,返回值为当前图像中颜色的种类
function Delzero(Var ClrCount : array of LColor): Integer;
var i,CIndex : Integer;
begin
CIndex := 0;
for i := 0 to 4096 do
begin
if (ClrCount[i]。
Times <> 0) then
begin
ClrCount[CIndex] := ClrCount[i];
ClrCount[i]。Times := 0;
Inc(CIndex);
end;
end;
Result := CIndex;
end;//function Delzero
// 快速排序, 将各种颜色 按使用的频率排序(Hight -- Low )
procedure Sort(var A: array of LColor; Top : Integer);
procedure QuickSort(var A: array of LColor; iLo, iHi: Integer);
var
Lo, Hi, Mid: Integer;
Temp : LColor;
begin
Lo := iLo;
Hi := iHi;
Mid := A[(Lo + Hi) div 2]。
Times;
repeat
while A[Lo]。Times > Mid do Inc(Lo);
while A[Hi]。Times Hi;
if Hi > iLo then QuickSort(A, iLo, Hi);
if Lo < iHi then QuickSort(A, Lo, iHi);
end;
begin
QuickSort(A, Low(A), Top);
end;
// 构建调色表
function BuildColorTable(var ClrCount : array of LColor;
var Pal :PLogPalette):HPalette;
var i : Integer;
begin
lVersion:=$300;
lNumEntries:=256;
for i := 0 to 255 do
begin
lPalEntry[i]。
peRed := ((ClrCount[i]。Color and $0F00) shr 4) + 7;
lPalEntry[i]。peGreen := (ClrCount[i]。Color and $0F0) + 7;
lPalEntry[i]。
peBlue := ((ClrCount[i]。Color and $00F) shl 4) + 7;
lPalEntry[i]。peFlags := 0;
end;
Result := CreatePalette(Pal^);
end;
//根据统计的信息调整图像中的颜色, 将不常用的颜色用常用的颜色代替
procedure AdjustColor(ClrNumber : Integer; ClrCount : array of LColor);
var i ,C,Error,m: Integer;
CIndex : Byte;
begin
// for i := 0 to 4096 do ColorTable[i] := 0;
for i := 0 to 255 do
ColorTable[ClrCount[i]。
Color] := i;
for i := 256 to ClrNumber do
begin
Error := 10000;
CIndex := 0;
C := ClrCount[i]。
Color;
for m := 0 to 255 do
if abs(ClrCount[m]。Color - C) < Error then
begin
Error := abs(ClrCount[m]。
Color - C);
CIndex := m;
end;
ColorTable[ClrCount[i]。Color] := CIndex;
end;
end;//procedure AdjustColor
procedure Convert(SBitmap : TBitMap; var DBitMap: TBitMap) ;
var
Pal: PLogPalette;
i , j , t, ColorNumber: integer;
SPtr : PRGBColor;
DPtr : PByte;
begin
if (SBitMap。
Empty) then
Exit;
CountColor(SBitMap,ColorCount); //统计颜色的使用频率
ColorNumber := DelZero(ColorCount); //去处不使用的颜色
Sort(ColorCount,ColorNumber); // 将颜色按使用频率排序
AdjustColor(ColorNumber,ColorCount);
With DBitMap do
begin
PixelFormat := pf8bit;
SBitMap。
PixelFormat := pf24bit;
Width := SBitMap。Width;
Height := SBitMap。Height;
GetMem(pal, sizeof(TLogPalette) + sizeof(TPaletteEntry) * 255);
BuildColorTable(ColorCount,Pal);
Palette := BuildColorTable(ColorCount,Pal); // Set DBitMap。
Palette
FreeMem(pal);
for i := 0 to ( Height - 1 ) do
begin
SPtr := SBitMap。ScanLine[i];
DPtr := ScanLine[i];
for j := 0 to (Width - 1) do
begin
t := (SPtr。
R and $0F0) shl 4;
t := t + (SPtr。G and $0F0);
t := t + ((SPtr。B and $0F0) shr 4);
DPtr^ := ColorTable[t];
Inc(SPtr);
Inc(DPtr);
end;
end;
end;
end; //procedure Convert
end。
/////////////////////////////
在主程序中调用
uses CUnit2;
。。。
procedure TForm1。Button1Click(Sender: TObject);
begin
if OpenDialog1。
Execute then
Image1。Picture。LoadFromFile(OpenDialog1。FileName);
end;
procedure TForm1。Button2Click(Sender: TObject);
var Bmp : TBitMap;
begin
Bmp := TBitMap。
Create;
// Bmp。Assign(Image1。Picture。Bitmap);
Convert(Image1。Picture。Bitmap,Bmp);
PaintBox1。
Canvas。Draw(0,0,Bmp);
Bmp。Free;
end;
。收起