Delphi Programming / Object Pascal
サイトのトップページへ リンクのページへ ロゴマーク
[掲載 2014年06月30日] [更新 2018年01月11日]　Delphi サンプルプログラム集
914_256 色のビットマップと TGifImage.Bitmap のピクセル操作
動作確認等 Windows 7 U64(SP1) + Delphi XE(UP1) Pro
914_256Biamp_TGifImage.zip　[5,264 KB]　2018年01月11日版 (EXE 同梱)






256 色ビットマップと TGIFImage.Bitmap のピクセル操作


ビット深さ 8 (256 色) のビットマップのピクセル操作に関するテストプログラムです．

8 ビット以下のビットマップの各ピクセルの値は，ピクセルの色の値ではありません．ピクセルの値はパレットのインデックスです．パレットというのは，色の情報を格納したテーブルのことです．
8 ビットのビットマップの場合，256 個の色情報があります．この各々に 4 バイトの色の値が格納されています．ビットマップは，画像を表示する時，ピクセルの値，つまり，インデックスに相当する色の値をパレットから取り出して表示します．
4 ビットのビットマップのパレットには，16 色分の色情報があり，その各々に 4 バイトの色の値が格納されています．256 色や 16 色は，システムで使用可能な，フルカラーの中の任意の 256 色または 16 色ということになります．

256 色の以下のビットマップのピクセルデータは，

  • 8 ビットのビットマップでは，8 ビットでパレットのインデックスの値
  • 4 ビットのビットマップでは，4 ビットでパレットのインデックスの値
  • 2 ビットのビットマップでは，2 ビットでパレットのインデックスの値
  • 1 ビットのビットマップでは，1 ビットでパレットのインデックスの値

が割り当てられています．256 色以下のビットマップの縦と横のサイズの，内部での値は 4 の倍数になります．4 の倍数でない残りのピクセルはデータのない領域となります．

このことから，256 未満のビットマップのピクセル操作は面倒だと言えます．
そこで，本ページでは，256 色のビットマップだけのデータを，別の 256 色のビットマップに転送するテストとしています．TGifImage.Bitamap だけは，32 ビットのビットマップにデータを転送するサンプルとなっています．

24 ビットと 32 ビットのビットマップには，パレット情報はありません．24 ビット，32 ビットのビットマップのピクセルの値は色の値です．



元のビットマップ画像と同じビットマップ画像を複製するだけであれば，以下のように，Assign で代入するとか，DestBitmap の Canvas に Draw メソッド等で描画すれば十分です．本ページのサンプルコードは必要ありません．
DestBitmap の Canvas に Draw メソッド等の描画用のメソッドや関数類を使用する場合は，ビットマップのサイズをあらかじめ設定しておきます．
本ページのサンプルは，ビットマップのピクセル操作が必要な場合の参考です． 



procedure TForm1.Button1Click(Sender: TObject);
var
  LSrcBitmap : TBitmap;
  LDstBitmap : TBitmap;
begin
  Image1.Transparent := True;
  Image2.Transparent := True;

  Image1.Picture.Assign(nil);
  Image2.Picture.Assign(nil);

  LSrcBitmap := TBitmap.Create;
  LDstBitmap := TBitmap.Create;
  try
    //256色のビットマップ画像を読み込む
    LSrcBitmap.LoadFromFile('503.bmp');

    //DstBitmapに元のビットマップを代入
    //DstBitmapも8ビットとなる
    LDstBitmap.Assign(LSrcBitmap);

    //両方のビットマップをTIamgeに描画
    Image1.Picture.Assign(LSrcBitmap);
    Image2.Picture.Assign(LDstBitmap);
  finally
    FreeAndNil(LSrcBitmap);
    FreeAndNil(LDstBitmap);
  end;
end;


[備考 1]
本ページのサンプルのように，ビットマップの幅と高さの値で for ... to 処理する場合は，データのない領域を意識する必要はありません．問題となるのは，下記のリンクの記事のように，ビットマップのデータをメモリストリームで操作する場合や減色操作の場合等です．


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





01_256 色ビットマップのピクセル操作  -  パレット設定なし


次の処理を行うサンプルです．

  • ディスクから 8 ビットのビットマップを読み込む
  • 新規に 8 ビットのビットマップを作成する
  • 新規に作成したビットマップに，元のビットマップのデータを転送する
  • 元のビットマップと処理したビットマップを，比較のため TImage に表示する

上で書いたように，ピクセルの値はパレットのインデックスです．
Button1 クリックでは，このインデックスから PALETTEINDEX で色を取得して，その色の値を，転送先のビットマップの Canvas の Pixels プロパティに代入しています．
Button2 クリックイベントでは，元のパレットのインデックスの値を，転送先のピクセルに代入しています．ScanLine プロパティを使用しています．

以下の結果の図から分かるように，元の色が反映されていません．
これは，新規に作成したビットマップにパレットが設定されていないためです．TBitmap で新規にビットマップを生成した場合，Windows のシステム既定のパレットカラーが使用されます．



図1
設計時画面
図2
TBitmap の TCanvas.Pixels にセットした場合
図3
ScanLine プロパティを使用した結果

リスト1
256 色のビットマップのピクセル操作の例．パレットの設定がない場合 
unit Unit1;

interface

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

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

var
  Form1: TForm1;

implementation

{$R *.dfm}

//=============================================================================
//  8ビット(256色)ビットマップの，ピクセル操作による転送例
//  元のビットマップはScanLineで，転送先はTCanvas.Pixelsで色を代入
//  パレットの指定がない場合
//
//  ビットマップのパレットの指定がないとデフォルトのパレットが使用される
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LSrcBitmap    : TBitmap;
  LDstBitmap    : TBitmap;
  LSrcScanArray : PByteArray;
  LPosX         : Integer;
  LPosY         : Integer;
  LPalColor     : Cardinal;
begin
  Image1.Transparent := True;
  Image2.Transparent := True;

  Image1.Picture.Assign(nil);
  Image2.Picture.Assign(nil);

  LSrcBitmap := TBitmap.Create;
  LDstBitmap := TBitmap.Create;
  try
    //256色のビットマップ画像を読み込んでTImageに表示
    LSrcBitmap.LoadFromFile('503.bmp');
    Image1.Picture.Assign(LSrcBitmap);

    //256色のビットマップを生成
    LDstBitmap.PixelFormat := pf8bit;
    LDstBitmap.Width       := LSrcBitmap.Width;
    LDstBitmap.Height      := LSrcBitmap.Height;

    //ピクセル操作でコピー
    for LPosY := 0 to LSrcBitmap.Height - 1 do begin
      LSrcScanArray := LSrcBitmap.ScanLine[LPosY];
      for LPosX := 0 to LSrcBitmap.Width - 1 do begin
        LPalColor := PALETTEINDEX(LSrcScanArray[LPosX]);
        LDstBitmap.Canvas.Pixels[LPosX, LPosY] := LPalColor;
      end;
    end;
    Image2.Picture.Assign(LDstBitmap);
  finally
    FreeAndNil(LSrcBitmap);
    FreeAndNil(LDstBitmap);
  end;
