Delphi Programming / Object Pascal
サイトのトップページへ リンクのページへ ロゴマーク
[掲載 2014年06月30日] [更新 2014年06月30日]　Delphi サンプルプログラム集
912_ビットマップの減色とグレイスケール化
動作確認等 Windows 7 U64(SP1) + Delphi XE(UP1) Pro
912_ReduceColors_GrayScale.zip　[9,019 KB]　2014年06月30日版 (EXE 同梱)
Junki さん作の画像処理用ユニット類を同梱



  • 2014年06月30日
  • [910_Disable なビットマップの作成] から，ビットマップの減色とグレイスケール化の記事を，新規作成の本ページに移動



ビットマップの減色とグレイスケール化


ビットマップの減色とグレイスケール化のサンプルです．
元の画像の色数を減らすことを「減色」と言っています．また，色数のことを「階調度」と言うこともあります．

Windows で扱えるビットマップの色数，1 ピクセルのビット数は，1, 4, 8, 16, 24, 32 です．
16 ビットはハイカラーと呼ばれていますが，非推奨です．したがって，減色は事実上，256 色または 16 色への減色を意味することになります．
なお，1 ビットは白黒 (モノクロ) とは限りません．2 色です．

Delphi で新規に TBitmap のオブジェクトを生成すると，その色数は 32 ビットとなります．
この色数は，PixelFormat プロパティで設定できますが，PexelFormat で減色した画像の品質は必ずしも良質とは言えません．そこで，本ページでは，ネット上で入所可能なコンポーネントやコード類を利用する減色方法をテストしています．






01_ビットマップ画像のビット数 ( 色数 ) の変更


次の方法で減色したビットマップを比較するサンプルです．
  • TBitmap.PixelFormat で設定したビットマップを使用
  • DHGL が提供している減色用の関数を使用
DHGL は中村拓男さんが提供している，グラフィック関係のグラフィックスライブラリ集です．


図1
設計時画面
図2
添付のビットマップ画像を読み込んで表示
  • これはアルファチャンネル付きの 32 ビット画像

下図は Button2 をクリックした結果です．色数が 8 ビットのビットマップを作成しています．
  • ディスクからビットマップ画像を読み出し TImage に描画する
  • 操作用のビットマップを生成し，そのビットマップの PixelFormat を pf8bit とする
  • そのビットマップのサイズを元のビットマップと同じサイズにする
  • そのビットマップの Canvas に TImage のビットマップ (元のビットマップ) を描画する
という手順で作成しています．


図3
色数を 8 ビットにした画像
  • TBitmap.PixelFormat := pf8bit で減色した場合

下図は，Button3 をクリックした場合の結果です．上の図と同じく 8 ビットにしていますが，中村拓男さんが提供している DHGL に含まれている MedianCut.pas 内の減色用の関数で，メディアンカットというアルゴリズムで減色しています．


図4
DHGL の関数を使用した 8 ビットへの減色
  • 減色アルゴリズムはメディアンカット

リスト1
ビットマップ画像のビット深さ (色数) の変更 
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Image1: TImage;
    Button2: TButton;
    Button3: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
  private
    { Private 宣言 }
    bmpWidth  : Integer;
    bmpHeight : Integer;
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

uses MedianCut;

{$R *.dfm}

//=============================================================================
//  ディスクから画像ファイルを読み込んでTImageに描画
//  画像ファイルのビット深さは32ビット(アルファチャンネル付き)
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  OriginBMP: TBitmap;
begin
  Image1.Picture.Assign(nil);
  Image1.Transparent := True;

  OriginBMP := TBitmap.Create;
  try
    OriginBMP.Transparent := True;
    OriginBMP.LoadFromFile('bmp-32.bmp');

    bmpWidth  := OriginBMP.Width;
    bmpHeight := OriginBMP.Height;

    Image1.Canvas.StretchDraw(Rect(0, 0, bmpWidth, bmpHeight), OriginBMP);
  finally
    FreeAndNil(OriginBMP);
  end;
end;

//=============================================================================
//  TImageに表示している画像をビットマップとして保存
//  TBitmap.PixelFormatを使用した方法
//  保存した画像は色数が8ビットの画像となる
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
var
  TempBMP : TBitMap;
begin
  Button1Click(nil);

  TempBMP := TBitMap.Create;
  try
    TempBMP.PixelFormat := pf8bit;
    TempBMP.SetSize(bmpWidth, bmpHeight);
    TempBMP.Canvas.Draw(0, 0, Image1.Picture.Bitmap);

    TempBMP.SaveToFile('bmp-8-1.bmp');

    Image1.Picture.Assign(nil);
    Image1.Picture.Assign(TempBMP);
  finally
    FreeAndNil(TempBmp);
  end;
end;

//=============================================================================
//  中村拓男さん提供のDHGLを使用した減色
//  メディアンカットによる減色
//  DHGLでは，元のビットマップのビット深さは24ビットで扱うことに注意
//
//  ReduceColorsByMedianCutの使用にはusesにMedianCutが必要
//=============================================================================
procedure TForm1.Button3Click(Sender: TObject);
var
  TempBmp : TBitmap;
  OutBmp  : TBitmap;
begin
  Button1Click(nil);

  TempBmp := TBitmap.Create;
  OutBmp  := TBitmap.Create;
  try
    TempBmp.PixelFormat := pf24bit;
    TempBmp.SetSize(bmpWidth, bmpHeight);
    TempBmp.Canvas.Draw(0, 0, Image1.Picture.Bitmap);

    OutBmp := ReduceColorsByMedianCut(TempBmp, 8);
    OutBmp.SaveToFile('bmp-8-2.bmp');

    Image1.Picture.Assign(nil);
    Image1.Picture.Assign(OutBmp);
  finally
    FreeAndNil(TempBmp);
    FreeAndNil(OutBmp);
  end;
