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.

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.

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.

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.

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.

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.

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.

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.