end;

//=============================================================================
//  8ビット(256色)ビットマップの，ピクセル操作による転送例
//  元のビットマップも転送先もScanLineで操作
//  パレットの指定がない場合
//
//  ビットマップのパレットの指定がないとデフォルトのパレットが使用される
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
var
  LSrcBitmap     : TBitmap;
  LDstBitmap     : TBitmap;
  LSrcScanArray  : PByteArray;
  LDstScanArray  : PByteArray;
  LPosX          : Integer;
  LPosY          : Integer;
begin
  Image1.Transparent := True;
  Image2.Transparent := True;

  Image1.Picture.Assign(nil);
  Image2.Picture.Assign(nil);

  LSrcBitmap := TBitmap.Create;
  LDstBitmap := TBitmap.Create;
  try
    //256色のビットマップ画像を読み込んでTImageに表示
    LSrcBitmap.LoadFromFile('503.bmp');
    Image1.Picture.Assign(LSrcBitmap);

    //256色のビットマップを生成
    LDstBitmap.PixelFormat := pf8bit;
    LDstBitmap.Width       := LSrcBitmap.Width;
    LDstBitmap.Height      := LSrcBitmap.Height;

    //ピクセル操作でコピー
    for LPosY := 0 to LSrcBitmap.Height - 1 do begin
      LSrcScanArray := LSrcBitmap.ScanLine[LPosY];
      LDstScanArray := LDstBitmap.ScanLine[LPosY];
      for LPosX := 0 to LSrcBitmap.Width - 1 do begin
        LDstScanArray[LPosX] := LSrcScanArray[LPosX];
      end;
    end;
    Image2.Picture.Assign(LDstBitmap);
  finally
    FreeAndNil(LSrcBitmap);
    FreeAndNil(LDstBitmap);
  end;
end;

end.



02_システム既定のパレット


前項のサンプルで，転送先のビットマップのパレットとして使用されたのは，システム既定のパレットです．このパレットは，GetSystemPaletteEntries を使用して取得できます．
どのような色が使用されたかを確認するために，パレットの色を表示してみました．

新規に 256 色以下のビットマップを生成すると，自動的にシステム既定のパレットが使用されます．したがって，実際には改めてシステムパレットに設定する必要はありません．



図4
設計時画面
図5
システム既定のパレットの色．256 色の場合
図6
システム既定のパレットの色．16 色の場合

リスト2
システム既定のパレットを取得して表示する		 
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;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private 宣言 }
    procedure DrawPalleteColor(OutImage: TImage; TargetBmp: TBitmap;
      RectSize: Integer);
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

//-----------------------------------------------------------------------------
//  システムのデフォルト(既定)のパレットを取得する関数
//  Colors : 16 or 256
//-----------------------------------------------------------------------------
function GetDesktopPalette(Colors: Cardinal): HPALETTE;
var
  LLogPal : TMaxLogPalette;
  LScrDC  : HDC;
begin
  LLogPal.palVersion    := $300;
  LLogPal.palNumEntries := Colors;

  LScrDC := GetDC(0);
  try
    if GetSystemPaletteEntries(LScrDC, 0, Colors, LLogPal.palPalEntry) > 0 then begin
      Result := CreatePalette(pLogPalette(@LLogPal)^);
    end else begin
      Result := 0;
    end;
  finally
    ReleaseDC(0, LScrDC);
  end;
end;

//=============================================================================
//  ビットマップのパレット表示 256色
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LSrcBmp : TBitmap;
begin
  Image1.Picture.Assign(nil);

  LSrcBmp := TBitmap.Create;
  try
    LSrcBmp.PixelFormat := pf8bit;
    LSrcBmp.Width       := 40;
    LSrcBmp.Height      := 40;

    //システムの既定の256色のパレットにする
    LSrcBmp.Palette := GetDesktopPalette(256);

    DrawPalleteColor(Image1, LSrcBmp, 15);
  finally
    FreeAndNil(LSrcBmp);
  end;
end;

//=============================================================================
//  ビットマップのパレット表示 16色
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
var
  LSrcBmp : TBitmap;
begin
  Image1.Picture.Assign(nil);

  LSrcBmp := TBitmap.Create;
  try
    LSrcBmp.PixelFormat := pf4bit;
    LSrcBmp.Width       := 40;
    LSrcBmp.Height      := 40;

    //システムの既定の16色のパレットにする
    LSrcBmp.Palette := GetDesktopPalette(16);

    DrawPalleteColor(Image1, LSrcBmp, 15);
  finally
    FreeAndNil(LSrcBmp);
  end;
end;

//-----------------------------------------------------------------------------
//  OoutImage(TImage)にTargetBmp(TBitmap)のパレットの色を描画するメソッド
//  RectSizeは描画する矩形のサイズ
//-----------------------------------------------------------------------------
procedure TForm1.DrawPalleteColor(OutImage: TImage; TargetBmp: TBitmap;
  RectSize: Integer);
var
  LPosY        : Integer;
  LPosX        : Integer;
  ALeft        : Integer;
  LTop         : Integer;
  LCntVertRect : Integer;
  LCntHorzRect : Integer;
  LIndex       : Integer;
begin
  if TargetBmp.PixelFormat = pf4bit then begin
    LCntHorzRect := 4;
    LCntVertRect := 4;
  end else
  if TargetBmp.PixelFormat = pf8bit then begin
    LCntHorzRect := 16;
    LCntVertRect := 16;
  end else begin
    exit;
  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
    ALeft := 0;
    for LPosX := 0 to LCntHorzRect - 1 do begin
      LIndex := LCntHorzRect * LPosY + LPosX;
      OutImage.Canvas.Brush.Color := PALETTEINDEX(LIndex);
      OutImage.Canvas.Rectangle(ALeft, LTop, ALeft + RectSize, LTop + RectSize );
      Inc( ALeft, RectSize - 1);
    end;
    Inc( LTop, RectSize - 1);
  end;
end;

end.



03_256 色ビットマップのピクセル操作  -  パレット設定あり


システム既定のパレットを使用したのでは，元のビットマップと違った配色になってしまいます．
次のサンプルは，以下のコードを追加して，転送先のビットマップのパレットの設定を，元のビットマップのそれと同じしています． 


    DstBitmap.Palette := SrcBitmap.Palette;

結果は，下図の通り，元の画像と同じになっています．