end;

end.


ビットマップの色数は PixelFormat で変更できます．
画質をそれほど問題にしなければ使用可能でしょう．

TImage は表示用のコントロールです．ビットマップ等の画像は，その処理結果を描画する目的で使用する方がトラブルの回避になります．この意味では，TImage に描画中のビットマップを取得して処理する上のサンプルはあまり適切とは言えないかも知れません．




02_TNkDIB を使用したビットマップ画像の減色


上のサンプルの例ように，ビットマップを減色するには，ただ単に PixelFormat で色数を変えただけでは品質の高い減色画像が得られないことが分かりました．
上のサンプルでも使用した中村拓男さんが提供している TNkDIB というビットマップ操作関係のユニットを使用すると，画質の高い減色が可能です．TNkDIB (NkDIB) は非常に機能が豊富です．中村の里でダウンロードすることができます．

次のサンプルは，この TNkDIB を使用したビットマップの減色の例です．減色のアルゴリズムについては，TNkDIB に添付の文書で確認してください．

次のサンプルは，8 ビットと 4 ビットへの減色のテストです．
Button1 クリックイベントでは，元の 32 ビット色のビットマップを TBitmap.PixelFormat で 8 ビット，つまり 256 色にした結果と TNkDIB で 256 色にした結果を比較します．
Button2 のコードでは 4 ビット (16 色) に減色します．
Button3 のコードは，ハーフトーンのグレイスケール画像にした後，16 色に変換し，結果的に 4 ビット (16 色) のグレイスケールのビットマップ画像にしています．

TNkDIB は，アルファチャンネルの操作はしません．そこで，このサンプルでは，上のサンプルで使用している 32 ビットの画像の透明部分である背景を「白」にした画像を使用しています．



図5
設計時画面
図6
8 ビット(256 色) に減色
  • 左は TBitmap の PixelFormat を使用
  • 右は TNkDIB を使用した結果
図7
4 ビット(16 色) に減色
  • 左は TBitmap の PixelFormat を使用
  • 右は TNkDIB を使用した結果．少し縞模様になっているが，品質は高い
図8
グレイスケールの画像に変換
  • 左は元の画像
  • 右は TNkDIB で 4 ビットの深さにしたグレイスケールのハーフトーン画像

リスト2
TNkDIB を使用したビットマップ画像の減色
TNkDIB は機能が豊富で，減色したグレイスケールのビットマップへの変換も可能		 
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Image1: TImage;
    Image2: TImage;
    Button2: TButton;
    Button3: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

uses NkDIB;

{$R *.dfm}

//=============================================================================
//  TNkDIBを使用したビットマップの減色
//  8ビット(256色)に減色
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  tempBmp : TBitmap;
  dibBmp  : TNkDIB;
begin
  Image1.Transparent := True;

  tempBmp := TBitmap.Create;
  dibBmp  := TNkDIB.Create;
  try
    tempBmp.LoadFromFile('bmp-32.bmp');

    //NkDIBに読み込んだビットマップをコピー
    dibBmp.Assign(tempBmp);

    //ビットマップの色数を8ビット(256)色にして表示
    tempBmp.PixelFormat := pf8bit;
    Image1.Picture.Assign(tempBmp);

    //NkDIBビットマップの色数を8ビット(256)色にして表示
    dibBmp.PixelFormat := nkPf8Bit;
    Image2.Picture.Assign(dibBmp);

    //保存
    tempBmp.SaveToFile('bmp-11.bmp');
    dibBmp.SaveToFile ('bmp-12.bmp');
  finally
    FreeAndNil(tempBmp);
    FreeAndNil(dibBmp);
  end;
end;

//=============================================================================
//  TNkDIBを使用したビットマップの減色
//  4ビット(16色)に減色
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
var
  tempBmp : TBitmap;
  dibBmp  : TNkDIB;
begin
  Image1.Transparent := True;

  tempBmp := TBitmap.Create;
  dibBmp  := TNkDIB.Create;
  try
    tempBmp.LoadFromFile('bmp-32.bmp');

    //NkDIBに読み込んだビットマップをコピー
    dibBmp.Assign(tempBmp);

    //ビットマップの色数を4ビット(16)色にして表示
    tempBmp.PixelFormat := pf4bit;
    Image1.Picture.Assign(tempBmp);

    //NkDIBビットマップの色数を4ビット(16)色にして表示
    dibBmp.PixelFormat := nkPf4Bit;
    Image2.Picture.Assign(dibBmp);

    //保存
    tempBmp.SaveToFile('bmp-21.bmp');
    dibBmp.SaveToFile ('bmp-22.bmp');
  finally
    FreeAndNil(tempBmp);
    FreeAndNil(dibBmp);
  end;
end;

//=============================================================================
//  TNkDIBを使用したビットマップの減色
//  色数が4ビット(16色)のグレイスケールのビットマップを作成
//=============================================================================
procedure TForm1.Button3Click(Sender: TObject);
var
  tempBmp : TBitmap;
  dibBmp  : TNkDIB;
