24位的bmp图像如何转换为16位的?100分,解决问题者再送100分.高手来帮忙,低手来试试.结贴率100%的哦

//  写的很匆忙可能效率不高请见谅 --- LHA  2001.11.7
//  Function: 24位颜色的BMP 转换为8位（256色）的BMP
//
//  它的思想是：准备一个长度为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) ;implementationvar
    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 < Mid do Dec(Hi);
      if Lo <= Hi then
      begin
        Temp := A[Lo];
        A[Lo] := A[Hi];
        A[Hi] := Temp;
        Inc(Lo);
        Dec(Hi);
      end;
    until Lo > 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
  Pal.palVersion:=$300;
  Pal.palNumEntries:=256;
  for i := 0 to 255 do
  begin
    Pal.palPalEntry[i].peRed := ((ClrCount[i].Color and $0F00) shr 4) + 7;
    Pal.palPalEntry[i].peGreen := (ClrCount[i].Color and $0F0) + 7;
    Pal.palPalEntry[i].peBlue := ((ClrCount[i].Color and $00F) shl 4) + 7;
    pal.palPalEntry[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 AdjustColorprocedure 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 Convertend.
/////////////////////////////
在主程序中调用
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;//////////////////////

经典的Floyed-Steinberg抖动算法,其中心思想是把误差按比例分给相邻的像素.
类似的方法还有Stucki算法:
      x  8  4
2  4  8  4  2
1  2  4  2  1
Burkes算法:
      x  8  4
2  4  8  4  2
其实我个人更倾向于用模式匹配的方法,效率很高. 比如Bayer模式.unit 24bitto256;
{$A-}
interfaceuses
   Sysutils, Classes, Dialogs, Graphics;procedure DitherImage(FullBMP : TBitmap);implementationvar
  CurrBMP : TBitmap;
  CurrPxlPos : Integer;
  CmpRVal,
  CmpGVal,
  CmpBVal    : Byte;
  RunRErr,
  RunGErr,
  RunBErr    : SmallInt;function DitherPixel(ABmp.Canvas.Pixels(Row, Col) : TColor) : TColor;
var
  I, J, K : Integer;
  RedVal,
  GreenVal,
  BlueVal : Byte;
  CurrRErr,
  CurrGErr,
  CurrBErr : SmallInt;
  MyClr : TColor;begin
  CurrRErr := 0;
  CurrGErr := 0;
  CurrBErr := 0;
  RedVal := ABmp.Canvas.Pixels(Row,Col).Red;
  GreenVal := ABmp.Canvas.Pixels(Row,Col).Green;
  BlueVal := ABmp.Canvas.Pixels(Row,Col).Blue;
  CmpRVal := ABmp.Canvas.Pixels(Row, Col + 1).Red;
  CmpGVal := ABmp.Canvas.Pixels(Row, Col + 1).Green;
  CmpBVal := ABmp.Canvas.Pixels(Row, Col + 1).Blue;
  CurrRErr := CurrRErr + (RedVal - CmpRVal) div 16;
  CurrGErr := CurrGErr + (GreenVal - CmpGVal) div 16;
  CurrBErr := CurrBErr + (BlueVal - CmpBVal) div 16;
  CmpRVal := ABmp.Canvas.Pixels(Row + 1, Col - 1).Red;
  CmpGVal := ABmp.Canvas.Pixels(Row + 1, Col - 1).Green;
  CmpBVal := ABmp.Canvas.Pixels(Row+ 1, Col - 1).Blue;
  CurrRErr := CurrRErr + ((RedVal - CmpRVal) div 16) * 7;
  CurrGErr := CurrGErr + ((GreenVal - CmpGVal) div 16) * 7;
  CurrBErr := CurrBErr + ((BlueVal = CmpBVal)) div 16) * 7;
  CmpRVal := ABmp.Canvas.Pixels(Row + 1, Col).Red;
  CmpGVal := ABmp.Canvas.Pixels(Row + 1, Col).Green;
  CmpBVal := ABmp.Canvas.Pixels(Row + 1, Col).Blue;
  CurrRErr := CurrRErr + ((RedVal - CmpRVal) div 16) * 5;
  CurrGErr := CurrGErr + ((GreenVal - CmpGVal) div 16) * 5;
  CurrBErr := CurrBErr + ((BlueVal - cmpBVal) div 16) * 5;
  CmpRVal := ABmp.Canvas.Pixels(Row + 1, Col + 1).Red;
  CmpGVal := ABmp.Canvas.Pixels(Row + 1, Col + 1).Green;
  CmpBVal := ABmp.Canvas.Pixels(Row + 1, Col + 1).Blue;
  CurrRErr := CurrRErr + ((RedVal - CmpRVal) div 16) * 3;
  CurrGErr := CurrGErr + ((GreenVal - CmpGVal) div 16) * 3;
  CurrBErr := CurrBErr + ((BlueVal - CmpBVal) div 16) * 3;
  RunRErr := RunRErr + CurrRErr;
  RunGErr := RunGErr + CurrGErr;
  RunBErr := RunBErr + CurrBErr;
  MyClr.Red := RedVal + RunRErr;
  MyClr.Green := GreenVal + RunGErr;
  MYClr.Blue := BlueVal + RunBErr;
  DitherPixel := MyClr;