図7
TBitmap の TCanvas.Pixels にセットした場合
図8
ScanLine プロパティを使用した結果

リスト3
256 色のビットマップのピクセル操作の例		 
unit Unit1;

interface

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

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

var
  Form1: TForm1;

implementation

{$R *.dfm}

//=============================================================================
//  8ビット(256色)ビットマップの転送例
//  元のビットマップはScanLineで，転送先はTCanvas.Pixelsで色を代入
//  転送先のパレットを元のビットマップのパレットと同じにする場合
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LSrcBitmap    : TBitmap;
  LDstBitmap    : TBitmap;
  LSrcScanArray : PByteArray;
  LPosX         : Integer;
  LPosY         : Integer;
  LPalColor     : Cardinal;
begin
  Image1.Transparent := True;
  Image2.Transparent := True;

  Image1.Picture.Assign(nil);
  Image2.Picture.Assign(nil);

  LSrcBitmap := TBitmap.Create;
  LDstBitmap := TBitmap.Create;
  try
    //256色のビットマップ画像を読み込んでTImageに表示
    LSrcBitmap.LoadFromFile('503.bmp');
    Image1.Picture.Assign(LSrcBitmap);

    //256色のビットマップを生成
    LDstBitmap.PixelFormat := pf8bit;
    LDstBitmap.Width       := LSrcBitmap.Width;
    LDstBitmap.Height      := LSrcBitmap.Height;

    //転送先のビットマップのパレットを，転送元のパレットと同じにする
    LDstBitmap.Palette := LSrcBitmap.Palette;

    //ピクセル操作でコピー
    for LPosY := 0 to LSrcBitmap.Height - 1 do begin
      LSrcScanArray := LSrcBitmap.ScanLine[LPosY];
      for LPosX := 0 to LSrcBitmap.Width - 1 do begin
        LPalColor := PALETTEINDEX(LSrcScanArray[LPosX]);
        LDstBitmap.Canvas.Pixels[LPosX, LPosY] := LPalColor;
      end;
    end;
    Image2.Picture.Assign(LDstBitmap);
  finally
    FreeAndNil(LSrcBitmap);
    FreeAndNil(LDstBitmap);
  end;
end;

//=============================================================================
//  8ビット(256色)ビットマップの転送例
//  元のビットマップも転送先もScanLineで操作
//  転送先のパレットを元のビットマップのパレットと同じにする場合
//
//  パレットのインデックスの代入なのでそのまま代入すればよい
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
var
  LSrcBitmap    : TBitmap;
  LDstBitmap    : TBitmap;
  LSrcScanArray : PByteArray;
  LDstScanArray : PByteArray;
  LPosX         : Integer;
  LPosY         : Integer;
begin
  Image1.Transparent := True;
  Image2.Transparent := True;

  Image1.Picture.Assign(nil);
  Image2.Picture.Assign(nil);

  LSrcBitmap := TBitmap.Create;
  LDstBitmap := TBitmap.Create;
  try
    //256色のビットマップ画像を読み込んでTImageに表示
    LSrcBitmap.LoadFromFile('503.bmp');
    Image1.Picture.Assign(LSrcBitmap);

    //256色のビットマップを生成
    LDstBitmap.PixelFormat := pf8bit;
    LDstBitmap.Width       := LSrcBitmap.Width;
    LDstBitmap.Height      := LSrcBitmap.Height;

    //転送先のビットマップのパレットを，転送元のパレットと同じにする
    LDstBitmap.Palette := LSrcBitmap.Palette;

    //ピクセル操作でコピー
    for LPosY := 0 to LSrcBitmap.Height - 1 do begin
      LSrcScanArray := LSrcBitmap.ScanLine[LPosY];
      LDstScanArray := LDstBitmap.ScanLine[LPosY];
      for LPosX := 0 to LSrcBitmap.Width - 1 do begin
        LDstScanArray[LPosX] := LSrcScanArray[LPosX];
      end;
    end;
    Image2.Picture.Assign(LDstBitmap);
  finally
    FreeAndNil(LSrcBitmap);
    FreeAndNil(LDstBitmap);
  end;
end;

end.



04_256 色ビットマップのピクセル操作  -  パレットの操作例


パレットの色を変更すれば，ビットマップの色も変わります．そのテストです．

  • 新規作成したビットマップのパレットを，元のビットマップのパレットと同じにする
  • GetPaletteEntries 関数で，そのパレットのエントリを取得する
  • 指定した範囲のパレットインデックスのエントリに，色の値をセットする
  • CreatePalette 関数でそのパレットを転送先のパレットに設定する

という手順で行います．下図がその結果です．



図9
パレットエントリの操作結果

リスト4
256 色のビットマップのパレット操作の例		 
unit Unit1;

interface

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

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

var
  Form1: TForm1;

implementation

{$R *.dfm}

//=============================================================================
//  8ビット(256色)ビットマップの，ピクセル操作による転送例
//  元のビットマップも転送先もScanLineで操作
//
//  転送先のビットマップのパレットの色を変更する操作の例
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LSrcBitmap    : TBitmap;
  LDstBitmap    : TBitmap;
  LSrcScanArray : PByteArray;
  LDstScanArray : PByteArray;
  LPosX         : Integer;
  LposY         : Integer;
  LLogPal       : TMaxLogPalette;
  LCntEntry     : WORD;
  LPalIndex     : Byte;
  LReffColor    : Cardinal;
  LIndex        : Integer;
begin
  Image1.Transparent := True;
  Image2.Transparent := True;

  Image1.Picture.Assign(nil);
  Image2.Picture.Assign(nil);

  LSrcBitmap := TBitmap.Create;
  LDstBitmap := TBitmap.Create;
  try
    //256色のビットマップを読み込んでTImageに表示
    LSrcBitmap.LoadFromFile('503.bmp');
    Image1.Picture.Assign(LSrcBitmap);

    //256色のビットマップを生成
    LDstBitmap.PixelFormat := pf8bit;
    LDstBitmap.Width       := LSrcBitmap.Width;
    LDstBitmap.Height      := LSrcBitmap.Height;

    //転送先のビットマップのパレットは，元のビットマップのパレットと同じにする
    LDstBitmap.Palette := LSrcBitmap.Palette;

    //転送先のビットマップのパレットのエントリを取得
    LLogPal.palVersion    := $300;
    LLogPal.palNumEntries := 256;
    GetPaletteEntries(LDstBitmap.Palette, 0, 256, LLogPal.palPalEntry);
    LCntEntry := LLogPal.palNumEntries;

    LReffColor := clWebDarkCyan;
    //指定範囲のインデックスのパレットの色を指定の色に変更してみる
    for LIndex := 160 to 190 do begin
      LPalIndex  := Byte(LIndex);
      if LPalIndex <= LCntEntry then begin
        LLogPal.palPalEntry[LPalIndex].peRed   := GetRValue(LReffColor);
        LLogPal.palPalEntry[LPalIndex].peGreen := GetGValue(LReffColor);
        LLogPal.palPalEntry[LPalIndex].peBlue  := GetBValue(LReffColor);
        LLogPal.palPalEntry[LPalIndex].peFlags := 0;
      end;
    end;
    //変更したパレットを転送先のビットマップのパレットとする
    LDstBitmap.Palette := CreatePalette(pLogPalette(@LLogPal)^);

    //ピクセル操作でコピー
    for LposY := 0 to LSrcBitmap.Height - 1 do begin
      LSrcScanArray := LSrcBitmap.ScanLine[LposY];
      LDstScanArray := LDstBitmap.ScanLine[LposY];
      for LPosX := 0 to LSrcBitmap.Width - 1 do begin
        LDstScanArray[LPosX] := LSrcScanArray[LPosX];
      end;
    end;
    Image2.Picture.Assign(LDstBitmap);
  finally
    FreeAndNil(LSrcBitmap);
    FreeAndNil(LDstBitmap);
  end;