begin
  Image1.Transparent := True;

  tempBmp := TBitmap.Create;
  dibBmp  := TNkDIB.Create;
  try
    tempBmp.LoadFromFile('bmp-32.bmp');

    //NkDIBに読み込んだビットマップをコピー
    dibBmp.Assign(tempBmp);

    //元のビットマップを表示
    Image1.Picture.Assign(tempBmp);

    //ビットマップをグレイスケールのハーフトーンにして色数を4ビット(16)色する
    dibBmp.PixelFormat := nkPfHalftoneBW;
    dibBmp.PixelFormat := nkPf4Bit;
    Image2.Picture.Assign(dibBmp);

    //保存
    dibBmp.SaveToFile ('bmp-31.bmp');
  finally
    FreeAndNil(tempBmp);
    FreeAndNil(dibBmp);
  end;
end;

end.



03_TGIFImage を使用したビットマップ画像の減色


ビットマップの減色は，TGIFImage の ReduceColors 関数を使用しても可能です．
そのサンプルです．この関数の引数で減色方法とディザリングモードを設定できます．この指定によって結果が異なってきます．ただし，グレイスケール化は，256 色限定で，ディザリングモードたけが指定可能です．

GIF 形式の画像は，1 ビット (2 色) から 8 ビット (256 色) までを扱えますが，GIF 画像のビット深さは 8 ビットです．したがって，このサンプルで保存した画像ファイルのビット深さは 8 ビットとなります．これはエクスプローラからファイルの [プロパティ] ダイアログで確認できます．

Delphi 2006 以前で GIF 画像を扱うには，後述の [07_VCLImageUtils を使用したビットマップ画像のグレイスケール化] の記事を参考にしてください．



図9
設計時画面
図10
256 色と 16 色に減色した結果
  • 左は 256 色に減色した結果
  • 右は 16 色に減色した結果．少し縞模様が認められる
図11
上と同じく 256 と 16 色に変換
  • 左が 256 色に減色した結果
  • 右が 16 色に減色した結果
  • 上の図と違うのはディザリングモードの指定
図12
256 色のグレイスケールの画像に変換
  • 減色方法に rmGrayScale を指定するとグレイスケールにできるが，色数の指定は無視される

リスト3
TGIFImg を使用したビットマップ画像の減色
グレイスケールの減色はできない		 
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Image1: TImage;
    Button2: TButton;
    Button3: TButton;
    Image2: TImage;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

uses Gifimg;

{$R *.dfm}

//=============================================================================
//  TGIFImageを使用したビットマップの減色
//  256色と16色に減色
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  SrcBmp : TBitmap;
  DstBmp : TBitmap;
begin
  Image1.Transparent := True;
  Image2.Transparent := True;

  SrcBmp := TBitmap.Create;
  DstBmp := TBitmap.Create;
  try
    SrcBmp.LoadFromFile('bmp-32.bmp');

    //8ビット(256色)に減色
    //操作結果のビットマップを保存して，それを読み出してImage1に表示
    DstBmp := ReduceColors(SrcBmp, rmQuantizeWindows, dmSierra, 8, 0);
    DstBmp.SaveToFile('gif-11.bmp');
    Image1.Picture.LoadFromFile('gif-11.bmp');

    //4ビット(16色)に減色
    //操作結果のビットマップを保存して，それを読み出してImage2に表示
    DstBmp := ReduceColors(SrcBmp, rmQuantize, dmSierra, 4, 0);
    DstBmp.SaveToFile('gif-12.bmp');
    Image2.Picture.LoadFromFile('gif-12.bmp');
  finally
    FreeAndNil(SrcBmp);
    FreeAndNil(DstBmp);
  end;
end;

//=============================================================================
//  TGIFImageを使用したビットマップの減色
//  256色と16色に減色
//  TColorReductionとTDitherModeの値によって結果が異なることの確認用
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
var
  SrcBmp : TBitmap;
  DstBmp : TBitmap;
begin
  Image1.Transparent := True;
  Image2.Transparent := True;

  SrcBmp := TBitmap.Create;
  DstBmp := TBitmap.Create;
  try
    SrcBmp.LoadFromFile('bmp-32.bmp');

    //8ビット(256色)に減色
    //操作結果のビットマップを保存して，それを読み出してImage1に表示
　  DstBmp := ReduceColors(SrcBmp, rmQuantize, dmFloydSteinberg, 8, 0);
    DstBmp.SaveToFile('gif-21.bmp');
    Image1.Picture.LoadFromFile('gif-21.bmp');

    //4ビット(16色)に減色
    //操作結果のビットマップを保存して，それを読み出してImage2に表示
    DstBmp := ReduceColors(SrcBmp, rmQuantize, dmFloydSteinberg, 4, 0);
    DstBmp.SaveToFile('gif-22.bmp');
    Image2.Picture.LoadFromFile('gif-22.bmp');
  finally
    FreeAndNil(SrcBmp);
    FreeAndNil(DstBmp);
  end;
end;

//=============================================================================
//  TGIFImageを使用したビットマップのグレイスケール化
//  グレイスケール(rmGrayScale)の場合は色数の指定は無視される．その確認
//=============================================================================
procedure TForm1.Button3Click(Sender: TObject);

var
  SrcBmp : TBitmap;
  DstBmp : TBitmap;
begin
  Image1.Transparent := True;
  Image2.Transparent := True;

  SrcBmp := TBitmap.Create;
  DstBmp := TBitmap.Create;
  try
    SrcBmp.LoadFromFile('bmp-32.bmp');

    //8ビット(256色)を指定してグレイスケール化
    //操作結果のビットマップを保存して，それを読み出してImage1に表示
    DstBmp := ReduceColors(SrcBmp, rmGrayScale, dmNearest, 8, 0);
    DstBmp.SaveToFile('gif-31.bmp');
    Image1.Picture.LoadFromFile('gif-31.bmp');

    //4ビット(16色)を指定してグレイスケール化
    //操作結果のビットマップを保存して，それを読み出してImage2に表示
    DstBmp := ReduceColors(SrcBmp, rmGrayScale, dmNearest, 4, 0);
    DstBmp.SaveToFile('gif-32.bmp');
    Image2.Picture.LoadFromFile('gif-32.bmp');
  finally
    FreeAndNil(SrcBmp);
    FreeAndNil(DstBmp);
  end;