end;procedure DitherLine(TheBMP : TBitmap; LineCntr : Integer);begin
  For J := 0 to TheBMP.Width - 1 do
  begin
    TheBMP.Canvas.Pixels(LineCntr, J) := DitherPxl(TheBMP.Canvas.Pixels(LineCntr, J));
  end;
end;procedure DitherImage(FullBMP : TBitmap);
var
  I : Integer;begin
  CurrBMP := TBitmap.Create;
  CurrBMP.Assign(FullBMP);
  RunErr := 0;
  for I := 0 to FullBMP.Height - 1 do
  begin
    DitherLine(CurrBMP, I);
  end;
  FullBMP.Assign(CurrBMP);
  CurrBMP.Free;
end;end.

图像处理的书上就有啊，
可以用RGB来计算某个点的灰度值，自己传建一个调色板，对应过去

直接，
bmp.PixelFormat:=pf16bit
剩下的工作让delphi帮你完成

晕到，24位色是最好处理的了，每个字节表示一个r，g，b值，即8-8-8，共3个字节。很多做图的，如果图像不是24位色，都先转成24位色，这样能很方便的用指针获得每点的rgb值，
如bmp.Scanline[0]就是对应TBitmap图像的第一行所有象素的指针地址，

就是转565格式吧,看看我写的一段,利用vcl自己的处理实现过程比较另类,大致如下:
1,建立一个内存流,并写入565位图的头信息
2,用TImage装入
3,将原图象画到TImage的Canvas上
4,保存procedure Convert555to565(var srcbmp: TBitmap);
var
  IM                : TMemoryStream;
  Img1              : TImage;
  Img2              : TImage;
  BH                : TBitmapFileHeader;
  BI                : TBitmapInfoHeader;
  tmpWord           : Word;
begin  Img1 := TImage.Create(nil);
  Img2 := TImage.Create(nil);
  Img1.AutoSize := FALSE;
  Img2.AutoSize := TRUE;
  Img2.Picture.Bitmap.Assign(srcbmp);  IM := TMemoryStream.Create;  try
    IM.Clear;    FillChar(BH, sizeof(BH), #0);       //填充0空值
    BH.bfType := $4D42;
    BI.biSize := 40;
    BI.biPlanes := 1;
    BI.biBitCount := 16;
    BI.biCompression := BI_BITFIELDS;
    BI.biXPelsPerMeter := 0;
    BI.biYPelsPerMeter := 0;
    BI.biClrUsed := 0;
    BI.biClrImportant := 0;
    BH.bfSize := srcbmp.width * srcbmp.height + sizeOf(BI);
    BI.biWidth := srcbmp.width;
    BI.biHeight := srcbmp.Height;
    BI.biSizeImage := (srcbmp.width * srcbmp.height) * 2;
    BH.bfOffBits := sizeof(BI) + sizeof(BH) + 3 * sizeof(dword);
    IM.Write(BH, SizeOf(BH));
    IM.Write(BI, sizeof(BI));
    tmpWord := 63488;                   //红
    IM.write(tmpWord, 4);               //
    tmpWord := 2016;                    //绿色
    IM.write(tmpWord, 4);               //
    tmpWord := 31;                      //
    IM.write(tmpWord, 4);               //
    IM.Seek(0, 0);    Img1.Picture.Bitmap.LoadFromStream(IM);
    Img1.Width := srcbmp.Width;
    Img1.Height := srcbmp.Height;
    Img1.Canvas.Draw(0, 0, Img2.Picture.Graphic);    srcbmp.Assign(Img1.Picture.Bitmap);
  finally
    Img1.Free;
    Img2.Free;
    IM.Free;
  end;end;

不好意思,我无能为力,csdn取消了分捐赠功能///////////////////////////////////////////////////////////////////////////////////
安全性考虑，CSDN目前版本取消可用分捐赠功能。下一版本我们会提供一个新的积分评价体系。
///////////////////////////////////////////////////////////////////////////////////

调试易

24位的bmp图像如何转换为16位的?100分,解决问题者再送100分.高手来帮忙,低手来试试.结贴率100%的哦

解决方案 »