end;

end.



05_TImage の Canvas のピクセル操作


上のコードは，ビットマップのインスタンスを直接操作する例です．TImage に描画したビットマップを操作する場合は，TImage のビットマップに対する操作となります．
次のコードは，8 ビットのビットマップを TImage に表示します．その後，表示した画像の上で (正確には TImage の上で) マウスボタンを押下すると，その位置の色の値を表示し，TPanel の色をその色にします．
この時，色の値を TImage.Canvas の Pixels プロパティで取得しています．この値は，上のサンプルとは違い，パレットのインデックスではありません．

つまり，本サンプルは，TImage に描画した元のビットマップの色数には関係なく動作します．



図10
マウス押下位置の色を取得して表示

画像以外の部分をクリックすると，下図のような結果となります．
この結果は，TImage のビットマップのピクセルの色を取得しているからです．したがって，TImage に描画する方法によって違ってきます．Assign または LoadFromXXX で描画した場合と，Draw メソッド等の描画用のメソッド，あるいは関数類を使用した場合とで違ってきます．

画面上で見えている色を取得するには，例えば，以下のリンクの記事のように，画面 (スクリーン) のデバイスコンテキストを使用します．



図11
画像の背景部分をクリックした場合
  • この画像 (ビットマップ) は．透過表示している
  • 見えている色ではなく，実際の背景色が検出される
図12
TImage の画像部分以外をクリックした場合
  • この部分は，何も描画されていない
  • 何も描画されていない部分は「黒」

リスト5
TImage 上で，マウスボタンを押下した位置の色を取得		 
//=============================================================================
//  256色(8ビット)のビットマップを読み込んでTImageに表示
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LSrcBitmap : TBitmap;
begin
  Image1.Transparent := True;
  Image1.Picture.Assign(nil);

  LSrcBitmap := TBitmap.Create;
  try
    //256色のビットマップ画像を読み込んでTImageに表示
    LSrcBitmap.LoadFromFile('503.bmp');
    Image1.Picture.Assign(LSrcBitmap);
  finally
    FreeAndNil(LSrcBitmap);
  end;
end;

//=============================================================================
//  Image1のOnMouseDownイベント処理
//  マウスボタンを押下した位置の色の値を取得して，その色を表示
//=============================================================================
procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
  LColor : Cardinal;
begin
  Panel1.Caption := '';
  Panel2.Caption := '';

  Panel1.ParentBackground := False;
  Panel2.ParentBackground := False;

  if Assigned(Image1.Picture.Bitmap) then begin
    //LColor := Image1.Picture.Bitmap.Canvas.Pixels[X, Y];でも同じ
    LColor := Image1.Canvas.Pixels[X, Y];

    Panel1.Caption := Format('$%.8x', [LColor]);
    Panel2.Color   :=  LColor;
  end;
end;


次のコードは，マウスボタン押下位置のピクセルの色を変更します．TImage.Canvas の Pixels プロパティに色の値をセットしています．画像は，Draw メソッドで TImage の Canvas に描画しています．
TImage に追加描画する必要がある場合，Assign ではなく，Draw メソッド等で描画します．

上のコードのように，Assign メソッドや LoadFromXXX メソッド で描画した場合は，読み込んだビットマップが TImage のビットマップとなります．Assign や LoadFromXXX による描画は，主に画像の表示だけが目的の場合に使用されます．
一方，Draw メソッド等の描画用メソッドや関数で描画した場合は，TImage 内部のビットマップに，目的のビットマップ画像を描画します．

TImage 内部のビットマップは，何も描画していない状態では，その大きさは 0 です．TImage の Canvas に何かを描画すると，TImage と同じ大きさとなり，背景が「白」で塗り潰されます．この TImage のビットマップは 32 ビットです．
この TImage 内部のビットマップは，外部から直接アクセスすることはできません．TImaage.Canvas に描画処理を行うと，その処理に内部的に使用されています．

TImage に描画した複数のビットマップ画像を個別に取り出せないか，という質問を以前見たことがあります．描画した画像は，TImage 内部のビットマップに描画して，1 つのビットマップ (画像) となっています．したがって，描画前の画像として，各々を個別に取り出すことはできません．
本サンプルでも同じです．マウスクリックで描画した赤い点を，各々別の画像として取り出すことはできません．



図13
マウス押下位置の色を変更
図14
部分拡大図

リスト6
TImage 上で，マウスボタンを押下した位置のピクセルの色を変更		 
//=============================================================================
//  256色(8ビット)のビットマップを読み込んでTImageに表示
//  TImageのCanvasに，読み込んだビットマップを描画
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LSrcBitmap : TBitmap;
begin
  Image1.Transparent := True;
  Image1.Picture.Assign(nil);

  LSrcBitmap := TBitmap.Create;
  try
    //256色のビットマップ画像を読み込む
    LSrcBitmap.LoadFromFile('503.bmp');
    LSrcBitmap.Transparent := True;
    //Image1に描画する
    //Image1.Picture.Assign(LSrcBitmap);ではなくDrawを使用する
    Image1.Canvas.Draw(0, 0, LSrcBitmap);
  finally
    FreeAndNil(LSrcBitmap);
  end;
end;

//=============================================================================
//  Image1のOnMouseDownイベント処理
//  マウスボタンを押下した位置の色を，指定の色に変更する
//=============================================================================
procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  if Assigned(Image1.Picture.Bitmap) then begin
    //Image1.Picture.Bitmap.Canvas.Pixels[X, Y] := clRed;でも同じ
    Image1.Canvas.Pixels[X, Y] := clRed;
  end;