end;

end.



04_TGIFImage で減色したビットマップのビット深さを 4 にする


上の TGIFImage を使用したビットマップの減色は，ディザリングモードを指定できますが，4 ビットに減色したビットマップのビット深さは 8 ビットです． これをビット深さ 4 ビットのビットマップに変換する関数を作成してみました．

TBitmap の PixelFormat を pf4bit にした画像のないビットマップを作成し，パレットとビットマップ画像のデータを TGIFImage で作成したビットマップから取得しています．
この時，Pixels プロパティで色の値をセットしてしまうと，PixelFormat を pf4bit にしただけの時と同じ低い品質の画像になってしまいます．そこで，ビットマップのヘッダ情報を取得して，メモリ操作でデータをセットしています．



図13
設計時画面
図14
16 色への減色結果
  • 左端は元の画像
  • 次は dmNearest モード
  • 次は dmBurkes モード

リスト4
TGIFImg を使用して 16 色に減色したビットマップの深さは 8 ビット
それを 4 ビットの深さのビットマップにするサンプル		 
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Image1: TImage;
    Image2: TImage;
    Image3: TImage;
    procedure Button1Click(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

uses Gifimg;

{$R *.dfm}

type
  TplBitmapHeader = packed record
    BmpFileHeader : TBitmapFileHeader;
    BmpInfoHeader : TBitmapInfoHeader;
    BmpInfoColors : array of TRGBQuad;
  end;
  PplBitmapHeader = ^TplBitmapHeader;

//-----------------------------------------------------------------------------
//  TGIFImageを使用して作成したビットマップのビット深さを変更する関数
//  4ビットのみ対応
//  4ビット以外はGIFImageのReduceColors関数の結果をそのまま返す
//
//  SrcBmp     : 減色対象のビットマップ
//  DitherMode : 減色ディザモード
//  Bits       : 減色後の色ビット数(4または8)
//
//  usesにGifimg(Delphi 2007以降)が必要
//-----------------------------------------------------------------------------
function Reduct4bitColorDepthBitmap(SrcBmp: TBitmap; DitherMode: TDitherMode;
  Bits: Integer): TBitmap;
var
  NumOfColors  : Integer;
  SrcHeader    : TplBitmapHeader;
  DstHeader    : TplBitmapHeader;
  SrcStream    : TMemoryStream;
  DstStream    : TMemoryStream;
  DstBmp       : TBitmap;
  SrcImageSize : Cardinal;
  DstImageSize : Cardinal;
  SrcBmpData   : array of Byte;
  DstBmpData   : array of Byte;
  i            : Integer;
begin
  Result := nil;

  //元のビットマップをTGIGImageの関数を使用して減色処理
  Result := ReduceColors(SrcBmp, rmQuantize, DitherMode, Bits, 0);
  if Bits <> 4 then exit;

  //減色後の色数
  NumOfColors := 1 shl Bits;
  SrcStream   := TMemoryStream.Create;
  try
    //TGIFImageのReduceColorsで作成したビットマップをストリームに保存
    Result.SaveToStream(SrcStream);

    //ヘッダ部の情報を読み出す
    SrcStream.Position := 0;
    SrcStream.Read(SrcHeader.BmpFileHeader, SizeOf(TBitmapFileHeader));
    SrcStream.Read(SrcHeader.BmpInfoHeader, SizeOf(TBitmapInfoHeader));

    //カラーパレット用のバイト配列のサイズを設定して読み出す
    SetLength(SrcHeader.BmpInfoColors, NumOfColors * SizeOf(TRGBQuad));
    SrcStream.Read(SrcHeader.BmpInfoColors[0], NumOfColors * SizeOf(TRGBQuad));

    //ビットマップデータ用のバイト配列のサイズと読み出し位置を設定して読み出す
    SrcStream.Position := SrcHeader.BmpFileHeader.bfOffBits;
    SrcImageSize := SrcHeader.BmpInfoHeader.biSizeImage;
    SetLength(SrcBmpData, SrcImageSize);
    SrcStream.Read(SrcBmpData[0], SrcImageSize);
  finally
    FreeAndNil(SrcStream);
  end;


  //出力用のビットマップを生成
  DstBmp             := TBitmap.Create;
  DstBmp.PixelFormat := pf4bit;
  DstBmp.Width       := SrcBmp.Width;
  DstBmp.Height      := SrcBmp.Height;

  //出力先用のデータ操作のストリームを生成
  DstStream := TMemoryStream.Create;
  try
    DstBmp.SaveToStream(DstStream);

    //出力先のビットマップのヘッダ部の情報を読み出す
    DstStream.Position := 0;
    DstStream.Read(DstHeader.BmpFileHeader, SizeOf(TBitmapFileHeader));
    DstStream.Read(DstHeader.BmpInfoHeader, SizeOf(TBitmapInfoHeader));

    //カラーパレットの情報を書き込む
    //カラーパレットの値は，TGIFImageで作成したビットマップのもの
    DstStream.Write(SrcHeader.BmpInfoColors[0], NumOfColors * SizeOf(TRGBQuad));

    //出力先ビットマップデータ用のバイト配列を確保
    DstImageSize := DstHeader.BmpInfoHeader.biSizeImage;
    SetLength(DstBmpData, DstImageSize);

    //確保したバイト配列にビットマップデータを書き込む
    for i := 0 to DstImageSize - 1 do begin
      DstBmpData[i] := (SrcBmpData[i * 2] shl 4) or (SrcBmpData[i * 2 + 1]);
    end;
    //バイト配列に格納したビットマップデータをストリームに書き込む
    DstStream.Position := DstHeader.BmpFileHeader.bfOffBits;
    DstStream.Write(DstBmpData[0], DstImageSize);

    //出力先のビットマップに，ビットマップをストリームから読み込む
    DstStream.Position := 0;
    DstBmp.LoadFromStream(DstStream);
    Result.Assign(DstBmp);
  finally
    FreeAndNil(DstBmp);
    FreeAndNil(DstStream);
  end;
end;

//=============================================================================
//  TGIFImageで減色した4ビットのビットマップのビット深さを4ビットにする
//  4ビット以外はTGIFImage.ReduceColorsを実行したまま
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  ColorBits : Integer;
  SrcBmp    : TBitmap;
  DstBmp    : TBitmap;
begin
  ColorBits := 4;
  SrcBmp    := TBitmap.Create;
  DstBmp    := TBitmap.Create;
  try
    SrcBmp.LoadFromFile('bmp-32.bmp');
    Image1.Picture.Assign(SrcBmp);

    DstBmp := Reduct4bitColorDepthBitmap(SrcBmp, dmNearest, ColorBits);
    if DstBmp <> nil then begin
      Image2.Picture.Assign(DstBmp);
      DstBmp.SaveToFile('001.bmp');
    end;

    DstBmp := Reduct4bitColorDepthBitmap(SrcBmp, dmBurkes, ColorBits);
    if DstBmp <> nil then begin
      Image3.Picture.Assign(DstBmp);
      DstBmp.SaveToFile('002.bmp');
    end;
  finally
    FreeAndNil(SrcBmp);
    FreeAndNil(DstBmp);
  end;
end;

end.



05_ビットマップのカラーパレットの表示


減色とは直接関係ありませんが，上のサンプルを作成する際に確認のために作成したコードです．
参考用に添付しておきました．
左の画像は 256 色で，右は 16 色に減色した画像です．パレットのデータは 256 色以下のビットマップだけに存在します．24, 32 ビットのビットマップには存在しません．


図15
実行例
図16
別の減色アルゴリズムの場合

リスト5
ビットマップのカラーパレットの表示		 
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Image1: TImage;
    Image2: TImage;
    Image3: TImage;
    Button2: TButton;
    Image4: TImage;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private 宣言 }
    procedure DrawPalleteColor(OutImage: TImage; TargetBmp: TBitmap;
      BitsColors, RectSize: Integer);
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

