如何实现24位图转化成8位位图！！~~

    // 它的思想是：准备一个长度为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; 。