end;


TImage のビットマップは，何も描画していない状態では，そのサイズは 0 です．したがって，下のコードを実行しても，画像は描画されません．
描画するには，TImage.Canvas に対して描画します．TImage.Canvas に対して実行すれば，TImage が内部で処理してくれます． 



procedure TForm1.Button1Click(Sender: TObject);
var
  LSrcBitmap : TBitmap;
begin
  LSrcBitmap := TBitmap.Create;
  try
    LSrcBitmap.LoadFromFile('503.bmp');

    //描画する
    Image1.Picture.Bitmap.Canvas.Draw(0, 0, LSrcBitmap);
  finally
    FreeAndNil(LSrcBitmap);
  end;
end;



06_TGifImage.Bitmap のピクセル操作


GIF は，最大 256 色のビットマップを複数格納できる形式です．以下のコードは画像が 1 つだけの場合です．

TGifImage の場合は，TGifImage.Bitmap の Canvas の Pixels プロパティ，あるいは ScanLine で取得した配列から，該当するピクセルの色の値を取得することができます．この色の値は，32 ビットのビットマップと同じ 4 バイトです．
このことを利用したサンプルです．転送先が 256 色以下では操作が面倒なので，ここでは 32 ビットのビットマップを新規に作成して操作しています．

Button1 クリックでは，元のビットマップのピクセルデータを Scnaline で取り出し，ScanLine で取得した転送先のビットマップのピクセルにデータを代入します．
Button2 クリックでは，ピクセルの色が指定した色と同じだった場合，別の色に変更します．
Button3 は，確認のために Pixels プロパティを使用した例です．

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




図15
ScanLine でビットマップのデータを転送
図16
指定した色と同じ色のピクセルの値を変更
図17
Pixels プロパティを使用した例

リスト7
TGifImage.Bitmap のピクセル操作		 
unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Image1: TImage;
    Button1: TButton;
    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のBitmapのピクセルの操作例
//  TGifImage.BitmapのScanLineでは，ピクセルの色情報が取得できる
//  1ピクセル当たり4バイトの情報
//
//  ScanLineデータの格納は， Gifimg.pas内のPRGBQuadArrayを利用
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LSrcGifImg    : TGIFImage;
  LDstBitmap    : TBitmap;
  LSrcScanArray : PRGBQuadArray;
  LDstScanArray : PRGBQuadArray;
  LPosX         : Integer;
  LPosY         : Integer;
begin
  Image1.Transparent := True;
  Image2.Transparent := True;

  Image1.Picture.Assign(nil);
  Image2.Picture.Assign(nil);

  LSrcGifImg := TGIFImage.Create;
  LDstBitmap := TBitmap.Create;
  try
    //GIF画像を読み込んで表示
    LSrcGifImg.LoadFromFile('502.gif');
    Image1.Picture.Assign(LSrcGifImg);

    //32ビットのビットマップを生成
    LDstBitmap.PixelFormat := pf32bit;
    LDstBitmap.Width  := LSrcGifImg.Width;
    LDstBitmap.Height := LSrcGifImg.Height;


    //ピクセル操作
    for LPosY := 0 to LSrcGifImg.Bitmap.Height - 1 do begin

      LSrcScanArray := LSrcGifImg.Bitmap.ScanLine[LPosY];
      LDstScanArray := LDstBitmap.ScanLine[LPosY];

      for LPosX := 0 to LSrcGifImg.Bitmap.Width - 1 do begin
        LDstScanArray[LPosX] := LSrcScanArray[LPosX];
      end;
    end;
    Image2.Picture.Assign(LDstBitmap);
  finally
    FreeAndNil(LSrcGifImg);
    FreeAndNil(LDstBitmap);
  end;
end;

//=============================================================================
//  TGifImageのBitmapのピクセルの操作例
//  TGifImage.BitmapのScanLineでは，ピクセルの色情報が取得できる
//  1ピクセル当たり4バイトの情報
//  元の画像の中央の色と同じピクセルの色を変更する例
//
//  ScanLineデータの格納は， Gifimg.pas内のPRGBQuadArrayを利用
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
var
  LSrcGifImg    : TGIFImage;
  LDstBitmap    : TBitmap;
  LSrcScanArray : PRGBQuadArray;
  LDstScanArray : PRGBQuadArray;
  LColorQuad    : RGBQUAD;
  LPosX         : Integer;
  LPosY         : Integer;
  LColor        : Cardinal;
  LXCenter      : Integer;
  LYCenter      : Integer;
  LReffColor    : Cardinal;
  LChangeColor  : Cardinal;
begin
  Image1.Transparent := True;
  Image2.Transparent := True;

  Image1.Picture.Assign(nil);
  Image2.Picture.Assign(nil);

  LSrcGifImg := TGIFImage.Create;
  LDstBitmap := TBitmap.Create;
  try
    //GIF画像を読み込んで表示
    LSrcGifImg.LoadFromFile('502.gif');
    Image1.Picture.Assign(LSrcGifImg);

    //32ビットのビットマップを生成
    LDstBitmap.PixelFormat := pf32bit;
    LDstBitmap.Width  := LSrcGifImg.Width;
    LDstBitmap.Height := LSrcGifImg.Height;

    LXCenter     := LSrcGifImg.Width  div 2;
    LYCenter     := LSrcGifImg.Height div 2;
    LReffColor   := LSrcGifImg.Bitmap.Canvas.Pixels[LXCenter, LYCenter];
    LChangeColor := clWebLightGoldenrodYellow;


    //ピクセル操作
    for LPosY := 0 to LSrcGifImg.Bitmap.Height - 1 do begin

      LSrcScanArray := LSrcGifImg.Bitmap.ScanLine[LPosY];
      LDstScanArray := LDstBitmap.ScanLine[LPosY];

      for LPosX := 0 to LSrcGifImg.Bitmap.Width - 1 do begin
        LColorQuad := LSrcScanArray[LPosX];
        LColor    := RGB(LColorQuad.rgbRed, LColorQuad.rgbGreen, LColorQuad.rgbBlue);
        if LColor = LReffColor then begin
          LColorQuad.rgbRed      := GetRValue(LChangeColor);
          LColorQuad.rgbGreen    := GetGValue(LChangeColor);
          LColorQuad.rgbBlue     := GetBValue(LChangeColor);
          LColorQuad.rgbReserved := 0;
          LDstScanArray[LPosX]       := LColorQuad;
        end else begin
          LDstScanArray[LPosX] := LSrcScanArray[LPosX];
        end;
      end;
    end;
    Image2.Picture.Assign(LDstBitmap);
  finally
    FreeAndNil(LSrcGifImg);
    FreeAndNil(LDstBitmap);
  end;