uses Gifimg;

{$R *.dfm}

//=============================================================================
//  TGIFImageを使用したビットマップの減色
//  256色と16色に減色
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LSrcBmp : TBitmap;
  LDstBmp : TBitmap;
begin
  Image1.Transparent := True;
  Image2.Transparent := True;

  LSrcBmp := TBitmap.Create;
  LDstBmp := TBitmap.Create;
  try
    LSrcBmp.LoadFromFile('bmp-32.bmp');

    //8ビット(256色)に減色
    //操作結果のビットマップを保存して，それを読み出してImage1に表示
    LDstBmp := ReduceColors(LSrcBmp, rmQuantize, dmSierra, 8, 0);
    Image1.Picture.Assign(LDstBmp);

    //DstBmpのパレットを描画
    DrawPalleteColor(Image3, LDstBmp, 8, 15);

    //4ビット(16色)に減色
    //操作結果のビットマップを保存して，それを読み出してImage2に表示
    LDstBmp := ReduceColors(LSrcBmp, rmQuantize, dmNearest, 4, 0);
    Image2.Picture.Assign(LDstBmp);

    //DstBmpのパレットを描画
    DrawPalleteColor(Image4, LDstBmp, 4, 15);
  finally
    FreeAndNil(LSrcBmp);
    FreeAndNil(LDstBmp);
  end;
end;

//=============================================================================
//  TGIFImageを使用したビットマップの減色
//  256色と16色に減色
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
var
  LSrcBmp : TBitmap;
  LDstBmp : TBitmap;
begin
  Image1.Transparent := True;
  Image2.Transparent := True;

  LSrcBmp := TBitmap.Create;
  LDstBmp := TBitmap.Create;
  try
    LSrcBmp.LoadFromFile('bmp-32.bmp');

    //8ビット(256色)に減色
    //操作結果のビットマップを保存して，それを読み出してImage1に表示
    LDstBmp := ReduceColors(LSrcBmp, rmQuantizeWindows, dmSierra, 8, 0);
    Image1.Picture.Assign(LDstBmp);

    //DstBmpのパレットを描画
    DrawPalleteColor(Image3, LDstBmp, 8, 15);

    //4ビット(16色)に減色
    //操作結果のビットマップを保存して，それを読み出してImage2に表示
    LDstBmp := ReduceColors(LSrcBmp, rmQuantize, dmBurkes, 4, 0);
    Image2.Picture.Assign(LDstBmp);

    //DstBmpのパレットを描画
    DrawPalleteColor(Image4, LDstBmp, 4, 15);
  finally
    FreeAndNil(LSrcBmp);
    FreeAndNil(LDstBmp);
  end;
end;

//-----------------------------------------------------------------------------
//  OitImage(TImage)にTargetBmp(TBitmap)のパレットの色を描画するルーチン
//  BitsColorsはパレットのビット数(色のビット数
//  RectSizeは描画する矩形のサイズ
//-----------------------------------------------------------------------------
procedure TForm1.DrawPalleteColor(OutImage: TImage; TargetBmp: TBitmap;
  BitsColors, RectSize: Integer);