end;

//=============================================================================
//  TGifImageのBitmapのピクセルの操作例
//  TGifImage.BitmapのScanLineでは，ピクセルの色情報が取得できる
//  1ピクセル当たり4バイトの情報
//  元の画像の中央の色と同じピクセルの色を変更する例(Pixelsプロパティを使用)
//
//  ScanLineデータの格納は， Gifimg.pas内のPRGBQuadArrayを利用
//=============================================================================
procedure TForm1.Button3Click(Sender: TObject);
var
  LSrcGifImg   : TGIFImage;
  LDstBitmap   : TBitmap;
  SrcScanArray : PRGBQuadArray;
  LColorQuad   : RGBQUAD;
  LPosX        : Integer;
  LPosY        : Integer;
  LColor       : Cardinal;
  LXCenter     : Integer;
  LYCenter     : Integer;
  LReffColor   : Cardinal;
begin
  Image1.Transparent := True;
  Image2.Transparent := True;

  Image1.Picture.Assign(nil);
  Image2.Picture.Assign(nil);

  LSrcGifImg := TGIFImage.Create;
  LDstBitmap := TBitmap.Create;
  try
    //GIF画像を読み込んで表示
    LSrcGifImg.LoadFromFile('502.gif');
    Image1.Picture.Assign(LSrcGifImg);

    //32ビットのビットマップを生成
    LDstBitmap.PixelFormat := pf32bit;
    LDstBitmap.Width  := LSrcGifImg.Width;
    LDstBitmap.Height := LSrcGifImg.Height;

    LXCenter   := LSrcGifImg.Width  div 2;
    LYCenter   := LSrcGifImg.Height div 2;
    LReffColor := LSrcGifImg.Bitmap.Canvas.Pixels[LXCenter, LYCenter];


    //ピクセル操作
    for LPosY := 0 to LSrcGifImg.Bitmap.Height - 1 do begin

      SrcScanArray := LSrcGifImg.Bitmap.ScanLine[LPosY];

      for LPosX := 0 to LSrcGifImg.Bitmap.Width - 1 do begin
        LColorQuad := SrcScanArray[LPosX];
        LColor    := RGB(LColorQuad.rgbRed, LColorQuad.rgbGreen, LColorQuad.rgbBlue);
        if LColor = LReffColor then begin
          LDstBitmap.Canvas.Pixels[LPosX, LPosY] := clWebDarkCyan;
        end else begin
          LDstBitmap.Canvas.Pixels[LPosX, LPosY] := LColor;
        end;
      end;
    end;
    Image2.Picture.Assign(LDstBitmap);
  finally
    FreeAndNil(LSrcGifImg);
    FreeAndNil(LDstBitmap);
  end;
end;

end.


本ページの最初に述べたように，TGifImage の場合も，元の GIF 画像からビットマップ画像をコピーするだけであれば，以下のように，Assign で代入するとか，DestBitmap の Canvas に Draw メソッド等で描画すれば十分です．
DestBitmap の Canvas に Draw メソッド等の描画用のメソッドや関数類を使用する場合は，ビットマップのサイズをあらかじめ設定しておきます．



[備考]
TGifImage のピクセル当たりのビット数は TGifImage.BitsPerPixel で取得できます．



リスト8
TGifImage から 24 ビットまたは 32 ビットのビットマップに変換する場合		 
procedure TForm1.Button2Click(Sender: TObject);
var
  LSrcGifImg : TGifImage;
  LDstBitmap : TBitmap;
begin
  Image1.Transparent := True;
  Image2.Transparent := True;

  Image1.Picture.Assign(nil);
  Image2.Picture.Assign(nil);

  LSrcGifImg := TGIFImage.Create;
  LDstBitmap := TBitmap.Create;
  try
    //256色のGIF画像を読み込む
    LSrcGifImg.LoadFromFile('502.gif');

    //DstBitmapに元のGIF画像を代入
    LDstBitmap.Assign(LSrcGifImg);
    //pfDevice(デバイス依存のDDB形式)となるのでDIB(デバイス非依存形式)に変換
    LDstBitmap.PixelFormat := pf32bit;

    //両方の画像をTIamgeに描画
    Image1.Picture.Assign(LSrcGifImg);
    Image2.Picture.Assign(LDstBitmap);
  finally
    FreeAndNil(LSrcGifImg);
    FreeAndNil(LDstBitmap);
  end;
end;


転送先が 8 ビットのビットマップの場合は，例えば，次のようにします．8 ビットの場合はパレットの設定が必要です．
ただし，本サンプルで使用している添付の GIF 画像のピクセル当たりのビット数は 7 ビットです．したがって，正確には色の値が反映されません．微妙に違ってきます．上のコードのように 32 ビットにする方が確実です．4 ビット以下のビットマップへのコピーは，減色になります．以下の記事を参考にしてください．



リスト9
TGifImage から 256 色のビットマップに変換する場合
パレットの設定をする		 
procedure TForm1.Button3Click(Sender: TObject);
var
  LSrcGifImg : TGifImage;
  LDstBitmap : TBitmap;
begin
  Image1.Transparent := True;
  Image2.Transparent := True;

  Image1.Picture.Assign(nil);
  Image2.Picture.Assign(nil);

  LSrcGifImg := TGIFImage.Create;
 L DstBitmap := TBitmap.Create;
  try
    //256色のGIF画像を読み込む
    LSrcGifImg.LoadFromFile('502.gif');

    //DstBitmapに元のGIF画像を代入
    LDstBitmap.Assign(LSrcGifImg);

    //pfDevice(デバイス依存のDDB形式)となるのでDIB(デバイス非依存形式)に変換
    LDstBitmap.PixelFormat := pf8bit;
    //8ビットの場合はパレットを同じにする(しないと色が正しく反映されない)
    LDstBitmap.Palette := LSrcGifImg.Bitmap.Palette;

    //両方の画像をTIamgeに描画
    Image1.Picture.Assign(LSrcGifImg);
    Image2.Picture.Assign(LDstBitmap);
  finally
    FreeAndNil(LSrcGifImg);
    FreeAndNil(LDstBitmap);
  end;
end;



07_TColor と RGB 値の相互変換


本ページのサンプルでも，当サイトのサンプルプログラム集，あるいはネット上のサンプルでも多くの使われていますが，TColor と R (赤)，G (緑), B (青) の値の相互変換の確認テストです．

TColor の値から R, G, B の各値を求めるには GetRValue, GetGValue, GetBValue 関数が利用できます．その逆に R, G, B の値から TColor の値に変換するには，RGB という関数が使用できます．
その他にも色に関係する関数をいくつかテストしてみました．