var
  LPosY        : Integer;
  LPosX        : Integer;
  LLeft        : Integer;
  LTop         : Integer;
  LCntVertRect : Integer;
  LCntHorzRect : Integer;
  LIndex       : Integer;
begin
  case BitsColors of
  1: begin
       LCntHorzRect := 1;
       LCntVertRect := 2;
     end;
  2: begin
       LCntHorzRect := 2;
       LCntVertRect := 2;
     end;
  3: begin
       LCntHorzRect := 2;
       LCntVertRect := 4;
     end;
  4: begin
       LCntHorzRect := 4;
       LCntVertRect := 4;
     end;
  5: begin
       LCntHorzRect := 4;
       LCntVertRect := 8;
     end;
  6: begin
       LCntHorzRect := 8;
       LCntVertRect := 8;
     end;
  7: begin
       LCntHorzRect := 8;
       LCntVertRect := 16;
     end;
   8: begin
       LCntHorzRect := 16;
       LCntVertRect := 16;
     end;
    else begin
       LCntHorzRect := 0;
       LCntVertRect := 0;
    end;
  end;

  OutImage.Picture.Assign(nil);
  OutImage.Width  := LCntHorzRect * RectSize - LCntHorzRect + 1;
  OutImage.Height := LCntVertRect * RectSize - LCntVertRect + 1;

  OutImage.Canvas.Pen.Width :=0;
  OutImage.Canvas.Pen.Color :=clBlack;

  SelectPalette(OutImage.Canvas.Handle, TargetBmp.Palette, False);
  RealizePalette(OutImage.Canvas.Handle);

  LTop := 0;
  //縦方向は
  for LPosY := 0 to LCntVertRect - 1 do begin
    LLeft := 0;
    for LPosX := 0 to LCntHorzRect - 1 do begin
      LIndex := LCntHorzRect * LPosY + LPosX;
      OutImage.Canvas.Brush.Color := PALETTEINDEX(LIndex);
      OutImage.Canvas.Rectangle(LLeft, LTop, LLeft + RectSize, LTop + RectSize );
      Inc( LLeft, RectSize - 1);
    end;
    Inc( LTop, RectSize - 1);
  end;
end;

end.



06_ビットマップ画像のグレイスケール化


EDN (Embarcadero Developer Network) の ID: 27677 でビットマップのグレイスケール化用のユニットが提供されています．以下はこのユニットを使用したサンプルです．このユニットは，ScanLine を使用しない方法，グレイスケール化の際に，各色の重みづけを変えた時の結果の違いを確認することができます．
Button1 のコードでは，ビットマップを 24 ビットとして扱います．したがって，結果のビットマップ画像も 24 ビットの深さとなります．

Button2 のコードは，グレイスケール化した後に，TNkDIB で 4 ビット (16 色) に減色処理したビットマップを作成します．高品質のグレイスケールのビットマップが作成できます．



図17
設計時画面
図18
24 ビットにグレイスケール化した画像
  • 左は元の 32 ビットの画像であるが，24 ビットに変換したもの
  • 右はグレイスケール化した 24 ビットの画像
図19
4 ビットにグレイスケール化した画像
  • 左は元の 32 ビットの画像であるが，24 ビットに変換したもの
  • 右は TNkDIB で 16 色に減色処理したグレイスケール化ビットット画像
    上の画像と比べて，少し縞模様が見える

リスト6
ビットマップ画像のグレイスケール化
TNkDIB と組み合わせると高品質のグレイスケールの減色ビットマップの作成が可能		 
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Image1: TImage;
    Image2: TImage;
    Button2: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

uses uBitmapUtils, NkDIB;

{$R *.dfm}

//=============================================================================
//  EDN ID: 27677のuBitmapUtilsを使用したビットマップのグレイスケール化
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  SrcBmp       : TBitmap;
  DstBmp       : TBitmap;
  bmpGrayScale : TColor2Grayscale;
  bmpAccess    : TBitmapAccess;
begin
  Image1.Transparent := True;
  Image2.Transparent := True;

  SrcBmp := TBitmap.Create;
  DstBmp := TBitmap.Create;
  try
    SrcBmp.LoadFromFile('bmp-32.bmp');
    SrcBmp.PixelFormat := pf24bit;

    //読み込んだビットマップをコピー
    DstBmp.Assign(SrcBmp);

    //グレイスケールの設定をしてグレイスケールのビットマップを作成
    bmpGrayScale := uBitmapUtils.TColor2Grayscale.c2gLuminosity;
    bmpAccess    := uBitmapUtils.TBitmapAccess.baScanLine;
    uBitmapUtils.ToGray(DstBmp, bmpGrayScale, bmpAccess);

    //元のビットマップとグレイスケール化したビットマップを表示
    Image1.Picture.Assign(SrcBmp);
    Image2.Picture.Assign(DstBmp);

    //保存
    DstBmp.SaveToFile('bmp-1.bmp');
  finally
    FreeAndNil(SrcBmp);
    FreeAndNil(DstBmp);
  end;
end;

//=============================================================================
//  uBitmapUtilsとTNkDIBを使用したビットマップのグレイスケール化
//  高い品質のグレイスケールの画像が作成できる
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
var
  SrcBmp       : TBitmap;
  bmpGrayScale : TColor2Grayscale;
  bmpAccess    : TBitmapAccess;
  dibBmp       : TNkDIB;
begin
  Image1.Transparent := True;
  Image2.Transparent := True;

  SrcBmp := TBitmap.Create;
  try
    SrcBmp.LoadFromFile('bmp-32.bmp');
    SrcBmp.PixelFormat := pf24bit;

    //読み込んだビットマップを表示
    Image1.Picture.Assign(SrcBmp);

    //グレイスケールの設定をしてグレイスケールのビットマップを作成
    bmpGrayScale := uBitmapUtils.TColor2Grayscale.c2gLuminosity;
    bmpAccess    := uBitmapUtils.TBitmapAccess.baScanLine;
    uBitmapUtils.ToGray(SrcBmp, bmpGrayScale, bmpAccess);

    dibBmp := TNkDIB.Create;
    try
      dibBmp.Assign(SrcBmp);
      dibBmp.PixelFormat := nkPf4Bit;
      dibBmp.SaveToFile('bmp-2.bmp');
      Image2.Picture.Assign(dibBmp);
    finally
      FreeAndNil(dibBmp);
    end;
  finally
    FreeAndNil(SrcBmp);
  end;
end;

end.



07_VCLImageUtils を使用したビットマップ画像のグレイスケール化


ビットマップの操作ついて，[めもニャンだむ] の Junki さんが多くのサンプルを掲載しています．主に，その中の VCLImageUtils というビットマップ操作用の関数類を収めたユニットを利用した，ビットマップのグレイスケール化のサンプルです．
高品質の減色化グレイスケールのビットマップ画像が作成できます．

Junki さん作成のユニット類は，現在ダウンロードできません．再配布条件に基づき，本ページのサンプルプログラムのダウンロードファイルに同梱しています．リンクの最初のサンプル以外の関数類は全て VCLImageUtils.pas に含まれています．

VCLImageUtils では GIFImage と PngImage が必要ですが，GIFImage は Delphi 2007 以降，PngImage は Delphi 2009 以降で使用可能です．
Delphi 2009 以降で使用する場合は，VCLImageUtils の以下の部分を修正して使用してください．

  • uses 部に Types を追加
  • uses 部の GifImage を GifImg に変更
  • TPngObject を TPngImage に変更

Delphi 2007 以前で使用可能な GIF 画像と PNG 画像操作用のユニット類が，2014年03月03日現在，下のリンクからダウンロードできます．Delphi 7, 2007 で使用可能であることを確認しています．


上のリンクの PngImage を Delphi 2009 以降で使用すると，「E2064 代入できない左辺値です」のエラーが発生します．このエラーは，Delphi 2007 以前のコードを， Delphi 2009 以降で使用する際によく発生するエラーです．
これは，Delphi 2007 以前で，PChar 等をポインタの代わりに使用していると発生します．逆に，Delphi 2009 以降で使用可能なコードに修正したものは，Delphi 2007 以前でも使用可能です．

下の図とコードは，VCL TBitmap GrayScale4FloydStucci と同じ動作をするコードとその実行結果です．元の 32 ビットのビットマップを 4 ビットである 16 色のビットにしています．
これ以外のサンプルは，ダウンロードしたファイルに同梱しています．



図20
実行結果