下図が設計時と実行の画面です．
色は，3 つのスクロールバーか TButtonColor ボタンで設定します．
TButtonColor は TTChar コンポーネントで実装されているカラーダイアログ表示用ボタンです．クリックするとカラーダイアログを表示し，SymbolColor で設定した値が取得できます．


COLOR Value TColor 値の 10 進数表示
COLOR HEX TColor 値の 16 進数表示
上位バイトから順に 0, B, G, R となっている (R, G, B 順ではない)
ColorToString TColor 値の clWhite 等の色定数名文字列
定数名がない場合は，TColor の 16 進数
ColoToIdent TColor 値の clWhite 等の色定数名文字列
定数名がない場合は空白文字
HTML RGB TColor 値を 16 進数にした値．上位バイトから順に R, G, B の値
HTML コードでそのまま使用可能な値．CSS で使用する場合は，4 バイトにして半透明色の指定が可能
WebColorName HTML 色の clWebRet 等の色定数名文字列
該当する色に定数名がない場合は，16 進数


図18
設計時画面
図19
実行例
図20
G の値だけが 128 で他の値が 0 の場合
  • 色の定数名があるので表示されている
図21
G の値だけが 255 で他の値が 0 の場合
  • G だが，clGreen ではなく clLime

リスト10
TColor と R, G, B 値の相互変換		 
unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    ButtonColor1: TButtonColor;
    Panel1: TPanel;
    ScrollBar1: TScrollBar;
    ScrollBar2: TScrollBar;
    ScrollBar3: TScrollBar;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Memo1: TMemo;
    Button1: TButton;
    procedure ButtonColor1Click(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure ScrollBar1Change(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    { Private 宣言 }
    procedure DisplayColorValues;
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

uses GraphUtil;

{$R *.dfm}

//=============================================================================
//  フォーム表示開始時の処理
//=============================================================================
procedure TForm1.FormShow(Sender: TObject);
begin
  //この設定がないと色は変化しない
  Panel1.ParentBackground := False;
  Panel1.Caption := '';

  //スクロールバーの最小値と最大値は各R,G,Bの最小値と最大値と同じにする
  ScrollBar1.Min := 0;
  ScrollBar1.Max := 255;

  ScrollBar2.Min := 0;
  ScrollBar2.Max := 255;

  ScrollBar3.Min := 0;
  ScrollBar3.Max := 255;

  //R,G,Bの値を表示するTLabelの文字の色
  Label1.Font.Color := clRed;
  Label2.Font.Color := RGB(0, $AF, 0);
  Label3.Font.Color := clBlue;
  Label1.Font.Style := [fsBold];
  Label2.Font.Style := [fsBold];
  Label3.Font.Style := [fsBold];

  //初期状態の色
  ScrollBar1.Position := 255;
  ScrollBar2.Position := 255;
  ScrollBar3.Position := 255;

  Button1.Visible := False;
end;

//=============================================================================
//  Memo1に色の値を表示
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LColor   : TColor;
  LRValue  : Byte;
  LGValue  : Byte;
  LBValue  : Byte;
  LIndent  : String;
  LStrHTML : string;
begin
  Memo1.Lines.Clear;
  Memo1.Lines.BeginUpdate;
  LColor := Panel1.Color;

  Memo1.Lines.Add('COLOR Value   : ' + IntToStr(LColor));
  Memo1.Lines.Add('COLOR HEX     : $' + IntToHex(LColor, 8));
  Memo1.Lines.Add('ColorToString : ' + ColorToString(LColor));
  ColorToIdent(LColor, LIndent);
  Memo1.Lines.Add('ColoToIdent   : ' + LIndent);

  LRValue  := GetRValue(LColor);
  LGValue  := GetGValue(LColor);
  LBValue  := GetBValue(LColor);
  LStrHTML := Format('#%.2x%.2x%.2x', [LRValue, LGValue, LBValue]);
  Memo1.Lines.Add('HTML RGB      : ' +  LStrHTML);
  Memo1.Lines.Add('WebColorName  : ' + ColorToWebColorName(LColor));

  ButtonColor1.SymbolColor := LColor;
  Memo1.Lines.EndUpdate;
end;

//=============================================================================
//  カラーダイアログを表示して色を設定
//  TColorの値をR,G,Bの各値に変換(分解)する例
//
//   TButtonColorは[TeeChartStd]タブにあるTTCharrのコンポーネント
//=============================================================================
procedure TForm1.ButtonColor1Click(Sender: TObject);
var
  LRValue : Byte;
  LGValue : Byte;
  LBValue : Byte;
begin
  //カラーダイアログで設定した値を設定した色の値とする
  Panel1.Color := ButtonColor1.SymbolColor;

  //TColorの値からR,G,Bの値を取得
  LRValue := GetRValue(Panel1.Color);
  LGValue := GetGValue(Panel1.Color);
  LBValue := GetBValue(Panel1.Color);

  //TScrollBarの位置を各R,G,Bの値と同じにする
  ScrollBar1.Position := LRValue;
  ScrollBar2.Position := LGValue;
  ScrollBar3.Position := LBValue;

  DisplayColorValues;
  Button1Click(nil);
end;

//=============================================================================
//  ScrollBar1のOnChangeイベント処理
//  R,G,Bの各値からTColorを取得する例
//
//  ScrollBar1,ScrollBar2,ScrollBar3共有イベント
//=============================================================================
procedure TForm1.ScrollBar1Change(Sender: TObject);
var
  LRValue : Byte;
  LGValue : Byte;
  LBValue : Byte;
begin
  //各ScrollBoxの値をR,G,Bの値とする
  LRValue := ScrollBar1.Position;
  LGValue := ScrollBar2.Position;
  LBValue := ScrollBar3.Position;

  //R,G,Bの各値からTColorの値を取得する
  //戻り値はCOLORREF(符号なし32ビット整数)
  //TColorでキャストしなくてもTColorの値として取得可能
  Panel1.Color := RGB(LRValue, LGValue, LBValue);

  DisplayColorValues;
  Button1Click(nil);
end;

//-----------------------------------------------------------------------------
//  各R(赤),G(緑),B(青)の値をTLabelに表示する
//-----------------------------------------------------------------------------
procedure TForm1.DisplayColorValues;
begin
  Label1.Caption := Format('%3d', [ScrollBar1.Position]);
  Label2.Caption := Format('%3d', [ScrollBar2.Position]);
  Label3.Caption := Format('%3d', [ScrollBar3.Position]);
end;

end.


ウィンドウ等の色は，システムカラーと呼ばれる色となっています．
Windows 7 の場合，デスクトップのポップアップメニューから [個人設定] で [ウィンドウの色] をクリックします．切替わったダイアログで [デザインの詳細設定] クリックで現れる [ウィンドウの色とデザイン] のダイアログで設定する色のことです．この [ウィンドウの色とデザイン] のダイアログは，次のコマンドでも表示できます．

この設定は Windwos 8, 8.1 にはありません．変更するにはレジストリの操作が必要です．


%SystemRoot%\System32\control.exe COLOR


図22
[ウィンドウの色とデザイン] の設定ダイアログ
  • Windwos 8, 8.1 にはない
  • ここでの設定色はシステムカラーと呼ばれる

これらの定数名で色を設定すると，Windows のバージョンや，システム関係の色を変更すると変わってしまいます．そこで，これらの値と色を確認するプログラムを作成してみました．

これらの色は，SetSysColors 関数で設定できます．[S02] [01-01_デスクトップの背景色の変更] に設定のサンプルがあります．システムカラーの Windwos の色定数の説明は，MSDN の GetSysColor 関数の記事に一覧があります．



図23
システムカラーの色を確認
  • 色の定数名があるので表示されている

リスト11
システムカラーの色を確認するためのプログラム		 
unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Panel1: TPanel;
    ListBox1: TListBox;
    procedure FormShow(Sender: TObject);
    procedure ListBox1Click(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

//=============================================================================
//  フォーム表示開始時の処理
//  TListBoxにシステムカラーの値をセット
//  値は，Delphi XE(UP1)のGraphics.pasで定義されているもの
//=============================================================================
procedure TForm1.FormShow(Sender: TObject);
begin
  //この設定がないと色は変化しない
  Panel1.ParentBackground := False;
  Panel1.Caption := '';

  with ListBox1.Items do begin
    AddObject('clScrollBar',               TObject(clScrollBar));
    AddObject('clBackground',              TObject(clBackground));
    AddObject('clActiveCaption',           TObject(clActiveCaption));
    AddObject('clInactiveCaption',         TObject(clInactiveCaption));
    AddObject('clMenu',                    TObject(clMenu));
    AddObject('clWindow',                  TObject(clWindow));
    AddObject('clWindowFrame',             TObject(clWindowFrame));
    AddObject('clMenuText',                TObject(clMenuText));
    AddObject('clWindowText',              TObject(clWindowText));
    AddObject('clCaptionText',             TObject(clCaptionText));
    AddObject('clActiveBorder',            TObject(clActiveBorder));
    AddObject('clInactiveBorder',          TObject(clInactiveBorder));
    AddObject('clAppWorkSpace',            TObject(clAppWorkSpace));
    AddObject('clHighlight',               TObject(clHighlight));
    AddObject('clHighlightText',           TObject(clHighlightText));
    AddObject('clBtnFace',                 TObject(clBtnFace));
    AddObject('clBtnShadow',               TObject(clBtnShadow));
    AddObject('clGrayText',                TObject(clGrayText));
    AddObject('clBtnText',                 TObject(clBtnText));
    AddObject('clInactiveCaptionText',     TObject(clInactiveCaptionText));
    AddObject('clBtnHighlight',            TObject(clBtnHighlight));
    AddObject('cl3DDkShadow',              TObject(cl3DDkShadow));
    AddObject('cl3DLight',                 TObject(cl3DLight));
    AddObject('clInfoText',                TObject(clInfoText));
    AddObject('clInfoBk',                  TObject(clInfoBk));
    AddObject('clHotLight',                TObject(clHotLight));
    AddObject('clGradientActiveCaption',   TObject(clGradientActiveCaption));
    AddObject('clGradientInactiveCaption', TObject(clGradientInactiveCaption));
    AddObject('clMenuHighlight',           TObject(clMenuHighlight));
    AddObject('clMenuBar',                 TObject(clMenuBar));
  end;
end;

//=============================================================================
//  ListBox1のOnClickイベント処理
//=============================================================================
procedure TForm1.ListBox1Click(Sender: TObject);
var
  LIndex : Integer;
  LColor : TColor;
begin
  LIndex := ListBox1.ItemIndex;
  if LIndex < 0 then exit;

  LColor := Integer(ListBox1.Items.Objects[LIndex]);
  Panel1.Color := LColor;
end;

end.



08_16 色 ( 4 ビット色 ) のビットマップのピクセル操作の例


本ページのサンプルでは 256 色のビットマップを扱っていますが，同様のコードで 16 色 (4 ビット) のビットマップ画像も処理できます．ただし，ページの最初で説明しているように，4 ビットのビットマップでは，1 バイトに 2 ピクセル (画素) 分のデータが格納されていることに注意します．

4 ビットのビットマップのデータは 1 バイトに 2 ピクセル分格納されていますから，別の 4 ビットのビットマップに転送する時はピクセル数の半分のバイト数を転送します．そのようにしたのが以下のコードです．
このサンプルではパレットの操作，つまり色の変更もサイズも変更していません．したがって，当然ですが，実際には単に Assign するだけでも同じです．



図24
実行結果
  • 左の元のビットマップは 128 x 128 の 16 色

リスト12
16 色 ( 4 ビット色 ) のピクセル操作の例		 
//=============================================================================
//  4ビット(16色)ビットマップの転送例
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LSrcBitmap    : TBitmap;
  LDstBitmap    : TBitmap;
  LSrcScanArray : PByteArray;
  LDstScanArray : PByteArray;
  LPosX         : Integer;
  LPosY         : Integer;
begin
  Image1.Transparent := True;
  Image2.Transparent := True;

  Image1.Picture.Assign(nil);
  Image2.Picture.Assign(nil);

  LSrcBitmap := TBitmap.Create;
  LDstBitmap := TBitmap.Create;
  try
    //16色のビットマップ画像を読み込んでTImageに表示
    LSrcBitmap.LoadFromFile('503.bmp');
    Image1.Picture.Assign(LSrcBitmap);

    //16色のビットマップを生成
    LDstBitmap.PixelFormat := pf4bit;
    LDstBitmap.Width       := LSrcBitmap.Width;
    LDstBitmap.Height      := LSrcBitmap.Height;

    //転送先のビットマップのパレットを，転送元のパレットと同じにする
    LDstBitmap.Palette := LSrcBitmap.Palette;

    //ピクセル操作でコピー
    for LPosY := 0 to LSrcBitmap.Height - 1 do begin
      LSrcScanArray := LSrcBitmap.ScanLine[LPosY];
      LDstScanArray := LDstBitmap.ScanLine[LPosY];
      for LPosX := 0 to LSrcBitmap.Width div 2 - 1 do begin
        LDstScanArray[LPosX] := LSrcScanArray[LPosX];
      end;
    end;
    Image2.Picture.Assign(LDstBitmap);
  finally
    FreeAndNil(LSrcBitmap);
    FreeAndNil(LDstBitmap);
  end;
end;