リスト7
Junki さんの VCL TBitmap GrayScale4FloydStucci サンプルと同じ動作をするコード		 
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Image1: TImage;
    Image2: TImage;
    Image3: TImage;
    procedure Button1Click(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

uses VCLImageUtils;

{$R *.dfm}

//=============================================================================
//  JunkiさんVCLImageUtilsを使用したサンプル
//  VCL TBitmap GrayScale4FloydStucciと同じ動作をするコード
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  SrcBmp : TBitmap;
  DstBmp : TBitmap;
begin
  SrcBmp := TBitmap.Create;
  try
    SrcBmp.LoadFromFile('bmp-32.bmp');
    Image1.Canvas.Draw(0, 0, SrcBmp);

    DstBmp := BmpClone(SrcBmp);
    try
      DstBmp.PixelFormat := pf24bit;
      if GrayScale4(DstBmp) then Image2.Canvas.Draw(0, 0, DstBmp);
    finally
      FreeAndNil(DstBmp);
    end;

    DstBmp := BmpClone(SrcBmp);
    try
      DstBmp.PixelFormat := pf24bit;
      if GrayScale4FloydStucci(DstBmp, false) then Image3.Canvas.Draw(0, 0, DstBmp);
    finally
      FreeAndNil(DstBmp);
    end;
  finally
    FreeAndNil(SrcBmp);
  end;
end;

end.



08_Delphi 2009 以降と Delphi 2007 以前でのピクセル操作


正確には，32 ビットと 24 ビットのビットマップのピクセル操作の例です．
Delphi 2009 では アルファチャネルをサポートした 32 ビットのビットマップが使用可能になりました．32 ビットは 4 バイトの色配列です．一方 24 ビットは 3 バイトの色配列です．
ネット上のサンプルを利用する際は注意が必要です．24 ビットのビットマップを前提にして動作確認しているサンプルがあります．

これまでのサンプルでは，主に 24 ビットのビットマップにして操作しています．次のサンプルは．元のビットマップを 24 ビットと 32 ビットの両方のビットマップとして操作して，元の画像をグレイスケール化する例です．



[備考 1]
色のビット数を「色数」と書いていますが，実際には 24 ビットも 32 ビットも色数は同じです．最上位の予約済みバイトの使用方法の違いです，
Delphi 2009 以降の TBitmap は，このバイトをアルファチャンネルとして使用しています．したがって，24 ビットのピクセル操作に RGBQUAD を使用しても問題ありません．下のコードでは，予約済みバイトの処理をしない RGBTRIPLE を使用しています．


[備考 2]
ScanLine プロパティは，for a to b do というループの中で使用した場合，a から b の範囲のピクセルのデータを全て配列に格納します．その配列の要素に対する操作そのものが，ピクセルのデータの操作となり，高速処理が可能です．
Pixcels プロパティからも指定座標のピクセルのデータを取得することができますが，この Pixels は，各座標のデータ取得にも書き込みにも，Scanline と同じ様な処理を実行しています．したがって，データの処理に時間がかかることになります．



図21
実行結果

リスト8
ビットマップのピクセル操作を 24 ビットまたは 32 ビットで操作する例		 
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Image1: TImage;
    Image2: TImage;
    procedure Button1Click(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

//-----------------------------------------------------------------------------
//  32ビットのビットマップをグレイスケール化するルーチン
//  32ビットは4バイトの色配列なのでRGBQUADを使用する
//  アルファチャンネルの処理も必要
//  Delphi 2009以降用
//-----------------------------------------------------------------------------
procedure BitmapColorTo32GrayScale(ABitmap: TBitmap);
type
  TRGBQArray = array [0..High(Integer) div 4 - 1] of RGBQUAD;
  PRGBQArray = ^TRGBQArray;
var
  LRValue    : Byte;
  LGValue    : Byte;
  LBValue    : Byte;
  LAValue    : Byte;
  LGray      : WORD;
  LPosY      : Integer;
  LPosX      : Integer;
  LScanArray : PRGBQArray;
  LColorQuad : RGBQUAD;
begin
  ABitmap.Canvas.Lock;
  ABitmap.PixelFormat := pf32bit;

  for LPosY := 0 to ABitmap.Height - 1 do begin
    LScanArray := ABitmap.ScanLine[LPosY];
    for LPosX  := 0 to ABitmap.Width - 1 do begin

      LRValue := LScanArray[LPosX].rgbRed;
      LGValue := LScanArray[LPosX].rgbGreen;
      LBValue := LScanArray[LPosX].rgbBlue;
      LAValue := LScanArray[LPosX].rgbReserved;

      LGray := Round((0.298912 * LRValue) + (0.586611 * LGValue) + (0.114478 * LBValue));
      if LGray > $FF then LGray := $FF;

      LColorQuad.rgbBlue     := LGray;
      LColorQuad.rgbGreen    := LGray;
      LColorQuad.rgbRed      := LGray;
      LColorQuad.rgbReserved := LAValue;

      LScanArray[LPosX] := LColorQuad;
    end;
  end;

  ABitmap.Canvas.Unlock;
end;

//-----------------------------------------------------------------------------
//  24ビットのビットマップをグレイスケール化するルーチン
//  24ビットは3バイトの色配列なのでRGBTRIPLEを使用する
//  Delphi 2007以前用
//-----------------------------------------------------------------------------
procedure BitmapColorTo24GrayScale(ABitmap: TBitmap);
type
  TRGBTArray = array [0..High(Integer) div 3 - 1] of RGBTRIPLE;
  PRGBTArray = ^TRGBTArray;

var
  LRValue      : Byte;
  LGValue      : Byte;
  LBValue      : Byte;
  LGray        : WORD;
  LPosY        : Integer;
  LPsX         : Integer;
  LScanArray   : PRGBTArray;
  LColorTriple : RGBTRIPLE;
begin
  ABitmap.Canvas.Lock;
  ABitmap.PixelFormat := pf24bit;

  for LPosY := 0 to ABitmap.Height - 1 do begin
    LScanArray := ABitmap.ScanLine[LPosY];
    for LPsX := 0 to ABitmap.Width - 1 do begin

      LRValue := LScanArray[LPsX].rgbtRed;
      LGValue := LScanArray[LPsX].rgbtGreen;
      LBValue := LScanArray[LPsX].rgbtBlue;

      LGray := Round((0.298912 * LRValue) + (0.586611 * LGValue) + (0.114478 * LBValue));
      if LGray > $FF then LGray := $FF;

      LColorTriple.rgbtBlue  := LGray;
      LColorTriple.rgbtGreen := LGray;
      LColorTriple.rgbtRed   := LGray;

      LScanArray[LPsX] := LColorTriple;
    end;
  end;

  ABitmap.Canvas.Unlock;
end;

//=============================================================================
//  ビットマップのグレイスケール化
//  24ビットと32ビットのビットマップのピクセル操作の例として
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LSrcBmp   : TBitmap;
  LDst32Bmp : TBitmap;
  LDst24Bmp : TBitmap;
begin
  Image1.Transparent := True;
  Image2.Transparent := True;

  LSrcBmp   := TBitmap.Create;
  LDst32Bmp := TBitmap.Create;
  LDst24Bmp := TBitmap.Create;
  try
    LSrcBmp.LoadFromFile('bmp-32.bmp');
    //読み込んだビットマップをコピー
    LDst32Bmp.Assign(LSrcBmp);
    LDst24Bmp.Assign(LSrcBmp);

    BitmapColorTo32GrayScale(LDst32Bmp);
    BitmapColorTo24GrayScale(LDst24Bmp);

    //元のビットマップとグレイスケール化したビットマップを表示
    Image1.Picture.Assign(LDst32Bmp);
    Image2.Picture.Assign(LDst24Bmp);
    //保存
    LDst32Bmp.SaveToFile('Gray32bmp.bmp');
    LDst24Bmp.SaveToFile('Gray24bmp.bmp');
  finally
    FreeAndNil(LSrcBmp);
    FreeAndNil(LDst32Bmp);
    FreeAndNil(LDst24Bmp);
  end;
end;

end.